wcc-0.0.2/0000755000175000017500000000000013122010155010725 5ustar philphilwcc-0.0.2/Makefile0000644000175000017500000000163113110675433012403 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # CFLAGS := -W -Wall -Wno-discarded-qualifiers -Wno-int-conversion -Wno-unused-parameter -Wno-unused-function -Wno-unused-result -fpie -pie -fPIC -g3 -ggdb -I../../include -I./include/sflib/ -I./include -I../../include/ -Wno-incompatible-pointer-types -fstack-protector-all -Wl,-z,relro,-z,now -DPACKAGE -DPACKAGE_VERSION -masm=intel -rdynamic -D_fORTIFY_SOURCE=2 -O2 all: mkdir -p bin cd src && make CFLAGS=" $(CFLAGS)" documentation: cd src && doxygen ./tex/project.cfg cd doc/latex && make && cp refman.pdf ../WCC_internal_documentation.pdf clean: cd src && make clean rm -f ./bin/* clean-documentation: # rm -rf ./doc/html rm -rf ./doc/latex install: cd src && make install uninstall: cd src && make uninstall wcc-0.0.2/src/0000755000175000017500000000000013110675433011531 5ustar philphilwcc-0.0.2/src/tools/0000755000175000017500000000000013110675433012671 5ustar philphilwcc-0.0.2/src/tools/Makefile0000644000175000017500000000070013110675433014326 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # all:: cp wldd ../../bin/ cp wcch ../../bin/ test: clean: rm ../../bin/wldd -f rm ../../bin/wcch -f install: cp wldd $(DESTDIR)/usr/bin/wldd cp wcch $(DESTDIR)/usr/bin/wcch uninstall: rm $(DESTDIR)/usr/bin/wldd -f rm $(DESTDIR)/usr/bin/wcch -f wcc-0.0.2/src/tools/wcch0000755000175000017500000000004213110675433013537 0ustar philphil#!/usr/bin/wsh headers() exit(0) wcc-0.0.2/src/tools/wldd0000755000175000017500000000102613110675433013550 0ustar philphil#!/bin/bash # # wlld : This file is part of the Witchcraft Compiler Collection # # Copyright : Jonathan Brossard - endrazine@gmail.com # # This file is licensed under the MIT license # # version 0.01 Sun Jul 17 19:25:18 PDT 2016 # # usage () { echo "Usage: $0 " echo "" echo " Returns libraries to be passed to gcc to relink this application." echo "" exit } getlibs (){ ldd $1|grep "=> /"|awk '{print $1}'|sed s#"\..*"##|sed s#"^lib"#"-l"#|tr "\n" " " echo "" } if [ "$1" == "" ] then usage fi getlibs $1 wcc-0.0.2/src/Makefile0000644000175000017500000000123313110675433013170 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # all:: cd wcc && make CFLAGS=" $(CFLAGS)" cd wld && make CFLAGS=" $(CFLAGS)" cd wsh && make CFLAGS=" $(CFLAGS)" cd tools && make CFLAGS=" $(CFLAGS)" clean: cd wcc && make clean cd wld && make clean cd wsh && make clean cd tools && make clean install: cd wcc && make install cd wld && make install cd wsh && make install cd tools && make install uninstall: cd wcc && make uninstall cd wld && make uninstall cd wsh && make uninstall cd tools && make uninstall wcc-0.0.2/src/wcc/0000755000175000017500000000000013110675433012305 5ustar philphilwcc-0.0.2/src/wcc/wcc.c0000644000175000017500000026425213110675433013240 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #define __USE_GNU #define _GNU_SOURCE #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define DEFAULT_STRNDX_SIZE 4096 // Valid flags for msec_t->flags #define FLAG_BSS 1 #define FLAG_NOBIT 2 #define FLAG_NOWRITE 4 #define FLAG_TEXT 8 #define ifis(x) if(!strncmp(name, x, strlen(x))) #define elis(x) else if(!strncmp(name, x, strlen(x))) #define EXTRA_CREATED_SECTIONS 4 #define RELOC_X86_64 1 #define RELOC_X86_32 2 //#ifdef __x86_64__ #ifdef __LP64__ // Generic 64b #define Elf_Ehdr Elf64_Ehdr #define Elf_Shdr Elf64_Shdr #define Elf_Sym Elf64_Sym #define Elf_Addr Elf64_Addr #define Elf_Sword Elf64_Sxword #define Elf_Section Elf64_Half #define ELF_ST_BIND ELF64_ST_BIND #define ELF_ST_TYPE ELF64_ST_TYPE #define Elf_Rel Elf64_Rel #define Elf_Rela Elf64_Rela #define ELF_R_SYM ELF64_R_SYM #define ELF_R_TYPE ELF64_R_TYPE #define ELF_R_INFO ELF64_R_INFO #define Elf_Phdr Elf64_Phdr #define Elf_Xword Elf64_Xword #define Elf_Word Elf64_Word #define Elf_Off Elf64_Off #define ELFCLASS ELFCLASS64 #define ELFMACHINE EM_X86_64 #define CS_MODE CS_MODE_64 #define RELOC_MODE RELOC_X86_64 #else // Generic 32b #define Elf_Ehdr Elf32_Ehdr #define Elf_Shdr Elf32_Shdr #define Elf_Sym Elf32_Sym #define Elf_Addr Elf32_Addr #define Elf_Sword Elf64_Sword #define Elf_Section Elf32_Half #define ELF_ST_BIND ELF32_ST_BIND #define ELF_ST_TYPE ELF32_ST_TYPE #define Elf_Rel Elf32_Rel #define Elf_Rela Elf32_Rela #define ELF_R_SYM ELF32_R_SYM #define ELF_R_TYPE ELF32_R_TYPE #define ELF_R_INFO ELF32_R_INFO #define Elf_Phdr Elf32_Phdr #define Elf_Xword Elf32_Xword #define Elf_Word Elf32_Word #define Elf_Off Elf32_Off #define ELFCLASS ELFCLASS32 #define ELFMACHINE EM_386 #define CS_MODE CS_MODE_32 #define RELOC_MODE RELOC_X86_32 #endif #define nullstr "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" unsigned int maxoldsec = 0, maxnewsec = 0; unsigned int deltastrtab = 0; char *allowed_sections[] = { ".rodata", ".data", ".text", ".load", ".strtab", ".symtab", ".comment", ".note.GNU-stack", ".rsrc", ".bss", // ".rela.plt", // ".rela.dyn" }; char *blnames[] = { "__init_array_start", "__init_array_end", "__libc_csu_init", "__libc_csu_fini", "__x86.get_pc_thunk.bx", // this is 32b only ".bss", ".comment", ".data", ".dynamic", ".fini", ".fini_array", ".got", ".got.plt", ".init", ".init_array", ".jcr", ".plt", ".plt.got", ".text", "__GNU_EH_FRAME_HDR", "__FRAME_END__", ".interp", ".note.ABI-tag", ".note.gnu.build-id", ".gnu.hash", ".dynsym", ".dynstr", ".gnu.version", ".gnu.version_r", ".rela.dyn", ".rela.plt", ".rodata", ".eh_frame_hdr", ".eh_frame", "_ITM_registerTMCloneTable", "_ITM_deregisterTMClone", "_ITM_deregisterTMCloneTab", "_Jv_RegisterClasses", "_ITM_registerTMCloneTa", "__cxa_finalize", "_DYNAMIC", "_GLOBAL_OFFSET_TABLE_", "__JCR_END__", "__JCR_LIST__", "__TMC_END__", "__bss_start", "__data_start", "_IO_stdin_used", "__do_global_dtors_aux", "__do_global_dtors_aux_fini_array_entry", "__dso_handle", "__frame_dummy_init_array_entry", "__libc_csu_fini", "_edata", "_end", "_fini", "__fini", "_init", "_start", "data_start", "deregister_tm_clones", "frame_dummy", "register_tm_clones", //"__libc_start_main", "__gmon_start__" }; /** * Meta section header */ typedef struct msec_t { char *name; unsigned long int len; unsigned char *data; unsigned long int outoffset; unsigned int flags; // See above asection *s_bfd; Elf_Shdr *s_elf; struct msec_t *prev; // utlist.h struct msec_t *next; // utlist.h } msec_t; /** * Meta segment header */ typedef struct mseg_t { Elf_Word p_type; Elf_Word p_flags; Elf_Off p_offset; // Segment file offset Elf_Addr p_vaddr; // Segment virtual address Elf_Addr p_paddr; // Segment physical address Elf_Xword p_filesz; // Segment size in file Elf_Xword p_memsz; // Segment size in memory Elf_Xword p_align; // Segment alignment, file & memory struct msec_t *prev; // utlist.h struct msec_t *next; // utlist.h } mseg_t; typedef struct ctx_t { /** * Internal options */ char *binname; unsigned int archsz; // Architecture size (64 or 32) unsigned int shnum; unsigned int phnum; // Number of program headers char *strndx; // pointer to section string table in memory unsigned int strndx_len; // length of section string table in bytes unsigned int strndx_index; // offset of sections string table in binary unsigned int start_shdrs; // Offset of section headers in output binary unsigned int start_phdrs; // Offset of Program headers in output binary int fdout; bfd *abfd; unsigned int corefile; // 1 if file is a core file unsigned int base_address; // VMA Address of first PT_LOAD segment in memory // Meta section headers (double linked list) msec_t *mshdrs; unsigned int mshnum; // Meta segment headers (double linked list) mseg_t *mphdrs; unsigned int mphnum; unsigned int has_relativerelocations; // 1 if binary has relative relocations (R_X86_64_RELATIVE) /** * User options */ char *opt_binname; char *opt_interp; unsigned int opt_arch; unsigned int opt_static; unsigned int opt_reloc; unsigned int opt_strip; unsigned int opt_sstrip; unsigned int opt_exec; unsigned int opt_core; unsigned int opt_shared; unsigned int opt_verbose; unsigned long int opt_entrypoint; unsigned char opt_poison; unsigned int opt_original; unsigned int opt_debug; unsigned int opt_asmdebug; unsigned int opt_flags; // used in setting eabi } ctx_t; /** * Forwardd prototypes declarations */ int craft_section(ctx_t * ctx, msec_t * m); unsigned int secindex_from_name(ctx_t * ctx, const char *name); msec_t *section_from_name(ctx_t * ctx, char *name); msec_t *section_from_addr(ctx_t * ctx, unsigned long int addr); int print_bfd_sections(ctx_t * ctx); unsigned int secindex_from_name(ctx_t * ctx, const char *name); msec_t *section_from_index(ctx_t * ctx, unsigned int index); unsigned int secindex_from_name_after_strip(ctx_t * ctx, const char *name); int analyze_text(ctx_t * ctx, char *data, unsigned int datalen, unsigned long int addr); int save_reloc(ctx_t * ctx, Elf_Rela * r, unsigned int sindex, int has_addend); /** * Globals */ char *globalsymtab = 0; int globalsymtablen = 0; unsigned int globalsymtableoffset = 0; char *globalstrtab = 0; unsigned int globalstrtablen = 0; unsigned int globalstrtableoffset = 0; unsigned int globalsymindex = 0; char *globalreloc = 0; unsigned int globalreloclen = 0; unsigned int globalrelocoffset = 0; unsigned long int mintext = -1; unsigned long int maxtext = 0; unsigned long int textvma = 0; unsigned long int mindata = -1; unsigned long int maxdata = 0; unsigned long int datavma = 0; unsigned long int orig_text = 0; unsigned long int orig_sz = 0; /** * Convert BFD permissions into regular octal perms */ static int parse_bfd_perm(int perm) { int heal_perm = 0; heal_perm |= (perm & SEC_CODE ? 1 : 0); heal_perm |= (perm & SEC_DATA ? 2 : 0); heal_perm |= (perm & SEC_ALLOC ? 4 : 0); heal_perm = (perm & SEC_READONLY ? heal_perm : 4); return heal_perm; } /** * Convert octal permissions into permissions consumable by mprotect() */ unsigned int protect_perms(unsigned int perms) { unsigned int memperms = 0; switch (perms) { case 7: memperms = PROT_READ | PROT_WRITE | PROT_EXEC; break; case 6: memperms = PROT_READ; break; case 5: memperms = PROT_READ | PROT_EXEC; break; case 4: memperms = PROT_READ | PROT_WRITE; break; default: memperms = 0; break; } return memperms; } struct symaddr { struct symaddr *next; char *name; int addr; } *symaddrs; /* typedef struct { Elf_Word st_name; unsigned char st_info; unsigned char st_other; Elf_Half st_shndx; Elf_Addr st_value; Elf_Xword st_size; } Elf_Sym; */ void add_symaddr(ctx_t * ctx, const char *name, int addr, char symclass) { struct symaddr *sa; Elf_Sym *s = 0; unsigned long int nameptr = 0; unsigned int i; if (*name == '\0') return; // search this address in symbol table : duplicates here trigger a NULL ptr dereference in ld for (i = 0; i < globalsymtablen / sizeof(Elf_Sym); i++) { s = (Elf_Sym *) (globalsymtab + i * sizeof(Elf_Sym)); // if ((s->st_value == addr - textvma) && (s->st_value != 0)) { return; // already in symtab } } // check if name is in blacklist for (i = 0; i < sizeof(blnames) / sizeof(char *); i++) { if ((strlen(name) == strlen(blnames[i])) && (!strncmp(name, blnames[i], strlen(blnames[i])))) { return; } } sa = (struct symaddr *) malloc(sizeof(struct symaddr)); memset(sa, 0, sizeof(struct symaddr)); sa->name = strdup(name); sa->addr = addr; sa->next = symaddrs; symaddrs = sa; if (ctx->opt_verbose) { printf("%-20s\t\t%x\t\t%c\n", sa->name, sa->addr, symclass); } /** * Append name to global string table */ if (globalstrtab == 0) { globalstrtab = calloc(1, strlen(sa->name) + 3); globalstrtablen++; // Start with a null byte } else { globalstrtab = realloc(globalstrtab, globalstrtablen + strlen(sa->name) + 2); } memcpy(globalstrtab + globalstrtablen, sa->name, strlen(sa->name) + 1); nameptr = globalstrtablen; globalstrtablen += strlen(sa->name) + 1; /** * Append symbol to global symbol table */ if (globalsymtab == 0) { globalsymtab = calloc(1, sizeof(Elf_Sym) * 2); globalsymtablen += sizeof(Elf_Sym); // Skip 1 NULL entry } else { globalsymtab = realloc(globalsymtab, sizeof(Elf_Sym) + globalsymtablen); } s = (Elf_Sym *) (globalsymtab + globalsymtablen); s->st_name = nameptr; s->st_size = 100; // default function size... (in bytes) s->st_value = addr; s->st_info = 0; s->st_other = 0; s->st_shndx = 0; switch (symclass) { case 'T': case 't': case 'C': case 'c': // s->st_value = addr; ; // adjust value from vma msec_t *t = section_from_name(ctx, ".text"); // s->st_value -= t->s_elf->sh_addr; if (ctx->opt_reloc) { s->st_value -= t->s_bfd->vma; //s->st_value -= orig_text; s->st_shndx = 1; // index to .text } s->st_info = STT_FUNC; break; case 'D': case 'd': case 'B': case 'b': case 'V': case 'v': ; // adjust value from vma // msec_t *t2 = section_from_addr(ctx, s->st_value); // s->st_value -= t2->s_bfd->vma; s->st_info = STT_OBJECT; break; case 'A': case 'a': s->st_info = STT_FILE; break; case 'R': case 'r': s->st_size = 0; s->st_info = STT_SECTION; break; default: break; } if (isupper(symclass)) { s->st_info += 0x10; } globalsymtablen += sizeof(Elf_Sym); return; } /** * Add extra symbols */ int add_extra_symbols(ctx_t * ctx) { add_symaddr(ctx, "old_plt", textvma, 0x54); add_symaddr(ctx, "old_text", orig_text, 0x54); add_symaddr(ctx, "old_text_end", orig_text + maxtext - mintext, 0x54); return 0; } /** * Read symbol table. * This is a two stages process : allocate the table, then read it */ int rd_symbols(ctx_t * ctx) { long storage_needed; asymbol **symbol_table = NULL; long number_of_symbols; long i; int ret = 0; const char *sym_name; int symclass; int sym_value; if (ctx->opt_verbose) { printf("\n\n -- Reading symbols\n\n"); printf(" Symbol\t\t\t\taddress\t\tclass\n"); printf(" -----------------------------------------------------\n"); } /** * Process symbol table */ storage_needed = bfd_get_symtab_upper_bound(ctx->abfd); if (storage_needed < 0) { bfd_perror("warning: bfd_get_symtab_upper_bound"); ret = 0; goto dynsym; } if (storage_needed == 0) { fprintf(stderr, "warning: no symbols\n"); goto dynsym; } symbol_table = (asymbol **) malloc(storage_needed); number_of_symbols = bfd_canonicalize_symtab(ctx->abfd, symbol_table); if (number_of_symbols < 0) { bfd_perror("warning: bfd_canonicalize_symtab"); ret = 0; goto dynsym; } for (i = 0; i < number_of_symbols; i++) { asymbol *asym = symbol_table[i]; sym_name = bfd_asymbol_name(asym); symclass = bfd_decode_symclass(asym); sym_value = bfd_asymbol_value(asym); if (*sym_name == '\0') { continue; } if (bfd_is_undefined_symclass(symclass)) { continue; } if (!ctx->opt_strip) { // process additional symbols from symbol table add_symaddr(ctx, sym_name, sym_value, symclass); } } /** * Process dynamic symbol table */ dynsym: if (symbol_table) { free(symbol_table); } symbol_table = NULL; storage_needed = bfd_get_dynamic_symtab_upper_bound(ctx->abfd); if (storage_needed < 0) { bfd_perror("warning: bfd_get_dynamic_symtab_upper_bound"); ret = 0; goto out; } if (storage_needed == 0) { fprintf(stderr, "warning: no symbols\n"); goto out; } symbol_table = (asymbol **) malloc(storage_needed); number_of_symbols = bfd_canonicalize_dynamic_symtab(ctx->abfd, symbol_table); if (number_of_symbols < 0) { bfd_perror("warning: bfd_canonicalize_symtab"); ret = 0; goto dynsym; } for (i = 0; i < number_of_symbols; i++) { asymbol *asym = symbol_table[i]; sym_name = bfd_asymbol_name(asym); symclass = bfd_decode_symclass(asym); sym_value = bfd_asymbol_value(asym); if (*sym_name == '\0') { continue; } if (bfd_is_undefined_symclass(symclass)) { continue; } } out: if (symbol_table) { free(symbol_table); } if (ctx->opt_verbose) { printf("\n"); } return ret; } /** * Return section entry size from name */ int entszfromname(const char *name) { unsigned int i = 0; for (i = 0; i < sizeof(nametosize) / sizeof(assoc_nametosz_t); i++) { if (!strncmp(nametosize[i].name, name, strlen(name))) { return nametosize[i].sz; } } return 0; } /** * Return max of two unsigned integers */ unsigned int max(unsigned int a, unsigned int b) { return a < b ? b : a; } /** * Return a section from its name */ msec_t *section_from_name(ctx_t * ctx, char *name) { msec_t *s; DL_FOREACH(ctx->mshdrs, s) { if (!strncmp(s->name, name, max(strlen(name), strlen(s->name)))) { return s; } } return 0; } /** * Return a section from its address */ msec_t *section_from_addr(ctx_t * ctx, unsigned long int addr) { msec_t *s; DL_FOREACH(ctx->mshdrs, s) { if ((s->s_bfd->vma) && (s->s_bfd->vma <= addr) && (s->s_bfd->vma + s->s_bfd->size > addr)) { return s; } } return 0; } /** * Return a section from its index */ msec_t *section_from_index(ctx_t * ctx, unsigned int index) { msec_t *s; unsigned int i = 1; // We count from 1 DL_FOREACH(ctx->mshdrs, s) { if (index == i) { return s; } i++; } return 0; } /** * Return a section index from its name */ unsigned int secindex_from_name(ctx_t * ctx, const char *name) { msec_t *s; unsigned int i = 1; // We count from 1 DL_FOREACH(ctx->mshdrs, s) { if (!strncmp(s->name, name, max(strlen(name), strlen(s->name)))) { return i; } i++; } return 0; } /** * Return a section index (after strip) from its name */ unsigned int secindex_from_name_after_strip(ctx_t * ctx, const char *name) { msec_t *s; unsigned int i = 1; // We count from 1 unsigned int j; DL_FOREACH(ctx->mshdrs, s) { if (!strncmp(s->name, name, max(strlen(name), strlen(s->name)))) { return i; } for (j = 0; j < sizeof(allowed_sections) / sizeof(char *); j++) { if (!strncmp(s->name, allowed_sections[j], strlen(allowed_sections[j]))) { i++; // Ok, this section is allowed break; } } } return 0; } char *sec_name_from_index_after_strip(ctx_t * ctx, unsigned int index) { msec_t *s; unsigned int i = 0; unsigned int j; DL_FOREACH(ctx->mshdrs, s) { for (j = 0; j < sizeof(allowed_sections) / sizeof(char *); j++) { if (!strncmp(s->name, allowed_sections[j], strlen(allowed_sections[j]))) { i++; // Ok, this section is allowed break; } } if (i == index) { return s->name; } } return NULL; } /** * Return a section link from its name */ int link_from_name(ctx_t * ctx, const char *name) { unsigned int i = 0; char *destsec = 0; unsigned int d = 0; for (i = 0; i < sizeof(nametolink) / sizeof(assoc_nametolink_t); i++) { if (!strncmp(nametolink[i].name, name, strlen(name))) { destsec = nametolink[i].dst; } } if (!destsec) { return 0; } d = secindex_from_name(ctx, destsec); return d; } /** * Return a section info from its name */ int info_from_name(ctx_t * ctx, const char *name) { unsigned int i = 0; char *destsec = 0; unsigned int d = 0; for (i = 0; i < sizeof(nametoinfo) / sizeof(assoc_nametoinfo_t); i++) { if (!strncmp(nametoinfo[i].name, name, strlen(name))) { destsec = nametoinfo[i].dst; } } if (!destsec) { return 0; } d = secindex_from_name(ctx, destsec); return d; } /** * Return a section type from its name */ int typefromname(const char *name) { unsigned int i = 0; for (i = 0; i < sizeof(nametotype) / sizeof(assoc_nametotype_t); i++) { if (!strncmp(nametotype[i].name, name, strlen(name))) { return nametotype[i].type; } } return SHT_PROGBITS; } /** * Return a section alignment from its name */ unsigned int alignfromname(const char *name) { unsigned int i = 0; for (i = 0; i < sizeof(nametoalign) / sizeof(assoc_nametoalign_t); i++) { if (!strncmp(nametoalign[i].name, name, strlen(name))) { return nametoalign[i].alignment; } } return 8; } /** * Return Segment ptype */ unsigned int ptype_from_section(msec_t * ms) { // Return type based on section name if (!strncmp(ms->name, ".interp", 7)) { return PT_INTERP; } if (!strncmp(ms->name, ".dynamic", 8)) { return PT_DYNAMIC; } if (!strncmp(ms->name, ".eh_frame_hdr", 13)) { return PT_GNU_EH_FRAME; } switch (ms->s_elf->sh_type) { case SHT_NULL: return PT_NULL; case SHT_PROGBITS: return PT_LOAD; case SHT_NOTE: return PT_NOTE; case SHT_DYNAMIC: return PT_DYNAMIC; case SHT_SYMTAB: case SHT_STRTAB: case SHT_RELA: case SHT_HASH: case SHT_NOBITS: case SHT_REL: case SHT_SHLIB: case SHT_DYNSYM: case SHT_NUM: case SHT_LOSUNW: case SHT_GNU_verdef: case SHT_GNU_verneed: case SHT_GNU_versym: default: break; } return PT_LOAD; } /** * Return Segment flags based on a section */ unsigned int pflag_from_section(msec_t * ms) { unsigned int dperms = 0; dperms = 0; switch (ms->s_elf->sh_flags) { case SHF_ALLOC | SHF_WRITE | SHF_EXECINSTR: dperms = PF_R | PF_W | PF_X; // "rwx"; break; case SHF_ALLOC: dperms = PF_R; //"r--"; break; case SHF_ALLOC | SHF_EXECINSTR: dperms = PF_R | PF_X; // "r-x"; break; case SHF_ALLOC | SHF_WRITE: dperms = PF_R | PF_W; // "rw-" break; default: dperms = 0; // "---" break; } return dperms; } /** * Helper sort routine for ELF Phdrs (pre-merge) */ int phdr_cmp_premerge(mseg_t * a, mseg_t * b) { if (a->p_type != b->p_type) { return a->p_type - b->p_type; } // Sort by type return a->p_vaddr - b->p_vaddr; // else by vma } /** * Helper sort routine for ELF Phdrs */ int phdr_cmp(mseg_t * a, mseg_t * b) { return a->p_vaddr - b->p_vaddr; // This is correct, see elf.pdf } /** * Reorganise Program Headers : * sort by p_offset */ int sort_phdrs(ctx_t * ctx) { DL_SORT(ctx->mphdrs, phdr_cmp); return 0; } /** * Helper sort routine for ELF Phdrs */ int sort_phdrs_premerge(ctx_t * ctx) { DL_SORT(ctx->mphdrs, phdr_cmp_premerge); return 0; } /** * Allocate Phdr */ mseg_t *alloc_phdr(msec_t * ms) { mseg_t *p; Elf_Shdr *s; s = ms->s_elf; p = calloc(1, sizeof(mseg_t)); p->p_type = ptype_from_section(ms); p->p_flags = pflag_from_section(ms); p->p_offset = s->sh_offset; p->p_vaddr = s->sh_addr; p->p_paddr = s->sh_addr; p->p_filesz = s->sh_size; p->p_memsz = s->sh_size; p->p_align = s->sh_addralign; return p; } /** * Create Program Headers based on ELF section headers */ int create_phdrs(ctx_t * ctx) { msec_t *ms, *tmp; mseg_t *p = 0; DL_FOREACH_SAFE(ctx->mshdrs, ms, tmp) { p = alloc_phdr(ms); if (p->p_type == PT_LOAD) { unsigned int r = 0; // reminder p->p_align = 0x200000; // We need to align segment p_vaddr - p_offset on page boundaries r = (p->p_vaddr - p->p_offset) % 4096; p->p_vaddr -= r; // Adjust initial address p->p_paddr -= r; // Adjust initial address p->p_filesz += r; // Adjust size p->p_memsz += r; // Adjust size } if (p->p_flags) { // Add to linked list of segments DL_APPEND(ctx->mphdrs, p); ctx->mphnum++; ctx->phnum++; } else { // Sections not mapped have no segment free(p); } } return 0; } /** * Merge two consecutive Phdrs if: * - their vma ranges overlap * - Permissions match * - Type of segment matches * * Note: assume phdrs have been sorted by increasing p_vaddr first */ int merge_phdrs(ctx_t * ctx) { mseg_t *ms, *n; retry: ms = ctx->mphdrs; while (ms) { if (ms->next) { n = (mseg_t *) ms->next; if (ms->p_flags != n->p_flags) { goto skipseg; } if (ms->p_type != n->p_type) { goto skipseg; } // merge sections into the first one : // extend section ms->p_filesz = n->p_filesz + (n->p_offset - ms->p_offset); ms->p_memsz = ms->p_memsz + (n->p_offset - ms->p_offset); // unlink deleted section from double linked list if (n->next) { n->next->prev = (void *) ms; } ms->next = n->next; free(n); ctx->mphnum--; ctx->phnum--; goto retry; } skipseg: ms = (mseg_t *) ms->next; } return 0; } int adjust_baseaddress(ctx_t * ctx) { mseg_t *ms; // find base address (first allocated PT_LOAD chunk) ms = ctx->mphdrs; while (ms) { if ((ms->p_type == PT_LOAD) && (ms->p_flags == (PF_R))) { if (ctx->base_address > (ms->p_vaddr & ~0xfff)) { ctx->base_address = ms->p_vaddr & ~0xfff; } } ms = (mseg_t *) ms->next; } if (ctx->base_address == 0) { ctx->base_address = ctx->mphdrs->p_vaddr & ~0xfff; } if (ctx->opt_debug) { printf("\n * first loadable segment at: 0x%x\n", ctx->base_address); } // patch load address of first chunk PT_LOAD allocated RX ms = ctx->mphdrs; while (ms) { if ((ms->p_type == PT_LOAD) && (ms->p_flags == (PF_R | PF_X))) { if (ctx->opt_debug) { printf (" -- patching base load address of first PT_LOAD Segment: %lu -->> %u\n", ms->p_vaddr, ctx->base_address); } ms->p_vaddr = ctx->base_address; ms->p_paddr = ctx->base_address; ms->p_memsz += ms->p_offset; ms->p_filesz += ms->p_offset; ms->p_offset = 0; break; } ms = (void *) ms->next; } return 0; } /** * Read Program Headers from disk */ static unsigned int rd_phdrs(ctx_t * ctx) { struct stat sb; char *p; int fdin; Elf_Ehdr *e = 0; unsigned int i = 0; int nread; Elf_Phdr *phdr, *eph; if (stat(ctx->binname, &sb) == -1) { perror("stat"); exit(EXIT_FAILURE); } p = calloc(1, sb.st_size); fdin = open(ctx->binname, O_RDONLY); if (fdin <= 0) { perror("open"); exit(-1); } nread = read(fdin, p, sb.st_size); if (nread != sb.st_size) { perror("read"); exit(EXIT_FAILURE); } close(fdin); printf(" -- read: %u bytes\n", nread); e = (Elf_Ehdr *) p; phdr = (Elf_Phdr *) (p + e->e_phoff); eph = phdr + e->e_phnum; for (; phdr < eph; phdr++) { // Add to linked list // Create Meta section mseg_t *ms = calloc(1, sizeof(mseg_t)); if (!ms) { perror("calloc"); exit(EXIT_FAILURE); } memcpy(ms, phdr, sizeof(Elf_Phdr)); // Add to double linked list of msec_t Meta sections DL_APPEND(ctx->mphdrs, ms); ctx->mphnum++; ctx->phnum++; i++; } printf(" -- Original: %u\n", i); return 0; } /** * Create Program Headers from Sections */ static unsigned int mk_phdrs(ctx_t * ctx) { /** * Create a segment per section */ create_phdrs(ctx); /** * Sort segments for merging */ sort_phdrs_premerge(ctx); /** * Merge segments with overlapping/consecutive memory chunks */ merge_phdrs(ctx); sort_phdrs(ctx); adjust_baseaddress(ctx); sort_phdrs(ctx); // Need to resort after patching merge_phdrs(ctx); sort_phdrs(ctx); // Need to resort after patching return 0; } /** * Write Program Headers to disk */ static unsigned int write_phdrs(ctx_t * ctx) { unsigned int tmpm = 0; // Goto end of file, align on 8 bytes boundaries tmpm = lseek(ctx->fdout, 0x00, SEEK_END); write(ctx->fdout, nullstr, 20); if ((tmpm % 8) == 0) { tmpm += 8; } tmpm &= ~0xf; tmpm += sizeof(Elf_Phdr); // Prepend NULL section ftruncate(ctx->fdout, tmpm); ctx->start_phdrs = lseek(ctx->fdout, 0x00, SEEK_END); ctx->phnum += 2; if (ctx->opt_verbose) { printf(" -- Writting %u segment headers\n", ctx->phnum); } // first entry is the program header itself Elf_Phdr *phdr = calloc(1, sizeof(Elf_Phdr)); phdr->p_vaddr = ctx->base_address; phdr->p_paddr = ctx->base_address; phdr->p_type = PT_PHDR; phdr->p_offset = ctx->start_phdrs; phdr->p_flags = 5; phdr->p_filesz = ctx->phnum * sizeof(Elf_Phdr); phdr->p_memsz = ctx->phnum * sizeof(Elf_Phdr); phdr->p_align = 8; write(ctx->fdout, phdr, sizeof(Elf_Phdr)); // Copy all the Phdrs mseg_t *p; DL_FOREACH(ctx->mphdrs, p) { write(ctx->fdout, p, sizeof(Elf_Phdr)); } // Append a Program Header for the stack phdr->p_vaddr = 0; phdr->p_paddr = 0; phdr->p_type = PT_GNU_STACK; phdr->p_offset = 0; phdr->p_flags = 3; phdr->p_filesz = 0; phdr->p_memsz = 0; phdr->p_align = 0x10; write(ctx->fdout, phdr, sizeof(Elf_Phdr)); return ctx->start_phdrs; } /** * Write Original Program Headers to disk */ static unsigned int write_phdrs_original(ctx_t * ctx) { unsigned int tmpm = 0; // Goto end of file, align on 8 bytes boundaries tmpm = lseek(ctx->fdout, 0x00, SEEK_END); write(ctx->fdout, nullstr, 20); if ((tmpm % 8) == 0) { tmpm += 8; } tmpm &= ~0xf; ftruncate(ctx->fdout, tmpm); ctx->start_phdrs = lseek(ctx->fdout, 0x00, SEEK_END); mseg_t *p; unsigned int i = 0; DL_FOREACH(ctx->mphdrs, p) { if (i == 0) { // First Phdr is the Program Header itself p->p_offset = ctx->start_phdrs; // Patch offset of Program header i = 1; } write(ctx->fdout, p, sizeof(Elf_Phdr)); } return ctx->start_phdrs; } msec_t *mk_section(void) { msec_t *ms; // allocate memory ms = calloc(1, sizeof(msec_t)); if (!ms) { perror("calloc"); exit(EXIT_FAILURE); } ms->s_elf = calloc(1, sizeof(Elf_Shdr)); if (!ms->s_elf) { perror("calloc"); exit(EXIT_FAILURE); } return ms; } static int write_strtab_and_reloc(ctx_t * ctx) { unsigned int tmpm = 0; if (ctx->opt_debug) { printf(" * .strtab length:\t\t\t%u\n", globalstrtablen); printf(" * .symtab length:\t\t\t%u\n", globalsymtablen); } // Goto end of file tmpm = lseek(ctx->fdout, 0x00, SEEK_END); write(ctx->fdout, nullstr, 20); // align on 8 bytes boundaries if ((tmpm % 8) == 0) { tmpm += 8; }; tmpm &= ~0xf; // truncate ftruncate(ctx->fdout, tmpm); // write relocations to binary tmpm = lseek(ctx->fdout, 0x00, SEEK_END); globalrelocoffset = tmpm; write(ctx->fdout, globalreloc, globalreloclen); // write string table to binary tmpm = lseek(ctx->fdout, 0x00, SEEK_END); globalstrtableoffset = tmpm; write(ctx->fdout, globalstrtab, globalstrtablen); // write symbol table to binary tmpm = lseek(ctx->fdout, 0x00, SEEK_END); globalsymtableoffset = tmpm; write(ctx->fdout, globalsymtab, globalsymtablen); return 0; } char *reloc_htype_x86_64(int thetype) { char *htype; switch (thetype) { case R_X86_64_NONE: htype = "R_X86_64_NONE"; break; case R_X86_64_64: htype = "R_X86_64_64"; break; case R_X86_64_32: htype = "R_X86_64_32"; break; case R_X86_64_32S: htype = "R_X86_64_32S"; break; case R_X86_64_PC32: htype = "R_X86_64_PC32"; break; case R_X86_64_GOT32: htype = "R_X86_64_GOT32"; break; case R_X86_64_PLT32: htype = "R_X86_64_PLT32"; break; case R_X86_64_COPY: htype = "R_X86_64_COPY"; break; case R_X86_64_GLOB_DAT: htype = "R_X86_64_GLOB_DAT"; break; case R_X86_64_JUMP_SLOT: htype = "R_X86_64_JUMP_SLOT"; break; case R_X86_64_RELATIVE: htype = "R_X86_64_RELATIVE"; break; case R_X86_64_GOTPCREL: htype = "R_X86_64_GOTPCREL"; break; case R_X86_64_16: htype = "R_X86_64_16"; break; case R_X86_64_PC16: htype = "R_X86_64_PC16"; break; case R_X86_64_8: htype = "R_X86_64_8"; break; case R_X86_64_PC8: htype = "R_X86_64_PC8"; break; case R_X86_64_NUM: htype = "R_X86_64_NUM"; break; default: htype = "Unknown"; break; } return htype; } char *reloc_htype_x86_32(int thetype) { char *htype; switch (thetype) { case R_386_NONE: htype = "R_386_NONE"; break; case R_386_32: htype = "R_386_32"; break; case R_386_PC32: htype = "R_386_PC32"; break; case R_386_GOT32: htype = "R_386_GOT32"; break; case R_386_PLT32: htype = "R_386_PLT32"; break; case R_386_COPY: htype = "R_386_COPY"; break; case R_386_GLOB_DAT: htype = "R_386_GLOB_DAT"; break; case R_386_JMP_SLOT: htype = "R_386_JMP_SLOT"; break; case R_386_RELATIVE: htype = "R_386_RELATIVE"; break; case R_386_GOTOFF: htype = "R_386_GOTOFF"; break; case R_386_GOTPC: htype = "R_386_GOTPC"; break; case R_386_NUM: htype = "R_386_NUM"; break; default: htype = "Unknown"; break; } return htype; } char *reloc_htype(int thetype) { switch (RELOC_MODE) { case RELOC_X86_64: return reloc_htype_x86_64(thetype); case RELOC_X86_32: return reloc_htype_x86_32(thetype); default: return "UNKNOWN_RELOCATION"; break; } } /** * Parse relocations from a given section */ static int parse_reloc(ctx_t * ctx, msec_t * s) { Elf_Shdr *shdr; Elf_Rela *r; unsigned int sz; unsigned int i; char *htype = 0; unsigned int sindex = 0; unsigned int has_addend = 0; shdr = s->s_elf; sz = shdr->sh_size; has_addend = (shdr->sh_type == SHT_RELA) ? 1 : 0; // SHT_RELA has addends, SHT_REL doesn't if ((shdr->sh_type == SHT_RELA) && ((int)shdr->sh_entsize != entszfromname(".rela.dyn"))) { printf("warning: strange relocation size: %lu != %u in %s\n", shdr->sh_entsize, entszfromname(".rela.dyn"), s->name); return -1; } if ((shdr->sh_type == SHT_REL) && ((int)shdr->sh_entsize != entszfromname(".rel.dyn"))) { printf("warning: strange relocation size: %lu != %u in %s\n", shdr->sh_entsize, entszfromname(".rel.dyn"), s->name); return -1; } if ((shdr->sh_type == SHT_RELA) && ((int)shdr->sh_size % entszfromname(".rela.dyn"))) { printf ("warning: strange relocation section size: %lu not a multiple of %u in %s\n", shdr->sh_size, entszfromname(".rela.dyn"), s->name); return -1; } if ((shdr->sh_type == SHT_REL) && (shdr->sh_size % entszfromname(".rel.dyn"))) { printf ("warning: strange relocation section size: %lu not a multiple of %u in %s\n", shdr->sh_size, entszfromname(".rel.dyn"), s->name); return -1; } if (ctx->opt_verbose) { printf("\t%s\tsize:%u\t%lu relocations\n", s->name, sz, sz / shdr->sh_entsize); } for (i = 0; i < sz / shdr->sh_entsize; i++) { r = s->data + i * shdr->sh_entsize; htype = reloc_htype(ELF_R_TYPE(r->r_info)); if (ELF_R_TYPE(r->r_info) == R_X86_64_RELATIVE) { if (ctx->opt_debug) { printf("reloc[%u] %016lx\t%lu\t%s\t%u\taddend:%lx\t\n", i, r->r_offset, r->r_info, htype, sindex, r->r_addend); printf(" * Skipping relative relocation\n"); } ctx->has_relativerelocations = 1; // Binary has relative relocations continue; // Do not save relocation for R_X86_64_RELATIVE } else { sindex = ELF_R_SYM(r->r_info); sindex += maxnewsec; // account for section references at top of symbol table // write back sindex in symtab ELF_R_INFO(sindex, ELF_R_TYPE(r->r_info)); } if (ctx->opt_verbose) { printf("reloc[%u] %016lx\t%lu\t%s\t%u\taddend:%lu\t\n", i, r->r_offset, r->r_info, htype, sindex, r->r_addend); } save_reloc(ctx, r, sindex, has_addend); } if (ctx->opt_verbose) { printf("\n"); } return 0; } int fixup_strtab_and_symtab(ctx_t * ctx) { char *sname = 0; Elf_Sym *s; unsigned int i, sindex; if (!globalsymtab) { return 0; } if (!globalstrtab) { return 0; } if (ctx->opt_debug) { printf("\n -- Fixing strtab and symtab with delta of %u\n\n", deltastrtab); } for (sindex = maxnewsec + 1; sindex < (globalsymtablen / sizeof(Elf_Sym)); sindex++) { // get symbol name from index s = globalsymtab + sindex * sizeof(Elf_Sym); s->st_name += deltastrtab; // fix symbol name offset in symbol table /** * check if name is in blacklist */ for (i = 0; i < sizeof(blnames) / sizeof(char *); i++) { sname = (char *) (globalstrtab + s->st_name); if ((s->st_name < globalstrtablen) && (strlen(sname) == strlen(blnames[i])) && (!strncmp(sname, blnames[i], strlen(blnames[i])))) { if (ctx->opt_debug) { printf(" * name blacklisted: %s at index %u\n", sname, sindex); } // generate new symbol name from old one globalstrtab = realloc(globalstrtab, globalstrtablen + strlen(sname) + 5); sprintf(globalstrtab + globalstrtablen, "old_%s", sname); s->st_name = globalstrtablen; globalstrtablen += strlen(globalstrtab + globalstrtablen) + 1; // change type and link information s->st_info = ELF64_ST_INFO(STB_WEAK, STT_NOTYPE); s->st_shndx = 0; } } } return 0; } int fixup_text(ctx_t * ctx) { msec_t *s; if (ctx->opt_debug) { printf(" -- Fixup .text\n\n"); } DL_FOREACH(ctx->mshdrs, s) { if (!strncmp(s->name, ".text", 6)) { unsigned int newsz = datavma - textvma + maxdata - mindata; if (ctx->opt_debug) { printf (" * .text section found, increasing size from 0x%lx to 0x%x (0x%lx)\n", s->s_elf->sh_size, newsz, s->len); } s->s_elf->sh_size = newsz; // extend data s->data = realloc(s->data, newsz); // pad memset(s->data + s->len, 0x00, newsz - s->len); s->s_elf->sh_offset = orig_sz; s->outoffset = orig_sz; // extend output file ftruncate(ctx->fdout, s->outoffset + s->s_elf->sh_size); s->len = newsz; break; } } return 0; } /** * Parse relocations */ static unsigned int parse_relocations(ctx_t * ctx) { msec_t *s; if (ctx->opt_verbose) { printf("\n -- Parsing existing relocations\n\n"); } DL_FOREACH(ctx->mshdrs, s) { if ((s->s_elf) && (s->s_elf->sh_type == SHT_RELA)) { // relocations with addends parse_reloc(ctx, s); } else if ((s->s_elf) && (s->s_elf->sh_type == SHT_REL)) { // relocations without addends parse_reloc(ctx, s); } } if (ctx->opt_verbose) { printf("\n"); } return 0; } /** * Append a symbol to global symbol table */ unsigned int append_sym(Elf_Sym * s) { if (globalsymtab == 0) { globalsymtab = calloc(1, sizeof(Elf_Sym) * 2); globalsymtablen += sizeof(Elf_Sym); // Skip 1 NULL entry } else { globalsymtab = realloc(globalsymtab, sizeof(Elf_Sym) + globalsymtablen); } memcpy(globalsymtab + globalsymtablen, s, sizeof(Elf_Sym)); globalsymtablen += sizeof(Elf_Sym); return 0; } /** * Append a string to symbol table, reports offset in strtab where this symbol will start */ unsigned int append_strtab(char *str) { unsigned int nameptr; if (globalstrtab == 0) { globalstrtab = calloc(1, strlen(str) + 3); globalstrtablen++; // Start with a null byte } else { globalstrtab = realloc(globalstrtab, globalstrtablen + strlen(str) + 2); } memcpy(globalstrtab + globalstrtablen, str, strlen(str) + 1); nameptr = globalstrtablen; globalstrtablen += strlen(str) + 1; return nameptr; } /** * Create sections in symbol table/string table */ static int create_section_symbols(ctx_t * ctx) { msec_t *tmp; msec_t *s; unsigned int nameptr; Elf_Sym *sym; unsigned int i, n; sym = calloc(1, sizeof(Elf_Sym)); DL_COUNT(ctx->mshdrs, tmp, maxoldsec); // count before stripping for (i = 1; i <= maxoldsec; i++) { s = section_from_index(ctx, i); n = secindex_from_name_after_strip(ctx, s->name); if (n > maxnewsec) { maxnewsec = n; } } // maxnewsec += EXTRA_CREATED_SECTIONS; // count sections not yet created if (ctx->opt_debug) { printf(" -- Max section index after stripping: %u\n", maxnewsec); } // Create symbol for section for (i = 1; i <= maxnewsec; i++) { char *newsname = 0; newsname = sec_name_from_index_after_strip(ctx, i); if (!newsname) { switch (i - EXTRA_CREATED_SECTIONS - 1) { case 1: newsname = ".rela.all"; break; case 2: newsname = ".strtab"; break; case 3: newsname = ".symtab"; break; case 4: newsname = ".shstrtab"; break; default: newsname = ".unknown"; break; } } nameptr = append_strtab(newsname); if (ctx->opt_debug) { printf("%u %s\n", i, newsname); } sym->st_name = nameptr; sym->st_size = 0; sym->st_value = 0; sym->st_info = STT_SECTION; sym->st_other = 0; sym->st_shndx = i; append_sym(sym); } free(sym); deltastrtab = globalstrtablen; if (ctx->opt_debug) { printf(" -- Base sections symbol index: %u\n", 0); printf(" -- Delta string table: %u\n", deltastrtab); } return 0; } static unsigned int process_text(ctx_t * ctx) { msec_t *t; unsigned int delta; t = section_from_name(ctx, ".text"); delta = orig_text - textvma; // create section symbols // create_section_symbols(ctx); // parse text for relocations analyze_text(ctx, (char *) (t->data + delta), maxtext - mintext - delta, orig_text); return 0; } /** * Create Section Headers */ static unsigned int write_shdrs(ctx_t * ctx) { Elf_Shdr *shdr = 0; unsigned int tmpm = 0; msec_t *s; /** * Align section headers on 8 bytes boundaries */ // Goto end of file tmpm = lseek(ctx->fdout, 0x00, SEEK_END); write(ctx->fdout, nullstr, 20); write(ctx->fdout, nullstr, 20); write(ctx->fdout, nullstr, 20); tmpm = lseek(ctx->fdout, 0x00, SEEK_END); // align on 8 bytes boundaries if ((tmpm % 8) == 0) { tmpm += 8; }; tmpm &= ~0xf; tmpm += sizeof(Elf_Shdr); // Prepend a NULL section // truncate ftruncate(ctx->fdout, tmpm); ctx->start_shdrs = lseek(ctx->fdout, 0x00, SEEK_END) - sizeof(Elf_Shdr); // New start of SHDRs ctx->strndx[0] = 0; ctx->strndx_len = 1; /** * Write each ELF section header */ DL_FOREACH(ctx->mshdrs, s) { // append name to strndx memcpy(ctx->strndx + ctx->strndx_len, s->name, strlen(s->name) + 1); // do copy the final "\x00" s->s_elf->sh_name = ctx->strndx_len; ctx->strndx_len += strlen(s->name) + 1; // adjust section links and info s->s_elf->sh_link = link_from_name(ctx, s->name); // Link to another section s->s_elf->sh_info = info_from_name(ctx, s->name); // Additional section information // write section header to binary write(ctx->fdout, s->s_elf, sizeof(Elf_Shdr)); } /** * Add a section header for relocations */ // append name to strndx memcpy(ctx->strndx + ctx->strndx_len, ".rela.all", 10); shdr = calloc(1, sizeof(Elf_Shdr)); shdr->sh_name = ctx->strndx_len; // index in string table shdr->sh_type = SHT_RELA; // Section type shdr->sh_flags = 2; // Section flags shdr->sh_addr = 0; // Section virtual addr at execution shdr->sh_offset = globalrelocoffset; // Section file offset shdr->sh_size = globalreloclen; // Section size in bytes shdr->sh_link = ctx->shnum + 3; // Link to another section shdr->sh_info = 1; // Additional section information : .text shdr->sh_addralign = 8; // Section alignment shdr->sh_entsize = entszfromname(".rela.plt"); // Entry size if section holds table ctx->strndx_len += 10; // append string table section header to binary write(ctx->fdout, shdr, sizeof(Elf_Shdr)); free(shdr); ctx->strndx_index = ctx->shnum + 1; // append sections strint table to binary // write(ctx->fdout, ctx->strndx, ctx->strndx_len); /** * Add a section header for string table */ // append name to strndx memcpy(ctx->strndx + ctx->strndx_len, ".strtab", 8); shdr = calloc(1, sizeof(Elf_Shdr)); shdr->sh_name = ctx->strndx_len; // index in string table shdr->sh_type = SHT_STRTAB; // Section type shdr->sh_flags = 0; // Section flags shdr->sh_addr = 0; // Section virtual addr at execution shdr->sh_offset = globalstrtableoffset; // Section file offset shdr->sh_size = globalstrtablen; // Section size in bytes shdr->sh_link = 0; // Link to another section shdr->sh_info = 0; // Additional section information shdr->sh_addralign = 1; // Section alignment shdr->sh_entsize = entszfromname(".strtab"); // Entry size if section holds table ctx->strndx_len += 8; // append string table section header to binary write(ctx->fdout, shdr, sizeof(Elf_Shdr)); free(shdr); ctx->strndx_index = ctx->shnum + 1; // append sections strint table to binary // write(ctx->fdout, ctx->strndx, ctx->strndx_len); /** * Add a section header for symbol table */ // append name to strndx memcpy(ctx->strndx + ctx->strndx_len, ".symtab", 8); shdr = calloc(1, sizeof(Elf_Shdr)); shdr->sh_name = ctx->strndx_len; // index in string table shdr->sh_type = SHT_SYMTAB; // Section type shdr->sh_flags = 0; // Section flags shdr->sh_addr = 0; // Section virtual addr at execution shdr->sh_offset = globalsymtableoffset; // Section file offset shdr->sh_size = globalsymtablen; // Section size in bytes shdr->sh_link = ctx->shnum + 2; // Link to another section (strtab) shdr->sh_info = ctx->shnum + 1; // Additional section information shdr->sh_addralign = 8; // Section alignment // shdr->sh_entsize = 0; // Entry size if section holds table shdr->sh_entsize = entszfromname(".symtab"); // Entry size if section holds table ctx->strndx_len += 8; // append string table section header to binary write(ctx->fdout, shdr, sizeof(Elf_Shdr)); free(shdr); ctx->strndx_index = ctx->shnum + 1; // append sections strint table to binary // write(ctx->fdout, ctx->strndx, ctx->strndx_len); /** * Append an additional section header for the Section header string table */ // append name to strndx memcpy(ctx->strndx + ctx->strndx_len, ".shstrtab", 10); shdr = calloc(1, sizeof(Elf_Shdr)); shdr->sh_name = ctx->strndx_len; // index in string table shdr->sh_type = SHT_STRTAB; // Section type shdr->sh_flags = 0; // Section flags shdr->sh_addr = 0; // Section virtual addr at execution // shdr->sh_offset = lseek(ctx->fdout, 0x00, SEEK_END) + 64; // Section file offset shdr->sh_offset = lseek(ctx->fdout, 0x00, SEEK_END) + sizeof(Elf_Shdr); // Section file offset shdr->sh_size = ctx->strndx_len + 10; // Section size in bytes shdr->sh_link = 0; // Link to another section shdr->sh_info = 0; // Additional section information shdr->sh_addralign = 1; // Section alignment shdr->sh_entsize = 0; // Entry size if section holds table ctx->strndx_len += 9 + 1; // append string table section header to binary write(ctx->fdout, shdr, sizeof(Elf_Shdr)); free(shdr); ctx->strndx_index = ctx->shnum + 1; // append sections strint table to binary write(ctx->fdout, ctx->strndx, ctx->strndx_len); if (ctx->opt_debug) { printf(" * section headers at:\t\t\t0x%x\n", ctx->start_shdrs); printf(" * section string table index:\t\t%u\n", ctx->shnum); } return ctx->start_shdrs; } /** * Create ELF Headers */ static int mk_ehdr(ctx_t * ctx) { Elf_Ehdr *e = 0; e = calloc(1, sizeof(Elf_Ehdr)); if (!e) { perror("calloc"); exit(EXIT_FAILURE); } /** * Set defaults */ // Set ELF signature memcpy(e->e_ident, "\x7f\x45\x4c\x46\x02\x01\x01", 7); e->e_ident[EI_CLASS] = ELFCLASS; // 64 or 32 bits e->e_entry = bfd_get_start_address(ctx->abfd); // Set type of ELF based on command line options and compilation target e->e_type = ET_DYN; // Default is shared library e->e_machine = ctx->opt_arch ? ctx->opt_arch : ELFMACHINE; // Default : idem compiler cpu, else, user specified e->e_version = 0x1; // ABI Version, Always 1 e->e_phoff = ctx->start_phdrs; e->e_shoff = ctx->start_shdrs; e->e_flags = ctx->opt_flags; // default is null. Used in setting some EABI versions on ARM e->e_ehsize = sizeof(Elf_Ehdr); // Size of this header e->e_phentsize = sizeof(Elf_Phdr); // Size of each program header e->e_phnum = ctx->phnum; e->e_shentsize = sizeof(Elf_Shdr); // Size of each section header e->e_shnum = ctx->shnum + 5; // We added a null section and a string table index + .strtab + .symtab + .rela.all e->e_shstrndx = ctx->shnum + 4; // Sections Seader String table index is last valid /** * Now apply options */ if (ctx->opt_sstrip) { e->e_shoff = 0; e->e_shnum = 0; e->e_shstrndx = 0; // Sections Seader String table index is last valid e->e_shentsize = 0; } if ((ctx->opt_exec) || (ctx->opt_static)) { e->e_type = ET_EXEC; // Executable } if (ctx->opt_shared) { e->e_type = ET_DYN; // Shared library } if (ctx->opt_reloc) { e->e_type = ET_REL; // Relocatable object e->e_entry = 0; e->e_phoff = 0; e->e_phnum = 0; e->e_phentsize = 0; } if (ctx->opt_core) { e->e_type = ET_CORE; // Core file } // write ELF Header lseek(ctx->fdout, 0x00, SEEK_SET); write(ctx->fdout, e, sizeof(Elf_Ehdr)); return 0; } /** * Write a section to disk */ static int write_section(ctx_t * ctx, msec_t * m) { unsigned int nwrite = 0; // Go to correct offset in output binary lseek(ctx->fdout, m->outoffset, SEEK_SET); // write to fdout nwrite = write(ctx->fdout, m->data, m->len); if (nwrite != m->len) { printf("write failed: %u != %lu %s\n", nwrite, m->len, strerror(errno)); exit(EXIT_FAILURE); } return nwrite; } static int rd_extended_text(ctx_t * ctx) { unsigned int i; asection *s; if (ctx->opt_debug) { printf(" -- Finding .text segment boundaries\n\n"); printf(" index\t\tname\t\t\trange\tsize\tpermissions\toffset\n"); printf ("--------------------------------------------------------------------\n"); } s = ctx->abfd->sections; for (i = 0; i < ctx->shnum; i++) { unsigned perms = parse_bfd_perm(s->flags); if (perms == 5) { if (ctx->opt_debug) { printf(" [%2u] \t%-20s\t%012lx-%012lx %lu\t%s\t%lu\n", i + 1, s->name, s->vma, s->vma + s->size, s->size, "RX", s->filepos); } if ((unsigned long)s->filepos < mintext) { mintext = s->filepos; textvma = s->vma; } if ((unsigned long)s->filepos + s->size > maxtext) { maxtext = s->filepos + s->size; } } s = s->next; } if (ctx->opt_debug) { printf(" --> .text future boundaries: offset:%lu sz:%lu vma:%lx\n\n", mintext, maxtext - mintext, textvma); } return 0; } static int rd_extended_data(ctx_t * ctx) { unsigned int i, perms; asection *s; if (ctx->opt_debug) { printf(" -- Finding .data segment boundaries\n\n"); printf(" index\t\tname\t\t\trange\tsize\tpermissions\toffset\n"); printf("--------------------------------------------------------------------\n"); } s = ctx->abfd->sections; for (i = 0; i < ctx->shnum; i++) { perms = parse_bfd_perm(s->flags); if (perms == 4) { if (ctx->opt_debug) { printf(" [%2u] \t%-20s\t%012lx-%012lx %lu\t%s\t%lu\n", i + 1, s->name, s->vma, s->vma + s->size, s->size, "RW", s->filepos); } if ((unsigned long)s->filepos < mindata) { mindata = s->filepos; datavma = s->vma; } if (s->filepos + s->size > maxdata) { maxdata = s->filepos + s->size; } } s = s->next; } if (ctx->opt_debug) { printf(" --> .data future boundaries: offset:%lu sz:%lu vma:%lx\n\n", mindata, maxdata - mindata, datavma); } return 0; } static int extend_text(ctx_t * ctx) { unsigned int i; asection *s; if (ctx->opt_debug) { printf(" -- Extending .text\n\n"); } s = ctx->abfd->sections; for (i = 0; i < ctx->shnum; i++) { if (!strncmp(s->name, ".text", 5)) { orig_text = s->vma; s->vma = textvma; s->filepos = mintext; s->flags = -1; s->size = maxtext - mintext; if (ctx->opt_debug) { printf(" * extending section %s\n", s->name); printf(" * new .text boundaries: offset:%lu sz:%lu vma:%lx\n\n", mintext, s->size, textvma); } } s = s->next; } return 0; } /** * Display BFD memory sections */ int print_bfd_sections(ctx_t * ctx) { unsigned int i; asection *s; unsigned perms; char *hperms; if (ctx->opt_verbose) { printf("\n -- Input binary sections\n\n"); printf (" name address range pages perms offset\n"); printf (" --------------------------------------------------------------------------------\n"); } s = ctx->abfd->sections; for (i = 0; i < ctx->shnum; i++) { perms = parse_bfd_perm(s->flags); switch (perms) { case 7: hperms = "rwx"; break; case 6: hperms = "r--"; break; case 5: hperms = "r-x"; break; case 4: hperms = "rw-"; break; default: hperms = "---"; break; } if (ctx->opt_verbose) { printf(" [%2u] %-20s\t%012lx-%012lx %lu\t%s\t%lu\n", i + 1, s->name, s->vma, s->vma + s->size, s->size, hperms, s->filepos); } s = s->next; } if (ctx->opt_verbose) { printf("\n"); } return 0; } /** * Simple hexdump routine */ void hexdump(unsigned char *data, size_t size) { size_t i, j; for (j = 0; j < size; j += 16) { for (i = j; i < j + 16; i++) { if (i < size) { printf("%02x ", data[i] & 255); } else { printf(" "); } } printf(" "); for (i = j; i < j + 16; i++) { if (i < size) putchar(32 <= (data[i] & 127) && (data[i] & 127) < 127 ? data[i] & 127 : '.'); else putchar(' '); } putchar('\n'); } } /** * Open a binary the best way we can */ unsigned int open_best(ctx_t * ctx) { int formatok = 0; // Open as object formatok = bfd_check_format(ctx->abfd, bfd_object); ctx->shnum = bfd_count_sections(ctx->abfd); ctx->corefile = 0; // Open as core file if ((!formatok) || (!ctx->shnum)) { formatok = bfd_check_format(ctx->abfd, bfd_core); ctx->shnum = bfd_count_sections(ctx->abfd); ctx->corefile = 1; } // Open as archive if ((!formatok) || (!ctx->shnum)) { formatok = bfd_check_format(ctx->abfd, bfd_archive); ctx->shnum = bfd_count_sections(ctx->abfd); ctx->corefile = 0; } if ((!formatok) || (!ctx->shnum)) { printf(" -- couldn't find a format for %s\n", ctx->binname); return 0; } return ctx->shnum; } /** * Open destination binary */ int open_target(ctx_t * ctx) { int fd = 0; struct stat sb; char *newname; char *p; if (stat(ctx->binname, &sb) == -1) { perror("stat"); exit(EXIT_FAILURE); } if ((ctx->opt_binname) && (strlen(ctx->opt_binname))) { newname = ctx->opt_binname; } else { newname = calloc(1, strlen(ctx->binname) + 20); sprintf(newname, "a.out"); } if (ctx->opt_debug) { printf(" -- Creating output file: %s\n\n", newname); } fd = open(newname, O_RDWR | O_CREAT | O_TRUNC, 0666); if (fd <= 0) { printf(" ERROR: open(%s) %s\n", newname, strerror(errno)); exit(EXIT_FAILURE); } // set end of file ftruncate(fd, sb.st_size); // Copy default content : poison bytes or original data p = calloc(1, sb.st_size); if (ctx->opt_poison) { // map entire binary with poison byte memset(p, ctx->opt_poison, sb.st_size); } else { // Default : copy original binary int fdin = open(ctx->binname, O_RDONLY); read(fdin, p, sb.st_size); close(fdin); } lseek(fd, 0x00, SEEK_SET); write(fd, p, sb.st_size); free(p); lseek(fd, 0x00, SEEK_SET); ctx->fdout = fd; return fd; } /** * Write sections to disk */ int copy_body(ctx_t * ctx) { msec_t *s; DL_FOREACH(ctx->mshdrs, s) { write_section(ctx, s); } return 0; } /** * Load a binary using bfd */ int load_binary(ctx_t * ctx) { ctx->abfd = bfd_openr(ctx->binname, NULL); ctx->shnum = open_best(ctx); ctx->archsz = bfd_get_arch_size(ctx->abfd); if (ctx->opt_verbose) { printf(" -- Architecture size: %u\n", ctx->archsz); } return 0; } /** * Return section flags from its name */ int flags_from_name(const char *name) { ifis(".bss") { return FLAG_BSS | FLAG_NOBIT | FLAG_NOWRITE; } elis(".text") { return FLAG_TEXT; } return 0; } /** * Craft Section header */ int craft_section(ctx_t * ctx, msec_t * m) { asection *s = m->s_bfd; Elf_Shdr *shdr = m->s_elf; unsigned int dalign = 0; unsigned int dperms = 0; unsigned perms = parse_bfd_perm(s->flags); dperms = 0; switch (perms & 0xf) { case 7: dperms = SHF_ALLOC | SHF_WRITE | SHF_EXECINSTR; // "rwx"; break; case 6: dperms = SHF_ALLOC; //"r--"; break; case 5: dperms = SHF_ALLOC | SHF_EXECINSTR; // "r-x"; break; case 4: dperms = SHF_ALLOC | SHF_WRITE; // "rw-" break; default: dalign = 1; dperms = 0; // "---" break; } // append name to strndx memcpy(ctx->strndx + ctx->strndx_len, s->name, strlen(s->name)); shdr->sh_name = ctx->strndx_len; // Section name (string tbl index) shdr->sh_type = typefromname(s->name); // Section type shdr->sh_flags = dperms; // Section flags shdr->sh_addr = s->vma; // Section virtual addr at execution if (ctx->opt_reloc) { shdr->sh_addr = 0; // vma is null in relocatable files } shdr->sh_offset = s->filepos; // Section file offset shdr->sh_size = s->size; // Section size in bytes shdr->sh_addralign = dalign ? dalign : alignfromname(s->name); // Section alignment shdr->sh_entsize = entszfromname(s->name); // Entry size if section holds table ctx->strndx_len += strlen(s->name) + 1; return 0; } /** * Read a section from disk */ static int read_section(ctx_t * ctx, asection * s) { int fd = 0; unsigned int n, nread = 0, nwrite = 0; asection *buf; unsigned int wantedsz = 0; // Open input binary fd = open(ctx->binname, O_RDONLY); if (fd <= 0) { printf("error: open(%s) : %s\n", ctx->binname, strerror(errno)); exit(0); } // Go to correct offset lseek(fd, s->filepos, SEEK_SET); // allocate tmp memory wantedsz = s->size; if (!strncmp(s->name, ".text", 5)) { wantedsz = s->size; } buf = calloc(1, wantedsz); // Create Meta section msec_t *ms = calloc(1, sizeof(msec_t)); if (!ms) { perror("calloc"); exit(EXIT_FAILURE); } ms->s_elf = calloc(1, sizeof(Elf_Shdr)); if (!ms->s_elf) { perror("calloc"); exit(EXIT_FAILURE); } // read data from disk if (!strncmp(s->name, ".bss", 4)) { // SHT_NOBITS Section contains no data (Global Uninitialized Data) n = 0; buf = realloc(buf, 0); } else { // read from disk n = 0; nread = read(fd, buf, s->size); while ((nread != 0) && (n <= s->size)) { n += nread; nread = read(fd, buf + n, s->size - n); } if ((n != s->size) && (!strncmp(s->name, ".text", 5))) { n = s->size; // initialized at 0x00 by calloc } else if (n != s->size) { printf("read failed: %u != %u\n", n, (unsigned int) s->size); } } // fill Meta section ms->s_bfd = s; ms->len = n; ms->name = strdup(s->name); ms->data = (unsigned char *) buf; ms->outoffset = s->filepos; // fill ELF section craft_section(ctx, ms); ms->flags = flags_from_name(s->name); // Add to double linked list of msec_t Meta sections DL_APPEND(ctx->mshdrs, ms); ctx->mshnum++; // Close file descriptor close(fd); return nwrite; } /** * Display sections */ int print_msec(ctx_t * ctx) { msec_t *ms; unsigned int count; DL_COUNT(ctx->mshdrs, ms, count); printf(" -- %u elements\n", count); DL_FOREACH(ctx->mshdrs, ms) { printf("%s %lu\n", ms->name, ms->len); } return 0; } /** * Read sections from input binary */ int rd_sections(ctx_t * ctx) { unsigned int i; asection *s = ctx->abfd->sections; for (i = 0; i < ctx->shnum; i++) { read_section(ctx, s); s = s->next; } return 0; } int save_dynstr(ctx_t * ctx, GElf_Shdr shdr, char *binary) { if (globalstrtab == 0) { globalstrtab = calloc(1, shdr.sh_size + 3); globalstrtablen++; // Start with a null byte } else { globalstrtab = realloc(globalstrtab, globalstrtablen + shdr.sh_size + 2); } memcpy(globalstrtab + globalstrtablen, binary + shdr.sh_offset, shdr.sh_size + 1); globalstrtablen += shdr.sh_size + 1; return 0; } int save_dynsym(ctx_t * ctx, GElf_Shdr shdr, char *binary) { if (globalsymtab == 0) { globalsymtab = calloc(1, sizeof(Elf_Sym) + shdr.sh_size); // globalsymtablen += sizeof(Elf_Sym); // Skip 1 NULL entry } else { globalsymtab = realloc(globalsymtab, shdr.sh_size + globalsymtablen); } memcpy(globalsymtab + globalsymtablen, binary + shdr.sh_offset + sizeof(Elf_Sym), shdr.sh_size - sizeof(Elf_Sym)); globalsymtablen += shdr.sh_size - sizeof(Elf_Sym); return 0; } int patch_symbol_index(ctx_t * ctx, Elf_Sym * s) { msec_t *sec; // char *sname; // sname = globalstrtab + s->st_name; sec = section_from_index(ctx, s->st_shndx); // section related to this object if (sec) { // patch section index in symbol table s->st_shndx = secindex_from_name_after_strip(ctx, sec->name); } else { // printf(" no section info for symbol: %s\n", sname); } return 0; } int fixup_symtab_section_index(ctx_t * ctx) { Elf_Sym *s; unsigned int sindex; for (sindex = maxnewsec + 1; sindex < globalsymtablen / sizeof(Elf_Sym); sindex++) { // get symbol name from index s = globalsymtab + sindex * sizeof(Elf_Sym); if (s->st_shndx) { patch_symbol_index(ctx, s); } } return 0; } int append_reloc(Elf_Rela * r) { unsigned int i; Elf_Rela *s; // search this address in reloc table for (i = 0; i < globalreloclen / sizeof(Elf_Rela); i++) { s = globalreloc + i * sizeof(Elf_Rela); // if (s->r_offset == r->r_offset) { printf("warning: already have a relocation at %lu\n", r->r_offset); return -1; // already in relocation section } } // save relocation if (!globalreloc) { globalreloc = calloc(1, sizeof(Elf_Rela)); } else { globalreloc = realloc(globalreloc, sizeof(Elf_Rela) + globalreloclen); } memcpy(globalreloc + globalreloclen, r, sizeof(Elf_Rela)); globalreloclen += sizeof(Elf_Rela); return 0; } typedef struct gimport_t { char *sname; msec_t *sec; Elf_Rela *r; int rtype; unsigned int sindex; } gimport_t; gimport_t **gimports = 0; unsigned int gimportslen = 0; int save_global_import(ctx_t * ctx, char *sname, msec_t * sec, Elf_Rela * r, unsigned int sindex) { int rtype; gimport_t *g; Elf_Rela *rnew; rtype = ELF_R_TYPE(r->r_info); if (ctx->opt_verbose) { printf ("recording blobal import variable %s in section: %s\t%s\tat:%lu\toff:%lu\n", sname, sec->name, reloc_htype(rtype), r->r_offset, r->r_offset - textvma); } g = calloc(1, sizeof(gimport_t)); g->sname = strdup(sname); g->sec = sec; g->sindex = sindex; // index of symbol in symbol table rnew = calloc(1, sizeof(Elf_Rela)); memcpy(rnew, r, sizeof(Elf_Rela)); g->r = rnew; g->rtype = rtype; if (!gimports) { gimports = calloc(1, sizeof(gimport_t *)); } else { gimports = realloc(gimports, sizeof(gimport_t *) * (gimportslen + 1)); } gimports[gimportslen++] = g; return 0; } /** * Return index in global import matching this address */ int check_global_import(unsigned long int addr) { unsigned i; if (addr < 4096) { return -1; } for (i = 0; i < gimportslen; i++) { if ((gimports[i]) && (gimports[i]->r) && (gimports[i]->r->r_offset == addr)) { return i; } } return -1; } int save_reloc(ctx_t * ctx, Elf_Rela * r, unsigned int sindex, int has_addend) { Elf_Sym *s; char *sname = 0; unsigned int i; int rtype, outtype; char *htype; msec_t *sec; Elf_Rela *rout; rout = calloc(1, sizeof(Elf_Rela)); // Work on a copy of the relocation instead of the original one memcpy(rout, r, sizeof(Elf_Rela)); if (!has_addend) { rout->r_addend = 0; }; // search symbol corresponding to this index if (!globalsymtab) { printf("warning: no symbol table for relocation index %u\n", sindex); return 0; } if (sindex > globalsymtablen / sizeof(Elf_Sym)) { // verify index is within bound of symtab... printf("warning: symbol index %u is out of bounds of symbol table\n", sindex); return 0; } if (!globalstrtab) { printf("warning: no string table for relocation index %u\n", sindex); return 0; } // get symbol name from index s = globalsymtab + sindex * sizeof(Elf_Sym); sname = globalstrtab + s->st_name; // check if name is "old_" : if so, skip if (!strncmp(sname, "old_", 4)) { return -1; } // check if name is in blacklist for (i = 0; i < sizeof(blnames) / sizeof(char *); i++) { if ((strlen(sname) == strlen(blnames[i])) && (!strncmp(sname, blnames[i], strlen(blnames[i])))) { if (ctx->opt_verbose) { printf(" * name blacklisted: %s\n", sname); } return -1; // Name in blacklist } } if (ctx->opt_debug) { printf(" * adding relocation for: %s\n", sname); } /** * Convert relocation depending on type and source section */ outtype = 0; rtype = ELF_R_TYPE(rout->r_info); sec = section_from_index(ctx, s->st_shndx); // section related to this object if (sec) { if (!strncmp(sec->name, ".bss", 4)) { // Save global import save_global_import(ctx, sname, sec, r, sindex); return 0; } else { // Skip if (ctx->opt_debug) { printf ("warning: skipping unknown relocation for symbol: %s in section: %s\t%s\tat:%lu\toff:%lu\n", sname, sec->name, reloc_htype(rtype), rout->r_offset, rout->r_offset - textvma); } s->st_shndx = 0; s->st_value = 0; // Actual value is null in this case return 0; } } else if (rtype == R_X86_64_RELATIVE) { if (ctx->opt_debug) { printf(" * Not saving Relative relocation %lu %lu\n", rout->r_offset, rout->r_addend); } // rout->r_offset -= textvma; return 0; } else { // Jump slots if (ctx->opt_debug) { printf(" no section info for symbol: %s\n", sname); } //#define R_386_JUMP_SLOT 7 #ifdef __x86_64__ outtype = R_X86_64_64; #else outtype = R_386_32; //printf("textvma: %llx\n", textvma); // rout->r_addend = +4; #endif rout->r_offset -= textvma; rout->r_info = ELF_R_INFO(sindex, outtype); } if (ctx->opt_debug) { htype = reloc_htype(outtype); printf("-->> %016lx\t%lu\t%s\t%u\taddend:%lu\t\n\n", rout->r_offset, rout->r_info, htype, sindex, rout->r_addend); } append_reloc(rout); return 0; } #include static void print_string_hex(char *comment, unsigned char *str, size_t len) { unsigned char *c; printf("%s", comment); for (c = str; c < str + len; c++) { printf("0x%02x ", *c & 0xff); } printf("\n"); } static void print_insn_detail(ctx_t * ctx, csh handle, cs_mode mode, cs_insn * ins) { int count, i; cs_x86 *x86; // detail can be NULL on "data" instruction if SKIPDATA option is turned ON if (ins->detail == NULL) return; x86 = &(ins->detail->x86); printf("\tAddress: %lu\n", ins->address); printf("\tInstruction Length: %u\n", ins->size); print_string_hex("\tPrefix:", x86->prefix, 4); print_string_hex("\tOpcode:", x86->opcode, 4); printf("\trex: 0x%x\n", x86->rex); printf("\taddr_size: %u\n", x86->addr_size); printf("\tmodrm: 0x%x\n", x86->modrm); printf("\tdisp: 0x%x\n", x86->disp); // SIB is not available in 16-bit mode if ((mode & CS_MODE_16) == 0) { printf("\tsib: 0x%x\n", x86->sib); if (x86->sib_base != X86_REG_INVALID) printf("\t\tsib_base: %s\n", cs_reg_name(handle, x86->sib_base)); if (x86->sib_index != X86_REG_INVALID) printf("\t\tsib_index: %s\n", cs_reg_name(handle, x86->sib_index)); if (x86->sib_scale != 0) printf("\t\tsib_scale: %d\n", x86->sib_scale); } // SSE code condition if (x86->sse_cc != X86_SSE_CC_INVALID) { printf("\tsse_cc: %u\n", x86->sse_cc); } // AVX code condition if (x86->avx_cc != X86_AVX_CC_INVALID) { printf("\tavx_cc: %u\n", x86->avx_cc); } // AVX Suppress All Exception if (x86->avx_sae) { printf("\tavx_sae: %u\n", x86->avx_sae); } // AVX Rounding Mode if (x86->avx_rm != X86_AVX_RM_INVALID) { printf("\tavx_rm: %u\n", x86->avx_rm); } count = cs_op_count(handle, ins, X86_OP_IMM); if (count) { printf("\timm_count: %u\n", count); for (i = 1; i < count + 1; i++) { int index = cs_op_index(handle, ins, X86_OP_IMM, i); printf("\t\timms[%u]: 0x%" PRIx64 "\n", i, x86->operands[index].imm); } } if (x86->op_count) printf("\top_count: %u\n", x86->op_count); for (i = 0; i < x86->op_count; i++) { cs_x86_op *op = &(x86->operands[i]); switch ((int) op->type) { case X86_OP_REG: printf("\t\toperands[%u].type: REG = %s\n", i, cs_reg_name(handle, op->reg)); break; case X86_OP_IMM: printf("\t\toperands[%u].type: IMM = 0x%" PRIx64 "\n", i, op->imm); break; case X86_OP_MEM: printf("\t\toperands[%u].type: MEM\n", i); if (op->mem.segment != X86_REG_INVALID) printf("\t\t\toperands[%u].mem.segment: REG = %s\n", i, cs_reg_name(handle, op->mem.segment)); if (op->mem.base != X86_REG_INVALID) printf("\t\t\toperands[%u].mem.base: REG = %s\n", i, cs_reg_name(handle, op->mem.base)); if (op->mem.index != X86_REG_INVALID) printf("\t\t\toperands[%u].mem.index: REG = %s\n", i, cs_reg_name(handle, op->mem.index)); if (op->mem.scale != 1) printf("\t\t\toperands[%u].mem.scale: %u\n", i, op->mem.scale); if (op->mem.disp != 0) printf("\t\t\toperands[%u].mem.disp: 0x%" PRIx64 "\n", i, op->mem.disp); break; default: break; } // AVX broadcast type if (op->avx_bcast != X86_AVX_BCAST_INVALID) printf("\t\toperands[%u].avx_bcast: %u\n", i, op->avx_bcast); // AVX zero opmask {z} if (op->avx_zero_opmask != false) printf("\t\toperands[%u].avx_zero_opmask: TRUE\n", i); printf("\t\toperands[%u].size: %u\n", i, op->size); } printf("\n"); } static int create_text_data_reloc(ctx_t * ctx, cs_insn * ins, msec_t * m, unsigned int soff, int rip_relative, unsigned int argnum) { unsigned int sindex = 0; unsigned int wheretowrite = 0; unsigned int n = 0; int gimport = -1; cs_x86 *x86; x86 = &(ins->detail->x86); n = x86->op_count; wheretowrite = ins->size - 4; if (ctx->opt_debug) { printf(" --> transforming relocation from section: %s at ", m->name); printf("0x%" PRIx64 ":\t%s\t%s\tinslen:%u argoffset:%u\n", ins->address, ins->mnemonic, ins->op_str, ins->size, wheretowrite); } sindex = secindex_from_name_after_strip(ctx, m->name); if ((!strncmp(m->name, ".bss", 4)) && (n == 2) && (!rip_relative)) { gimport = check_global_import(x86->operands[1].imm); } if (rip_relative) { // printf(" ** destination: %lx\n", x86->operands[1]->mem.disp + ins->address + 7); gimport = check_global_import(x86->operands[1].mem.disp + ins->address + 7); if (ctx->opt_debug) { printf("** global imports match : %d\n", gimport); } } if ((gimport != -1) && (!rip_relative)) { // Relocation to .bss with a known global import if (ctx->opt_debug) { printf(" * known imported global : %s\n", gimports[gimport]->sname); } Elf_Rela *r = calloc(1, sizeof(Elf_Rela)); if (!r) { perror("calloc"); exit(-1); } sindex = gimports[gimport]->sindex; // reset string index in symbol table Elf_Sym *st = 0; st = globalsymtab + gimports[gimport]->sindex * sizeof(Elf_Sym); st->st_shndx = 0; st->st_value = 0; r->r_info = ELF_R_INFO(gimports[gimport]->sindex, R_X86_64_PC32); r->r_addend = 0; //-4; r->r_offset = ins->address - textvma + wheretowrite; // patch back binary msec_t *t = section_from_name(ctx, ".text"); memset(t->data + r->r_offset, 0x00, 4); if (ctx->opt_debug) { printf("%" PRIx64 "\t%s+%u\t\t\t(%s %s)\n", ins->address, m->name, soff, ins->mnemonic, ins->op_str); printf("%012lx\t%012lx\t%s\t%012x\t%s+%u\n", r->r_offset, r->r_info, "R_X86_64_32", 0, m->name, soff); } // append relocation append_reloc(r); free(r); } else if ((gimport != -1) && (rip_relative)) { // Relocation to .bss with a known global import via rip relative if (ctx->opt_debug) { printf(" * known imported global (rip relative) : %s\n", gimports[gimport]->sname); } Elf_Rela *r = calloc(1, sizeof(Elf_Rela)); if (!r) { perror("calloc"); exit(-1); } sindex = gimports[gimport]->sindex; // reset string index in symbol table Elf_Sym *st = 0; st = globalsymtab + gimports[gimport]->sindex * sizeof(Elf_Sym); st->st_shndx = 0; st->st_value = 0; r->r_info = ELF_R_INFO(gimports[gimport]->sindex, R_X86_64_PC32); r->r_addend = -4; r->r_offset = ins->address - textvma + wheretowrite; // patch back binary msec_t *t = section_from_name(ctx, ".text"); memset(t->data + r->r_offset, 0x00, 4); if (ctx->opt_debug) { printf("%012lx\t%012lx\t%s\t%012x\t%s+%ld\n", r->r_offset, r->r_info, "R_X86_64_32", 0, gimports[gimport]->sname, r->r_addend); } // append relocation append_reloc(r); free(r); } else if (sindex) { // Any other local section relocation (.rodata, .data ...) Elf_Rela *r = calloc(1, sizeof(Elf_Rela)); if (!r) { perror("calloc"); exit(-1); } if (ctx->opt_debug) { printf("new %s sindex:%u addent:%u, off:0x%lx\thasrel:%u\n", rip_relative ? "rip relative local" : "local", sindex, soff, ins->address - textvma + wheretowrite, ctx->has_relativerelocations); } int newtype; #ifdef __x86_64__ newtype = ctx->has_relativerelocations ? R_X86_64_PC32 : R_X86_64_32; #else #ifdef __i386__ newtype = R_386_32; //R_386_PLT32;//R_386_GOTOFF;//R_386_GOTPC; //R_386_GOT32; //R_386_COPY; //R_386_RELATIVE; //R_386_PC32; //R_386_GLOB_DAT; //R_386_32; #endif #endif // patch back .text msec_t *t = section_from_name(ctx, ".text"); if (argnum == 0) { // typically: cmp [rip+0xdeadbeef], 0 or something like mov qword ptr [rip+0xdeadbeef], rax /* * find at witch position we shall patch by scanning memory for the memory displacement */ for (wheretowrite = 0; wheretowrite <= ins->size; wheretowrite++) { unsigned int searchval = x86->operands[0].mem.disp; if (!memcmp (t->data + (ins->address - textvma + wheretowrite), &searchval, 4)) { // printf(" * patching instruction at offset: %u addend: %d relative:%d\n", wheretowrite, soff, rip_relative ? rip_relative : 0); break; } } // not found ? Fatal error if (wheretowrite == ins->size) { printf("error: can't find patch location\n"); exit(-1); } } if (rip_relative) { // compute new addend and set reloc type cs_x86_op *op = &(x86->operands[argnum]); r->r_addend = ((op->mem.disp) + ins->address) - m->s_bfd->vma; // (rip + (immediate|displacement)) - m->s_bfd->vma; // dst - (section vma) // printf("* new rip based addend : %llx\n", r->r_addend); newtype = R_X86_64_PC32; } else { r->r_addend = soff; // default } r->r_info = ELF_R_INFO(sindex, newtype); r->r_offset = ins->address - textvma + wheretowrite; if ((argnum == 0) && (rip_relative)) { // write at custom location memset(t->data + r->r_offset, 0x00, 4); // write back where computed previously // r->r_addend = -4; } else if (rip_relative) { // patch back register index (from rip to 0x00) memset(t->data + r->r_offset, 0x00, 4); // write back 4 bytes (one 32b address) + 1 if relative (overwrite rip) // r->r_addend = 0;//0x29a; } else if (ELFMACHINE == EM_386) { // R_386_32 doesn't account for the addend : write it back to .text memcpy(t->data + r->r_offset, &soff, 4); } else { memset(t->data + r->r_offset, 0x00, 4); // write back 4 bytes (one 32b address) + 1 if relative (overwrite rip) } /** * FIXED : Problem : http://fossies.org/linux/glibc/sysdeps/x86_64/dl-machine.h line 452 : possible overflow in relocation amd64 when using type R_X86_64_32 : should be fixed * */ // if (ctx->opt_verbose) { // printf("%"PRIx64"\t%s+0x%lx\t\t\t(%s %s)\n",ins->address, m->name, soff, ins->mnemonic, ins->op_str); // printf("%012lx\t%012lx\t%s\t%s+%u\n", r->r_offset, r->r_info, reloc_htype(newtype), m->name, soff); // } // append relocation append_reloc(r); free(r); } else { // Unhandled relocation if (ctx->opt_debug) { printf("warning: unknown relocation section: %s at ", m->name); printf("0x%" PRIx64 ":\t%s\t%s\n", ins->address, ins->mnemonic, ins->op_str); } } return 0; } int internal_function_store(ctx_t * ctx, unsigned long long int addr) { unsigned int i; char buff[200]; Elf_Sym *s = 0; memset(buff, 0x00, 200); snprintf(buff, 200, "internal_%08llx", addr); // search this symbol in string table for (i = 0; i < globalstrtablen; i += strlen(globalstrtab + i) + 1) { if (!strncmp(globalstrtab + i, buff, strlen(buff))) { return -1; // already in strtab, hence in symtab } } // search this address in symbol table for (i = 0; i < globalsymtablen / sizeof(Elf_Sym); i++) { s = globalsymtab + i * sizeof(Elf_Sym); // if (s->st_value == addr) { return -1; // already in symtab } } add_symaddr(ctx, buff, addr, 0x54); return 0; } static void parse_text_data_reloc(ctx_t * ctx, csh ud, cs_mode mode, cs_insn * ins) { int i; cs_x86 *x86; msec_t *m; // detail can be NULL on "data" instruction if SKIPDATA option is turned ON if (ins->detail == NULL) return; x86 = &(ins->detail->x86); // if(ctx->opt_debug){ // printf("\t\tRELOC Address: %lu\n", ins->address); // printf("\t\tRELOC operands.type: MEM, opcount:%u\n", x86->op_count); // } for (i = 0; i < x86->op_count; i++) { cs_x86_op *op = &(x86->operands[i]); m = 0; switch ((int) op->type) { case X86_OP_IMM: ; m = section_from_addr(ctx, op->imm); if (m) { if (i == 1) { // only match arg=1 // second argument is of form [0xdeadbeef] create_text_data_reloc(ctx, ins, m, op->imm - m->s_bfd->vma, 0, i); } else if (i == 0) { // first argument is of form [0xdeadbeef] if ((!strncmp(ins->mnemonic, "call", 4)) && (!strncmp(m->name, ".text", 5))) { // printf(" --> call to internal function at %lx\n", op->imm); internal_function_store(ctx, op->imm); } else { // TODO instrument internal/cross sections jumps and calls // printf("We have a problem: (dst section: %s)\n", m->name); // printf("0x%llx %s %s\n", ins->address, ins->mnemonic, ins->op_str); } } } break; case X86_OP_MEM: ; m = section_from_addr(ctx, op->mem.disp + ins->address + 10 * ctx->has_relativerelocations); // assume rip relative //printf("sec name: %s\t%lx\n", m ? m->name : "-", op->mem.disp + ins->address + 10*ctx->has_relativerelocations); if ((m) && (m->name) && (strncmp(m->name, ".text", 5) || ctx->has_relativerelocations) && (cs_reg_name(ud, op->mem.base)) && (!strncmp(cs_reg_name(ud, op->mem.base), "rip", 3))) { // destination section can't be .text, must be rip relative if (i == 1) { // only match arg=1 create_text_data_reloc(ctx, ins, m, op->mem.disp + ins->address - m->s_bfd->vma, 1, i); // Addressing is rip relative break; } } if (!strncmp(ins->mnemonic, "nop", 3)) { // ignore nops break; } // handle write to 1st argument, which is a rip relative mapped section if ((i == 0) && (m) && (m->name) && (strncmp(m->name, ".text", 5) || ctx->has_relativerelocations) && (cs_reg_name(ud, op->mem.base)) && (!strncmp(cs_reg_name(ud, op->mem.base), "rip", 3))) { // printf(" * handling 1st arg access : %llx %s %s (%s)\n",ins->address, ins->mnemonic, ins->op_str, m ? m->name : "-"); create_text_data_reloc(ctx, ins, m, op->mem.disp + ins->address - m->s_bfd->vma, 1, i); // Addressing is rip relative break; } break; case X86_OP_REG: // case X86_OP_MEM: default: break; } } } int analyze_text(ctx_t * ctx, char *data, unsigned int datalen, unsigned long int addr) { csh handle; cs_insn *insn; size_t count; size_t j; if (cs_open(CS_ARCH_X86, CS_MODE, &handle)) { printf("error: Failed to initialize capstone library\n"); return -1; } // request disassembly details cs_option(handle, CS_OPT_DETAIL, CS_OPT_ON); count = cs_disasm(handle, (const uint8_t *)data, datalen - 1, addr, 0, &insn); if (!count) { printf("error: Cannot disassemble code\n"); return -1; } if (ctx->opt_asmdebug) { printf(" -- parsing %lu instructions from %lx (.text) for relocations\n\n", count, addr); printf ("\n Offset Info Type Sym. Value Sym. Name + Addend\n"); } // scan instructions for relocations for (j = 0; j < count; j++) { if (ctx->opt_asmdebug) { printf("0x%" PRIx64 ":\t%s\t%s\n", insn[j].address, insn[j].mnemonic, insn[j].op_str); print_insn_detail(ctx, handle, CS_MODE, &insn[j]); } parse_text_data_reloc(ctx, handle, CS_MODE, &insn[j]); } cs_free(insn, count); cs_close(&handle); return 0; } /** * Read original symtab + strtab. BDF doesn't do this */ int rd_symtab(ctx_t * ctx) { Elf *elf; Elf_Scn *scn = NULL; GElf_Shdr shdr; int fd; const char *binary; struct stat sb; size_t shstrndx; char *sname = 0; if (ctx->opt_debug) { printf(" -- searching for .strtab/.symtab\n"); } elf_version(EV_CURRENT); fd = open(ctx->binname, O_RDONLY); fstat(fd, &sb); binary = mmap(NULL, sb.st_size, PROT_READ, MAP_PRIVATE, fd, 0); if (binary == MAP_FAILED) { perror("mmap"); exit(EXIT_FAILURE); } elf = elf_begin(fd, ELF_C_READ, NULL); if (!elf) { printf("error: not a valid ELF\n"); return -1; } if (elf_getshdrstrndx(elf, &shstrndx) != 0) { printf("error: in elf_getshdrstrndx\n"); return -1; } while ((scn = elf_nextscn(elf, scn)) != NULL) { gelf_getshdr(scn, &shdr); sname = elf_strptr(elf, shstrndx, shdr.sh_name); switch (shdr.sh_type) { case SHT_SYMTAB: if (ctx->opt_debug) { printf(" * symbol table at offset:%lu, sz:%lu\n", shdr.sh_offset, shdr.sh_size); } break; case SHT_STRTAB: if (!strncmp(sname, ".dynstr", 7)) { if (ctx->opt_debug) { printf(" * dynamic string table at offset:%lu, sz:%lu\n", shdr.sh_offset, shdr.sh_size); } save_dynstr(ctx, shdr, binary); } else { if (ctx->opt_debug) { printf(" * string table at offset:%lu, sz:%lu\n", shdr.sh_offset, shdr.sh_size); } } break; case SHT_DYNSYM: if (ctx->opt_debug) { printf(" * dynamic symbol table at offset:%lu, sz:%lu\n", shdr.sh_offset, shdr.sh_size); } save_dynsym(ctx, shdr, binary); break; default: break; } } elf_end(elf); close(fd); if ((ctx->opt_verbose) || (ctx->opt_debug)) { printf("\n"); } return 0; } /** * Suppress a given section */ int rm_section(ctx_t * ctx, char *name) { msec_t *s; msec_t *rmsec = 0; DL_FOREACH(ctx->mshdrs, s) { if (!strncmp(s->name, name, strlen(name))) { rmsec = s; break; } } if (!rmsec) { return 0; } // Not found DL_DELETE(ctx->mshdrs, rmsec); ctx->shnum--; ctx->mshnum--; return 0; } /** * Strip binary relocation data */ int strip_binary_reloc(ctx_t * ctx) { msec_t *s, *tmp; unsigned int allowed, i; if (ctx->opt_verbose) { printf("\n -- Stripping\n\n"); } DL_FOREACH_SAFE(ctx->mshdrs, s, tmp) { allowed = 0; for (i = 0; i < sizeof(allowed_sections) / sizeof(char *); i++) { if (!strncmp(s->name, allowed_sections[i], strlen(allowed_sections[i]))) { allowed = 1; break; } } if (!allowed) { if (ctx->opt_verbose) { printf(" * %s\n", s->name); } rm_section(ctx, s->name); } } if (ctx->opt_verbose) { printf("\n"); } return 0; } /** * Main routine */ unsigned int libify(ctx_t * ctx) { char const *target = NULL; int is_pe64 = 0, is_pe32 = 0; /** * * LOAD OPERATIONS * */ /** * Load each section of binary using bfd */ load_binary(ctx); /** * Print BFD sections */ print_bfd_sections(ctx); /** * Read .text segment boundaries */ rd_extended_text(ctx); rd_extended_data(ctx); extend_text(ctx); /** * Open target binary */ open_target(ctx); /** * Read sections from disk */ rd_sections(ctx); create_section_symbols(ctx); /** * Read symtab + strtab : BFD doesn't do this */ rd_symtab(ctx); fixup_strtab_and_symtab(ctx); /** * Read symbols */ target = bfd_get_target(ctx->abfd); is_pe64 = (strcmp(target, "pe-x86-64") == 0 || strcmp(target, "pei-x86-64") == 0); is_pe32 = (strcmp(target, "pe-i386") == 0 || strcmp(target, "pei-i386") == 0 || strcmp(target, "pe-arm-wince-little") == 0 || strcmp(target, "pei-arm-wince-little") == 0); if ((is_pe64) || (is_pe32)) { printf("target: %s\n", target); } else { rd_symbols(ctx); } fixup_text(ctx); /** * Add extra symbols */ add_extra_symbols(ctx); /** * Parse relocations */ parse_relocations(ctx); /** * Fix section indexes in symtab */ fixup_symtab_section_index(ctx); process_text(ctx); /** * * PROCESSING * */ /** * Copy each section content in output file */ copy_body(ctx); /** * Relocation stripping */ if ((ctx->opt_static) || (ctx->opt_reloc)) { rm_section(ctx, ".interp"); rm_section(ctx, ".dynamic"); } if (ctx->opt_reloc) { strip_binary_reloc(ctx); } /** * Create Program Headers */ if (!ctx->opt_original) { mk_phdrs(ctx); // Create Program Headers from sections } else { // Read Original Program Headers rd_phdrs(ctx); } /** * * FINAL WRITE OPERATIONS * */ /** * Write strtab and symtab */ write_strtab_and_reloc(ctx); /** * Add section headers to output file */ if (!ctx->opt_sstrip) { write_shdrs(ctx); } /** * Add segment headers to output file */ if (!ctx->opt_reloc) { if (!ctx->opt_original) { write_phdrs(ctx); } else { write_phdrs_original(ctx); } } /** * Add ELF Header to output file */ mk_ehdr(ctx); /** * Finalize/Close/Cleanup */ return 0; } /** * Print content of /proc/pid/maps */ int print_maps(void) { char cmd[1024]; sprintf(cmd, "cat /proc/%u/maps", getpid()); system(cmd); return 0; } /** * Initialize a reversing context */ ctx_t *ctx_init(void) { ctx_t *ctx; bfd_init(); errno = 0; ctx = calloc(1, sizeof(ctx_t)); if (!ctx) { printf("error: calloc(): %s\n", strerror(errno)); exit(EXIT_FAILURE); } /** * Set default values */ ctx->strndx = calloc(1, DEFAULT_STRNDX_SIZE); ctx->mshdrs = NULL; return ctx; } int usage(char *name) { printf("Usage: %s [options] file\n", name); printf("\noptions:\n\n"); printf(" -o, --output \n"); printf(" -m, --march \n"); printf(" -e, --entrypoint <0xaddress>\n"); printf(" -i, --interpreter \n"); printf(" -p, --poison \n"); printf(" -s, --shared\n"); printf(" -c, --compile\n"); printf(" -S, --static\n"); printf(" -x, --strip\n"); printf(" -X, --sstrip\n"); printf(" -E, --exec\n"); printf(" -C, --core\n"); printf(" -O, --original\n"); printf(" -D, --disasm\n"); printf(" -d, --debug\n"); printf(" -h, --help\n"); printf(" -v, --verbose\n"); printf(" -V, --version\n"); printf("\n"); return 0; } int print_version(void) { printf("%s version:%s (%s %s)\n", WNAME, WVERSION, WTIME, WDATE); return 0; } int desired_arch(ctx_t * ctx, char *name) { unsigned int i = 0; for (i = 0; i < sizeof(wccarch) / sizeof(archi_t); i++) { if (!strncmp(wccarch[i].name, name, strlen(name))) { if (ctx->opt_verbose) { printf(" * architecture: %s\n", name); } return wccarch[i].value; } } printf("error: architecture %s not supported\n", name); exit(EXIT_FAILURE); return 0; } int ctx_getopt(ctx_t * ctx, int argc, char **argv) { const char *short_opt = "ho:i:scSEsxCvVXp:Odm:e:f:D"; int count = 0; struct stat sb; int c; struct option long_opt[] = { {"help", no_argument, NULL, 'h'}, {"march", required_argument, NULL, 'm'}, {"output", required_argument, NULL, 'o'}, {"shared", no_argument, NULL, 's'}, {"compile", no_argument, NULL, 'c'}, {"debug", no_argument, NULL, 'd'}, {"disasm", no_argument, NULL, 'D'}, {"static", no_argument, NULL, 'S'}, {"exec", no_argument, NULL, 'E'}, {"core", no_argument, NULL, 'C'}, {"strip", no_argument, NULL, 'x'}, {"sstrip", no_argument, NULL, 'X'}, {"entrypoint", required_argument, NULL, 'e'}, {"interpreter", required_argument, NULL, 'i'}, {"poison", required_argument, NULL, 'p'}, {"original", no_argument, NULL, 'O'}, {"verbose", no_argument, NULL, 'v'}, {"version", no_argument, NULL, 'V'}, {NULL, 0, NULL, 0} }; // Parse options if (argc < 2) { print_version(); printf("\n"); usage(argv[0]); exit(EXIT_SUCCESS); } while ((c = getopt_long(argc, argv, short_opt, long_opt, NULL)) != -1) { count++; switch (c) { case -1: /* no more arguments */ case 0: break; case 'c': ctx->opt_reloc = 1; break; case 'C': ctx->opt_core = 1; break; case 'd': ctx->opt_debug = 1; ctx->opt_verbose = 1; break; case 'D': ctx->opt_asmdebug = 1; break; case 'e': ctx->opt_entrypoint = strtoul(optarg, NULL, 16); count++; break; case 'E': ctx->opt_exec = 1; break; case 'f': ctx->opt_flags = strtoul(optarg, NULL, 16); count++; break; case 'h': usage(argv[0]); exit(0); break; case 'i': ctx->opt_interp = strdup(optarg); count++; break; case 'm': ctx->opt_arch = desired_arch(ctx, optarg); count++; break; case 'o': ctx->opt_binname = strdup(optarg); count++; break; case 'O': ctx->opt_original = 1; break; case 'p': ctx->opt_poison = optarg[0]; count++; break; case 's': ctx->opt_shared = 1; break; case 'S': ctx->opt_static = 1; break; case 'v': ctx->opt_verbose = 1; break; case 'V': print_version(); exit(EXIT_SUCCESS); break; case 'x': ctx->opt_strip = 1; break; case 'X': ctx->opt_sstrip = 1; break; case ':': case '?': fprintf(stderr, "Try `%s --help' for more information.\n", argv[0]); exit(-2); default: fprintf(stderr, "%s: invalid option -- %c\n", argv[0], c); fprintf(stderr, "Try `%s --help' for more information.\n", argv[0]); exit(-2); }; }; // arguments sanity checks if (count >= argc - 1) { fprintf(stderr, "error: No source binary found in arguments.\n"); fprintf(stderr, "Try `%s --help' for more information.\n", argv[0]); exit(-2); } // verify target file exists if (stat(argv[count + 1], &sb)) { printf("error: Could not open file %s : %s\n", argv[count + 1], strerror(errno)); exit(EXIT_FAILURE); } // store original size orig_sz = sb.st_size; if (ctx->opt_debug) { printf(" -- Analysing: %s\n", argv[count + 1]); } // copy target file name ctx->binname = strdup(argv[count + 1]); return 0; } /** * Application Entry Point */ int main(int argc, char **argv) { ctx_t *ctx; ctx = ctx_init(); ctx_getopt(ctx, argc, argv); libify(ctx); return 0; } wcc-0.0.2/src/wcc/Makefile0000644000175000017500000000264413110675433013753 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # # Note: # You will need to provide your own 32b static library for libbfd if you # want to cross compile to 32b intel from amd64. Simply installing # the 32b library on top of a 64b system breaks ubuntu. # # Note that the 64bits version of wcc generates 64b ELF files, # while the 32bits version generates 32b ELF files. # So there is a point in having both. Cross compiling to # other architectures (eg ARM) seems pointless : the 32b intel # version can process 32b ARM, and the 64b version process AARCH64. # # Compiling natively on ARM or other architectures should work provided # capstone and libbfd are installed on the system. # WCC := ./wcc FILE := file all:: $(CC) $(CFLAGS) wcc.c -o wcc -lbfd -lelf -lcapstone # $(CC) $(CFLAGS) -m32 -Wl,-rpath /home/jonathan/solution-exp/unlinking/awareness/self/wcc/src/wcc/lib32/ wcc.c -o wcc32 -lelf ./lib32/libbfd-2.24-system.so ./lib32/libcapstone.so.3 cp wcc ../../bin/ # cp wcc32 ../../bin/ test:: $(WCC) /bin/ls -o ./ls.o -c $(CC) ./ls.o -o ./ls.so -shared -g3 -ggdb -O0 $(FILE) ls.so clean: rm -f wcc a.out wcc.o core wcc32 ls.o ls.so install: cp wcc $(DESTDIR)/usr/bin/wcc # cp wcc32 $(DESTDIR)/usr/bin/wcc32 uninstall: rm $(DESTDIR)/usr/bin/wcc -f # rm $(DESTDIR)/usr/bin/wcc32 -f wcc-0.0.2/src/wsh/0000755000175000017500000000000013110675433012332 5ustar philphilwcc-0.0.2/src/wsh/openlibm/0000755000175000017500000000000013122010155014122 5ustar philphilwcc-0.0.2/src/wsh/openlibm/Make.inc0000644000175000017500000000672313122010155015502 0ustar philphil# -*- mode: makefile-gmake -*- OS := $(shell uname) # Do not forget to bump SOMINOR when changing VERSION, # and SOMAJOR when breaking ABI in a backward-incompatible way VERSION = 0.5.2 SOMAJOR = 2 SOMINOR = 3 DESTDIR = prefix = /usr/local bindir = $(prefix)/bin libdir = $(prefix)/lib includedir = $(prefix)/include ifeq ($(OS), FreeBSD) pkgconfigdir = $(prefix)/libdata/pkgconfig else pkgconfigdir = $(libdir)/pkgconfig endif USEGCC = 1 USECLANG = 0 ifeq ($(OS), Darwin) USEGCC = 0 USECLANG = 1 endif ifeq ($(OS), FreeBSD) USEGCC = 0 USECLANG = 1 endif AR = ar ifeq ($(USECLANG),1) USEGCC = 0 CC = clang CFLAGS_add += -fno-builtin endif ifeq ($(USEGCC),1) CC = gcc CFLAGS_add += -fno-gnu89-inline -fno-builtin endif ARCH ?= $(shell $(CC) -dumpmachine | sed "s/\([^-]*\).*$$/\1/") ARCH_ORIGIN := $(origin ARCH) ifeq ($(ARCH),mingw32) $(error "the mingw32 compiler you are using fails the openblas testsuite. please see the Julia README.windows.md document for a replacement") endif CFLAGS_add += -std=c99 -Wall -I$(OPENLIBM_HOME) -I$(OPENLIBM_HOME)/include -I$(OPENLIBM_HOME)/ld80 -I$(OPENLIBM_HOME)/$(ARCH) -I$(OPENLIBM_HOME)/src -DASSEMBLER -D__BSD_VISIBLE -Wno-implicit-function-declaration default: all # *int / *intf need to be built with -O0 src/%int.c.o: src/%int.c $(CC) $(CPPFLAGS) -O0 $(CFLAGS_add) -c $< -o $@ src/%intf.c.o: src/%intf.c $(CC) $(CPPFLAGS) -O0 $(CFLAGS_add) -c $< -o $@ %.c.o: %.c $(CC) $(CPPFLAGS) $(CFLAGS) $(CFLAGS_add) -c $< -o $@ %.S.o: %.S $(CC) $(CPPFLAGS) $(SFLAGS) $(SFLAGS_add) $(filter -m% -B% -I% -D%,$(CFLAGS_add)) -c $< -o $@ # OS-specific stuff REAL_ARCH := $(ARCH) ifeq ($(findstring arm,$(ARCH)),arm) override ARCH := arm endif ifeq ($(ARCH),aarch64) override ARCH := arm endif ifeq ($(findstring powerpc,$(ARCH)),powerpc) override ARCH := powerpc endif ifeq ($(findstring ppc,$(ARCH)),ppc) override ARCH := powerpc endif ifeq ($(ARCH),i386) override ARCH := i387 endif ifeq ($(ARCH),i486) override ARCH := i387 endif ifeq ($(ARCH),i586) override ARCH := i387 endif ifeq ($(ARCH),i686) override ARCH := i387 endif ifeq ($(ARCH),x86_64) override ARCH := amd64 endif # The optimization flag may be overriden with the environment variable CFLAGS. CFLAGS ?= -O3 ifneq (,$(findstring MINGW,$(OS))) override OS=WINNT endif #keep these if statements separate ifeq ($(OS), WINNT) SHLIB_EXT = dll SONAME_FLAG = -soname CFLAGS_add += -nodefaultlibs shlibdir = $(bindir) else ifeq ($(OS), Darwin) SHLIB_EXT = dylib SONAME_FLAG = -install_name else SHLIB_EXT = so SONAME_FLAG = -soname endif CFLAGS_add += -fPIC shlibdir = $(libdir) endif # The target specific FLAGS_add ifeq ($(ARCH_ORIGIN),file) CFLAGS_add_TARGET_$(ARCH) := SFLAGS_add_TARGET_$(ARCH) := LDFLAGS_add_TARGET_$(ARCH) := else ifeq ($(ARCH),i387) CFLAGS_add_TARGET_$(ARCH) := -m32 -march=$(REAL_ARCH) SFLAGS_add_TARGET_$(ARCH) := -m32 -march=$(REAL_ARCH) LDFLAGS_add_TARGET_$(ARCH) := -m32 -march=$(REAL_ARCH) endif CFLAGS_add_TARGET_x86_64 := -m64 SFLAGS_add_TARGET_x86_64 := -m64 LDFLAGS_add_TARGET_x86_64 := -m64 # Arm ifeq ($(ARCH),arm) ifneq ($(REAL_ARCH),arm) CFLAGS_add_TARGET_$(ARCH) := -march=$(REAL_ARCH) SFLAGS_add_TARGET_$(ARCH) := -march=$(REAL_ARCH) LDFLAGS_add_TARGET_$(ARCH) := -march=$(REAL_ARCH) else $(error No known generic arm cflags. Please specify arch type) endif endif endif # Actually finish setting the FLAGS_add CFLAGS_add += $(CFLAGS_add_TARGET_$(ARCH)) LDFLAGS_add += $(LDFLAGS_add_TARGET_$(ARCH)) SFLAGS_add += $(SFLAGS_add_TARGET_$(ARCH)) wcc-0.0.2/src/wsh/openlibm/openlibm.pc.in0000644000175000017500000000042113122010155016655 0ustar philphilexec_prefix=${prefix} includedir=${prefix}/include libdir=${exec_prefix}/lib Name: openlibm Version: ${version} URL: https://github.com/JuliaLang/openlibm Description: High quality system independent, open source libm. Cflags: -I${includedir} Libs: -L${libdir} -lopenlibm wcc-0.0.2/src/wsh/openlibm/amd64/0000755000175000017500000000000013122010155015035 5ustar philphilwcc-0.0.2/src/wsh/openlibm/amd64/e_remainderl.S0000644000175000017500000000111413122010155017604 0ustar philphil/* * Based on the i387 version written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/e_remainderl.S,v 1.2 2011/01/07 16:13:12 kib Exp $") ENTRY(remainderl) #ifndef _WIN64 fldt 24(%rsp) fldt 8(%rsp) #else fldt (%r8) fldt (%rdx) #endif 1: fprem1 fstsw %ax testw $0x400,%ax jne 1b fstp %st(1) #ifdef _WIN64 mov %rcx,%rax movq $0x0,0x8(%rcx) fstpt (%rcx) #endif ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_scalbn.S0000644000175000017500000000363513122010155016754 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_scalbn.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(scalbn) movsd %xmm0,-8(%rsp) #ifndef _WIN64 movl %edi,-12(%rsp) #else movl %edx,-12(%rsp) #endif fildl -12(%rsp) fldl -8(%rsp) fscale fstp %st(1) fstpl -8(%rsp) movsd -8(%rsp),%xmm0 ret #ifndef _WIN64 END(scalbn) .globl CNAME(ldexp) #else .globl CNAME(ldexp); .section .drectve; .ascii " -export:ldexp" #endif .set CNAME(ldexp),CNAME(scalbn) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_lrintf.S0000644000175000017500000000323713122010155017006 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_lrintf.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(lrintf) #ifndef _WIN64 cvtss2si %xmm0, %rax #else cvtss2si %xmm0, %eax #endif ret END(lrintf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/e_sqrtl.S0000644000175000017500000000333113122010155016632 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/e_sqrtl.S,v 1.2 2011/01/07 16:13:12 kib Exp $") ENTRY(sqrtl) #ifndef _WIN64 fldt 8(%rsp) fsqrt #else fldt (%rdx) fsqrt mov %rcx,%rax movq $0x0,0x8(%rcx) fstpt (%rcx) #endif ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/bsd_ieeefp.h0000644000175000017500000001746413122010155017307 0ustar philphil/*- * Copyright (c) 2003 Peter Wemm. * Copyright (c) 1990 Andrew Moore, Talke Studio * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#) ieeefp.h 1.0 (Berkeley) 9/23/93 * $FreeBSD: src/sys/amd64/include/ieeefp.h,v 1.14 2005/04/12 23:12:00 jhb Exp $ */ /* * IEEE floating point type and constant definitions. */ #ifndef _BSD_IEEEFP_H_ #define _BSD_IEEEFP_H_ /* * FP rounding modes */ typedef enum { FP_RN=0, /* round to nearest */ FP_RM, /* round down to minus infinity */ FP_RP, /* round up to plus infinity */ FP_RZ /* truncate */ } fp_rnd_t; /* * FP precision modes */ typedef enum { FP_PS=0, /* 24 bit (single-precision) */ FP_PRS, /* reserved */ FP_PD, /* 53 bit (double-precision) */ FP_PE /* 64 bit (extended-precision) */ } fp_prec_t; #define fp_except_t int /* * FP exception masks */ #define FP_X_INV 0x01 /* invalid operation */ #define FP_X_DNML 0x02 /* denormal */ #define FP_X_DZ 0x04 /* zero divide */ #define FP_X_OFL 0x08 /* overflow */ #define FP_X_UFL 0x10 /* underflow */ #define FP_X_IMP 0x20 /* (im)precision */ #define FP_X_STK 0x40 /* stack fault */ /* * FP registers */ #define FP_MSKS_REG 0 /* exception masks */ #define FP_PRC_REG 0 /* precision */ #define FP_RND_REG 0 /* direction */ #define FP_STKY_REG 1 /* sticky flags */ /* * FP register bit field masks */ #define FP_MSKS_FLD 0x3f /* exception masks field */ #define FP_PRC_FLD 0x300 /* precision control field */ #define FP_RND_FLD 0xc00 /* round control field */ #define FP_STKY_FLD 0x3f /* sticky flags field */ /* * SSE mxcsr register bit field masks */ #define SSE_STKY_FLD 0x3f /* exception flags */ #define SSE_DAZ_FLD 0x40 /* Denormals are zero */ #define SSE_MSKS_FLD 0x1f80 /* exception masks field */ #define SSE_RND_FLD 0x6000 /* rounding control */ #define SSE_FZ_FLD 0x8000 /* flush to zero on underflow */ /* * FP register bit field offsets */ #define FP_MSKS_OFF 0 /* exception masks offset */ #define FP_PRC_OFF 8 /* precision control offset */ #define FP_RND_OFF 10 /* round control offset */ #define FP_STKY_OFF 0 /* sticky flags offset */ /* * SSE mxcsr register bit field offsets */ #define SSE_STKY_OFF 0 /* exception flags offset */ #define SSE_DAZ_OFF 6 /* DAZ exception mask offset */ #define SSE_MSKS_OFF 7 /* other exception masks offset */ #define SSE_RND_OFF 13 /* rounding control offset */ #define SSE_FZ_OFF 15 /* flush to zero offset */ #if (defined(__GNUCLIKE_ASM) && defined(__CC_SUPPORTS___INLINE__)) || defined(_WIN32) \ && !defined(__cplusplus) #define __fldenv(addr) __asm __volatile("fldenv %0" : : "m" (*(addr))) #define __fnstenv(addr) __asm __volatile("fnstenv %0" : "=m" (*(addr))) #define __fldcw(addr) __asm __volatile("fldcw %0" : : "m" (*(addr))) #define __fnstcw(addr) __asm __volatile("fnstcw %0" : "=m" (*(addr))) #define __fnstsw(addr) __asm __volatile("fnstsw %0" : "=m" (*(addr))) #define __ldmxcsr(addr) __asm __volatile("ldmxcsr %0" : : "m" (*(addr))) #define __stmxcsr(addr) __asm __volatile("stmxcsr %0" : "=m" (*(addr))) /* * General notes about conflicting SSE vs FP status bits. * This code assumes that software will not fiddle with the control * bits of the SSE and x87 in such a way to get them out of sync and * still expect this to work. Break this at your peril. * Because I based this on the i386 port, the x87 state is used for * the fpget*() functions, and is shadowed into the SSE state for * the fpset*() functions. For dual source fpget*() functions, I * merge the two together. I think. */ /* Set rounding control */ static __inline__ fp_rnd_t __fpgetround(void) { unsigned short _cw; __fnstcw(&_cw); return ((_cw & FP_RND_FLD) >> FP_RND_OFF); } static __inline__ fp_rnd_t __fpsetround(fp_rnd_t _m) { unsigned short _cw; unsigned int _mxcsr; fp_rnd_t _p; __fnstcw(&_cw); _p = (_cw & FP_RND_FLD) >> FP_RND_OFF; _cw &= ~FP_RND_FLD; _cw |= (_m << FP_RND_OFF) & FP_RND_FLD; __fldcw(&_cw); __stmxcsr(&_mxcsr); _mxcsr &= ~SSE_RND_FLD; _mxcsr |= (_m << SSE_RND_OFF) & SSE_RND_FLD; __ldmxcsr(&_mxcsr); return (_p); } /* * Set precision for fadd/fsub/fsqrt etc x87 instructions * There is no equivalent SSE mode or control. */ static __inline__ fp_prec_t __fpgetprec(void) { unsigned short _cw; __fnstcw(&_cw); return ((_cw & FP_PRC_FLD) >> FP_PRC_OFF); } static __inline__ fp_prec_t __fpsetprec(fp_rnd_t _m) { unsigned short _cw; fp_prec_t _p; __fnstcw(&_cw); _p = (_cw & FP_PRC_FLD) >> FP_PRC_OFF; _cw &= ~FP_PRC_FLD; _cw |= (_m << FP_PRC_OFF) & FP_PRC_FLD; __fldcw(&_cw); return (_p); } /* * Look at the exception masks * Note that x87 masks are inverse of the fp*() functions * API. ie: mask = 1 means disable for x87 and SSE, but * for the fp*() api, mask = 1 means enabled. */ static __inline__ fp_except_t __fpgetmask(void) { unsigned short _cw; __fnstcw(&_cw); return ((~_cw) & FP_MSKS_FLD); } static __inline__ fp_except_t __fpsetmask(fp_except_t _m) { unsigned short _cw; unsigned int _mxcsr; fp_except_t _p; __fnstcw(&_cw); _p = (~_cw) & FP_MSKS_FLD; _cw &= ~FP_MSKS_FLD; _cw |= (~_m) & FP_MSKS_FLD; __fldcw(&_cw); __stmxcsr(&_mxcsr); /* XXX should we clear non-ieee SSE_DAZ_FLD and SSE_FZ_FLD ? */ _mxcsr &= ~SSE_MSKS_FLD; _mxcsr |= ((~_m) << SSE_MSKS_OFF) & SSE_MSKS_FLD; __ldmxcsr(&_mxcsr); return (_p); } /* See which sticky exceptions are pending, and reset them */ static __inline__ fp_except_t __fpgetsticky(void) { unsigned short _sw; unsigned int _mxcsr; fp_except_t _ex; __fnstsw(&_sw); _ex = _sw & FP_STKY_FLD; __stmxcsr(&_mxcsr); _ex |= _mxcsr & SSE_STKY_FLD; return (_ex); } #endif /* __GNUCLIKE_ASM && __CC_SUPPORTS___INLINE__ && !__cplusplus */ #if !defined(__IEEEFP_NOINLINES__) && !defined(__cplusplus) \ && defined(__GNUCLIKE_ASM) && defined(__CC_SUPPORTS___INLINE__) #define fpgetround() __fpgetround() #define fpsetround(_m) __fpsetround(_m) #define fpgetprec() __fpgetprec() #define fpsetprec(_m) __fpsetprec(_m) #define fpgetmask() __fpgetmask() #define fpsetmask(_m) __fpsetmask(_m) #define fpgetsticky() __fpgetsticky() /* Suppress prototypes in the MI header. */ #define _IEEEFP_INLINED_ 1 #else /* !__IEEEFP_NOINLINES__ && !__cplusplus && __GNUCLIKE_ASM && __CC_SUPPORTS___INLINE__ */ /* Augment the userland declarations */ __BEGIN_DECLS extern fp_prec_t fpgetprec(void); extern fp_prec_t fpsetprec(fp_prec_t); __END_DECLS #endif /* !__IEEEFP_NOINLINES__ && !__cplusplus && __GNUCLIKE_ASM && __CC_SUPPORTS___INLINE__ */ #endif /* !_BSD_IEEEFP_H_ */ wcc-0.0.2/src/wsh/openlibm/amd64/s_remquol.S0000644000175000017500000000462513122010155017176 0ustar philphil/*- * Copyright (c) 2005-2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* * Based on public-domain remainder routine by J.T. Conklin . */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_remquol.S,v 1.2 2011/01/07 16:13:12 kib Exp $"); ENTRY(remquol) #ifndef _WIN64 fldt 24(%rsp) fldt 8(%rsp) #else fldt (%r8) fldt (%rdx) mov %rcx,%r8 #endif 1: fprem1 fstsw %ax btw $10,%ax jc 1b fstp %st(1) /* Extract the three low-order bits of the quotient from C0,C3,C1. */ shrl $6,%eax movl %eax,%ecx andl $0x108,%eax rorl $7,%eax orl %eax,%ecx roll $4,%eax orl %ecx,%eax andl $7,%eax /* Negate the quotient bits if x*y<0. Avoid using an unpredictable branch. */ movl 32(%rsp),%ecx xorl 16(%rsp),%ecx movsx %cx,%ecx sarl $16,%ecx sarl $16,%ecx xorl %ecx,%eax andl $1,%ecx addl %ecx,%eax /* Store the quotient and return. */ #ifndef _WIN64 movl %eax,(%rdi) #else movl %eax,(%r9) mov %r8,%rax movq $0x0,0x8(%r8) fstpt (%r8) #endif ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/e_sqrt.S0000644000175000017500000000314713122010155016463 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/e_sqrt.S,v 1.4 2011/01/07 16:13:12 kib Exp $") ENTRY(sqrt) sqrtsd %xmm0, %xmm0 ret END(sqrt) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_scalbnf.S0000644000175000017500000000364213122010155017120 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_scalbnf.S,v 1.4 2011/01/07 16:13:12 kib Exp $") ENTRY(scalbnf) movss %xmm0,-8(%rsp) #ifndef _WIN64 movl %edi,-4(%rsp) #else movl %edx,-4(%rsp) #endif fildl -4(%rsp) flds -8(%rsp) fscale fstp %st(1) fstps -8(%rsp) movss -8(%rsp),%xmm0 ret #ifndef _WIN64 END(scalbnf) .globl CNAME(ldexpf) #else .globl CNAME(ldexpf); .section .drectve; .ascii " -export:ldexpf" #endif .set CNAME(ldexpf),CNAME(scalbnf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_lrint.S0000644000175000017500000000323413122010155016635 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_lrint.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(lrint) #ifndef _WIN64 cvtsd2si %xmm0, %rax #else cvtsd2si %xmm0, %eax #endif ret END(lrint) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/Make.files0000644000175000017500000000043613122010155016741 0ustar philphil$(CUR_SRCS) = fenv.c e_remainder.S e_remainderf.S e_remainderl.S \ e_sqrt.S e_sqrtf.S e_sqrtl.S \ s_llrint.S s_llrintf.S s_llrintl.S \ s_logbl.S s_lrint.S s_lrintf.S s_lrintl.S \ s_remquo.S s_remquof.S s_remquol.S \ s_rintl.S s_scalbn.S s_scalbnf.S s_scalbnl.S wcc-0.0.2/src/wsh/openlibm/amd64/s_llrintf.S0000644000175000017500000000042013122010155017151 0ustar philphil#include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_llrintf.S,v 1.3 2011/02/04 21:54:06 kib Exp $") ENTRY(llrintf) cvtss2si %xmm0, %rax ret END(llrintf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_llrintl.S0000644000175000017500000000326413122010155017170 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_llrintl.S,v 1.2 2011/01/07 16:13:12 kib Exp $"); ENTRY(llrintl) #ifndef _WIN64 fldt 8(%rsp) #else fldt (%rcx) #endif subq $8,%rsp fistpll (%rsp) popq %rax ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_rintl.S0000644000175000017500000000056113122010155016635 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include ENTRY(rintl) #ifndef _WIN64 fldt 8(%rsp) frndint #else fldt (%rdx) frndint mov %rcx,%rax movq $0x0,0x8(%rcx) fstpt (%rcx) #endif ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/fenv.c0000644000175000017500000001004313122010155016135 0ustar philphil/*- * Copyright (c) 2004-2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/amd64/fenv.c,v 1.8 2011/10/21 06:25:31 das Exp $ */ #include "bsd_fpu.h" #include "math_private.h" #ifdef _WIN32 #define __fenv_static OLM_DLLEXPORT #endif #include #ifdef __GNUC_GNU_INLINE__ #error "This file must be compiled with C99 'inline' semantics" #endif const fenv_t __fe_dfl_env = { { 0xffff0000 | __INITIAL_FPUCW__, 0xffff0000, 0xffffffff, { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff } }, __INITIAL_MXCSR__ }; extern inline OLM_DLLEXPORT int feclearexcept(int __excepts); extern inline OLM_DLLEXPORT int fegetexceptflag(fexcept_t *__flagp, int __excepts); OLM_DLLEXPORT int fesetexceptflag(const fexcept_t *flagp, int excepts) { fenv_t env; __fnstenv(&env.__x87); env.__x87.__status &= ~excepts; env.__x87.__status |= *flagp & excepts; __fldenv(env.__x87); __stmxcsr(&env.__mxcsr); env.__mxcsr &= ~excepts; env.__mxcsr |= *flagp & excepts; __ldmxcsr(env.__mxcsr); return (0); } OLM_DLLEXPORT int feraiseexcept(int excepts) { fexcept_t ex = excepts; fesetexceptflag(&ex, excepts); __fwait(); return (0); } extern inline OLM_DLLEXPORT int fetestexcept(int __excepts); extern inline OLM_DLLEXPORT int fegetround(void); extern inline OLM_DLLEXPORT int fesetround(int __round); OLM_DLLEXPORT int fegetenv(fenv_t *envp) { __fnstenv(&envp->__x87); __stmxcsr(&envp->__mxcsr); /* * fnstenv masks all exceptions, so we need to restore the * control word to avoid this side effect. */ __fldcw(envp->__x87.__control); return (0); } OLM_DLLEXPORT int feholdexcept(fenv_t *envp) { uint32_t mxcsr; __stmxcsr(&mxcsr); __fnstenv(&envp->__x87); __fnclex(); envp->__mxcsr = mxcsr; mxcsr &= ~FE_ALL_EXCEPT; mxcsr |= FE_ALL_EXCEPT << _SSE_EMASK_SHIFT; __ldmxcsr(mxcsr); return (0); } extern inline OLM_DLLEXPORT int fesetenv(const fenv_t *__envp); OLM_DLLEXPORT int feupdateenv(const fenv_t *envp) { uint32_t mxcsr; uint16_t status; __fnstsw(&status); __stmxcsr(&mxcsr); fesetenv(envp); feraiseexcept((mxcsr | status) & FE_ALL_EXCEPT); return (0); } int feenableexcept(int mask) { uint32_t mxcsr, omask; uint16_t control; mask &= FE_ALL_EXCEPT; __fnstcw(&control); __stmxcsr(&mxcsr); omask = ~(control | mxcsr >> _SSE_EMASK_SHIFT) & FE_ALL_EXCEPT; control &= ~mask; __fldcw(control); mxcsr &= ~(mask << _SSE_EMASK_SHIFT); __ldmxcsr(mxcsr); return (omask); } int fedisableexcept(int mask) { uint32_t mxcsr, omask; uint16_t control; mask &= FE_ALL_EXCEPT; __fnstcw(&control); __stmxcsr(&mxcsr); omask = ~(control | mxcsr >> _SSE_EMASK_SHIFT) & FE_ALL_EXCEPT; control |= mask; __fldcw(control); mxcsr |= mask << _SSE_EMASK_SHIFT; __ldmxcsr(mxcsr); return (omask); } wcc-0.0.2/src/wsh/openlibm/amd64/s_llrint.S0000644000175000017500000000041513122010155017007 0ustar philphil#include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_llrint.S,v 1.3 2011/02/04 21:54:06 kib Exp $") ENTRY(llrint) cvtsd2si %xmm0, %rax ret END(llrint) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_remquof.S0000644000175000017500000000450313122010155017163 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* * Based on public-domain remainder routine by J.T. Conklin . */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_remquof.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); ENTRY(remquof) movss %xmm0,-4(%rsp) movss %xmm1,-8(%rsp) flds -8(%rsp) flds -4(%rsp) 1: fprem1 fstsw %ax btw $10,%ax jc 1b fstp %st(1) /* Extract the three low-order bits of the quotient from C0,C3,C1. */ shrl $6,%eax movl %eax,%ecx andl $0x108,%eax rorl $7,%eax orl %eax,%ecx roll $4,%eax orl %ecx,%eax andl $7,%eax /* Negate the quotient bits if x*y<0. Avoid using an unpredictable branch. */ movl -8(%rsp),%ecx xorl -4(%rsp),%ecx sarl $16,%ecx sarl $16,%ecx xorl %ecx,%eax andl $1,%ecx addl %ecx,%eax /* Store the quotient and return. */ #ifndef _WIN64 movl %eax,(%rdi) #else movl %eax,(%r8) #endif fstps -4(%rsp) movss -4(%rsp),%xmm0 ret END(remquof) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_lrintl.S0000644000175000017500000000325513122010155017014 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_lrintl.S,v 1.2 2011/01/07 16:13:12 kib Exp $"); ENTRY(lrintl) #ifndef _WIN64 fldt 8(%rsp) #else fldt (%rcx) #endif subq $8,%rsp fistpll (%rsp) popq %rax ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/bsd_fpu.h0000644000175000017500000001541513122010155016636 0ustar philphil/*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)npx.h 5.3 (Berkeley) 1/18/91 * $FreeBSD: src/sys/x86/include/fpu.h,v 1.1 2012/03/16 20:24:30 tijl Exp $ */ /* * Floating Point Data Structures and Constants * W. Jolitz 1/90 */ #ifndef _BSD_FPU_H_ #define _BSD_FPU_H_ #include "types-compat.h" /* Environment information of floating point unit. */ struct env87 { int32_t en_cw; /* control word (16bits) */ int32_t en_sw; /* status word (16bits) */ int32_t en_tw; /* tag word (16bits) */ int32_t en_fip; /* fp instruction pointer */ uint16_t en_fcs; /* fp code segment selector */ uint16_t en_opcode; /* opcode last executed (11 bits) */ int32_t en_foo; /* fp operand offset */ int32_t en_fos; /* fp operand segment selector */ }; /* Contents of each x87 floating point accumulator. */ struct fpacc87 { uint8_t fp_bytes[10]; }; /* Floating point context. (i386 fnsave/frstor) */ struct save87 { struct env87 sv_env; /* floating point control/status */ struct fpacc87 sv_ac[8]; /* accumulator contents, 0-7 */ uint8_t sv_pad0[4]; /* saved status word (now unused) */ /* * Bogus padding for emulators. Emulators should use their own * struct and arrange to store into this struct (ending here) * before it is inspected for ptracing or for core dumps. Some * emulators overwrite the whole struct. We have no good way of * knowing how much padding to leave. Leave just enough for the * GPL emulator's i387_union (176 bytes total). */ uint8_t sv_pad[64]; /* padding; used by emulators */ }; /* Contents of each SSE extended accumulator. */ struct xmmacc { uint8_t xmm_bytes[16]; }; /* Contents of the upper 16 bytes of each AVX extended accumulator. */ struct ymmacc { uint8_t ymm_bytes[16]; }; /* Rename structs below depending on machine architecture. */ #ifdef __i386__ #define __envxmm32 envxmm #else #define __envxmm32 envxmm32 #define __envxmm64 envxmm #endif struct __envxmm32 { uint16_t en_cw; /* control word (16bits) */ uint16_t en_sw; /* status word (16bits) */ uint16_t en_tw; /* tag word (16bits) */ uint16_t en_opcode; /* opcode last executed (11 bits) */ uint32_t en_fip; /* fp instruction pointer */ uint16_t en_fcs; /* fp code segment selector */ uint16_t en_pad0; /* padding */ uint32_t en_foo; /* fp operand offset */ uint16_t en_fos; /* fp operand segment selector */ uint16_t en_pad1; /* padding */ uint32_t en_mxcsr; /* SSE control/status register */ uint32_t en_mxcsr_mask; /* valid bits in mxcsr */ }; struct __envxmm64 { uint16_t en_cw; /* control word (16bits) */ uint16_t en_sw; /* status word (16bits) */ uint8_t en_tw; /* tag word (8bits) */ uint8_t en_zero; uint16_t en_opcode; /* opcode last executed (11 bits ) */ uint64_t en_rip; /* fp instruction pointer */ uint64_t en_rdp; /* fp operand pointer */ uint32_t en_mxcsr; /* SSE control/status register */ uint32_t en_mxcsr_mask; /* valid bits in mxcsr */ }; /* Floating point context. (i386 fxsave/fxrstor) */ struct savexmm { struct __envxmm32 sv_env; struct { struct fpacc87 fp_acc; uint8_t fp_pad[6]; /* padding */ } sv_fp[8]; struct xmmacc sv_xmm[8]; uint8_t sv_pad[224]; } __attribute__ ((aligned(16))); #ifdef __i386__ union savefpu { struct save87 sv_87; struct savexmm sv_xmm; }; #else /* Floating point context. (amd64 fxsave/fxrstor) */ struct savefpu { struct __envxmm64 sv_env; struct { struct fpacc87 fp_acc; uint8_t fp_pad[6]; /* padding */ } sv_fp[8]; struct xmmacc sv_xmm[16]; uint8_t sv_pad[96]; } __attribute__ ((aligned(16))); #endif struct xstate_hdr { uint64_t xstate_bv; uint8_t xstate_rsrv0[16]; uint8_t xstate_rsrv[40]; }; struct savexmm_xstate { struct xstate_hdr sx_hd; struct ymmacc sx_ymm[16]; }; struct savexmm_ymm { struct __envxmm32 sv_env; struct { struct fpacc87 fp_acc; int8_t fp_pad[6]; /* padding */ } sv_fp[8]; struct xmmacc sv_xmm[16]; uint8_t sv_pad[96]; struct savexmm_xstate sv_xstate; } __attribute__ ((aligned(16))); struct savefpu_xstate { struct xstate_hdr sx_hd; struct ymmacc sx_ymm[16]; }; struct savefpu_ymm { struct __envxmm64 sv_env; struct { struct fpacc87 fp_acc; int8_t fp_pad[6]; /* padding */ } sv_fp[8]; struct xmmacc sv_xmm[16]; uint8_t sv_pad[96]; struct savefpu_xstate sv_xstate; } __attribute__ ((aligned(64))); #undef __envxmm32 #undef __envxmm64 /* * The hardware default control word for i387's and later coprocessors is * 0x37F, giving: * * round to nearest * 64-bit precision * all exceptions masked. * * FreeBSD/i386 uses 53 bit precision for things like fadd/fsub/fsqrt etc * because of the difference between memory and fpu register stack arguments. * If its using an intermediate fpu register, it has 80/64 bits to work * with. If it uses memory, it has 64/53 bits to work with. However, * gcc is aware of this and goes to a fair bit of trouble to make the * best use of it. * * This is mostly academic for AMD64, because the ABI prefers the use * SSE2 based math. For FreeBSD/amd64, we go with the default settings. */ #define __INITIAL_FPUCW__ 0x037F #define __INITIAL_FPUCW_I386__ 0x127F #define __INITIAL_NPXCW__ __INITIAL_FPUCW_I386__ #define __INITIAL_MXCSR__ 0x1F80 #define __INITIAL_MXCSR_MASK__ 0xFFBF #endif /* !_BSD_FPU_H_ */ wcc-0.0.2/src/wsh/openlibm/amd64/s_remquo.S0000644000175000017500000000450313122010155017015 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* * Based on public-domain remainder routine by J.T. Conklin . */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_remquo.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); ENTRY(remquo) movsd %xmm0,-8(%rsp) movsd %xmm1,-16(%rsp) fldl -16(%rsp) fldl -8(%rsp) 1: fprem1 fstsw %ax btw $10,%ax jc 1b fstp %st(1) /* Extract the three low-order bits of the quotient from C0,C3,C1. */ shrl $6,%eax movl %eax,%ecx andl $0x108,%eax rorl $7,%eax orl %eax,%ecx roll $4,%eax orl %ecx,%eax andl $7,%eax /* Negate the quotient bits if x*y<0. Avoid using an unpredictable branch. */ movl -12(%rsp),%ecx xorl -4(%rsp),%ecx sarl $16,%ecx sarl $16,%ecx xorl %ecx,%eax andl $1,%ecx addl %ecx,%eax /* Store the quotient and return. */ #ifndef _WIN64 movl %eax,(%rdi) #else movl %eax,(%r8) #endif fstpl -8(%rsp) movsd -8(%rsp),%xmm0 ret END(remquo) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/e_sqrtf.S0000644000175000017500000000315113122010155016624 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/e_sqrtf.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(sqrtf) sqrtss %xmm0, %xmm0 ret END(sqrtf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/bsd_asm.h0000644000175000017500000000710013122010155016614 0ustar philphil/*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)DEFS.h 5.1 (Berkeley) 4/23/90 * $FreeBSD: src/sys/amd64/include/asm.h,v 1.18 2007/08/22 04:26:07 jkoshy Exp $ */ #ifndef _BSD_ASM_H_ #define _BSD_ASM_H_ #ifdef __APPLE__ #include "../i387/osx_asm.h" #define CNAME(x) EXT(x) #else #include "bsd_cdefs.h" #ifdef PIC #define PIC_PLT(x) x@PLT #define PIC_GOT(x) x@GOTPCREL(%rip) #else #define PIC_PLT(x) x #define PIC_GOT(x) x #endif /* * CNAME and HIDENAME manage the relationship between symbol names in C * and the equivalent assembly language names. CNAME is given a name as * it would be used in a C program. It expands to the equivalent assembly * language name. HIDENAME is given an assembly-language name, and expands * to a possibly-modified form that will be invisible to C programs. */ #define CNAME(csym) csym #define HIDENAME(asmsym) .asmsym #define _START_ENTRY .p2align 4,0x90 #if defined(__ELF__) #define _ENTRY(x) .text; _START_ENTRY; \ .globl CNAME(x); .type CNAME(x),@function; CNAME(x): #define END(x) .size x, . - x #elif defined(_WIN32) #ifndef _MSC_VER #define END(x) .end #define _START_ENTRY_WIN .text; _START_ENTRY #else #define END(x) end #define _START_ENTRY_WIN .code; _START_ENTRY #endif #define _ENTRY(x) _START_ENTRY_WIN; \ .globl CNAME(x); .section .drectve; .ascii " -export:", #x; \ .section .text; .def CNAME(x); .scl 2; .type 32; .endef; CNAME(x): #endif #ifdef PROF #define ALTENTRY(x) _ENTRY(x); \ pushq %rbp; movq %rsp,%rbp; \ call PIC_PLT(HIDENAME(mcount)); \ popq %rbp; \ jmp 9f #define ENTRY(x) _ENTRY(x); \ pushq %rbp; movq %rsp,%rbp; \ call PIC_PLT(HIDENAME(mcount)); \ popq %rbp; \ 9: #else #define ALTENTRY(x) _ENTRY(x) #define ENTRY(x) _ENTRY(x) #endif #define RCSID(x) .text; .asciz x #undef __FBSDID #if !defined(lint) && !defined(STRIP_FBSDID) #define __FBSDID(s) .ident s #else #define __FBSDID(s) /* nothing */ #endif /* not lint and not STRIP_FBSDID */ #endif #endif /* !_BSD_ASM_H_ */ wcc-0.0.2/src/wsh/openlibm/amd64/e_remainderf.S0000644000175000017500000000111413122010155017576 0ustar philphil/* * Based on the i387 version written by J.T. Conklin . * Public domain. */ #include //RCSID("from: $NetBSD: e_remainderf.S,v 1.2 1995/05/08 23:49:47 jtc Exp $") //__FBSDID("$FreeBSD: src/lib/msun/amd64/e_remainderf.S,v 1.2 2011/01/07 16:13:12 kib Exp $") ENTRY(remainderf) movss %xmm0,-4(%rsp) movss %xmm1,-8(%rsp) flds -8(%rsp) flds -4(%rsp) 1: fprem1 fstsw %ax testw $0x400,%ax jne 1b fstps -4(%rsp) movss -4(%rsp),%xmm0 fstp %st ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_logbl.S0000644000175000017500000000073013122010155016602 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_logbl.S,v 1.4 2011/01/07 16:13:12 kib Exp $") ENTRY(logbl) #ifndef _WIN64 fldt 8(%rsp) #else fldt (%rdx) #endif fxtract fstp %st #ifdef _WIN64 mov %rcx,%rax movq $0x0,0x8(%rcx) fstpt (%rcx) #endif ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/s_scalbnl.S0000644000175000017500000000146613122010155017130 0ustar philphil/* * Based on code written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/amd64/s_scalbnl.S,v 1.3 2011/01/07 16:13:12 kib Exp $") /* //RCSID("$NetBSD: s_scalbnf.S,v 1.4 1999/01/02 05:15:40 kristerw Exp $") */ ENTRY(scalbnl) #ifndef _WIN64 movl %edi,-4(%rsp) fildl -4(%rsp) fldt 8(%rsp) #else mov %r8,%rax movl %eax,-4(%rsp) fildl -4(%rsp) fldt (%rdx) #endif fscale fstp %st(1) #ifdef _WIN64 mov %rcx,%rax movq $0x0,0x8(%rcx) fstpt (%rcx) #endif ret #ifndef _WIN64 END(scalbnl) .globl CNAME(ldexpl) #else .globl CNAME(ldexpl); .section .drectve; .ascii " -export:ldexpl" #endif .set CNAME(ldexpl),CNAME(scalbnl) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/amd64/e_remainder.S0000644000175000017500000000113613122010155017434 0ustar philphil/* * Based on the i387 version written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //RCSID("from: FreeBSD: src/lib/msun/i387/e_remainder.S,v 1.8 2005/02/04 14:08:32 das Exp") //__FBSDID("$FreeBSD: src/lib/msun/amd64/e_remainder.S,v 1.2 2011/01/07 16:13:12 kib Exp $") ENTRY(remainder) movsd %xmm0,-8(%rsp) movsd %xmm1,-16(%rsp) fldl -16(%rsp) fldl -8(%rsp) 1: fprem1 fstsw %ax testw $0x400,%ax jne 1b fstpl -8(%rsp) movsd -8(%rsp),%xmm0 fstp %st ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/Makefile0000644000175000017500000000536313122010155015571 0ustar philphilOPENLIBM_HOME=$(abspath .) include ./Make.inc SUBDIRS = src $(ARCH) bsdsrc ifneq ($(ARCH), arm) ifneq ($(ARCH), powerpc) SUBDIRS += ld80 endif endif define INC_template TEST=test override CUR_SRCS = $(1)_SRCS include $(1)/Make.files SRCS += $$(addprefix $(1)/,$$($(1)_SRCS)) endef DIR=test $(foreach dir,$(SUBDIRS),$(eval $(call INC_template,$(dir)))) DUPLICATE_NAMES = $(filter $(patsubst %.S,%,$($(ARCH)_SRCS)),$(patsubst %.c,%,$(src_SRCS))) DUPLICATE_SRCS = $(addsuffix .c,$(DUPLICATE_NAMES)) OBJS = $(patsubst %.f,%.f.o,\ $(patsubst %.S,%.S.o,\ $(patsubst %.c,%.c.o,$(filter-out $(addprefix src/,$(DUPLICATE_SRCS)),$(SRCS))))) # If we're on windows, don't do versioned shared libraries. If we're on OSX, # put the version number before the .dylib. Otherwise, put it after. ifeq ($(OS), WINNT) OLM_MAJOR_MINOR_SHLIB_EXT := $(SHLIB_EXT) else ifeq ($(OS), Darwin) OLM_MAJOR_MINOR_SHLIB_EXT := $(SOMAJOR).$(SOMINOR).$(SHLIB_EXT) OLM_MAJOR_SHLIB_EXT := $(SOMAJOR).$(SHLIB_EXT) else OLM_MAJOR_MINOR_SHLIB_EXT := $(SHLIB_EXT).$(SOMAJOR).$(SOMINOR) OLM_MAJOR_SHLIB_EXT := $(SHLIB_EXT).$(SOMAJOR) endif endif .PHONY: all check test clean distclean \ install install-static install-shared install-pkgconfig install-headers all: libopenlibm.a libopenlibm.$(OLM_MAJOR_MINOR_SHLIB_EXT) check test: test/test-double test/test-float test/test-double test/test-float libopenlibm.a: $(OBJS) $(AR) -rcs libopenlibm.a $(OBJS) libopenlibm.$(OLM_MAJOR_MINOR_SHLIB_EXT): $(OBJS) $(CC) -shared $(OBJS) $(LDFLAGS) $(LDFLAGS_add) -Wl,$(SONAME_FLAG),libopenlibm.$(OLM_MAJOR_SHLIB_EXT) -o $@ ifneq ($(OS),WINNT) ln -sf $@ libopenlibm.$(OLM_MAJOR_SHLIB_EXT) ln -sf $@ libopenlibm.$(SHLIB_EXT) endif test/test-double: libopenlibm.$(OLM_MAJOR_MINOR_SHLIB_EXT) $(MAKE) -C test test-double test/test-float: libopenlibm.$(OLM_MAJOR_MINOR_SHLIB_EXT) $(MAKE) -C test test-float clean: rm -f amd64/*.o arm/*.o bsdsrc/*.o i387/*.o ld128/*.o ld80/*.o src/*.o rm -f libopenlibm.a libopenlibm.*$(SHLIB_EXT)* $(MAKE) -C test clean openlibm.pc: openlibm.pc.in Make.inc Makefile echo "prefix=${prefix}" > openlibm.pc echo "version=${VERSION}" >> openlibm.pc cat openlibm.pc.in >> openlibm.pc install-static: libopenlibm.a mkdir -p $(DESTDIR)$(libdir) cp -f -a libopenlibm.a $(DESTDIR)$(libdir)/ install-shared: libopenlibm.$(OLM_MAJOR_MINOR_SHLIB_EXT) mkdir -p $(DESTDIR)$(shlibdir) cp -f -a libopenlibm.*$(SHLIB_EXT)* $(DESTDIR)$(shlibdir)/ install-pkgconfig: openlibm.pc mkdir -p $(DESTDIR)$(pkgconfigdir) cp -f -a openlibm.pc $(DESTDIR)$(pkgconfigdir)/ install-headers: mkdir -p $(DESTDIR)$(includedir)/openlibm cp -f -a include/*.h $(DESTDIR)$(includedir)/openlibm cp -f -a src/*.h $(DESTDIR)$(includedir)/openlibm install: install-static install-shared install-pkgconfig install-headers wcc-0.0.2/src/wsh/openlibm/bsdsrc/0000755000175000017500000000000013122010155015402 5ustar philphilwcc-0.0.2/src/wsh/openlibm/bsdsrc/b_tgamma.c0000644000175000017500000002115413122010155017320 0ustar philphil/*- * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* @(#)gamma.c 8.1 (Berkeley) 6/4/93 */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/bsdsrc/b_tgamma.c,v 1.10 2008/02/22 02:26:51 das Exp $"); /* * This code by P. McIlroy, Oct 1992; * * The financial support of UUNET Communications Services is greatfully * acknowledged. */ #include #include "mathimpl.h" /* METHOD: * x < 0: Use reflection formula, G(x) = pi/(sin(pi*x)*x*G(x)) * At negative integers, return NaN and raise invalid. * * x < 6.5: * Use argument reduction G(x+1) = xG(x) to reach the * range [1.066124,2.066124]. Use a rational * approximation centered at the minimum (x0+1) to * ensure monotonicity. * * x >= 6.5: Use the asymptotic approximation (Stirling's formula) * adjusted for equal-ripples: * * log(G(x)) ~= (x-.5)*(log(x)-1) + .5(log(2*pi)-1) + 1/x*P(1/(x*x)) * * Keep extra precision in multiplying (x-.5)(log(x)-1), to * avoid premature round-off. * * Special values: * -Inf: return NaN and raise invalid; * negative integer: return NaN and raise invalid; * other x ~< 177.79: return +-0 and raise underflow; * +-0: return +-Inf and raise divide-by-zero; * finite x ~> 171.63: return +Inf and raise overflow; * +Inf: return +Inf; * NaN: return NaN. * * Accuracy: tgamma(x) is accurate to within * x > 0: error provably < 0.9ulp. * Maximum observed in 1,000,000 trials was .87ulp. * x < 0: * Maximum observed error < 4ulp in 1,000,000 trials. */ static double neg_gam(double); static double small_gam(double); static double smaller_gam(double); static struct Double large_gam(double); static struct Double ratfun_gam(double, double); /* * Rational approximation, A0 + x*x*P(x)/Q(x), on the interval * [1.066.., 2.066..] accurate to 4.25e-19. */ #define LEFT -.3955078125 /* left boundary for rat. approx */ #define x0 .461632144968362356785 /* xmin - 1 */ #define a0_hi 0.88560319441088874992 #define a0_lo -.00000000000000004996427036469019695 #define P0 6.21389571821820863029017800727e-01 #define P1 2.65757198651533466104979197553e-01 #define P2 5.53859446429917461063308081748e-03 #define P3 1.38456698304096573887145282811e-03 #define P4 2.40659950032711365819348969808e-03 #define Q0 1.45019531250000000000000000000e+00 #define Q1 1.06258521948016171343454061571e+00 #define Q2 -2.07474561943859936441469926649e-01 #define Q3 -1.46734131782005422506287573015e-01 #define Q4 3.07878176156175520361557573779e-02 #define Q5 5.12449347980666221336054633184e-03 #define Q6 -1.76012741431666995019222898833e-03 #define Q7 9.35021023573788935372153030556e-05 #define Q8 6.13275507472443958924745652239e-06 /* * Constants for large x approximation (x in [6, Inf]) * (Accurate to 2.8*10^-19 absolute) */ #define lns2pi_hi 0.418945312500000 #define lns2pi_lo -.000006779295327258219670263595 #define Pa0 8.33333333333333148296162562474e-02 #define Pa1 -2.77777777774548123579378966497e-03 #define Pa2 7.93650778754435631476282786423e-04 #define Pa3 -5.95235082566672847950717262222e-04 #define Pa4 8.41428560346653702135821806252e-04 #define Pa5 -1.89773526463879200348872089421e-03 #define Pa6 5.69394463439411649408050664078e-03 #define Pa7 -1.44705562421428915453880392761e-02 static const double zero = 0., one = 1.0, tiny = 1e-300; OLM_DLLEXPORT double tgamma(x) double x; { struct Double u; if (isgreaterequal(x, 6)) { if(x > 171.63) return (x / zero); u = large_gam(x); return(__exp__D(u.a, u.b)); } else if (isgreaterequal(x, 1.0 + LEFT + x0)) return (small_gam(x)); else if (isgreater(x, 1.e-17)) return (smaller_gam(x)); else if (isgreater(x, -1.e-17)) { if (x != 0.0) u.a = one - tiny; /* raise inexact */ return (one/x); } else if (!isfinite(x)) return (x - x); /* x is NaN or -Inf */ else return (neg_gam(x)); } /* * Accurate to max(ulp(1/128) absolute, 2^-66 relative) error. */ static struct Double large_gam(x) double x; { double z, p; struct Double t, u, v; z = one/(x*x); p = Pa0+z*(Pa1+z*(Pa2+z*(Pa3+z*(Pa4+z*(Pa5+z*(Pa6+z*Pa7)))))); p = p/x; u = __log__D(x); u.a -= one; v.a = (x -= .5); TRUNC(v.a); v.b = x - v.a; t.a = v.a*u.a; /* t = (x-.5)*(log(x)-1) */ t.b = v.b*u.a + x*u.b; /* return t.a + t.b + lns2pi_hi + lns2pi_lo + p */ t.b += lns2pi_lo; t.b += p; u.a = lns2pi_hi + t.b; u.a += t.a; u.b = t.a - u.a; u.b += lns2pi_hi; u.b += t.b; return (u); } /* * Good to < 1 ulp. (provably .90 ulp; .87 ulp on 1,000,000 runs.) * It also has correct monotonicity. */ static double small_gam(x) double x; { double y, ym1, t; struct Double yy, r; y = x - one; ym1 = y - one; if (y <= 1.0 + (LEFT + x0)) { yy = ratfun_gam(y - x0, 0); return (yy.a + yy.b); } r.a = y; TRUNC(r.a); yy.a = r.a - one; y = ym1; yy.b = r.b = y - yy.a; /* Argument reduction: G(x+1) = x*G(x) */ for (ym1 = y-one; ym1 > LEFT + x0; y = ym1--, yy.a--) { t = r.a*yy.a; r.b = r.a*yy.b + y*r.b; r.a = t; TRUNC(r.a); r.b += (t - r.a); } /* Return r*tgamma(y). */ yy = ratfun_gam(y - x0, 0); y = r.b*(yy.a + yy.b) + r.a*yy.b; y += yy.a*r.a; return (y); } /* * Good on (0, 1+x0+LEFT]. Accurate to 1ulp. */ static double smaller_gam(x) double x; { double t, d; struct Double r, xx; if (x < x0 + LEFT) { t = x, TRUNC(t); d = (t+x)*(x-t); t *= t; xx.a = (t + x), TRUNC(xx.a); xx.b = x - xx.a; xx.b += t; xx.b += d; t = (one-x0); t += x; d = (one-x0); d -= t; d += x; x = xx.a + xx.b; } else { xx.a = x, TRUNC(xx.a); xx.b = x - xx.a; t = x - x0; d = (-x0 -t); d += x; } r = ratfun_gam(t, d); d = r.a/x, TRUNC(d); r.a -= d*xx.a; r.a -= d*xx.b; r.a += r.b; return (d + r.a/x); } /* * returns (z+c)^2 * P(z)/Q(z) + a0 */ static struct Double ratfun_gam(z, c) double z, c; { double p, q; struct Double r, t; q = Q0 +z*(Q1+z*(Q2+z*(Q3+z*(Q4+z*(Q5+z*(Q6+z*(Q7+z*Q8))))))); p = P0 + z*(P1 + z*(P2 + z*(P3 + z*P4))); /* return r.a + r.b = a0 + (z+c)^2*p/q, with r.a truncated to 26 bits. */ p = p/q; t.a = z, TRUNC(t.a); /* t ~= z + c */ t.b = (z - t.a) + c; t.b *= (t.a + z); q = (t.a *= t.a); /* t = (z+c)^2 */ TRUNC(t.a); t.b += (q - t.a); r.a = p, TRUNC(r.a); /* r = P/Q */ r.b = p - r.a; t.b = t.b*p + t.a*r.b + a0_lo; t.a *= r.a; /* t = (z+c)^2*(P/Q) */ r.a = t.a + a0_hi, TRUNC(r.a); r.b = ((a0_hi-r.a) + t.a) + t.b; return (r); /* r = a0 + t */ } static double neg_gam(x) double x; { int sgn = 1; struct Double lg, lsine; double y, z; y = ceil(x); if (y == x) /* Negative integer. */ return ((x - x) / zero); z = y - x; if (z > 0.5) z = one - z; y = 0.5 * y; if (y == ceil(y)) sgn = -1; if (z < .25) z = sin(M_PI*z); else z = cos(M_PI*(0.5-z)); /* Special case: G(1-x) = Inf; G(x) may be nonzero. */ if (x < -170) { if (x < -190) return ((double)sgn*tiny*tiny); y = one - x; /* exact: 128 < |x| < 255 */ lg = large_gam(y); lsine = __log__D(M_PI/z); /* = TRUNC(log(u)) + small */ lg.a -= lsine.a; /* exact (opposite signs) */ lg.b -= lsine.b; y = -(lg.a + lg.b); z = (y + lg.a) + lg.b; y = __exp__D(y, z); if (sgn < 0) y = -y; return (y); } y = one-x; if (one-y == x) y = tgamma(y); else /* 1-x is inexact */ y = -x*tgamma(-x); if (sgn < 0) y = -y; return (M_PI / (y*z)); } wcc-0.0.2/src/wsh/openlibm/bsdsrc/mathimpl.h0000644000175000017500000000476513122010155017402 0ustar philphil/* * Copyright (c) 1988, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)mathimpl.h 8.1 (Berkeley) 6/4/93 * $FreeBSD: src/lib/msun/bsdsrc/mathimpl.h,v 1.7 2005/11/18 05:03:12 bde Exp $ */ #ifndef _MATHIMPL_H_ #define _MATHIMPL_H_ #include "cdefs-compat.h" #include "math_private.h" /* * TRUNC() is a macro that sets the trailing 27 bits in the mantissa of an * IEEE double variable to zero. It must be expression-like for syntactic * reasons, and we implement this expression using an inline function * instead of a pure macro to avoid depending on the gcc feature of * statement-expressions. */ #define TRUNC(d) (_b_trunc(&(d))) static __inline void _b_trunc(volatile double *_dp) { //VBS //u_int32_t _lw; u_int32_t _lw; GET_LOW_WORD(_lw, *_dp); SET_LOW_WORD(*_dp, _lw & 0xf8000000); } struct Double { double a; double b; }; /* * Functions internal to the math package, yet not static. */ double __exp__D(double, double); struct Double __log__D(double); #endif /* !_MATHIMPL_H_ */ wcc-0.0.2/src/wsh/openlibm/bsdsrc/Make.files0000644000175000017500000000006013122010155017277 0ustar philphil$(CUR_SRCS) += b_exp.c b_log.c b_tgamma.c wcc-0.0.2/src/wsh/openlibm/bsdsrc/b_exp.c0000644000175000017500000001202113122010155016637 0ustar philphil/* * Copyright (c) 1985, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* @(#)exp.c 8.1 (Berkeley) 6/4/93 */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/bsdsrc/b_exp.c,v 1.9 2011/10/16 05:37:20 das Exp $"); #include /* EXP(X) * RETURN THE EXPONENTIAL OF X * DOUBLE PRECISION (IEEE 53 bits, VAX D FORMAT 56 BITS) * CODED IN C BY K.C. NG, 1/19/85; * REVISED BY K.C. NG on 2/6/85, 2/15/85, 3/7/85, 3/24/85, 4/16/85, 6/14/86. * * Required system supported functions: * scalb(x,n) * copysign(x,y) * finite(x) * * Method: * 1. Argument Reduction: given the input x, find r and integer k such * that * x = k*ln2 + r, |r| <= 0.5*ln2 . * r will be represented as r := z+c for better accuracy. * * 2. Compute exp(r) by * * exp(r) = 1 + r + r*R1/(2-R1), * where * R1 = x - x^2*(p1+x^2*(p2+x^2*(p3+x^2*(p4+p5*x^2)))). * * 3. exp(x) = 2^k * exp(r) . * * Special cases: * exp(INF) is INF, exp(NaN) is NaN; * exp(-INF)= 0; * for finite argument, only exp(0)=1 is exact. * * Accuracy: * exp(x) returns the exponential of x nearly rounded. In a test run * with 1,156,000 random arguments on a VAX, the maximum observed * error was 0.869 ulps (units in the last place). */ #include "mathimpl.h" static const double p1 = 0x1.555555555553ep-3; static const double p2 = -0x1.6c16c16bebd93p-9; static const double p3 = 0x1.1566aaf25de2cp-14; static const double p4 = -0x1.bbd41c5d26bf1p-20; static const double p5 = 0x1.6376972bea4d0p-25; static const double ln2hi = 0x1.62e42fee00000p-1; static const double ln2lo = 0x1.a39ef35793c76p-33; static const double lnhuge = 0x1.6602b15b7ecf2p9; static const double lntiny = -0x1.77af8ebeae354p9; static const double invln2 = 0x1.71547652b82fep0; #if 0 OLM_DLLEXPORT double exp(x) double x; { double z,hi,lo,c; int k; #if !defined(vax)&&!defined(tahoe) if(x!=x) return(x); /* x is NaN */ #endif /* !defined(vax)&&!defined(tahoe) */ if( x <= lnhuge ) { if( x >= lntiny ) { /* argument reduction : x --> x - k*ln2 */ k=invln2*x+copysign(0.5,x); /* k=NINT(x/ln2) */ /* express x-k*ln2 as hi-lo and let x=hi-lo rounded */ hi=x-k*ln2hi; x=hi-(lo=k*ln2lo); /* return 2^k*[1+x+x*c/(2+c)] */ z=x*x; c= x - z*(p1+z*(p2+z*(p3+z*(p4+z*p5)))); return scalb(1.0+(hi-(lo-(x*c)/(2.0-c))),k); } /* end of x > lntiny */ else /* exp(-big#) underflows to zero */ if(finite(x)) return(scalb(1.0,-5000)); /* exp(-INF) is zero */ else return(0.0); } /* end of x < lnhuge */ else /* exp(INF) is INF, exp(+big#) overflows to INF */ return( finite(x) ? scalb(1.0,5000) : x); } #endif /* returns exp(r = x + c) for |c| < |x| with no overlap. */ double __exp__D(x, c) double x, c; { double z,hi,lo; int k; if (x != x) /* x is NaN */ return(x); if ( x <= lnhuge ) { if ( x >= lntiny ) { /* argument reduction : x --> x - k*ln2 */ z = invln2*x; k = z + copysign(.5, x); /* express (x+c)-k*ln2 as hi-lo and let x=hi-lo rounded */ hi=(x-k*ln2hi); /* Exact. */ x= hi - (lo = k*ln2lo-c); /* return 2^k*[1+x+x*c/(2+c)] */ z=x*x; c= x - z*(p1+z*(p2+z*(p3+z*(p4+z*p5)))); c = (x*c)/(2.0-c); return scalbn(1.+(hi-(lo - c)), k); } /* end of x > lntiny */ else /* exp(-big#) underflows to zero */ if(isfinite(x)) return(scalbn(1.0,-5000)); /* exp(-INF) is zero */ else return(0.0); } /* end of x < lnhuge */ else /* exp(INF) is INF, exp(+big#) overflows to INF */ return( isfinite(x) ? scalbn(1.0,5000) : x); } wcc-0.0.2/src/wsh/openlibm/bsdsrc/b_log.c0000644000175000017500000003275613122010155016645 0ustar philphil/* * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* @(#)log.c 8.2 (Berkeley) 11/30/93 */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/bsdsrc/b_log.c,v 1.9 2008/02/22 02:26:51 das Exp $"); #include #include "mathimpl.h" /* Table-driven natural logarithm. * * This code was derived, with minor modifications, from: * Peter Tang, "Table-Driven Implementation of the * Logarithm in IEEE Floating-Point arithmetic." ACM Trans. * Math Software, vol 16. no 4, pp 378-400, Dec 1990). * * Calculates log(2^m*F*(1+f/F)), |f/j| <= 1/256, * where F = j/128 for j an integer in [0, 128]. * * log(2^m) = log2_hi*m + log2_tail*m * since m is an integer, the dominant term is exact. * m has at most 10 digits (for subnormal numbers), * and log2_hi has 11 trailing zero bits. * * log(F) = logF_hi[j] + logF_lo[j] is in tabular form in log_table.h * logF_hi[] + 512 is exact. * * log(1+f/F) = 2*f/(2*F + f) + 1/12 * (2*f/(2*F + f))**3 + ... * the leading term is calculated to extra precision in two * parts, the larger of which adds exactly to the dominant * m and F terms. * There are two cases: * 1. when m, j are non-zero (m | j), use absolute * precision for the leading term. * 2. when m = j = 0, |1-x| < 1/256, and log(x) ~= (x-1). * In this case, use a relative precision of 24 bits. * (This is done differently in the original paper) * * Special cases: * 0 return signalling -Inf * neg return signalling NaN * +Inf return +Inf */ #define N 128 /* Table of log(Fj) = logF_head[j] + logF_tail[j], for Fj = 1+j/128. * Used for generation of extend precision logarithms. * The constant 35184372088832 is 2^45, so the divide is exact. * It ensures correct reading of logF_head, even for inaccurate * decimal-to-binary conversion routines. (Everybody gets the * right answer for integers less than 2^53.) * Values for log(F) were generated using error < 10^-57 absolute * with the bc -l package. */ static double A1 = .08333333333333178827; static double A2 = .01250000000377174923; static double A3 = .002232139987919447809; static double A4 = .0004348877777076145742; static double logF_head[N+1] = { 0., .007782140442060381246, .015504186535963526694, .023167059281547608406, .030771658666765233647, .038318864302141264488, .045809536031242714670, .053244514518837604555, .060624621816486978786, .067950661908525944454, .075223421237524235039, .082443669210988446138, .089612158689760690322, .096729626458454731618, .103796793681567578460, .110814366340264314203, .117783035656430001836, .124703478501032805070, .131576357788617315236, .138402322859292326029, .145182009844575077295, .151916042025732167530, .158605030176659056451, .165249572895390883786, .171850256926518341060, .178407657472689606947, .184922338493834104156, .191394852999565046047, .197825743329758552135, .204215541428766300668, .210564769107350002741, .216873938300523150246, .223143551314024080056, .229374101064877322642, .235566071312860003672, .241719936886966024758, .247836163904594286577, .253915209980732470285, .259957524436686071567, .265963548496984003577, .271933715484010463114, .277868451003087102435, .283768173130738432519, .289633292582948342896, .295464212893421063199, .301261330578199704177, .307025035294827830512, .312755710004239517729, .318453731118097493890, .324119468654316733591, .329753286372579168528, .335355541920762334484, .340926586970454081892, .346466767346100823488, .351976423156884266063, .357455888922231679316, .362905493689140712376, .368325561158599157352, .373716409793814818840, .379078352934811846353, .384411698910298582632, .389716751140440464951, .394993808240542421117, .400243164127459749579, .405465108107819105498, .410659924985338875558, .415827895143593195825, .420969294644237379543, .426084395310681429691, .431173464818130014464, .436236766774527495726, .441274560805140936281, .446287102628048160113, .451274644139630254358, .456237433481874177232, .461175715122408291790, .466089729924533457960, .470979715219073113985, .475845904869856894947, .480688529345570714212, .485507815781602403149, .490303988045525329653, .495077266798034543171, .499827869556611403822, .504556010751912253908, .509261901790523552335, .513945751101346104405, .518607764208354637958, .523248143765158602036, .527867089620485785417, .532464798869114019908, .537041465897345915436, .541597282432121573947, .546132437597407260909, .550647117952394182793, .555141507540611200965, .559615787935399566777, .564070138285387656651, .568504735352689749561, .572919753562018740922, .577315365035246941260, .581691739635061821900, .586049045003164792433, .590387446602107957005, .594707107746216934174, .599008189645246602594, .603290851438941899687, .607555250224322662688, .611801541106615331955, .616029877215623855590, .620240409751204424537, .624433288012369303032, .628608659422752680256, .632766669570628437213, .636907462236194987781, .641031179420679109171, .645137961373620782978, .649227946625615004450, .653301272011958644725, .657358072709030238911, .661398482245203922502, .665422632544505177065, .669430653942981734871, .673422675212350441142, .677398823590920073911, .681359224807238206267, .685304003098281100392, .689233281238557538017, .693147180560117703862 }; static double logF_tail[N+1] = { 0., -.00000000000000543229938420049, .00000000000000172745674997061, -.00000000000001323017818229233, -.00000000000001154527628289872, -.00000000000000466529469958300, .00000000000005148849572685810, -.00000000000002532168943117445, -.00000000000005213620639136504, -.00000000000001819506003016881, .00000000000006329065958724544, .00000000000008614512936087814, -.00000000000007355770219435028, .00000000000009638067658552277, .00000000000007598636597194141, .00000000000002579999128306990, -.00000000000004654729747598444, -.00000000000007556920687451336, .00000000000010195735223708472, -.00000000000017319034406422306, -.00000000000007718001336828098, .00000000000010980754099855238, -.00000000000002047235780046195, -.00000000000008372091099235912, .00000000000014088127937111135, .00000000000012869017157588257, .00000000000017788850778198106, .00000000000006440856150696891, .00000000000016132822667240822, -.00000000000007540916511956188, -.00000000000000036507188831790, .00000000000009120937249914984, .00000000000018567570959796010, -.00000000000003149265065191483, -.00000000000009309459495196889, .00000000000017914338601329117, -.00000000000001302979717330866, .00000000000023097385217586939, .00000000000023999540484211737, .00000000000015393776174455408, -.00000000000036870428315837678, .00000000000036920375082080089, -.00000000000009383417223663699, .00000000000009433398189512690, .00000000000041481318704258568, -.00000000000003792316480209314, .00000000000008403156304792424, -.00000000000034262934348285429, .00000000000043712191957429145, -.00000000000010475750058776541, -.00000000000011118671389559323, .00000000000037549577257259853, .00000000000013912841212197565, .00000000000010775743037572640, .00000000000029391859187648000, -.00000000000042790509060060774, .00000000000022774076114039555, .00000000000010849569622967912, -.00000000000023073801945705758, .00000000000015761203773969435, .00000000000003345710269544082, -.00000000000041525158063436123, .00000000000032655698896907146, -.00000000000044704265010452446, .00000000000034527647952039772, -.00000000000007048962392109746, .00000000000011776978751369214, -.00000000000010774341461609578, .00000000000021863343293215910, .00000000000024132639491333131, .00000000000039057462209830700, -.00000000000026570679203560751, .00000000000037135141919592021, -.00000000000017166921336082431, -.00000000000028658285157914353, -.00000000000023812542263446809, .00000000000006576659768580062, -.00000000000028210143846181267, .00000000000010701931762114254, .00000000000018119346366441110, .00000000000009840465278232627, -.00000000000033149150282752542, -.00000000000018302857356041668, -.00000000000016207400156744949, .00000000000048303314949553201, -.00000000000071560553172382115, .00000000000088821239518571855, -.00000000000030900580513238244, -.00000000000061076551972851496, .00000000000035659969663347830, .00000000000035782396591276383, -.00000000000046226087001544578, .00000000000062279762917225156, .00000000000072838947272065741, .00000000000026809646615211673, -.00000000000010960825046059278, .00000000000002311949383800537, -.00000000000058469058005299247, -.00000000000002103748251144494, -.00000000000023323182945587408, -.00000000000042333694288141916, -.00000000000043933937969737844, .00000000000041341647073835565, .00000000000006841763641591466, .00000000000047585534004430641, .00000000000083679678674757695, -.00000000000085763734646658640, .00000000000021913281229340092, -.00000000000062242842536431148, -.00000000000010983594325438430, .00000000000065310431377633651, -.00000000000047580199021710769, -.00000000000037854251265457040, .00000000000040939233218678664, .00000000000087424383914858291, .00000000000025218188456842882, -.00000000000003608131360422557, -.00000000000050518555924280902, .00000000000078699403323355317, -.00000000000067020876961949060, .00000000000016108575753932458, .00000000000058527188436251509, -.00000000000035246757297904791, -.00000000000018372084495629058, .00000000000088606689813494916, .00000000000066486268071468700, .00000000000063831615170646519, .00000000000025144230728376072, -.00000000000017239444525614834 }; #if 0 OLM_DLLEXPORT double #ifdef _ANSI_SOURCE log(double x) #else log(x) double x; #endif { int m, j; double F, f, g, q, u, u2, v, zero = 0.0, one = 1.0; volatile double u1; /* Catch special cases */ if (x <= 0) if (x == zero) /* log(0) = -Inf */ return (-one/zero); else /* log(neg) = NaN */ return (zero/zero); else if (!finite(x)) return (x+x); /* x = NaN, Inf */ /* Argument reduction: 1 <= g < 2; x/2^m = g; */ /* y = F*(1 + f/F) for |f| <= 2^-8 */ m = logb(x); g = ldexp(x, -m); if (m == -1022) { j = logb(g), m += j; g = ldexp(g, -j); } j = N*(g-1) + .5; F = (1.0/N) * j + 1; /* F*128 is an integer in [128, 512] */ f = g - F; /* Approximate expansion for log(1+f/F) ~= u + q */ g = 1/(2*F+f); u = 2*f*g; v = u*u; q = u*v*(A1 + v*(A2 + v*(A3 + v*A4))); /* case 1: u1 = u rounded to 2^-43 absolute. Since u < 2^-8, * u1 has at most 35 bits, and F*u1 is exact, as F has < 8 bits. * It also adds exactly to |m*log2_hi + log_F_head[j] | < 750 */ if (m | j) u1 = u + 513, u1 -= 513; /* case 2: |1-x| < 1/256. The m- and j- dependent terms are zero; * u1 = u to 24 bits. */ else u1 = u, TRUNC(u1); u2 = (2.0*(f - F*u1) - u1*f) * g; /* u1 + u2 = 2f/(2F+f) to extra precision. */ /* log(x) = log(2^m*F*(1+f/F)) = */ /* (m*log2_hi+logF_head[j]+u1) + (m*log2_lo+logF_tail[j]+q); */ /* (exact) + (tiny) */ u1 += m*logF_head[N] + logF_head[j]; /* exact */ u2 = (u2 + logF_tail[j]) + q; /* tiny */ u2 += logF_tail[N]*m; return (u1 + u2); } #endif /* * Extra precision variant, returning struct {double a, b;}; * log(x) = a+b to 63 bits, with a rounded to 26 bits. */ struct Double #ifdef _ANSI_SOURCE __log__D(double x) #else __log__D(x) double x; #endif { int m, j; double F, f, g, q, u, v, u2; volatile double u1; struct Double r; /* Argument reduction: 1 <= g < 2; x/2^m = g; */ /* y = F*(1 + f/F) for |f| <= 2^-8 */ m = logb(x); g = ldexp(x, -m); if (m == -1022) { j = logb(g), m += j; g = ldexp(g, -j); } j = N*(g-1) + .5; F = (1.0/N) * j + 1; f = g - F; g = 1/(2*F+f); u = 2*f*g; v = u*u; q = u*v*(A1 + v*(A2 + v*(A3 + v*A4))); if (m | j) u1 = u + 513, u1 -= 513; else u1 = u, TRUNC(u1); u2 = (2.0*(f - F*u1) - u1*f) * g; u1 += m*logF_head[N] + logF_head[j]; u2 += logF_tail[j]; u2 += q; u2 += logF_tail[N]*m; r.a = u1 + u2; /* Only difference is here */ TRUNC(r.a); r.b = (u1 - r.a) + u2; return (r); } wcc-0.0.2/src/wsh/openlibm/src/0000755000175000017500000000000013122010155014711 5ustar philphilwcc-0.0.2/src/wsh/openlibm/src/e_lgammaf_r.c0000644000175000017500000001624213122010155017313 0ustar philphil/* e_lgammaf_r.c -- float version of e_lgamma_r.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_lgammaf_r.c,v 1.12 2011/10/15 07:00:28 das Exp $"); #include #include "math_private.h" static const float two23= 8.3886080000e+06, /* 0x4b000000 */ half= 5.0000000000e-01, /* 0x3f000000 */ one = 1.0000000000e+00, /* 0x3f800000 */ pi = 3.1415927410e+00, /* 0x40490fdb */ a0 = 7.7215664089e-02, /* 0x3d9e233f */ a1 = 3.2246702909e-01, /* 0x3ea51a66 */ a2 = 6.7352302372e-02, /* 0x3d89f001 */ a3 = 2.0580807701e-02, /* 0x3ca89915 */ a4 = 7.3855509982e-03, /* 0x3bf2027e */ a5 = 2.8905137442e-03, /* 0x3b3d6ec6 */ a6 = 1.1927076848e-03, /* 0x3a9c54a1 */ a7 = 5.1006977446e-04, /* 0x3a05b634 */ a8 = 2.2086278477e-04, /* 0x39679767 */ a9 = 1.0801156895e-04, /* 0x38e28445 */ a10 = 2.5214456400e-05, /* 0x37d383a2 */ a11 = 4.4864096708e-05, /* 0x383c2c75 */ tc = 1.4616321325e+00, /* 0x3fbb16c3 */ tf = -1.2148628384e-01, /* 0xbdf8cdcd */ /* tt = -(tail of tf) */ tt = 6.6971006518e-09, /* 0x31e61c52 */ t0 = 4.8383611441e-01, /* 0x3ef7b95e */ t1 = -1.4758771658e-01, /* 0xbe17213c */ t2 = 6.4624942839e-02, /* 0x3d845a15 */ t3 = -3.2788541168e-02, /* 0xbd064d47 */ t4 = 1.7970675603e-02, /* 0x3c93373d */ t5 = -1.0314224288e-02, /* 0xbc28fcfe */ t6 = 6.1005386524e-03, /* 0x3bc7e707 */ t7 = -3.6845202558e-03, /* 0xbb7177fe */ t8 = 2.2596477065e-03, /* 0x3b141699 */ t9 = -1.4034647029e-03, /* 0xbab7f476 */ t10 = 8.8108185446e-04, /* 0x3a66f867 */ t11 = -5.3859531181e-04, /* 0xba0d3085 */ t12 = 3.1563205994e-04, /* 0x39a57b6b */ t13 = -3.1275415677e-04, /* 0xb9a3f927 */ t14 = 3.3552918467e-04, /* 0x39afe9f7 */ u0 = -7.7215664089e-02, /* 0xbd9e233f */ u1 = 6.3282704353e-01, /* 0x3f2200f4 */ u2 = 1.4549225569e+00, /* 0x3fba3ae7 */ u3 = 9.7771751881e-01, /* 0x3f7a4bb2 */ u4 = 2.2896373272e-01, /* 0x3e6a7578 */ u5 = 1.3381091878e-02, /* 0x3c5b3c5e */ v1 = 2.4559779167e+00, /* 0x401d2ebe */ v2 = 2.1284897327e+00, /* 0x4008392d */ v3 = 7.6928514242e-01, /* 0x3f44efdf */ v4 = 1.0422264785e-01, /* 0x3dd572af */ v5 = 3.2170924824e-03, /* 0x3b52d5db */ s0 = -7.7215664089e-02, /* 0xbd9e233f */ s1 = 2.1498242021e-01, /* 0x3e5c245a */ s2 = 3.2577878237e-01, /* 0x3ea6cc7a */ s3 = 1.4635047317e-01, /* 0x3e15dce6 */ s4 = 2.6642270386e-02, /* 0x3cda40e4 */ s5 = 1.8402845599e-03, /* 0x3af135b4 */ s6 = 3.1947532989e-05, /* 0x3805ff67 */ r1 = 1.3920053244e+00, /* 0x3fb22d3b */ r2 = 7.2193557024e-01, /* 0x3f38d0c5 */ r3 = 1.7193385959e-01, /* 0x3e300f6e */ r4 = 1.8645919859e-02, /* 0x3c98bf54 */ r5 = 7.7794247773e-04, /* 0x3a4beed6 */ r6 = 7.3266842264e-06, /* 0x36f5d7bd */ w0 = 4.1893854737e-01, /* 0x3ed67f1d */ w1 = 8.3333335817e-02, /* 0x3daaaaab */ w2 = -2.7777778450e-03, /* 0xbb360b61 */ w3 = 7.9365057172e-04, /* 0x3a500cfd */ w4 = -5.9518753551e-04, /* 0xba1c065c */ w5 = 8.3633989561e-04, /* 0x3a5b3dd2 */ w6 = -1.6309292987e-03; /* 0xbad5c4e8 */ static const float zero= 0.0000000000e+00; static float sin_pif(float x) { float y,z; int n,ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix<0x3e800000) return __kernel_sindf(pi*x); y = -x; /* x is assume negative */ /* * argument reduction, make sure inexact flag not raised if input * is an integer */ z = floorf(y); if(z!=y) { /* inexact anyway */ y *= (float)0.5; y = (float)2.0*(y - floorf(y)); /* y = |x| mod 2.0 */ n = (int) (y*(float)4.0); } else { if(ix>=0x4b800000) { y = zero; n = 0; /* y must be even */ } else { if(ix<0x4b000000) z = y+two23; /* exact */ GET_FLOAT_WORD(n,z); n &= 1; y = n; n<<= 2; } } switch (n) { case 0: y = __kernel_sindf(pi*y); break; case 1: case 2: y = __kernel_cosdf(pi*((float)0.5-y)); break; case 3: case 4: y = __kernel_sindf(pi*(one-y)); break; case 5: case 6: y = -__kernel_cosdf(pi*(y-(float)1.5)); break; default: y = __kernel_sindf(pi*(y-(float)2.0)); break; } return -y; } OLM_DLLEXPORT float __ieee754_lgammaf_r(float x, int *signgamp) { float t,y,z,nadj,p,p1,p2,p3,q,r,w; int32_t hx; int i,ix; GET_FLOAT_WORD(hx,x); /* purge off +-inf, NaN, +-0, tiny and negative arguments */ *signgamp = 1; ix = hx&0x7fffffff; if(ix>=0x7f800000) return x*x; if(ix==0) return one/zero; if(ix<0x35000000) { /* |x|<2**-21, return -log(|x|) */ if(hx<0) { *signgamp = -1; return -__ieee754_logf(-x); } else return -__ieee754_logf(x); } if(hx<0) { if(ix>=0x4b000000) /* |x|>=2**23, must be -integer */ return one/zero; t = sin_pif(x); if(t==zero) return one/zero; /* -integer */ nadj = __ieee754_logf(pi/fabsf(t*x)); if(t=0x3f3b4a20) {y = one-x; i= 0;} else if(ix>=0x3e6d3308) {y= x-(tc-one); i=1;} else {y = x; i=2;} } else { r = zero; if(ix>=0x3fdda618) {y=(float)2.0-x;i=0;} /* [1.7316,2] */ else if(ix>=0x3F9da620) {y=x-tc;i=1;} /* [1.23,1.73] */ else {y=x-one;i=2;} } switch(i) { case 0: z = y*y; p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10)))); p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11))))); p = y*p1+p2; r += (p-(float)0.5*y); break; case 1: z = y*y; w = z*y; p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */ p2 = t1+w*(t4+w*(t7+w*(t10+w*t13))); p3 = t2+w*(t5+w*(t8+w*(t11+w*t14))); p = z*p1-(tt-w*(p2+y*p3)); r += (tf + p); break; case 2: p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5))))); p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5)))); r += (-(float)0.5*y + p1/p2); } } else if(ix<0x41000000) { /* x < 8.0 */ i = (int)x; y = x-(float)i; p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6)))))); q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6))))); r = half*y+p/q; z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ switch(i) { case 7: z *= (y+(float)6.0); /* FALLTHRU */ case 6: z *= (y+(float)5.0); /* FALLTHRU */ case 5: z *= (y+(float)4.0); /* FALLTHRU */ case 4: z *= (y+(float)3.0); /* FALLTHRU */ case 3: z *= (y+(float)2.0); /* FALLTHRU */ r += __ieee754_logf(z); break; } /* 8.0 <= x < 2**58 */ } else if (ix < 0x5c800000) { t = __ieee754_logf(x); z = one/x; y = z*z; w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6))))); r = (x-half)*(t-one)+w; } else /* 2**58 <= x <= inf */ r = x*(__ieee754_logf(x)-one); if(hx<0) r = nadj - r; return r; } wcc-0.0.2/src/wsh/openlibm/src/s_log1p.c0000644000175000017500000001313413122010155016423 0ustar philphil/* @(#)s_log1p.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_log1p.c,v 1.10 2008/03/29 16:37:59 das Exp $"); /* double log1p(double x) * * Method : * 1. Argument Reduction: find k and f such that * 1+x = 2^k * (1+f), * where sqrt(2)/2 < 1+f < sqrt(2) . * * Note. If k=0, then f=x is exact. However, if k!=0, then f * may not be representable exactly. In that case, a correction * term is need. Let u=1+x rounded. Let c = (1+x)-u, then * log(1+x) - log(u) ~ c/u. Thus, we proceed to compute log(u), * and add back the correction term c/u. * (Note: when x > 2**53, one can simply return log(x)) * * 2. Approximation of log1p(f). * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s) * = 2s + 2/3 s**3 + 2/5 s**5 + ....., * = 2s + s*R * We use a special Reme algorithm on [0,0.1716] to generate * a polynomial of degree 14 to approximate R The maximum error * of this polynomial approximation is bounded by 2**-58.45. In * other words, * 2 4 6 8 10 12 14 * R(z) ~ Lp1*s +Lp2*s +Lp3*s +Lp4*s +Lp5*s +Lp6*s +Lp7*s * (the values of Lp1 to Lp7 are listed in the program) * and * | 2 14 | -58.45 * | Lp1*s +...+Lp7*s - R(z) | <= 2 * | | * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2. * In order to guarantee error in log below 1ulp, we compute log * by * log1p(f) = f - (hfsq - s*(hfsq+R)). * * 3. Finally, log1p(x) = k*ln2 + log1p(f). * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo))) * Here ln2 is split into two floating point number: * ln2_hi + ln2_lo, * where n*ln2_hi is always exact for |n| < 2000. * * Special cases: * log1p(x) is NaN with signal if x < -1 (including -INF) ; * log1p(+INF) is +INF; log1p(-1) is -INF with signal; * log1p(NaN) is that NaN with no signal. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. * * Note: Assuming log() return accurate answer, the following * algorithm can be used to compute log1p(x) to within a few ULP: * * u = 1+x; * if(u==1.0) return x ; else * return log(u)*(x/(u-1.0)); * * See HP-15C Advanced Functions Handbook, p.193. */ #include #include #include "math_private.h" static const double ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ Lp4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */ Lp5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */ Lp6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */ Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ static const double zero = 0.0; OLM_DLLEXPORT double log1p(double x) { double hfsq,f,c,s,z,R,u; int32_t k,hx,hu,ax; GET_HIGH_WORD(hx,x); ax = hx&0x7fffffff; k = 1; if (hx < 0x3FDA827A) { /* 1+x < sqrt(2)+ */ if(ax>=0x3ff00000) { /* x <= -1.0 */ if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */ else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ } if(ax<0x3e200000) { /* |x| < 2**-29 */ if(two54+x>zero /* raise inexact */ &&ax<0x3c900000) /* |x| < 2**-54 */ return x; else return x - x*x*0.5; } if(hx>0||hx<=((int32_t)0xbfd2bec4)) { k=0;f=x;hu=1;} /* sqrt(2)/2- <= 1+x < sqrt(2)+ */ } if (hx >= 0x7ff00000) return x+x; if(k!=0) { if(hx<0x43400000) { STRICT_ASSIGN(double,u,1.0+x); GET_HIGH_WORD(hu,u); k = (hu>>20)-1023; c = (k>0)? 1.0-(u-x):x-(u-1.0);/* correction term */ c /= u; } else { u = x; GET_HIGH_WORD(hu,u); k = (hu>>20)-1023; c = 0; } hu &= 0x000fffff; /* * The approximation to sqrt(2) used in thresholds is not * critical. However, the ones used above must give less * strict bounds than the one here so that the k==0 case is * never reached from here, since here we have committed to * using the correction term but don't use it if k==0. */ if(hu<0x6a09e) { /* u ~< sqrt(2) */ SET_HIGH_WORD(u,hu|0x3ff00000); /* normalize u */ } else { k += 1; SET_HIGH_WORD(u,hu|0x3fe00000); /* normalize u/2 */ hu = (0x00100000-hu)>>2; } f = u-1.0; } hfsq=0.5*f*f; if(hu==0) { /* |f| < 2**-20 */ if(f==zero) { if(k==0) { return zero; } else { c += k*ln2_lo; return k*ln2_hi+c; } } R = hfsq*(1.0-0.66666666666666666*f); if(k==0) return f-R; else return k*ln2_hi-((R-(k*ln2_lo+c))-f); } s = f/(2.0+f); z = s*s; R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); if(k==0) return f-(hfsq-s*(hfsq+R)); else return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); } wcc-0.0.2/src/wsh/openlibm/src/s_cpowf.c0000644000175000017500000000353213122010155016520 0ustar philphil/* $OpenBSD: s_cpowf.c,v 1.2 2010/07/18 18:42:26 guenther Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cpowf * * Complex power function * * * * SYNOPSIS: * * float complex cpowf(); * float complex a, z, w; * * w = cpowf (a, z); * * * * DESCRIPTION: * * Raises complex A to the complex Zth power. * Definition is per AMS55 # 4.2.8, * analytically equivalent to cpow(a,z) = cexp(z clog(a)). * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 9.4e-15 1.5e-15 * */ #include #include #include "math_private.h" OLM_DLLEXPORT float complex cpowf(float complex a, float complex z) { float complex w; float x, y, r, theta, absa, arga; x = crealf(z); y = cimagf(z); absa = cabsf (a); if (absa == 0.0f) { return (0.0f + 0.0f * I); } arga = cargf (a); r = powf (absa, x); theta = x * arga; if (y != 0.0f) { r = r * expf (-y * arga); theta = theta + y * logf (absa); } w = r * cosf (theta) + (r * sinf (theta)) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/e_acosl.c0000644000175000017500000000437413122010155016472 0ustar philphil /* @(#)e_acos.c 1.3 95/01/18 */ /* FreeBSD: head/lib/msun/src/e_acos.c 176451 2008-02-22 02:30:36Z das */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_acosl.c,v 1.2 2008/08/02 03:56:22 das Exp $"); /* * See comments in e_acos.c. * Converted to long double by David Schultz . */ #include #include #include "invtrig.h" #include "math_private.h" static const long double one= 1.00000000000000000000e+00; #ifdef __i386__ /* XXX Work around the fact that gcc truncates long double constants on i386 */ static volatile double pi1 = 3.14159265358979311600e+00, /* 0x1.921fb54442d18p+1 */ pi2 = 1.22514845490862001043e-16; /* 0x1.1a80000000000p-53 */ #define pi ((long double)pi1 + pi2) #else static const long double pi = 3.14159265358979323846264338327950280e+00L; #endif OLM_DLLEXPORT long double acosl(long double x) { union IEEEl2bits u; long double z,p,q,r,w,s,c,df; int16_t expsign, expt; u.e = x; expsign = u.xbits.expsign; expt = expsign & 0x7fff; if(expt >= BIAS) { /* |x| >= 1 */ if(expt==BIAS && ((u.bits.manh&~LDBL_NBIT)|u.bits.manl)==0) { if (expsign>0) return 0.0; /* acos(1) = 0 */ else return pi+2.0*pio2_lo; /* acos(-1)= pi */ } return (x-x)/(x-x); /* acos(|x|>1) is NaN */ } if(expt 0.5 */ z = (one-x)*0.5; s = sqrtl(z); u.e = s; u.bits.manl = 0; df = u.e; c = (z-df*df)/(s+df); p = P(z); q = Q(z); r = p/q; w = r*s+c; return 2.0*(df+w); } } wcc-0.0.2/src/wsh/openlibm/src/e_fmodl.c0000644000175000017500000000753313122010155016472 0ustar philphil/* @(#)e_fmod.c 1.3 95/01/18 */ /*- * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_fmodl.c,v 1.2 2008/07/31 20:09:47 das Exp $"); #include #include #include #include "fpmath.h" #include "math_private.h" #define BIAS (LDBL_MAX_EXP - 1) #if LDBL_MANL_SIZE > 32 typedef u_int64_t manl_t; #else typedef u_int32_t manl_t; #endif #if LDBL_MANH_SIZE > 32 typedef u_int64_t manh_t; #else typedef u_int32_t manh_t; #endif /* * These macros add and remove an explicit integer bit in front of the * fractional mantissa, if the architecture doesn't have such a bit by * default already. */ #ifdef LDBL_IMPLICIT_NBIT #define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) #define HFRAC_BITS LDBL_MANH_SIZE #else #define SET_NBIT(hx) (hx) #define HFRAC_BITS (LDBL_MANH_SIZE - 1) #endif #define MANL_SHIFT (LDBL_MANL_SIZE - 1) static const long double one = 1.0, Zero[] = {0.0, -0.0,}; /* * fmodl(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract * * Assumptions: * - The low part of the mantissa fits in a manl_t exactly. * - The high part of the mantissa fits in an int64_t with enough room * for an explicit integer bit in front of the fractional bits. */ OLM_DLLEXPORT long double fmodl(long double x, long double y) { union IEEEl2bits ux, uy; int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ manh_t hy; manl_t lx,ly,lz; int ix,iy,n,sx; ux.e = x; uy.e = y; sx = ux.bits.sign; /* purge off exception values */ if((uy.bits.exp|uy.bits.manh|uy.bits.manl)==0 || /* y=0 */ (ux.bits.exp == BIAS + LDBL_MAX_EXP) || /* or x not finite */ (uy.bits.exp == BIAS + LDBL_MAX_EXP && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)!=0)) /* or y is NaN */ return (x*y)/(x*y); if(ux.bits.exp<=uy.bits.exp) { if((ux.bits.exp>MANL_SHIFT); lx = lx+lx;} else { if ((hz|lz)==0) /* return sign(x)*0 */ return Zero[sx]; hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; } } hz=hx-hy;lz=lx-ly; if(lx=0) {hx=hz;lx=lz;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) /* return sign(x)*0 */ return Zero[sx]; while(hx<(1ULL<>MANL_SHIFT); lx = lx+lx; iy -= 1; } ux.bits.manh = hx; /* The mantissa is truncated here if needed. */ ux.bits.manl = lx; if (iy < LDBL_MIN_EXP) { ux.bits.exp = iy + (BIAS + 512); ux.e *= 0x1p-512; } else { ux.bits.exp = iy + BIAS; } x = ux.e * one; /* create necessary signal */ return x; /* exact output */ } wcc-0.0.2/src/wsh/openlibm/src/s_llrintf.c0000644000175000017500000000034313122010155017051 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_llrintf.c,v 1.1 2005/01/11 23:12:55 das Exp $"); #define type float #define roundit rintf #define dtype long long #define fn llrintf #include "s_lrint.c" wcc-0.0.2/src/wsh/openlibm/src/e_fmod.c0000644000175000017500000000650413122010155016313 0ustar philphil /* @(#)e_fmod.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_fmod.c,v 1.10 2008/02/22 02:30:34 das Exp $"); /* * __ieee754_fmod(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract */ #include #include "math_private.h" static const double one = 1.0, Zero[] = {0.0, -0.0,}; OLM_DLLEXPORT double __ieee754_fmod(double x, double y) { int32_t n,hx,hy,hz,ix,iy,sx,i; u_int32_t lx,ly,lz; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hy,ly,y); sx = hx&0x80000000; /* sign of x */ hx ^=sx; /* |x| */ hy &= 0x7fffffff; /* |y| */ /* purge off exception values */ if((hy|ly)==0||(hx>=0x7ff00000)|| /* y=0,or x not finite */ ((hy|((ly|-ly)>>31))>0x7ff00000)) /* or y is NaN */ return (x*y)/(x*y); if(hx<=hy) { if((hx>31]; /* |x|=|y| return x*0*/ } /* determine ix = ilogb(x) */ if(hx<0x00100000) { /* subnormal x */ if(hx==0) { for (ix = -1043, i=lx; i>0; i<<=1) ix -=1; } else { for (ix = -1022,i=(hx<<11); i>0; i<<=1) ix -=1; } } else ix = (hx>>20)-1023; /* determine iy = ilogb(y) */ if(hy<0x00100000) { /* subnormal y */ if(hy==0) { for (iy = -1043, i=ly; i>0; i<<=1) iy -=1; } else { for (iy = -1022,i=(hy<<11); i>0; i<<=1) iy -=1; } } else iy = (hy>>20)-1023; /* set up {hx,lx}, {hy,ly} and align y to x */ if(ix >= -1022) hx = 0x00100000|(0x000fffff&hx); else { /* subnormal x, shift x to normal */ n = -1022-ix; if(n<=31) { hx = (hx<>(32-n)); lx <<= n; } else { hx = lx<<(n-32); lx = 0; } } if(iy >= -1022) hy = 0x00100000|(0x000fffff&hy); else { /* subnormal y, shift y to normal */ n = -1022-iy; if(n<=31) { hy = (hy<>(32-n)); ly <<= n; } else { hy = ly<<(n-32); ly = 0; } } /* fix point fmod */ n = ix - iy; while(n--) { hz=hx-hy;lz=lx-ly; if(lx>31); lx = lx+lx;} else { if((hz|lz)==0) /* return sign(x)*0 */ return Zero[(u_int32_t)sx>>31]; hx = hz+hz+(lz>>31); lx = lz+lz; } } hz=hx-hy;lz=lx-ly; if(lx=0) {hx=hz;lx=lz;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) /* return sign(x)*0 */ return Zero[(u_int32_t)sx>>31]; while(hx<0x00100000) { /* normalize x */ hx = hx+hx+(lx>>31); lx = lx+lx; iy -= 1; } if(iy>= -1022) { /* normalize output */ hx = ((hx-0x00100000)|((iy+1023)<<20)); INSERT_WORDS(x,hx|sx,lx); } else { /* subnormal output */ n = -1022 - iy; if(n<=20) { lx = (lx>>n)|((u_int32_t)hx<<(32-n)); hx >>= n; } else if (n<=31) { lx = (hx<<(32-n))|(lx>>n); hx = sx; } else { lx = hx>>(n-32); hx = sx; } INSERT_WORDS(x,hx|sx,lx); x *= one; /* create necessary signal */ } return x; /* exact output */ } wcc-0.0.2/src/wsh/openlibm/src/s_csqrtl.c0000644000175000017500000000640013122010155016707 0ustar philphil/*- * Copyright (c) 2007-2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" #include #include #include #include "math_private.h" /* * gcc doesn't implement complex multiplication or division correctly, * so we need to handle infinities specially. We turn on this pragma to * notify conforming c99 compilers that the fast-but-incorrect code that * gcc generates is acceptable, since the special cases have already been * handled. */ #ifndef __GNUC__ #pragma STDC CX_LIMITED_RANGE ON #endif /* We risk spurious overflow for components >= LDBL_MAX / (1 + sqrt(2)). */ #define THRESH (LDBL_MAX / 2.414213562373095048801688724209698L) OLM_DLLEXPORT long double complex csqrtl(long double complex z) { long double complex result; long double a, b; long double t; int scale; a = creall(z); b = cimagl(z); /* Handle special cases. */ if (z == 0) return (CMPLXL(0, b)); if (isinf(b)) return (CMPLXL(INFINITY, b)); if (isnan(a)) { t = (b - b) / (b - b); /* raise invalid if b is not a NaN */ return (CMPLXL(a, t)); /* return NaN + NaN i */ } if (isinf(a)) { /* * csqrt(inf + NaN i) = inf + NaN i * csqrt(inf + y i) = inf + 0 i * csqrt(-inf + NaN i) = NaN +- inf i * csqrt(-inf + y i) = 0 + inf i */ if (signbit(a)) return (CMPLXL(fabsl(b - b), copysignl(a, b))); else return (CMPLXL(a, copysignl(b - b, b))); } /* * The remaining special case (b is NaN) is handled just fine by * the normal code path below. */ /* Scale to avoid overflow. */ if (fabsl(a) >= THRESH || fabsl(b) >= THRESH) { a *= 0.25; b *= 0.25; scale = 1; } else { scale = 0; } /* Algorithm 312, CACM vol 10, Oct 1967. */ if (a >= 0) { t = sqrtl((a + hypotl(a, b)) * 0.5); result = CMPLXL(t, b / (2 * t)); } else { t = sqrtl((-a + hypotl(a, b)) * 0.5); result = CMPLXL(fabsl(b) / (2 * t), copysignl(t, b)); } /* Rescale. */ if (scale) return (result * 2); else return (result); } wcc-0.0.2/src/wsh/openlibm/src/fpmath.h0000644000175000017500000000662113122010155016346 0ustar philphil/*- * Copyright (c) 2003 Mike Barcroft * Copyright (c) 2002 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/libc/include/fpmath.h,v 1.4 2008/12/23 22:20:59 marcel Exp $ */ #ifndef _FPMATH_H_ #define _FPMATH_H_ #if defined(__aarch64__) #include "aarch64_fpmath.h" #elif defined(__i386__) || defined(__x86_64__) #ifdef __LP64__ #include "amd64_fpmath.h" #else #include "i386_fpmath.h" #endif #elif defined(__powerpc__) #include "powerpc_fpmath.h" #endif /* Definitions provided directly by GCC and Clang. */ #if !(defined(__BYTE_ORDER__) && defined(__ORDER_LITTLE_ENDIAN__) && defined(__ORDER_BIG_ENDIAN__)) #if defined(__GLIBC__) #include #include #define __ORDER_LITTLE_ENDIAN__ __LITTLE_ENDIAN #define __ORDER_BIG_ENDIAN__ __BIG_ENDIAN #define __BYTE_ORDER__ __BYTE_ORDER #elif defined(__APPLE__) #include #define __ORDER_LITTLE_ENDIAN__ LITTLE_ENDIAN #define __ORDER_BIG_ENDIAN__ BIG_ENDIAN #define __BYTE_ORDER__ BYTE_ORDER #elif defined(_WIN32) #define __ORDER_LITTLE_ENDIAN__ 1234 #define __ORDER_BIG_ENDIAN__ 4321 #define __BYTE_ORDER__ __ORDER_LITTLE_ENDIAN__ #endif #endif /* __BYTE_ORDER__, __ORDER_LITTLE_ENDIAN__ and __ORDER_BIG_ENDIAN__ */ #ifndef __FLOAT_WORD_ORDER__ #define __FLOAT_WORD_ORDER__ __BYTE_ORDER__ #endif union IEEEf2bits { float f; struct { #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ unsigned int man :23; unsigned int exp :8; unsigned int sign :1; #else /* _BIG_ENDIAN */ unsigned int sign :1; unsigned int exp :8; unsigned int man :23; #endif } bits; }; #define DBL_MANH_SIZE 20 #define DBL_MANL_SIZE 32 union IEEEd2bits { double d; struct { #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ #if __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__ unsigned int manl :32; #endif unsigned int manh :20; unsigned int exp :11; unsigned int sign :1; #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__ unsigned int manl :32; #endif #else /* _BIG_ENDIAN */ unsigned int sign :1; unsigned int exp :11; unsigned int manh :20; unsigned int manl :32; #endif } bits; }; #endif wcc-0.0.2/src/wsh/openlibm/src/s_scalbln.c0000644000175000017500000000407213122010155017020 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_scalbln.c,v 1.2 2005/03/07 04:57:50 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT double scalbln (double x, long n) { int in; in = (int)n; if (in != n) { if (n > 0) in = INT_MAX; else in = INT_MIN; } return (scalbn(x, in)); } OLM_DLLEXPORT float scalblnf (float x, long n) { int in; in = (int)n; if (in != n) { if (n > 0) in = INT_MAX; else in = INT_MIN; } return (scalbnf(x, in)); } OLM_DLLEXPORT long double scalblnl (long double x, long n) { int in; in = (int)n; if (in != n) { if (n > 0) in = INT_MAX; else in = INT_MIN; } return (scalbnl(x, (int)n)); } wcc-0.0.2/src/wsh/openlibm/src/s_cabsl.c0000644000175000017500000000176213122010155016471 0ustar philphil/* $OpenBSD: s_cabsl.c,v 1.1 2011/07/08 19:25:31 martynas Exp $ */ /* * Copyright (c) 2011 Martynas Venckus * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include long double cabsl(long double complex z) { return hypotl(__real__ z, __imag__ z); } wcc-0.0.2/src/wsh/openlibm/src/e_lgamma_r.c0000644000175000017500000002550213122010155017144 0ustar philphil /* @(#)e_lgamma_r.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_lgamma_r.c,v 1.11 2011/10/15 07:00:28 das Exp $"); /* __ieee754_lgamma_r(x, signgamp) * Reentrant version of the logarithm of the Gamma function * with user provide pointer for the sign of Gamma(x). * * Method: * 1. Argument Reduction for 0 < x <= 8 * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may * reduce x to a number in [1.5,2.5] by * lgamma(1+s) = log(s) + lgamma(s) * for example, * lgamma(7.3) = log(6.3) + lgamma(6.3) * = log(6.3*5.3) + lgamma(5.3) * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3) * 2. Polynomial approximation of lgamma around its * minimun ymin=1.461632144968362245 to maintain monotonicity. * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use * Let z = x-ymin; * lgamma(x) = -1.214862905358496078218 + z^2*poly(z) * where * poly(z) is a 14 degree polynomial. * 2. Rational approximation in the primary interval [2,3] * We use the following approximation: * s = x-2.0; * lgamma(x) = 0.5*s + s*P(s)/Q(s) * with accuracy * |P/Q - (lgamma(x)-0.5s)| < 2**-61.71 * Our algorithms are based on the following observation * * zeta(2)-1 2 zeta(3)-1 3 * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ... * 2 3 * * where Euler = 0.5771... is the Euler constant, which is very * close to 0.5. * * 3. For x>=8, we have * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+.... * (better formula: * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...) * Let z = 1/x, then we approximation * f(z) = lgamma(x) - (x-0.5)(log(x)-1) * by * 3 5 11 * w = w0 + w1*z + w2*z + w3*z + ... + w6*z * where * |w - f(z)| < 2**-58.74 * * 4. For negative x, since (G is gamma function) * -x*G(-x)*G(x) = pi/sin(pi*x), * we have * G(x) = pi/(sin(pi*x)*(-x)*G(-x)) * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0 * Hence, for x<0, signgam = sign(sin(pi*x)) and * lgamma(x) = log(|Gamma(x)|) * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x); * Note: one should avoid compute pi*(-x) directly in the * computation of sin(pi*(-x)). * * 5. Special Cases * lgamma(2+s) ~ s*(1-Euler) for tiny s * lgamma(1) = lgamma(2) = 0 * lgamma(x) ~ -log(|x|) for tiny x * lgamma(0) = lgamma(neg.integer) = inf and raise divide-by-zero * lgamma(inf) = inf * lgamma(-inf) = inf (bug for bug compatible with C99!?) * */ #include #include "math_private.h" static const double two52= 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */ half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */ a0 = 7.72156649015328655494e-02, /* 0x3FB3C467, 0xE37DB0C8 */ a1 = 3.22467033424113591611e-01, /* 0x3FD4A34C, 0xC4A60FAD */ a2 = 6.73523010531292681824e-02, /* 0x3FB13E00, 0x1A5562A7 */ a3 = 2.05808084325167332806e-02, /* 0x3F951322, 0xAC92547B */ a4 = 7.38555086081402883957e-03, /* 0x3F7E404F, 0xB68FEFE8 */ a5 = 2.89051383673415629091e-03, /* 0x3F67ADD8, 0xCCB7926B */ a6 = 1.19270763183362067845e-03, /* 0x3F538A94, 0x116F3F5D */ a7 = 5.10069792153511336608e-04, /* 0x3F40B6C6, 0x89B99C00 */ a8 = 2.20862790713908385557e-04, /* 0x3F2CF2EC, 0xED10E54D */ a9 = 1.08011567247583939954e-04, /* 0x3F1C5088, 0x987DFB07 */ a10 = 2.52144565451257326939e-05, /* 0x3EFA7074, 0x428CFA52 */ a11 = 4.48640949618915160150e-05, /* 0x3F07858E, 0x90A45837 */ tc = 1.46163214496836224576e+00, /* 0x3FF762D8, 0x6356BE3F */ tf = -1.21486290535849611461e-01, /* 0xBFBF19B9, 0xBCC38A42 */ /* tt = -(tail of tf) */ tt = -3.63867699703950536541e-18, /* 0xBC50C7CA, 0xA48A971F */ t0 = 4.83836122723810047042e-01, /* 0x3FDEF72B, 0xC8EE38A2 */ t1 = -1.47587722994593911752e-01, /* 0xBFC2E427, 0x8DC6C509 */ t2 = 6.46249402391333854778e-02, /* 0x3FB08B42, 0x94D5419B */ t3 = -3.27885410759859649565e-02, /* 0xBFA0C9A8, 0xDF35B713 */ t4 = 1.79706750811820387126e-02, /* 0x3F9266E7, 0x970AF9EC */ t5 = -1.03142241298341437450e-02, /* 0xBF851F9F, 0xBA91EC6A */ t6 = 6.10053870246291332635e-03, /* 0x3F78FCE0, 0xE370E344 */ t7 = -3.68452016781138256760e-03, /* 0xBF6E2EFF, 0xB3E914D7 */ t8 = 2.25964780900612472250e-03, /* 0x3F6282D3, 0x2E15C915 */ t9 = -1.40346469989232843813e-03, /* 0xBF56FE8E, 0xBF2D1AF1 */ t10 = 8.81081882437654011382e-04, /* 0x3F4CDF0C, 0xEF61A8E9 */ t11 = -5.38595305356740546715e-04, /* 0xBF41A610, 0x9C73E0EC */ t12 = 3.15632070903625950361e-04, /* 0x3F34AF6D, 0x6C0EBBF7 */ t13 = -3.12754168375120860518e-04, /* 0xBF347F24, 0xECC38C38 */ t14 = 3.35529192635519073543e-04, /* 0x3F35FD3E, 0xE8C2D3F4 */ u0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */ u1 = 6.32827064025093366517e-01, /* 0x3FE4401E, 0x8B005DFF */ u2 = 1.45492250137234768737e+00, /* 0x3FF7475C, 0xD119BD6F */ u3 = 9.77717527963372745603e-01, /* 0x3FEF4976, 0x44EA8450 */ u4 = 2.28963728064692451092e-01, /* 0x3FCD4EAE, 0xF6010924 */ u5 = 1.33810918536787660377e-02, /* 0x3F8B678B, 0xBF2BAB09 */ v1 = 2.45597793713041134822e+00, /* 0x4003A5D7, 0xC2BD619C */ v2 = 2.12848976379893395361e+00, /* 0x40010725, 0xA42B18F5 */ v3 = 7.69285150456672783825e-01, /* 0x3FE89DFB, 0xE45050AF */ v4 = 1.04222645593369134254e-01, /* 0x3FBAAE55, 0xD6537C88 */ v5 = 3.21709242282423911810e-03, /* 0x3F6A5ABB, 0x57D0CF61 */ s0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */ s1 = 2.14982415960608852501e-01, /* 0x3FCB848B, 0x36E20878 */ s2 = 3.25778796408930981787e-01, /* 0x3FD4D98F, 0x4F139F59 */ s3 = 1.46350472652464452805e-01, /* 0x3FC2BB9C, 0xBEE5F2F7 */ s4 = 2.66422703033638609560e-02, /* 0x3F9B481C, 0x7E939961 */ s5 = 1.84028451407337715652e-03, /* 0x3F5E26B6, 0x7368F239 */ s6 = 3.19475326584100867617e-05, /* 0x3F00BFEC, 0xDD17E945 */ r1 = 1.39200533467621045958e+00, /* 0x3FF645A7, 0x62C4AB74 */ r2 = 7.21935547567138069525e-01, /* 0x3FE71A18, 0x93D3DCDC */ r3 = 1.71933865632803078993e-01, /* 0x3FC601ED, 0xCCFBDF27 */ r4 = 1.86459191715652901344e-02, /* 0x3F9317EA, 0x742ED475 */ r5 = 7.77942496381893596434e-04, /* 0x3F497DDA, 0xCA41A95B */ r6 = 7.32668430744625636189e-06, /* 0x3EDEBAF7, 0xA5B38140 */ w0 = 4.18938533204672725052e-01, /* 0x3FDACFE3, 0x90C97D69 */ w1 = 8.33333333333329678849e-02, /* 0x3FB55555, 0x5555553B */ w2 = -2.77777777728775536470e-03, /* 0xBF66C16C, 0x16B02E5C */ w3 = 7.93650558643019558500e-04, /* 0x3F4A019F, 0x98CF38B6 */ w4 = -5.95187557450339963135e-04, /* 0xBF4380CB, 0x8C0FE741 */ w5 = 8.36339918996282139126e-04, /* 0x3F4B67BA, 0x4CDAD5D1 */ w6 = -1.63092934096575273989e-03; /* 0xBF5AB89D, 0x0B9E43E4 */ static const double zero= 0.00000000000000000000e+00; static double sin_pi(double x) { double y,z; int n,ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; if(ix<0x3fd00000) return __kernel_sin(pi*x,zero,0); y = -x; /* x is assume negative */ /* * argument reduction, make sure inexact flag not raised if input * is an integer */ z = floor(y); if(z!=y) { /* inexact anyway */ y *= 0.5; y = 2.0*(y - floor(y)); /* y = |x| mod 2.0 */ n = (int) (y*4.0); } else { if(ix>=0x43400000) { y = zero; n = 0; /* y must be even */ } else { if(ix<0x43300000) z = y+two52; /* exact */ GET_LOW_WORD(n,z); n &= 1; y = n; n<<= 2; } } switch (n) { case 0: y = __kernel_sin(pi*y,zero,0); break; case 1: case 2: y = __kernel_cos(pi*(0.5-y),zero); break; case 3: case 4: y = __kernel_sin(pi*(one-y),zero,0); break; case 5: case 6: y = -__kernel_cos(pi*(y-1.5),zero); break; default: y = __kernel_sin(pi*(y-2.0),zero,0); break; } return -y; } OLM_DLLEXPORT double __ieee754_lgamma_r(double x, int *signgamp) { double t,y,z,nadj,p,p1,p2,p3,q,r,w; int32_t hx; int i,lx,ix; EXTRACT_WORDS(hx,lx,x); /* purge off +-inf, NaN, +-0, tiny and negative arguments */ *signgamp = 1; ix = hx&0x7fffffff; if(ix>=0x7ff00000) return x*x; if((ix|lx)==0) return one/zero; if(ix<0x3b900000) { /* |x|<2**-70, return -log(|x|) */ if(hx<0) { *signgamp = -1; return -__ieee754_log(-x); } else return -__ieee754_log(x); } if(hx<0) { if(ix>=0x43300000) /* |x|>=2**52, must be -integer */ return one/zero; t = sin_pi(x); if(t==zero) return one/zero; /* -integer */ nadj = __ieee754_log(pi/fabs(t*x)); if(t=0x3FE76944) {y = one-x; i= 0;} else if(ix>=0x3FCDA661) {y= x-(tc-one); i=1;} else {y = x; i=2;} } else { r = zero; if(ix>=0x3FFBB4C3) {y=2.0-x;i=0;} /* [1.7316,2] */ else if(ix>=0x3FF3B4C4) {y=x-tc;i=1;} /* [1.23,1.73] */ else {y=x-one;i=2;} } switch(i) { case 0: z = y*y; p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10)))); p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11))))); p = y*p1+p2; r += (p-0.5*y); break; case 1: z = y*y; w = z*y; p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */ p2 = t1+w*(t4+w*(t7+w*(t10+w*t13))); p3 = t2+w*(t5+w*(t8+w*(t11+w*t14))); p = z*p1-(tt-w*(p2+y*p3)); r += (tf + p); break; case 2: p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5))))); p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5)))); r += (-0.5*y + p1/p2); } } else if(ix<0x40200000) { /* x < 8.0 */ i = (int)x; y = x-(double)i; p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6)))))); q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6))))); r = half*y+p/q; z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ switch(i) { case 7: z *= (y+6.0); /* FALLTHRU */ case 6: z *= (y+5.0); /* FALLTHRU */ case 5: z *= (y+4.0); /* FALLTHRU */ case 4: z *= (y+3.0); /* FALLTHRU */ case 3: z *= (y+2.0); /* FALLTHRU */ r += __ieee754_log(z); break; } /* 8.0 <= x < 2**58 */ } else if (ix < 0x43900000) { t = __ieee754_log(x); z = one/x; y = z*z; w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6))))); r = (x-half)*(t-one)+w; } else /* 2**58 <= x <= inf */ r = x*(__ieee754_log(x)-one); if(hx<0) r = nadj - r; return r; } wcc-0.0.2/src/wsh/openlibm/src/e_exp.c0000644000175000017500000001265313122010155016164 0ustar philphil /* @(#)e_exp.c 1.6 04/04/22 */ /* * ==================================================== * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved. * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_exp.c,v 1.14 2011/10/21 06:26:38 das Exp $"); /* __ieee754_exp(x) * Returns the exponential of x. * * Method * 1. Argument reduction: * Reduce x to an r so that |r| <= 0.5*ln2 ~ 0.34658. * Given x, find r and integer k such that * * x = k*ln2 + r, |r| <= 0.5*ln2. * * Here r will be represented as r = hi-lo for better * accuracy. * * 2. Approximation of exp(r) by a special rational function on * the interval [0,0.34658]: * Write * R(r**2) = r*(exp(r)+1)/(exp(r)-1) = 2 + r*r/6 - r**4/360 + ... * We use a special Remes algorithm on [0,0.34658] to generate * a polynomial of degree 5 to approximate R. The maximum error * of this polynomial approximation is bounded by 2**-59. In * other words, * R(z) ~ 2.0 + P1*z + P2*z**2 + P3*z**3 + P4*z**4 + P5*z**5 * (where z=r*r, and the values of P1 to P5 are listed below) * and * | 5 | -59 * | 2.0+P1*z+...+P5*z - R(z) | <= 2 * | | * The computation of exp(r) thus becomes * 2*r * exp(r) = 1 + ------- * R - r * r*R1(r) * = 1 + r + ----------- (for better accuracy) * 2 - R1(r) * where * 2 4 10 * R1(r) = r - (P1*r + P2*r + ... + P5*r ). * * 3. Scale back to obtain exp(x): * From step 1, we have * exp(x) = 2^k * exp(r) * * Special cases: * exp(INF) is INF, exp(NaN) is NaN; * exp(-INF) is 0, and * for finite argument, only exp(0)=1 is exact. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Misc. info. * For IEEE double * if x > 7.09782712893383973096e+02 then exp(x) overflow * if x < -7.45133219101941108420e+02 then exp(x) underflow * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include #include #include "math_private.h" static const double one = 1.0, halF[2] = {0.5,-0.5,}, huge = 1.0e+300, o_threshold= 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */ u_threshold= -7.45133219101941108420e+02, /* 0xc0874910, 0xD52D3051 */ ln2HI[2] ={ 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */ -6.93147180369123816490e-01,},/* 0xbfe62e42, 0xfee00000 */ ln2LO[2] ={ 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */ -1.90821492927058770002e-10,},/* 0xbdea39ef, 0x35793c76 */ invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */ P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */ P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */ P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */ P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */ P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ static volatile double twom1000= 9.33263618503218878990e-302; /* 2**-1000=0x01700000,0*/ OLM_DLLEXPORT double __ieee754_exp(double x) /* default IEEE double exp */ { double y,hi=0.0,lo=0.0,c,t,twopk; int32_t k=0,xsb; u_int32_t hx; GET_HIGH_WORD(hx,x); xsb = (hx>>31)&1; /* sign bit of x */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out non-finite argument */ if(hx >= 0x40862E42) { /* if |x|>=709.78... */ if(hx>=0x7ff00000) { u_int32_t lx; GET_LOW_WORD(lx,x); if(((hx&0xfffff)|lx)!=0) return x+x; /* NaN */ else return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */ } if(x > o_threshold) return huge*huge; /* overflow */ if(x < u_threshold) return twom1000*twom1000; /* underflow */ } /* this implementation gives 2.7182818284590455 for exp(1.0), which is well within the allowable error. however, 2.718281828459045 is closer to the true value so we prefer that answer, given that 1.0 is such an important argument value. */ if (x == 1.0) return 2.718281828459045235360; /* argument reduction */ if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */ if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */ hi = x-ln2HI[xsb]; lo=ln2LO[xsb]; k = 1-xsb-xsb; } else { k = (int)(invln2*x+halF[xsb]); t = k; hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */ lo = t*ln2LO[0]; } STRICT_ASSIGN(double, x, hi - lo); } else if(hx < 0x3e300000) { /* when |x|<2**-28 */ if(huge+x>one) return one+x;/* trigger inexact */ } else k = 0; /* x is now in primary range */ t = x*x; if(k >= -1021) INSERT_WORDS(twopk,0x3ff00000+(k<<20), 0); else INSERT_WORDS(twopk,0x3ff00000+((k+1000)<<20), 0); c = x - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); if(k==0) return one-((x*c)/(c-2.0)-x); else y = one-((lo-(x*c)/(2.0-c))-hi); if(k >= -1021) { if (k==1024) return y*2.0*0x1p1023; return y*twopk; } else { return y*twopk*twom1000; } } wcc-0.0.2/src/wsh/openlibm/src/w_cabs.c0000644000175000017500000000075313122010155016320 0ustar philphil/* * cabs() wrapper for hypot(). * * Written by J.T. Conklin, * Placed into the Public Domain, 1994. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/w_cabs.c,v 1.7 2008/03/30 20:03:06 das Exp $"); #include #include #include #include "math_private.h" OLM_DLLEXPORT double cabs(double complex z) { return hypot(creal(z), cimag(z)); } #if LDBL_MANT_DIG == 53 __weak_reference(cabs, cabsl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_catanhf.c0000644000175000017500000000264513122010155017012 0ustar philphil/* $OpenBSD: s_catanhf.c,v 1.1 2008/09/07 20:36:09 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* catanhf * * Complex inverse hyperbolic tangent * * * * SYNOPSIS: * * float complex catanhf(); * float complex z, w; * * w = catanhf (z); * * * * DESCRIPTION: * * Inverse tanh, equal to -i catan (iz); * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 2.3e-16 6.2e-17 * */ #include #include float complex catanhf(float complex z) { float complex w; w = -1.0f * I * catanf (z * I); return (w); } wcc-0.0.2/src/wsh/openlibm/src/amd64_fpmath.h0000644000175000017500000000375713122010155017350 0ustar philphil/*- * Copyright (c) 2002, 2003 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/libc/amd64/_fpmath.h,v 1.7 2008/01/17 16:39:06 bde Exp $ */ union IEEEl2bits { long double e; struct { unsigned int manl :32; unsigned int manh :32; unsigned int exp :15; unsigned int sign :1; unsigned int junkl :16; unsigned int junkh :32; } bits; struct { unsigned long man :64; unsigned int expsign :16; unsigned long junk :48; } xbits; }; #define LDBL_NBIT 0x80000000 #define mask_nbit_l(u) ((u).bits.manh &= ~LDBL_NBIT) #define LDBL_MANH_SIZE 32 #define LDBL_MANL_SIZE 32 #define LDBL_TO_ARRAY32(u, a) do { \ (a)[0] = (uint32_t)(u).bits.manl; \ (a)[1] = (uint32_t)(u).bits.manh; \ } while (0) wcc-0.0.2/src/wsh/openlibm/src/s_remquof.c0000644000175000017500000000607013122010155017060 0ustar philphil/* @(#)e_fmod.c 1.3 95/01/18 */ /*- * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_remquof.c,v 1.1 2005/03/25 04:40:44 das Exp $"); #include #include "math_private.h" static const float Zero[] = {0.0, -0.0,}; /* * Return the IEEE remainder and set *quo to the last n bits of the * quotient, rounded to the nearest integer. We choose n=31 because * we wind up computing all the integer bits of the quotient anyway as * a side-effect of computing the remainder by the shift and subtract * method. In practice, this is far more bits than are needed to use * remquo in reduction algorithms. */ OLM_DLLEXPORT float remquof(float x, float y, int *quo) { int32_t n,hx,hy,hz,ix,iy,sx,i; u_int32_t q,sxy; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hy,y); sxy = (hx ^ hy) & 0x80000000; sx = hx&0x80000000; /* sign of x */ hx ^=sx; /* |x| */ hy &= 0x7fffffff; /* |y| */ /* purge off exception values */ if(hy==0||hx>=0x7f800000||hy>0x7f800000) /* y=0,NaN;or x not finite */ return (x*y)/(x*y); if(hx>31]; /* |x|=|y| return x*0*/ } /* determine ix = ilogb(x) */ if(hx<0x00800000) { /* subnormal x */ for (ix = -126,i=(hx<<8); i>0; i<<=1) ix -=1; } else ix = (hx>>23)-127; /* determine iy = ilogb(y) */ if(hy<0x00800000) { /* subnormal y */ for (iy = -126,i=(hy<<8); i>0; i<<=1) iy -=1; } else iy = (hy>>23)-127; /* set up {hx,lx}, {hy,ly} and align y to x */ if(ix >= -126) hx = 0x00800000|(0x007fffff&hx); else { /* subnormal x, shift x to normal */ n = -126-ix; hx <<= n; } if(iy >= -126) hy = 0x00800000|(0x007fffff&hy); else { /* subnormal y, shift y to normal */ n = -126-iy; hy <<= n; } /* fix point fmod */ n = ix - iy; q = 0; while(n--) { hz=hx-hy; if(hz<0) hx = hx << 1; else {hx = hz << 1; q++;} q <<= 1; } hz=hx-hy; if(hz>=0) {hx=hz;q++;} /* convert back to floating value and restore the sign */ if(hx==0) { /* return sign(x)*0 */ *quo = (sxy ? -q : q); return Zero[(u_int32_t)sx>>31]; } while(hx<0x00800000) { /* normalize x */ hx <<= 1; iy -= 1; } if(iy>= -126) { /* normalize output */ hx = ((hx-0x00800000)|((iy+127)<<23)); } else { /* subnormal output */ n = -126 - iy; hx >>= n; } fixup: SET_FLOAT_WORD(x,hx); y = fabsf(y); if (y < 0x1p-125f) { if (x+x>y || (x+x==y && (q & 1))) { q++; x-=y; } } else if (x>0.5f*y || (x==0.5f*y && (q & 1))) { q++; x-=y; } GET_FLOAT_WORD(hx,x); SET_FLOAT_WORD(x,hx^sx); q &= 0x7fffffff; *quo = (sxy ? -q : q); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_ccosf.c0000644000175000017500000000340313122010155016474 0ustar philphil/* $OpenBSD: s_ccosf.c,v 1.2 2010/07/18 18:42:26 guenther Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ccosf() * * Complex circular cosine * * * * SYNOPSIS: * * void ccosf(); * cmplxf z, w; * * ccosf( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = cos x cosh y - i sin x sinh y. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.8e-7 5.5e-8 */ #include #include /* calculate cosh and sinh */ static void _cchshf(float xx, float *c, float *s) { float x, e, ei; x = xx; if(fabsf(x) <= 0.5f) { *c = coshf(x); *s = sinhf(x); } else { e = expf(x); ei = 0.5f/e; e = 0.5f * e; *s = e - ei; *c = e + ei; } } float complex ccosf(float complex z) { float complex w; float ch, sh; _cchshf( cimagf(z), &ch, &sh ); w = cosf( crealf(z) ) * ch + ( -sinf( crealf(z) ) * sh) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/e_hypotf.c0000644000175000017500000000437513122010155016703 0ustar philphil/* e_hypotf.c -- float version of e_hypot.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_hypotf.c,v 1.14 2011/10/15 07:00:28 das Exp $"); #include #include "math_private.h" OLM_DLLEXPORT float __ieee754_hypotf(float x, float y) { float a,b,t1,t2,y1,y2,w; int32_t j,k,ha,hb; GET_FLOAT_WORD(ha,x); ha &= 0x7fffffff; GET_FLOAT_WORD(hb,y); hb &= 0x7fffffff; if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} a = fabsf(a); b = fabsf(b); if((ha-hb)>0xf000000) {return a+b;} /* x/y > 2**30 */ k=0; if(ha > 0x58800000) { /* a>2**50 */ if(ha >= 0x7f800000) { /* Inf or NaN */ /* Use original arg order iff result is NaN; quieten sNaNs. */ w = fabsf(x+0.0F)-fabsf(y+0.0F); if(ha == 0x7f800000) w = a; if(hb == 0x7f800000) w = b; return w; } /* scale a and b by 2**-68 */ ha -= 0x22000000; hb -= 0x22000000; k += 68; SET_FLOAT_WORD(a,ha); SET_FLOAT_WORD(b,hb); } if(hb < 0x26800000) { /* b < 2**-50 */ if(hb <= 0x007fffff) { /* subnormal b or 0 */ if(hb==0) return a; SET_FLOAT_WORD(t1,0x7e800000); /* t1=2^126 */ b *= t1; a *= t1; k -= 126; } else { /* scale a and b by 2^68 */ ha += 0x22000000; /* a *= 2^68 */ hb += 0x22000000; /* b *= 2^68 */ k -= 68; SET_FLOAT_WORD(a,ha); SET_FLOAT_WORD(b,hb); } } /* medium size a and b */ w = a-b; if (w>b) { SET_FLOAT_WORD(t1,ha&0xfffff000); t2 = a-t1; w = __ieee754_sqrtf(t1*t1-(b*(-b)-t2*(a+t1))); } else { a = a+a; SET_FLOAT_WORD(y1,hb&0xfffff000); y2 = b - y1; SET_FLOAT_WORD(t1,(ha+0x00800000)&0xfffff000); t2 = a - t1; w = __ieee754_sqrtf(t1*y1-(w*(-w)-(t1*y2+t2*b))); } if(k!=0) { SET_FLOAT_WORD(t1,0x3f800000+(k<<23)); return t1*w; } else return w; } wcc-0.0.2/src/wsh/openlibm/src/s_logb.c0000644000175000017500000000233613122010155016326 0ustar philphil/* @(#)s_logb.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_logb.c,v 1.12 2008/02/08 01:22:13 bde Exp $"); /* * double logb(x) * IEEE 754 logb. Included to pass IEEE test suite. Not recommend. * Use ilogb instead. */ #include #include #include "math_private.h" static const double two54 = 1.80143985094819840000e+16; /* 43500000 00000000 */ OLM_DLLEXPORT double logb(double x) { int32_t lx,ix; EXTRACT_WORDS(ix,lx,x); ix &= 0x7fffffff; /* high |x| */ if((ix|lx)==0) return -1.0/fabs(x); if(ix>=0x7ff00000) return x*x; if(ix<0x00100000) { x *= two54; /* convert subnormal x to normal */ GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; return (double) ((ix>>20)-1023-54); } else return (double) ((ix>>20)-1023); } #if (LDBL_MANT_DIG == 53) __weak_reference(logb, logbl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_nextafterl.c0000644000175000017500000000416613122010155017562 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_nextafterl.c,v 1.2 2008/02/22 02:30:36 das Exp $"); /* IEEE functions * nextafter(x,y) * return the next machine floating-point number of x in the * direction toward y. * Special cases: */ #include #include #include "fpmath.h" #include "math_private.h" #if LDBL_MAX_EXP != 0x4000 #error "Unsupported long double format" #endif OLM_DLLEXPORT long double nextafterl(long double x, long double y) { volatile long double t; union IEEEl2bits ux, uy; ux.e = x; uy.e = y; if ((ux.bits.exp == 0x7fff && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl) != 0) || (uy.bits.exp == 0x7fff && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) return x+y; /* x or y is nan */ if(x==y) return y; /* x=y, return y */ if(x==0.0) { ux.bits.manh = 0; /* return +-minsubnormal */ ux.bits.manl = 1; ux.bits.sign = uy.bits.sign; t = ux.e*ux.e; if(t==ux.e) return t; else return ux.e; /* raise underflow flag */ } if((x>0.0) ^ (x * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_remainderl.c,v 1.1 2008/03/30 20:47:42 das Exp $"); #include #include "math_private.h" OLM_DLLEXPORT long double remainderl(long double x, long double y) { int quo; return (remquol(x, y, &quo)); } wcc-0.0.2/src/wsh/openlibm/src/s_clogf.c0000644000175000017500000000340713122010155016475 0ustar philphil/* $OpenBSD: s_clogf.c,v 1.2 2010/07/18 18:42:26 guenther Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* clogf.c * * Complex natural logarithm * * * * SYNOPSIS: * * void clogf(); * cmplxf z, w; * * clogf( &z, &w ); * * * * DESCRIPTION: * * Returns complex logarithm to the base e (2.718...) of * the complex argument x. * * If z = x + iy, r = sqrt( x**2 + y**2 ), * then * w = log(r) + i arctan(y/x). * * The arctangent ranges from -PI to +PI. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.9e-6 6.2e-8 * * Larger relative error can be observed for z near 1 +i0. * In IEEE arithmetic the peak absolute error is 3.1e-7. * */ #include #include float complex clogf(float complex z) { float complex w; float p, rr, x, y; x = crealf(z); y = cimagf(z); rr = atan2f(y, x); p = cabsf(z); p = logf(p); w = p + rr * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_tanf.c0000644000175000017500000000410313122010155016325 0ustar philphil/* s_tanf.c -- float version of s_tan.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_tanf.c,v 1.17 2008/02/25 22:19:17 bde Exp $"); #include #include //#define INLINE_KERNEL_TANDF //#define INLINE_REM_PIO2F #include "math_private.h" //#include "e_rem_pio2f.c" //#include "k_tanf.c" /* Small multiples of pi/2 rounded to double precision. */ static const double t1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */ t2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */ t3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */ t4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */ OLM_DLLEXPORT float tanf(float x) { double y; int32_t n, hx, ix; GET_FLOAT_WORD(hx,x); ix = hx & 0x7fffffff; if(ix <= 0x3f490fda) { /* |x| ~<= pi/4 */ if(ix<0x39800000) /* |x| < 2**-12 */ if(((int)x)==0) return x; /* x with inexact if x != 0 */ return __kernel_tandf(x,1); } if(ix<=0x407b53d1) { /* |x| ~<= 5*pi/4 */ if(ix<=0x4016cbe3) /* |x| ~<= 3pi/4 */ return __kernel_tandf(x + (hx>0 ? -t1pio2 : t1pio2), -1); else return __kernel_tandf(x + (hx>0 ? -t2pio2 : t2pio2), 1); } if(ix<=0x40e231d5) { /* |x| ~<= 9*pi/4 */ if(ix<=0x40afeddf) /* |x| ~<= 7*pi/4 */ return __kernel_tandf(x + (hx>0 ? -t3pio2 : t3pio2), -1); else return __kernel_tandf(x + (hx>0 ? -t4pio2 : t4pio2), 1); } /* tan(Inf or NaN) is NaN */ else if (ix>=0x7f800000) return x-x; /* general argument reduction needed */ else { n = __ieee754_rem_pio2f(x,&y); /* integer parameter: 1 -- n even; -1 -- n odd */ return __kernel_tandf(y,1-((n&1)<<1)); } } wcc-0.0.2/src/wsh/openlibm/src/s_trunc.c0000644000175000017500000000313513122010155016534 0ustar philphil/* @(#)s_floor.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_trunc.c,v 1.4 2008/02/22 02:27:34 das Exp $"); /* * trunc(x) * Return x rounded toward 0 to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to trunc(x). */ #include #include #include "math_private.h" static const double huge = 1.0e300; OLM_DLLEXPORT double trunc(double x) { int32_t i0,i1,j0; u_int32_t i; EXTRACT_WORDS(i0,i1,x); j0 = ((i0>>20)&0x7ff)-0x3ff; if(j0<20) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) {/* |x|<1, so return 0*sign(x) */ i0 &= 0x80000000U; i1 = 0; } } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ i0 &= (~i); i1=0; } } } else if (j0>51) { if(j0==0x400) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) /* raise inexact flag */ i1 &= (~i); } INSERT_WORDS(x,i0,i1); return x; } #if LDBL_MANT_DIG == 53 __weak_reference(trunc, truncl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_catanhl.c0000644000175000017500000000270313122010155017013 0ustar philphil/* $OpenBSD: s_catanhl.c,v 1.1 2011/07/08 19:25:31 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* catanhl * * Complex inverse hyperbolic tangent * * * * SYNOPSIS: * * long double complex catanhl(); * long double complex z, w; * * w = catanhl (z); * * * * DESCRIPTION: * * Inverse tanh, equal to -i catan (iz); * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 2.3e-16 6.2e-17 * */ #include #include long double complex catanhl(long double complex z) { long double complex w; w = -1.0L * I * catanl(z * I); return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_floorl.c0000644000175000017500000000477313122010155016707 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * From: @(#)s_floor.c 5.1 93/09/24 */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_floorl.c,v 1.8 2008/02/14 15:10:34 bde Exp $"); /* * floorl(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to floorl(x). */ #include #include #include #include "fpmath.h" #include "math_private.h" #ifdef LDBL_IMPLICIT_NBIT #define MANH_SIZE (LDBL_MANH_SIZE + 1) #define INC_MANH(u, c) do { \ uint64_t o = u.bits.manh; \ u.bits.manh += (c); \ if (u.bits.manh < o) \ u.bits.exp++; \ } while (0) #else #define MANH_SIZE LDBL_MANH_SIZE #define INC_MANH(u, c) do { \ uint64_t o = u.bits.manh; \ u.bits.manh += (c); \ if (u.bits.manh < o) { \ u.bits.exp++; \ u.bits.manh |= 1llu << (LDBL_MANH_SIZE - 1); \ } \ } while (0) #endif static const long double huge = 1.0e300; OLM_DLLEXPORT long double floorl(long double x) { union IEEEl2bits u = { .e = x }; int e = u.bits.exp - LDBL_MAX_EXP + 1; if (e < MANH_SIZE - 1) { if (e < 0) { /* raise inexact if x != 0 */ if (huge + x > 0.0) if (u.bits.exp > 0 || (u.bits.manh | u.bits.manl) != 0) u.e = u.bits.sign ? -1.0 : 0.0; } else { uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); if (((u.bits.manh & m) | u.bits.manl) == 0) return (x); /* x is integral */ if (u.bits.sign) { #ifdef LDBL_IMPLICIT_NBIT if (e == 0) u.bits.exp++; else #endif INC_MANH(u, 1llu << (MANH_SIZE - e - 1)); } if (huge + x > 0.0) { /* raise inexact flag */ u.bits.manh &= ~m; u.bits.manl = 0; } } } else if (e < LDBL_MANT_DIG - 1) { uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); if ((u.bits.manl & m) == 0) return (x); /* x is integral */ if (u.bits.sign) { if (e == MANH_SIZE - 1) INC_MANH(u, 1); else { uint64_t o = u.bits.manl; u.bits.manl += 1llu << (LDBL_MANT_DIG - e - 1); if (u.bits.manl < o) /* got a carry */ INC_MANH(u, 1); } } if (huge + x > 0.0) /* raise inexact flag */ u.bits.manl &= ~m; } return (u.e); } wcc-0.0.2/src/wsh/openlibm/src/s_cprojf.c0000644000175000017500000000333113122010155016662 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cprojf.c,v 1.1 2008/08/07 15:07:48 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT float complex cprojf(float complex z) { if (!isinf(crealf(z)) && !isinf(cimagf(z))) return (z); else return (CMPLXF(INFINITY, copysignf(0.0, cimagf(z)))); } wcc-0.0.2/src/wsh/openlibm/src/k_expf.c0000644000175000017500000000533413122010155016336 0ustar philphil/*- * Copyright (c) 2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_expf.c,v 1.1 2011/10/21 06:27:56 das Exp $"); #include #include #include "math_private.h" static const u_int32_t k = 235; /* constant for reduction */ static const float kln2 = 162.88958740F; /* k * ln2 */ /* * See k_exp.c for details. * * Input: ln(FLT_MAX) <= x < ln(2 * FLT_MAX / FLT_MIN_DENORM) ~= 192.7 * Output: 2**127 <= y < 2**128 */ static float __frexp_expf(float x, int *expt) { double exp_x; u_int32_t hx; exp_x = expf(x - kln2); GET_FLOAT_WORD(hx, exp_x); *expt = (hx >> 23) - (0x7f + 127) + k; SET_FLOAT_WORD(exp_x, (hx & 0x7fffff) | ((0x7f + 127) << 23)); return (exp_x); } OLM_DLLEXPORT float __ldexp_expf(float x, int expt) { float exp_x, scale; int ex_expt; exp_x = __frexp_expf(x, &ex_expt); expt += ex_expt; SET_FLOAT_WORD(scale, (0x7f + expt) << 23); return (exp_x * scale); } OLM_DLLEXPORT float complex __ldexp_cexpf(float complex z, int expt) { float x, y, exp_x, scale1, scale2; int ex_expt, half_expt; x = crealf(z); y = cimagf(z); exp_x = __frexp_expf(x, &ex_expt); expt += ex_expt; half_expt = expt / 2; SET_FLOAT_WORD(scale1, (0x7f + half_expt) << 23); half_expt = expt - half_expt; SET_FLOAT_WORD(scale2, (0x7f + half_expt) << 23); return (CMPLXF(cosf(y) * exp_x * scale1 * scale2, sinf(y) * exp_x * scale1 * scale2)); } wcc-0.0.2/src/wsh/openlibm/src/s_csqrtf.c0000644000175000017500000000601413122010155016702 0ustar philphil/*- * Copyright (c) 2007 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_csqrtf.c,v 1.3 2008/08/08 00:15:16 das Exp $"); #include #include #include "math_private.h" /* * gcc doesn't implement complex multiplication or division correctly, * so we need to handle infinities specially. We turn on this pragma to * notify conforming c99 compilers that the fast-but-incorrect code that * gcc generates is acceptable, since the special cases have already been * handled. */ #ifndef __GNUC__ #pragma STDC CX_LIMITED_RANGE ON #endif OLM_DLLEXPORT float complex csqrtf(float complex z) { float a = crealf(z), b = cimagf(z); double t; /* Handle special cases. */ if (z == 0) return (CMPLXF(0, b)); if (isinf(b)) return (CMPLXF(INFINITY, b)); if (isnan(a)) { t = (b - b) / (b - b); /* raise invalid if b is not a NaN */ return (CMPLXF(a, t)); /* return NaN + NaN i */ } if (isinf(a)) { /* * csqrtf(inf + NaN i) = inf + NaN i * csqrtf(inf + y i) = inf + 0 i * csqrtf(-inf + NaN i) = NaN +- inf i * csqrtf(-inf + y i) = 0 + inf i */ if (signbit(a)) return (CMPLXF(fabsf(b - b), copysignf(a, b))); else return (CMPLXF(a, copysignf(b - b, b))); } /* * The remaining special case (b is NaN) is handled just fine by * the normal code path below. */ /* * We compute t in double precision to avoid overflow and to * provide correct rounding in nearly all cases. * This is Algorithm 312, CACM vol 10, Oct 1967. */ if (a >= 0) { t = sqrt((a + hypot(a, b)) * 0.5); return (CMPLXF(t, b / (2.0 * t))); } else { t = sqrt((-a + hypot(a, b)) * 0.5); return (CMPLXF(fabsf(b) / (2.0 * t), copysignf(t, b))); } } wcc-0.0.2/src/wsh/openlibm/src/s_erf.c0000644000175000017500000002566013122010155016164 0ustar philphil/* @(#)s_erf.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_erf.c,v 1.8 2008/02/22 02:30:35 das Exp $"); /* double erf(double x) * double erfc(double x) * x * 2 |\ * erf(x) = --------- | exp(-t*t)dt * sqrt(pi) \| * 0 * * erfc(x) = 1-erf(x) * Note that * erf(-x) = -erf(x) * erfc(-x) = 2 - erfc(x) * * Method: * 1. For |x| in [0, 0.84375] * erf(x) = x + x*R(x^2) * erfc(x) = 1 - erf(x) if x in [-.84375,0.25] * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375] * where R = P/Q where P is an odd poly of degree 8 and * Q is an odd poly of degree 10. * -57.90 * | R - (erf(x)-x)/x | <= 2 * * * Remark. The formula is derived by noting * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....) * and that * 2/sqrt(pi) = 1.128379167095512573896158903121545171688 * is close to one. The interval is chosen because the fix * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is * near 0.6174), and by some experiment, 0.84375 is chosen to * guarantee the error is less than one ulp for erf. * * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and * c = 0.84506291151 rounded to single (24 bits) * erf(x) = sign(x) * (c + P1(s)/Q1(s)) * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0 * 1+(c+P1(s)/Q1(s)) if x < 0 * |P1/Q1 - (erf(|x|)-c)| <= 2**-59.06 * Remark: here we use the taylor series expansion at x=1. * erf(1+s) = erf(1) + s*Poly(s) * = 0.845.. + P1(s)/Q1(s) * That is, we use rational approximation to approximate * erf(1+s) - (c = (single)0.84506291151) * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25] * where * P1(s) = degree 6 poly in s * Q1(s) = degree 6 poly in s * * 3. For x in [1.25,1/0.35(~2.857143)], * erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1) * erf(x) = 1 - erfc(x) * where * R1(z) = degree 7 poly in z, (z=1/x^2) * S1(z) = degree 8 poly in z * * 4. For x in [1/0.35,28] * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0 * = 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6 x >= 28 * erf(x) = sign(x) *(1 - tiny) (raise inexact) * erfc(x) = tiny*tiny (raise underflow) if x > 0 * = 2 - tiny if x<0 * * 7. Special case: * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, * erfc/erf(NaN) is NaN */ #include #include "math_private.h" static const double tiny = 1e-300, half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */ /* c = (float)0.84506291151 */ erx = 8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */ /* * Coefficients for approximation to erf on [0,0.84375] */ efx = 1.28379167095512586316e-01, /* 0x3FC06EBA, 0x8214DB69 */ efx8= 1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */ pp0 = 1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */ pp1 = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */ pp2 = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */ pp3 = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */ pp4 = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */ qq1 = 3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */ qq2 = 6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */ qq3 = 5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */ qq4 = 1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */ qq5 = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */ /* * Coefficients for approximation to erf in [0.84375,1.25] */ pa0 = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */ pa1 = 4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */ pa2 = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */ pa3 = 3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */ pa4 = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */ pa5 = 3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */ pa6 = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */ qa1 = 1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */ qa2 = 5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */ qa3 = 7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */ qa4 = 1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */ qa5 = 1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */ qa6 = 1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */ /* * Coefficients for approximation to erfc in [1.25,1/0.35] */ ra0 = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */ ra1 = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */ ra2 = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */ ra3 = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */ ra4 = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */ ra5 = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */ ra6 = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */ ra7 = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */ sa1 = 1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */ sa2 = 1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */ sa3 = 4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */ sa4 = 6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */ sa5 = 4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */ sa6 = 1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */ sa7 = 6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */ sa8 = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */ /* * Coefficients for approximation to erfc in [1/.35,28] */ rb0 = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */ rb1 = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */ rb2 = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */ rb3 = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */ rb4 = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */ rb5 = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */ rb6 = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */ sb1 = 3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */ sb2 = 3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */ sb3 = 1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */ sb4 = 3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */ sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */ sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */ sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */ OLM_DLLEXPORT double erf(double x) { int32_t hx,ix,i; double R,S,P,Q,s,y,z,r; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) { /* erf(nan)=nan */ i = ((u_int32_t)hx>>31)<<1; return (double)(1-i)+one/x; /* erf(+-inf)=+-1 */ } if(ix < 0x3feb0000) { /* |x|<0.84375 */ if(ix < 0x3e300000) { /* |x|<2**-28 */ if (ix < 0x00800000) return 0.125*(8.0*x+efx8*x); /*avoid underflow */ return x + efx*x; } z = x*x; r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); y = r/s; return x + x*y; } if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */ s = fabs(x)-one; P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); if(hx>=0) return erx + P/Q; else return -erx - P/Q; } if (ix >= 0x40180000) { /* inf>|x|>=6 */ if(hx>=0) return one-tiny; else return tiny-one; } x = fabs(x); s = one/(x*x); if(ix< 0x4006DB6E) { /* |x| < 1/0.35 */ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( ra5+s*(ra6+s*ra7)))))); S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( sa5+s*(sa6+s*(sa7+s*sa8))))))); } else { /* |x| >= 1/0.35 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( rb5+s*rb6))))); S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( sb5+s*(sb6+s*sb7)))))); } z = x; SET_LOW_WORD(z,0); r = __ieee754_exp(-z*z-0.5625)*__ieee754_exp((z-x)*(z+x)+R/S); if(hx>=0) return one-r/x; else return r/x-one; } OLM_DLLEXPORT double erfc(double x) { int32_t hx,ix; double R,S,P,Q,s,y,z,r; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) { /* erfc(nan)=nan */ /* erfc(+-inf)=0,2 */ return (double)(((u_int32_t)hx>>31)<<1)+one/x; } if(ix < 0x3feb0000) { /* |x|<0.84375 */ if(ix < 0x3c700000) /* |x|<2**-56 */ return one-x; z = x*x; r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); y = r/s; if(hx < 0x3fd00000) { /* x<1/4 */ return one-(x+x*y); } else { r = x*y; r += (x-half); return half - r ; } } if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */ s = fabs(x)-one; P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); if(hx>=0) { z = one-erx; return z - P/Q; } else { z = erx+P/Q; return one+z; } } if (ix < 0x403c0000) { /* |x|<28 */ x = fabs(x); s = one/(x*x); if(ix< 0x4006DB6D) { /* |x| < 1/.35 ~ 2.857143*/ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( ra5+s*(ra6+s*ra7)))))); S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( sa5+s*(sa6+s*(sa7+s*sa8))))))); } else { /* |x| >= 1/.35 ~ 2.857143 */ if(hx<0&&ix>=0x40180000) return two-tiny;/* x < -6 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( rb5+s*rb6))))); S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( sb5+s*(sb6+s*sb7)))))); } z = x; SET_LOW_WORD(z,0); r = __ieee754_exp(-z*z-0.5625)* __ieee754_exp((z-x)*(z+x)+R/S); if(hx>0) return r/x; else return two-r/x; } else { if(hx>0) return tiny*tiny; else return two-tiny; } } wcc-0.0.2/src/wsh/openlibm/src/s_catanl.c0000644000175000017500000000566413122010155016654 0ustar philphil/* $OpenBSD: s_catanl.c,v 1.3 2011/07/20 21:02:51 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* catanl() * * Complex circular arc tangent * * * * SYNOPSIS: * * long double complex catanl(); * long double complex z, w; * * w = catanl( z ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * 1 ( 2x ) * Re w = - arctan(-----------) + k PI * 2 ( 2 2) * (1 - x - y ) * * ( 2 2) * 1 (x + (y+1) ) * Im w = - log(------------) * 4 ( 2 2) * (x + (y-1) ) * * Where k is an arbitrary integer. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5900 1.3e-16 7.8e-18 * IEEE -10,+10 30000 2.3e-15 8.5e-17 * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2, * had peak relative error 1.5e-16, rms relative error * 2.9e-17. See also clog(). */ #include #include #include static const long double PIL = 3.141592653589793238462643383279502884197169L; static const long double DP1 = 3.14159265358979323829596852490908531763125L; static const long double DP2 = 1.6667485837041756656403424829301998703007e-19L; static const long double DP3 = 1.8830410776607851167459095484560349402753e-39L; static long double redupil(long double x) { long double t; long i; t = x / PIL; if (t >= 0.0L) t += 0.5L; else t -= 0.5L; i = t; /* the multiple */ t = i; t = ((x - t * DP1) - t * DP2) - t * DP3; return (t); } long double complex catanl(long double complex z) { long double complex w; long double a, t, x, x2, y; x = creall(z); y = cimagl(z); if ((x == 0.0L) && (y > 1.0L)) goto ovrf; x2 = x * x; a = 1.0L - x2 - (y * y); if (a == 0.0L) goto ovrf; t = atan2l(2.0L * x, a) * 0.5L; w = redupil(t); t = y - 1.0L; a = x2 + (t * t); if (a == 0.0L) goto ovrf; t = y + 1.0L; a = (x2 + (t * t)) / a; w = w + (0.25L * logl(a)) * I; return (w); ovrf: /*mtherr( "catanl", OVERFLOW );*/ w = LDBL_MAX + LDBL_MAX * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_exp2f.c0000644000175000017500000001026613122010155016430 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_exp2f.c,v 1.9 2008/02/22 02:27:34 das Exp $"); #include #include #include "math_private.h" #define TBLBITS 4 #define TBLSIZE (1 << TBLBITS) static const float huge = 0x1p100f, redux = 0x1.8p23f / TBLSIZE, P1 = 0x1.62e430p-1f, P2 = 0x1.ebfbe0p-3f, P3 = 0x1.c6b348p-5f, P4 = 0x1.3b2c9cp-7f; static volatile float twom100 = 0x1p-100f; static const double exp2ft[TBLSIZE] = { 0x1.6a09e667f3bcdp-1, 0x1.7a11473eb0187p-1, 0x1.8ace5422aa0dbp-1, 0x1.9c49182a3f090p-1, 0x1.ae89f995ad3adp-1, 0x1.c199bdd85529cp-1, 0x1.d5818dcfba487p-1, 0x1.ea4afa2a490dap-1, 0x1.0000000000000p+0, 0x1.0b5586cf9890fp+0, 0x1.172b83c7d517bp+0, 0x1.2387a6e756238p+0, 0x1.306fe0a31b715p+0, 0x1.3dea64c123422p+0, 0x1.4bfdad5362a27p+0, 0x1.5ab07dd485429p+0, }; /* * exp2f(x): compute the base 2 exponential of x * * Accuracy: Peak error < 0.501 ulp; location of peak: -0.030110927. * * Method: (equally-spaced tables) * * Reduce x: * x = 2**k + y, for integer k and |y| <= 1/2. * Thus we have exp2f(x) = 2**k * exp2(y). * * Reduce y: * y = i/TBLSIZE + z for integer i near y * TBLSIZE. * Thus we have exp2(y) = exp2(i/TBLSIZE) * exp2(z), * with |z| <= 2**-(TBLSIZE+1). * * We compute exp2(i/TBLSIZE) via table lookup and exp2(z) via a * degree-4 minimax polynomial with maximum error under 1.4 * 2**-33. * Using double precision for everything except the reduction makes * roundoff error insignificant and simplifies the scaling step. * * This method is due to Tang, but I do not use his suggested parameters: * * Tang, P. Table-driven Implementation of the Exponential Function * in IEEE Floating-Point Arithmetic. TOMS 15(2), 144-157 (1989). */ OLM_DLLEXPORT float exp2f(float x) { double tv, twopk, u, z; float t; u_int32_t hx, ix, i0; int32_t k; /* Filter out exceptional cases. */ GET_FLOAT_WORD(hx, x); ix = hx & 0x7fffffff; /* high word of |x| */ if(ix >= 0x43000000) { /* |x| >= 128 */ if(ix >= 0x7f800000) { if ((ix & 0x7fffff) != 0 || (hx & 0x80000000) == 0) return (x + x); /* x is NaN or +Inf */ else return (0.0); /* x is -Inf */ } if(x >= 0x1.0p7f) return (huge * huge); /* overflow */ if(x <= -0x1.2cp7f) return (twom100 * twom100); /* underflow */ } else if (ix <= 0x33000000) { /* |x| <= 0x1p-25 */ return (1.0f + x); } /* Reduce x, computing z, i0, and k. */ STRICT_ASSIGN(float, t, x + redux); GET_FLOAT_WORD(i0, t); i0 += TBLSIZE / 2; k = (i0 >> TBLBITS) << 20; i0 &= TBLSIZE - 1; t -= redux; z = x - t; INSERT_WORDS(twopk, 0x3ff00000 + k, 0); /* Compute r = exp2(y) = exp2ft[i0] * p(z). */ tv = exp2ft[i0]; u = tv * z; tv = tv + u * (P1 + z * P2) + u * (z * z) * (P3 + z * P4); /* Scale by 2**(k>>20). */ return (tv * twopk); } wcc-0.0.2/src/wsh/openlibm/src/s_copysignf.c0000644000175000017500000000175213122010155017405 0ustar philphil/* s_copysignf.c -- float version of s_copysign.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_copysignf.c,v 1.10 2008/02/22 02:30:35 das Exp $"); /* * copysignf(float x, float y) * copysignf(x,y) returns a value with the magnitude of x and * with the sign bit of y. */ #include #include "math_private.h" OLM_DLLEXPORT float copysignf(float x, float y) { u_int32_t ix,iy; GET_FLOAT_WORD(ix,x); GET_FLOAT_WORD(iy,y); SET_FLOAT_WORD(x,(ix&0x7fffffff)|(iy&0x80000000)); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_cbrtl.c0000644000175000017500000000731713122010155016515 0ustar philphil/*- * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2009-2011, Bruce D. Evans, Steven G. Kargl, David Schultz. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * The argument reduction and testing for exceptional cases was * written by Steven G. Kargl with input from Bruce D. Evans * and David A. Schultz. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cbrtl.c,v 1.1 2011/03/12 19:37:35 kargl Exp $"); #include #include // VBS //#include #include "fpmath.h" #include "math_private.h" #if defined(__i386__) #include "i387/bsd_ieeefp.h" #endif #define BIAS (LDBL_MAX_EXP - 1) static const unsigned B1 = 709958130; /* B1 = (127-127.0/3-0.03306235651)*2**23 */ OLM_DLLEXPORT long double cbrtl(long double x) { union IEEEl2bits u, v; long double r, s, t, w; double dr, dt, dx; float ft, fx; u_int32_t hx; u_int16_t expsign; int k; u.e = x; expsign = u.xbits.expsign; k = expsign & 0x7fff; /* * If x = +-Inf, then cbrt(x) = +-Inf. * If x = NaN, then cbrt(x) = NaN. */ if (k == BIAS + LDBL_MAX_EXP) return (x + x); #ifdef __i386__ fp_prec_t oprec; oprec = fpgetprec(); if (oprec != FP_PE) fpsetprec(FP_PE); #endif if (k == 0) { /* If x = +-0, then cbrt(x) = +-0. */ if ((u.bits.manh | u.bits.manl) == 0) { #ifdef __i386__ if (oprec != FP_PE) fpsetprec(oprec); #endif return (x); } /* Adjust subnormal numbers. */ u.e *= 0x1.0p514; k = u.bits.exp; k -= BIAS + 514; } else k -= BIAS; u.xbits.expsign = BIAS; v.e = 1; x = u.e; switch (k % 3) { case 1: case -2: x = 2*x; k--; break; case 2: case -1: x = 4*x; k -= 2; break; } v.xbits.expsign = (expsign & 0x8000) | (BIAS + k / 3); /* * The following is the guts of s_cbrtf, with the handling of * special values removed and extra care for accuracy not taken, * but with most of the extra accuracy not discarded. */ /* ~5-bit estimate: */ fx = x; GET_FLOAT_WORD(hx, fx); SET_FLOAT_WORD(ft, ((hx & 0x7fffffff) / 3 + B1)); /* ~16-bit estimate: */ dx = x; dt = ft; dr = dt * dt * dt; dt = dt * (dx + dx + dr) / (dx + dr + dr); /* ~47-bit estimate: */ dr = dt * dt * dt; dt = dt * (dx + dx + dr) / (dx + dr + dr); #if LDBL_MANT_DIG == 64 /* * dt is cbrtl(x) to ~47 bits (after x has been reduced to 1 <= x < 8). * Round it away from zero to 32 bits (32 so that t*t is exact, and * away from zero for technical reasons). */ volatile double vd2 = 0x1.0p32; volatile double vd1 = 0x1.0p-31; #define vd ((long double)vd2 + vd1) t = dt + vd - 0x1.0p32; #elif LDBL_MANT_DIG == 113 /* * Round dt away from zero to 47 bits. Since we don't trust the 47, * add 2 47-bit ulps instead of 1 to round up. Rounding is slow and * might be avoidable in this case, since on most machines dt will * have been evaluated in 53-bit precision and the technical reasons * for rounding up might not apply to either case in cbrtl() since * dt is much more accurate than needed. */ t = dt + 0x2.0p-46 + 0x1.0p60L - 0x1.0p60; #else #error "Unsupported long double format" #endif /* * Final step Newton iteration to 64 or 113 bits with * error < 0.667 ulps */ s=t*t; /* t*t is exact */ r=x/s; /* error <= 0.5 ulps; |r| < |t| */ w=t+t; /* t+t is exact */ r=(r-t)/(w+r); /* r-t is exact; w+r ~= 3*t */ t=t+t*r; /* error <= 0.5 + 0.5/3 + epsilon */ t *= v.e; #ifdef __i386__ if (oprec != FP_PE) fpsetprec(oprec); #endif return (t); } wcc-0.0.2/src/wsh/openlibm/src/s_csinl.c0000644000175000017500000000357313122010155016517 0ustar philphil/* $OpenBSD: s_csinl.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* csinl() * * Complex circular sine * * * * SYNOPSIS: * * long double complex csinl(); * long double complex z, w; * * w = csinl( z ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = sin x cosh y + i cos x sinh y. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8400 5.3e-17 1.3e-17 * IEEE -10,+10 30000 3.8e-16 1.0e-16 * Also tested by csin(casin(z)) = z. * */ #include #include static void cchshl(long double x, long double *c, long double *s) { long double e, ei; if(fabsl(x) <= 0.5L) { *c = coshl(x); *s = sinhl(x); } else { e = expl(x); ei = 0.5L/e; e = 0.5L * e; *s = e - ei; *c = e + ei; } } long double complex csinl(long double complex z) { long double complex w; long double ch, sh; cchshl(cimagl(z), &ch, &sh); w = sinl(creall(z)) * ch + (cosl(creall(z)) * sh) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/e_hypotl.c0000644000175000017500000000640213122010155016702 0ustar philphil/* From: @(#)e_hypot.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_hypotl.c,v 1.3 2011/10/16 05:36:39 das Exp $"); /* long double version of hypot(). See e_hypot.c for most comments. */ #include #include #include "fpmath.h" #include "math_private.h" #define GET_LDBL_MAN(h, l, v) do { \ union IEEEl2bits uv; \ \ uv.e = v; \ h = uv.bits.manh; \ l = uv.bits.manl; \ } while (0) #undef GET_HIGH_WORD #define GET_HIGH_WORD(i, v) GET_LDBL_EXPSIGN(i, v) #undef SET_HIGH_WORD #define SET_HIGH_WORD(v, i) SET_LDBL_EXPSIGN(v, i) #define DESW(exp) (exp) /* delta expsign word */ #define ESW(exp) (MAX_EXP - 1 + (exp)) /* expsign word */ #define MANT_DIG LDBL_MANT_DIG #define MAX_EXP LDBL_MAX_EXP #if LDBL_MANL_SIZE > 32 typedef u_int64_t man_t; #else typedef u_int32_t man_t; #endif OLM_DLLEXPORT long double hypotl(long double x, long double y) { long double a=x,b=y,t1,t2,y1,y2,w; int32_t j,k,ha,hb; GET_HIGH_WORD(ha,x); ha &= 0x7fff; GET_HIGH_WORD(hb,y); hb &= 0x7fff; if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} a = fabsl(a); b = fabsl(b); if((ha-hb)>DESW(MANT_DIG+7)) {return a+b;} /* x/y > 2**(MANT_DIG+7) */ k=0; if(ha > ESW(MAX_EXP/2-12)) { /* a>2**(MAX_EXP/2-12) */ if(ha >= ESW(MAX_EXP)) { /* Inf or NaN */ man_t manh, manl; /* Use original arg order iff result is NaN; quieten sNaNs. */ w = fabsl(x+0.0)-fabsl(y+0.0); GET_LDBL_MAN(manh,manl,a); if (manh == LDBL_NBIT && manl == 0) w = a; GET_LDBL_MAN(manh,manl,b); if (hb >= ESW(MAX_EXP) && manh == LDBL_NBIT && manl == 0) w = b; return w; } /* scale a and b by 2**-(MAX_EXP/2+88) */ ha -= DESW(MAX_EXP/2+88); hb -= DESW(MAX_EXP/2+88); k += MAX_EXP/2+88; SET_HIGH_WORD(a,ha); SET_HIGH_WORD(b,hb); } if(hb < ESW(-(MAX_EXP/2-12))) { /* b < 2**-(MAX_EXP/2-12) */ if(hb <= 0) { /* subnormal b or 0 */ man_t manh, manl; GET_LDBL_MAN(manh,manl,b); if((manh|manl)==0) return a; t1=0; SET_HIGH_WORD(t1,ESW(MAX_EXP-2)); /* t1=2^(MAX_EXP-2) */ b *= t1; a *= t1; k -= MAX_EXP-2; } else { /* scale a and b by 2^(MAX_EXP/2+88) */ ha += DESW(MAX_EXP/2+88); hb += DESW(MAX_EXP/2+88); k -= MAX_EXP/2+88; SET_HIGH_WORD(a,ha); SET_HIGH_WORD(b,hb); } } /* medium size a and b */ w = a-b; if (w>b) { t1 = a; union IEEEl2bits uv; uv.e = t1; uv.bits.manl = 0; t1 = uv.e; t2 = a-t1; w = sqrtl(t1*t1-(b*(-b)-t2*(a+t1))); } else { a = a+a; y1 = b; union IEEEl2bits uv; uv.e = y1; uv.bits.manl = 0; y1 = uv.e; y2 = b - y1; t1 = a; uv.e = t1; uv.bits.manl = 0; t1 = uv.e; t2 = a - t1; w = sqrtl(t1*y1-(w*(-w)-(t1*y2+t2*b))); } if(k!=0) { u_int32_t high; t1 = 1.0; GET_HIGH_WORD(high,t1); SET_HIGH_WORD(t1,high+DESW(k)); return t1*w; } else return w; } wcc-0.0.2/src/wsh/openlibm/src/e_sinhf.c0000644000175000017500000000302713122010155016472 0ustar philphil/* e_sinhf.c -- float version of e_sinh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_sinhf.c,v 1.10 2011/10/21 06:28:47 das Exp $"); #include #include "math_private.h" static const float one = 1.0, shuge = 1.0e37; OLM_DLLEXPORT float __ieee754_sinhf(float x) { float t,h; int32_t ix,jx; GET_FLOAT_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7f800000) return x+x; h = 0.5; if (jx<0) h = -h; /* |x| in [0,9], return sign(x)*0.5*(E+E/(E+1))) */ if (ix < 0x41100000) { /* |x|<9 */ if (ix<0x39800000) /* |x|<2**-12 */ if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ t = expm1f(fabsf(x)); if(ix<0x3f800000) return h*((float)2.0*t-t*t/(t+one)); return h*(t+t/(t+one)); } /* |x| in [9, logf(maxfloat)] return 0.5*exp(|x|) */ if (ix < 0x42b17217) return h*__ieee754_expf(fabsf(x)); /* |x| in [logf(maxfloat), overflowthresold] */ if (ix<=0x42b2d4fc) return h*2.0F*__ldexp_expf(fabsf(x), -1); /* |x| > overflowthresold, sinh(x) overflow */ return x*shuge; } wcc-0.0.2/src/wsh/openlibm/src/e_acoshf.c0000644000175000017500000000256413122010155016633 0ustar philphil/* e_acoshf.c -- float version of e_acosh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_acoshf.c,v 1.8 2008/02/22 02:30:34 das Exp $"); #include #include "math_private.h" static const float one = 1.0, ln2 = 6.9314718246e-01; /* 0x3f317218 */ OLM_DLLEXPORT float __ieee754_acoshf(float x) { float t; int32_t hx; GET_FLOAT_WORD(hx,x); if(hx<0x3f800000) { /* x < 1 */ return (x-x)/(x-x); } else if(hx >=0x4d800000) { /* x > 2**28 */ if(hx >=0x7f800000) { /* x is inf of NaN */ return x+x; } else return __ieee754_logf(x)+ln2; /* acosh(huge)=log(2x) */ } else if (hx==0x3f800000) { return 0.0; /* acosh(1) = 0 */ } else if (hx > 0x40000000) { /* 2**28 > x > 2 */ t=x*x; return __ieee754_logf((float)2.0*x-one/(x+__ieee754_sqrtf(t-one))); } else { /* 1 #include #include "math_private.h" #if LDBL_MANT_DIG == 64 #include "../ld80/e_rem_pio2l.h" #elif LDBL_MANT_DIG == 113 #include "../ld128/e_rem_pio2l.h" #else #error "Unsupported long double format" #endif OLM_DLLEXPORT long double tanl(long double x) { union IEEEl2bits z; int e0, s; long double y[2]; long double hi, lo; z.e = x; s = z.bits.sign; z.bits.sign = 0; /* If x = +-0 or x is subnormal, then tan(x) = x. */ if (z.bits.exp == 0) return (x); /* If x = NaN or Inf, then tan(x) = NaN. */ if (z.bits.exp == 32767) return ((x - x) / (x - x)); /* Optimize the case where x is already within range. */ if (z.e < M_PI_4) { hi = __kernel_tanl(z.e, 0, 0); return (s ? -hi : hi); } e0 = __ieee754_rem_pio2l(x, y); hi = y[0]; lo = y[1]; switch (e0 & 3) { case 0: case 2: hi = __kernel_tanl(hi, lo, 0); break; case 1: case 3: hi = __kernel_tanl(hi, lo, 1); break; } return (hi); } wcc-0.0.2/src/wsh/openlibm/src/s_cproj.c0000644000175000017500000000342513122010155016520 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cproj.c,v 1.1 2008/08/07 15:07:48 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT double complex cproj(double complex z) { if (!isinf(creal(z)) && !isinf(cimag(z))) return (z); else return (CMPLX(INFINITY, copysign(0.0, cimag(z)))); } #if LDBL_MANT_DIG == 53 __weak_reference(cproj, cprojl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_ccosh.c0000644000175000017500000001167213122010155016505 0ustar philphil/*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Hyperbolic cosine of a complex argument z = x + i y. * * cosh(z) = cosh(x+iy) * = cosh(x) cos(y) + i sinh(x) sin(y). * * Exceptional values are noted in the comments within the source code. * These values and the return value were taken from n1124.pdf. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ccosh.c,v 1.2 2011/10/21 06:29:32 das Exp $"); #include #include #include "math_private.h" static const double huge = 0x1p1023; OLM_DLLEXPORT double complex ccosh(double complex z) { double x, y, h; int32_t hx, hy, ix, iy, lx, ly; x = creal(z); y = cimag(z); EXTRACT_WORDS(hx, lx, x); EXTRACT_WORDS(hy, ly, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; /* Handle the nearly-non-exceptional cases where x and y are finite. */ if (ix < 0x7ff00000 && iy < 0x7ff00000) { if ((iy | ly) == 0) return (CMPLX(cosh(x), x * y)); if (ix < 0x40360000) /* small x: normal case */ return (CMPLX(cosh(x) * cos(y), sinh(x) * sin(y))); /* |x| >= 22, so cosh(x) ~= exp(|x|) */ if (ix < 0x40862e42) { /* x < 710: exp(|x|) won't overflow */ h = exp(fabs(x)) * 0.5; return (CMPLX(h * cos(y), copysign(h, x) * sin(y))); } else if (ix < 0x4096bbaa) { /* x < 1455: scale to avoid overflow */ z = __ldexp_cexp(CMPLX(fabs(x), y), -1); return (CMPLX(creal(z), cimag(z) * copysign(1, x))); } else { /* x >= 1455: the result always overflows */ h = huge * x; return (CMPLX(h * h * cos(y), h * sin(y))); } } /* * cosh(+-0 +- I Inf) = dNaN + I sign(d(+-0, dNaN))0. * The sign of 0 in the result is unspecified. Choice = normally * the same as dNaN. Raise the invalid floating-point exception. * * cosh(+-0 +- I NaN) = d(NaN) + I sign(d(+-0, NaN))0. * The sign of 0 in the result is unspecified. Choice = normally * the same as d(NaN). */ if ((ix | lx) == 0 && iy >= 0x7ff00000) return (CMPLX(y - y, copysign(0, x * (y - y)))); /* * cosh(+-Inf +- I 0) = +Inf + I (+-)(+-)0. * * cosh(NaN +- I 0) = d(NaN) + I sign(d(NaN, +-0))0. * The sign of 0 in the result is unspecified. */ if ((iy | ly) == 0 && ix >= 0x7ff00000) { if (((hx & 0xfffff) | lx) == 0) return (CMPLX(x * x, copysign(0, x) * y)); return (CMPLX(x * x, copysign(0, (x + x) * y))); } /* * cosh(x +- I Inf) = dNaN + I dNaN. * Raise the invalid floating-point exception for finite nonzero x. * * cosh(x + I NaN) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero x. Choice = don't raise (except for signaling NaNs). */ if (ix < 0x7ff00000 && iy >= 0x7ff00000) return (CMPLX(y - y, x * (y - y))); /* * cosh(+-Inf + I NaN) = +Inf + I d(NaN). * * cosh(+-Inf +- I Inf) = +Inf + I dNaN. * The sign of Inf in the result is unspecified. Choice = always +. * Raise the invalid floating-point exception. * * cosh(+-Inf + I y) = +Inf cos(y) +- I Inf sin(y) */ if (ix >= 0x7ff00000 && ((hx & 0xfffff) | lx) == 0) { if (iy >= 0x7ff00000) return (CMPLX(x * x, x * (y - y))); return (CMPLX((x * x) * cos(y), x * sin(y))); } /* * cosh(NaN + I NaN) = d(NaN) + I d(NaN). * * cosh(NaN +- I Inf) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception. * Choice = raise. * * cosh(NaN + I y) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero y. Choice = don't raise (except for signaling NaNs). */ return (CMPLX((x * x) * (y - y), (x + x) * (y - y))); } OLM_DLLEXPORT double complex ccos(double complex z) { /* ccos(z) = ccosh(I * z) */ return (ccosh(CMPLX(-cimag(z), creal(z)))); } wcc-0.0.2/src/wsh/openlibm/src/s_cabsf.c0000644000175000017500000000174513122010155016464 0ustar philphil/* $OpenBSD: s_cabsf.c,v 1.1 2008/09/07 20:36:09 martynas Exp $ */ /* * Copyright (c) 2008 Martynas Venckus * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include float cabsf(float complex z) { return hypotf(__real__ z, __imag__ z); } wcc-0.0.2/src/wsh/openlibm/src/s_ccoshl.c0000644000175000017500000000300113122010155016644 0ustar philphil/* $OpenBSD: s_ccoshl.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ccoshl * * Complex hyperbolic cosine * * * * SYNOPSIS: * * long double complex ccoshl(); * long double complex z, w; * * w = ccoshl (z); * * * * DESCRIPTION: * * ccosh(z) = cosh x cos y + i sinh x sin y . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 2.9e-16 8.1e-17 * */ #include #include long double complex ccoshl(long double complex z) { long double complex w; long double x, y; x = creall(z); y = cimagl(z); w = coshl(x) * cosl(y) + (sinhl(x) * sinl(y)) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/math_private_openbsd.h0000644000175000017500000001142113122010155021256 0ustar philphil/* $OpenBSD: math_private.h,v 1.17 2014/06/02 19:31:17 kettenis Exp $ */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * from: @(#)fdlibm.h 5.1 93/09/24 */ #ifndef _MATH_PRIVATE_OPENBSD_H_ #define _MATH_PRIVATE_OPENBSD_H_ #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__ typedef union { long double value; struct { u_int32_t mswhi; u_int32_t mswlo; u_int32_t lswhi; u_int32_t lswlo; } parts32; struct { u_int64_t msw; u_int64_t lsw; } parts64; } ieee_quad_shape_type; #endif #if __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__ typedef union { long double value; struct { u_int32_t lswlo; u_int32_t lswhi; u_int32_t mswlo; u_int32_t mswhi; } parts32; struct { u_int64_t lsw; u_int64_t msw; } parts64; } ieee_quad_shape_type; #endif /* Get two 64 bit ints from a long double. */ #define GET_LDOUBLE_WORDS64(ix0,ix1,d) \ do { \ ieee_quad_shape_type qw_u; \ qw_u.value = (d); \ (ix0) = qw_u.parts64.msw; \ (ix1) = qw_u.parts64.lsw; \ } while (0) /* Set a long double from two 64 bit ints. */ #define SET_LDOUBLE_WORDS64(d,ix0,ix1) \ do { \ ieee_quad_shape_type qw_u; \ qw_u.parts64.msw = (ix0); \ qw_u.parts64.lsw = (ix1); \ (d) = qw_u.value; \ } while (0) /* Get the more significant 64 bits of a long double mantissa. */ #define GET_LDOUBLE_MSW64(v,d) \ do { \ ieee_quad_shape_type sh_u; \ sh_u.value = (d); \ (v) = sh_u.parts64.msw; \ } while (0) /* Set the more significant 64 bits of a long double mantissa from an int. */ #define SET_LDOUBLE_MSW64(d,v) \ do { \ ieee_quad_shape_type sh_u; \ sh_u.value = (d); \ sh_u.parts64.msw = (v); \ (d) = sh_u.value; \ } while (0) /* Get the least significant 64 bits of a long double mantissa. */ #define GET_LDOUBLE_LSW64(v,d) \ do { \ ieee_quad_shape_type sh_u; \ sh_u.value = (d); \ (v) = sh_u.parts64.lsw; \ } while (0) /* A union which permits us to convert between a long double and three 32 bit ints. */ #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__ typedef union { long double value; struct { #ifdef __LP64__ int padh:32; #endif int exp:16; int padl:16; u_int32_t msw; u_int32_t lsw; } parts; } ieee_extended_shape_type; #endif #if __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__ typedef union { long double value; struct { u_int32_t lsw; u_int32_t msw; int exp:16; int padl:16; #ifdef __LP64__ int padh:32; #endif } parts; } ieee_extended_shape_type; #endif /* Get three 32 bit ints from a double. */ #define GET_LDOUBLE_WORDS(se,ix0,ix1,d) \ do { \ ieee_extended_shape_type ew_u; \ ew_u.value = (d); \ (se) = ew_u.parts.exp; \ (ix0) = ew_u.parts.msw; \ (ix1) = ew_u.parts.lsw; \ } while (0) /* Set a double from two 32 bit ints. */ #define SET_LDOUBLE_WORDS(d,se,ix0,ix1) \ do { \ ieee_extended_shape_type iw_u; \ iw_u.parts.exp = (se); \ iw_u.parts.msw = (ix0); \ iw_u.parts.lsw = (ix1); \ (d) = iw_u.value; \ } while (0) /* Get the more significant 32 bits of a long double mantissa. */ #define GET_LDOUBLE_MSW(v,d) \ do { \ ieee_extended_shape_type sh_u; \ sh_u.value = (d); \ (v) = sh_u.parts.msw; \ } while (0) /* Set the more significant 32 bits of a long double mantissa from an int. */ #define SET_LDOUBLE_MSW(d,v) \ do { \ ieee_extended_shape_type sh_u; \ sh_u.value = (d); \ sh_u.parts.msw = (v); \ (d) = sh_u.value; \ } while (0) /* Get int from the exponent of a long double. */ #define GET_LDOUBLE_EXP(se,d) \ do { \ ieee_extended_shape_type ge_u; \ ge_u.value = (d); \ (se) = ge_u.parts.exp; \ } while (0) /* Set exponent of a long double from an int. */ #define SET_LDOUBLE_EXP(d,se) \ do { \ ieee_extended_shape_type se_u; \ se_u.value = (d); \ se_u.parts.exp = (se); \ (d) = se_u.value; \ } while (0) /* * Common routine to process the arguments to nan(), nanf(), and nanl(). */ void __scan_nan(uint32_t *__words, int __num_words, const char *__s); /* * Functions internal to the math package, yet not static. */ double __exp__D(double, double); struct Double __log__D(double); long double __p1evll(long double, void *, int); long double __polevll(long double, void *, int); #endif /* _MATH_PRIVATE_OPENBSD_H_ */ wcc-0.0.2/src/wsh/openlibm/src/e_sqrt.c0000644000175000017500000003432313122010155016357 0ustar philphil /* @(#)e_sqrt.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_sqrt.c,v 1.11 2008/03/02 01:47:58 das Exp $"); /* __ieee754_sqrt(x) * Return correctly rounded sqrt. * ------------------------------------------ * | Use the hardware sqrt if you have one | * ------------------------------------------ * Method: * Bit by bit method using integer arithmetic. (Slow, but portable) * 1. Normalization * Scale x to y in [1,4) with even powers of 2: * find an integer k such that 1 <= (y=x*2^(2k)) < 4, then * sqrt(x) = 2^k * sqrt(y) * 2. Bit by bit computation * Let q = sqrt(y) truncated to i bit after binary point (q = 1), * i 0 * i+1 2 * s = 2*q , and y = 2 * ( y - q ). (1) * i i i i * * To compute q from q , one checks whether * i+1 i * * -(i+1) 2 * (q + 2 ) <= y. (2) * i * -(i+1) * If (2) is false, then q = q ; otherwise q = q + 2 . * i+1 i i+1 i * * With some algebric manipulation, it is not difficult to see * that (2) is equivalent to * -(i+1) * s + 2 <= y (3) * i i * * The advantage of (3) is that s and y can be computed by * i i * the following recurrence formula: * if (3) is false * * s = s , y = y ; (4) * i+1 i i+1 i * * otherwise, * -i -(i+1) * s = s + 2 , y = y - s - 2 (5) * i+1 i i+1 i i * * One may easily use induction to prove (4) and (5). * Note. Since the left hand side of (3) contain only i+2 bits, * it does not necessary to do a full (53-bit) comparison * in (3). * 3. Final rounding * After generating the 53 bits result, we compute one more bit. * Together with the remainder, we can decide whether the * result is exact, bigger than 1/2ulp, or less than 1/2ulp * (it will never equal to 1/2ulp). * The rounding mode can be detected by checking whether * huge + tiny is equal to huge, and whether huge - tiny is * equal to huge for some floating point number "huge" and "tiny". * * Special cases: * sqrt(+-0) = +-0 ... exact * sqrt(inf) = inf * sqrt(-ve) = NaN ... with invalid signal * sqrt(NaN) = NaN ... with invalid signal for signaling NaN * * Other methods : see the appended file at the end of the program below. *--------------- */ #include #include #include "math_private.h" static const double one = 1.0, tiny=1.0e-300; OLM_DLLEXPORT double __ieee754_sqrt(double x) { double z; int32_t sign = (int)0x80000000; int32_t ix0,s0,q,m,t,i; u_int32_t r,t1,s1,ix1,q1; EXTRACT_WORDS(ix0,ix1,x); /* take care of Inf and NaN */ if((ix0&0x7ff00000)==0x7ff00000) { return x*x+x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf sqrt(-inf)=sNaN */ } /* take care of zero */ if(ix0<=0) { if(((ix0&(~sign))|ix1)==0) return x;/* sqrt(+-0) = +-0 */ else if(ix0<0) return (x-x)/(x-x); /* sqrt(-ve) = sNaN */ } /* normalize x */ m = (ix0>>20); if(m==0) { /* subnormal x */ while(ix0==0) { m -= 21; ix0 |= (ix1>>11); ix1 <<= 21; } for(i=0;(ix0&0x00100000)==0;i++) ix0<<=1; m -= i-1; ix0 |= (ix1>>(32-i)); ix1 <<= i; } m -= 1023; /* unbias exponent */ ix0 = (ix0&0x000fffff)|0x00100000; if(m&1){ /* odd m, double x to make it even */ ix0 += ix0 + ((ix1&sign)>>31); ix1 += ix1; } m >>= 1; /* m = [m/2] */ /* generate sqrt(x) bit by bit */ ix0 += ix0 + ((ix1&sign)>>31); ix1 += ix1; q = q1 = s0 = s1 = 0; /* [q,q1] = sqrt(x) */ r = 0x00200000; /* r = moving bit from right to left */ while(r!=0) { t = s0+r; if(t<=ix0) { s0 = t+r; ix0 -= t; q += r; } ix0 += ix0 + ((ix1&sign)>>31); ix1 += ix1; r>>=1; } r = sign; while(r!=0) { t1 = s1+r; t = s0; if((t>31); ix1 += ix1; r>>=1; } /* use floating add to find out rounding direction */ if((ix0|ix1)!=0) { z = one-tiny; /* trigger inexact flag */ if (z>=one) { z = one+tiny; if (q1==(u_int32_t)0xffffffff) { q1=0; q += 1;} else if (z>one) { if (q1==(u_int32_t)0xfffffffe) q+=1; q1+=2; } else q1 += (q1&1); } } ix0 = (q>>1)+0x3fe00000; ix1 = q1>>1; if ((q&1)==1) ix1 |= sign; ix0 += (m <<20); INSERT_WORDS(z,ix0,ix1); return z; } #if (LDBL_MANT_DIG == 53) __weak_reference(sqrt, sqrtl); #endif /* Other methods (use floating-point arithmetic) ------------- (This is a copy of a drafted paper by Prof W. Kahan and K.C. Ng, written in May, 1986) Two algorithms are given here to implement sqrt(x) (IEEE double precision arithmetic) in software. Both supply sqrt(x) correctly rounded. The first algorithm (in Section A) uses newton iterations and involves four divisions. The second one uses reciproot iterations to avoid division, but requires more multiplications. Both algorithms need the ability to chop results of arithmetic operations instead of round them, and the INEXACT flag to indicate when an arithmetic operation is executed exactly with no roundoff error, all part of the standard (IEEE 754-1985). The ability to perform shift, add, subtract and logical AND operations upon 32-bit words is needed too, though not part of the standard. A. sqrt(x) by Newton Iteration (1) Initial approximation Let x0 and x1 be the leading and the trailing 32-bit words of a floating point number x (in IEEE double format) respectively 1 11 52 ...widths ------------------------------------------------------ x: |s| e | f | ------------------------------------------------------ msb lsb msb lsb ...order ------------------------ ------------------------ x0: |s| e | f1 | x1: | f2 | ------------------------ ------------------------ By performing shifts and subtracts on x0 and x1 (both regarded as integers), we obtain an 8-bit approximation of sqrt(x) as follows. k := (x0>>1) + 0x1ff80000; y0 := k - T1[31&(k>>15)]. ... y ~ sqrt(x) to 8 bits Here k is a 32-bit integer and T1[] is an integer array containing correction terms. Now magically the floating value of y (y's leading 32-bit word is y0, the value of its trailing word is 0) approximates sqrt(x) to almost 8-bit. Value of T1: static int T1[32]= { 0, 1024, 3062, 5746, 9193, 13348, 18162, 23592, 29598, 36145, 43202, 50740, 58733, 67158, 75992, 85215, 83599, 71378, 60428, 50647, 41945, 34246, 27478, 21581, 16499, 12183, 8588, 5674, 3403, 1742, 661, 130,}; (2) Iterative refinement Apply Heron's rule three times to y, we have y approximates sqrt(x) to within 1 ulp (Unit in the Last Place): y := (y+x/y)/2 ... almost 17 sig. bits y := (y+x/y)/2 ... almost 35 sig. bits y := y-(y-x/y)/2 ... within 1 ulp Remark 1. Another way to improve y to within 1 ulp is: y := (y+x/y) ... almost 17 sig. bits to 2*sqrt(x) y := y - 0x00100006 ... almost 18 sig. bits to sqrt(x) 2 (x-y )*y y := y + 2* ---------- ...within 1 ulp 2 3y + x This formula has one division fewer than the one above; however, it requires more multiplications and additions. Also x must be scaled in advance to avoid spurious overflow in evaluating the expression 3y*y+x. Hence it is not recommended uless division is slow. If division is very slow, then one should use the reciproot algorithm given in section B. (3) Final adjustment By twiddling y's last bit it is possible to force y to be correctly rounded according to the prevailing rounding mode as follows. Let r and i be copies of the rounding mode and inexact flag before entering the square root program. Also we use the expression y+-ulp for the next representable floating numbers (up and down) of y. Note that y+-ulp = either fixed point y+-1, or multiply y by nextafter(1,+-inf) in chopped mode. I := FALSE; ... reset INEXACT flag I R := RZ; ... set rounding mode to round-toward-zero z := x/y; ... chopped quotient, possibly inexact If(not I) then { ... if the quotient is exact if(z=y) { I := i; ... restore inexact flag R := r; ... restore rounded mode return sqrt(x):=y. } else { z := z - ulp; ... special rounding } } i := TRUE; ... sqrt(x) is inexact If (r=RN) then z=z+ulp ... rounded-to-nearest If (r=RP) then { ... round-toward-+inf y = y+ulp; z=z+ulp; } y := y+z; ... chopped sum y0:=y0-0x00100000; ... y := y/2 is correctly rounded. I := i; ... restore inexact flag R := r; ... restore rounded mode return sqrt(x):=y. (4) Special cases Square root of +inf, +-0, or NaN is itself; Square root of a negative number is NaN with invalid signal. B. sqrt(x) by Reciproot Iteration (1) Initial approximation Let x0 and x1 be the leading and the trailing 32-bit words of a floating point number x (in IEEE double format) respectively (see section A). By performing shifs and subtracts on x0 and y0, we obtain a 7.8-bit approximation of 1/sqrt(x) as follows. k := 0x5fe80000 - (x0>>1); y0:= k - T2[63&(k>>14)]. ... y ~ 1/sqrt(x) to 7.8 bits Here k is a 32-bit integer and T2[] is an integer array containing correction terms. Now magically the floating value of y (y's leading 32-bit word is y0, the value of its trailing word y1 is set to zero) approximates 1/sqrt(x) to almost 7.8-bit. Value of T2: static int T2[64]= { 0x1500, 0x2ef8, 0x4d67, 0x6b02, 0x87be, 0xa395, 0xbe7a, 0xd866, 0xf14a, 0x1091b,0x11fcd,0x13552,0x14999,0x15c98,0x16e34,0x17e5f, 0x18d03,0x19a01,0x1a545,0x1ae8a,0x1b5c4,0x1bb01,0x1bfde,0x1c28d, 0x1c2de,0x1c0db,0x1ba73,0x1b11c,0x1a4b5,0x1953d,0x18266,0x16be0, 0x1683e,0x179d8,0x18a4d,0x19992,0x1a789,0x1b445,0x1bf61,0x1c989, 0x1d16d,0x1d77b,0x1dddf,0x1e2ad,0x1e5bf,0x1e6e8,0x1e654,0x1e3cd, 0x1df2a,0x1d635,0x1cb16,0x1be2c,0x1ae4e,0x19bde,0x1868e,0x16e2e, 0x1527f,0x1334a,0x11051,0xe951, 0xbe01, 0x8e0d, 0x5924, 0x1edd,}; (2) Iterative refinement Apply Reciproot iteration three times to y and multiply the result by x to get an approximation z that matches sqrt(x) to about 1 ulp. To be exact, we will have -1ulp < sqrt(x)-z<1.0625ulp. ... set rounding mode to Round-to-nearest y := y*(1.5-0.5*x*y*y) ... almost 15 sig. bits to 1/sqrt(x) y := y*((1.5-2^-30)+0.5*x*y*y)... about 29 sig. bits to 1/sqrt(x) ... special arrangement for better accuracy z := x*y ... 29 bits to sqrt(x), with z*y<1 z := z + 0.5*z*(1-z*y) ... about 1 ulp to sqrt(x) Remark 2. The constant 1.5-2^-30 is chosen to bias the error so that (a) the term z*y in the final iteration is always less than 1; (b) the error in the final result is biased upward so that -1 ulp < sqrt(x) - z < 1.0625 ulp instead of |sqrt(x)-z|<1.03125ulp. (3) Final adjustment By twiddling y's last bit it is possible to force y to be correctly rounded according to the prevailing rounding mode as follows. Let r and i be copies of the rounding mode and inexact flag before entering the square root program. Also we use the expression y+-ulp for the next representable floating numbers (up and down) of y. Note that y+-ulp = either fixed point y+-1, or multiply y by nextafter(1,+-inf) in chopped mode. R := RZ; ... set rounding mode to round-toward-zero switch(r) { case RN: ... round-to-nearest if(x<= z*(z-ulp)...chopped) z = z - ulp; else if(x<= z*(z+ulp)...chopped) z = z; else z = z+ulp; break; case RZ:case RM: ... round-to-zero or round-to--inf R:=RP; ... reset rounding mod to round-to-+inf if(x=(z+ulp)*(z+ulp) ...rounded up) z = z+ulp; break; case RP: ... round-to-+inf if(x>(z+ulp)*(z+ulp)...chopped) z = z+2*ulp; else if(x>z*z ...chopped) z = z+ulp; break; } Remark 3. The above comparisons can be done in fixed point. For example, to compare x and w=z*z chopped, it suffices to compare x1 and w1 (the trailing parts of x and w), regarding them as two's complement integers. ...Is z an exact square root? To determine whether z is an exact square root of x, let z1 be the trailing part of z, and also let x0 and x1 be the leading and trailing parts of x. If ((z1&0x03ffffff)!=0) ... not exact if trailing 26 bits of z!=0 I := 1; ... Raise Inexact flag: z is not exact else { j := 1 - [(x0>>20)&1] ... j = logb(x) mod 2 k := z1 >> 26; ... get z's 25-th and 26-th fraction bits I := i or (k&j) or ((k&(j+j+1))!=(x1&3)); } R:= r ... restore rounded mode return sqrt(x):=z. If multiplication is cheaper then the foregoing red tape, the Inexact flag can be evaluated by I := i; I := (z*z!=x) or I. Note that z*z can overwrite I; this value must be sensed if it is True. Remark 4. If z*z = x exactly, then bit 25 to bit 0 of z1 must be zero. -------------------- z1: | f2 | -------------------- bit 31 bit 0 Further more, bit 27 and 26 of z1, bit 0 and 1 of x1, and the odd or even of logb(x) have the following relations: ------------------------------------------------- bit 27,26 of z1 bit 1,0 of x1 logb(x) ------------------------------------------------- 00 00 odd and even 01 01 even 10 10 odd 10 00 even 11 01 even ------------------------------------------------- (4) Special cases (see (4) of Section A). */ wcc-0.0.2/src/wsh/openlibm/src/s_frexp.c0000644000175000017500000000263013122010155016524 0ustar philphil/* @(#)s_frexp.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_frexp.c,v 1.11 2008/02/22 02:30:35 das Exp $"); /* * for non-zero x * x = frexp(arg,&exp); * return a double fp quantity x such that 0.5 <= |x| <1.0 * and the corresponding binary exponent "exp". That is * arg = x*2^exp. * If arg is inf, 0.0, or NaN, then frexp(arg,&exp) returns arg * with *exp=0. */ #include #include #include "math_private.h" static const double two54 = 1.80143985094819840000e+16; /* 0x43500000, 0x00000000 */ OLM_DLLEXPORT double frexp(double x, int *eptr) { int32_t hx, ix, lx; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; *eptr = 0; if(ix>=0x7ff00000||((ix|lx)==0)) return x; /* 0,inf,nan */ if (ix<0x00100000) { /* subnormal */ x *= two54; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; *eptr = -54; } *eptr += (ix>>20)-1022; hx = (hx&0x800fffff)|0x3fe00000; SET_HIGH_WORD(x,hx); return x; } #if (LDBL_MANT_DIG == 53) __weak_reference(frexp, frexpl); #endif wcc-0.0.2/src/wsh/openlibm/src/e_acosh.c0000644000175000017500000000321513122010155016457 0ustar philphil /* @(#)e_acosh.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_acosh.c,v 1.9 2008/02/22 02:30:34 das Exp $"); /* __ieee754_acosh(x) * Method : * Based on * acosh(x) = log [ x + sqrt(x*x-1) ] * we have * acosh(x) := log(x)+ln2, if x is large; else * acosh(x) := log(2x-1/(sqrt(x*x-1)+x)) if x>2; else * acosh(x) := log1p(t+sqrt(2.0*t+t*t)); where t=x-1. * * Special cases: * acosh(x) is NaN with signal if x<1. * acosh(NaN) is NaN without signal. */ #include #include "math_private.h" static const double one = 1.0, ln2 = 6.93147180559945286227e-01; /* 0x3FE62E42, 0xFEFA39EF */ OLM_DLLEXPORT double __ieee754_acosh(double x) { double t; int32_t hx; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); if(hx<0x3ff00000) { /* x < 1 */ return (x-x)/(x-x); } else if(hx >=0x41b00000) { /* x > 2**28 */ if(hx >=0x7ff00000) { /* x is inf of NaN */ return x+x; } else return __ieee754_log(x)+ln2; /* acosh(huge)=log(2x) */ } else if(((hx-0x3ff00000)|lx)==0) { return 0.0; /* acosh(1) = 0 */ } else if (hx > 0x40000000) { /* 2**28 > x > 2 */ t=x*x; return __ieee754_log(2.0*x-one/(x+sqrt(t-one))); } else { /* 1 * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* csinhl * * Complex hyperbolic sine * * * * SYNOPSIS: * * long double complex csinhl(); * long double complex z, w; * * w = csinhl (z); * * DESCRIPTION: * * csinh z = (cexp(z) - cexp(-z))/2 * = sinh x * cos y + i cosh x * sin y . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 3.1e-16 8.2e-17 * */ #include #include long double complex csinhl(long double complex z) { long double complex w; long double x, y; x = creall(z); y = cimagl(z); w = sinhl(x) * cosl(y) + (coshl(x) * sinl(y)) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_asinh.c0000644000175000017500000000323013122010155016477 0ustar philphil/* @(#)s_asinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_asinh.c,v 1.9 2008/02/22 02:30:35 das Exp $"); /* asinh(x) * Method : * Based on * asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ] * we have * asinh(x) := x if 1+x*x=1, * := sign(x)*(log(x)+ln2)) for large |x|, else * := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else * := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2))) */ #include #include "math_private.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */ huge= 1.00000000000000000000e+300; OLM_DLLEXPORT double asinh(double x) { double t,w; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) return x+x; /* x is inf or NaN */ if(ix< 0x3e300000) { /* |x|<2**-28 */ if(huge+x>one) return x; /* return x inexact except 0 */ } if(ix>0x41b00000) { /* |x| > 2**28 */ w = __ieee754_log(fabs(x))+ln2; } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */ t = fabs(x); w = __ieee754_log(2.0*t+one/(__ieee754_sqrt(x*x+one)+t)); } else { /* 2.0 > |x| > 2**-28 */ t = x*x; w =log1p(fabs(x)+t/(one+__ieee754_sqrt(one+t))); } if(hx>0) return w; else return -w; } wcc-0.0.2/src/wsh/openlibm/src/s_roundf.c0000644000175000017500000000333613122010155016701 0ustar philphil/*- * Copyright (c) 2003, Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_roundf.c,v 1.4 2005/12/02 13:45:06 bde Exp $"); #include #include "math_private.h" OLM_DLLEXPORT float roundf(float x) { float t; if (!isfinite(x)) return (x); if (x >= 0.0) { t = floorf(x); if (t - x <= -0.5) t += 1.0; return (t); } else { t = floorf(-x); if (t + x <= -0.5) t += 1.0; return (-t); } } wcc-0.0.2/src/wsh/openlibm/src/s_cacoshl.c0000644000175000017500000000264413122010155017021 0ustar philphil/* $OpenBSD: s_cacoshl.c,v 1.1 2011/07/08 19:25:31 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cacoshl * * Complex inverse hyperbolic cosine * * * * SYNOPSIS: * * long double complex cacoshl(); * long double complex z, w; * * w = cacoshl (z); * * * * DESCRIPTION: * * acosh z = i acos z . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.6e-14 2.1e-15 * */ #include #include long double complex cacoshl(long double complex z) { long double complex w; w = I * cacosl(z); return (w); } wcc-0.0.2/src/wsh/openlibm/src/e_lgamma.c0000644000175000017500000000153113122010155016617 0ustar philphil /* @(#)e_lgamma.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_lgamma.c,v 1.9 2008/02/22 02:30:35 das Exp $"); /* __ieee754_lgamma(x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_lgamma_r */ #include #include "math_private.h" OLM_DLLEXPORT double __ieee754_lgamma(double x) { #ifdef OPENLIBM_ONLY_THREAD_SAFE int signgam; #endif return __ieee754_lgamma_r(x,&signgam); } wcc-0.0.2/src/wsh/openlibm/src/e_remainder.c0000644000175000017500000000356313122010155017336 0ustar philphil /* @(#)e_remainder.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_remainder.c,v 1.12 2008/03/30 20:47:42 das Exp $"); /* __ieee754_remainder(x,p) * Return : * returns x REM p = x - [x/p]*p as if in infinite * precise arithmetic, where [x/p] is the (infinite bit) * integer nearest x/p (in half way case choose the even one). * Method : * Based on fmod() return x-[x/p]chopped*p exactlp. */ #include #include #include "math_private.h" static const double zero = 0.0; OLM_DLLEXPORT double __ieee754_remainder(double x, double p) { int32_t hx,hp; u_int32_t sx,lx,lp; double p_half; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hp,lp,p); sx = hx&0x80000000; hp &= 0x7fffffff; hx &= 0x7fffffff; /* purge off exception values */ if((hp|lp)==0) return (x*p)/(x*p); /* p = 0 */ if((hx>=0x7ff00000)|| /* x not finite */ ((hp>=0x7ff00000)&& /* p is NaN */ (((hp-0x7ff00000)|lp)!=0))) return ((long double)x*p)/((long double)x*p); if (hp<=0x7fdfffff) x = __ieee754_fmod(x,p+p); /* now x < 2p */ if (((hx-hp)|(lx-lp))==0) return zero*x; x = fabs(x); p = fabs(p); if (hp<0x00200000) { if(x+x>p) { x-=p; if(x+x>=p) x -= p; } } else { p_half = 0.5*p; if(x>p_half) { x-=p; if(x>=p_half) x -= p; } } GET_HIGH_WORD(hx,x); if ((hx&0x7fffffff)==0) hx = 0; SET_HIGH_WORD(x,hx^sx); return x; } #if LDBL_MANT_DIG == 53 __weak_reference(remainder, remainderl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_logbf.c0000644000175000017500000000213313122010155016467 0ustar philphil/* s_logbf.c -- float version of s_logb.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_logbf.c,v 1.9 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" static const float two25 = 3.355443200e+07; /* 0x4c000000 */ OLM_DLLEXPORT float logbf(float x) { int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; /* high |x| */ if(ix==0) return (float)-1.0/fabsf(x); if(ix>=0x7f800000) return x*x; if(ix<0x00800000) { x *= two25; /* convert subnormal x to normal */ GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; return (float) ((ix>>23)-127-25); } else return (float) ((ix>>23)-127); } wcc-0.0.2/src/wsh/openlibm/src/s_round.c0000644000175000017500000000343713122010155016535 0ustar philphil/*- * Copyright (c) 2003, Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_round.c,v 1.4 2005/12/02 13:45:06 bde Exp $"); #include #include "math_private.h" OLM_DLLEXPORT double round(double x) { double t; uint32_t hx; GET_HIGH_WORD(hx, x); if ((hx & 0x7fffffff) == 0x7ff00000) return (x + x); if (!(hx & 0x80000000)) { t = floor(x); if (t - x <= -0.5) t += 1; return (t); } else { t = floor(-x); if (t + x <= -0.5) t += 1; return (-t); } } wcc-0.0.2/src/wsh/openlibm/src/s_modff.c0000644000175000017500000000275513122010155016503 0ustar philphil/* s_modff.c -- float version of s_modf.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_modff.c,v 1.9 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" static const float one = 1.0; OLM_DLLEXPORT float modff(float x, float *iptr) { int32_t i0,j0; u_int32_t i; GET_FLOAT_WORD(i0,x); j0 = ((i0>>23)&0xff)-0x7f; /* exponent of x */ if(j0<23) { /* integer part in x */ if(j0<0) { /* |x|<1 */ SET_FLOAT_WORD(*iptr,i0&0x80000000); /* *iptr = +-0 */ return x; } else { i = (0x007fffff)>>j0; if((i0&i)==0) { /* x is integral */ u_int32_t ix; *iptr = x; GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */ return x; } else { SET_FLOAT_WORD(*iptr,i0&(~i)); return x - *iptr; } } } else { /* no fraction part */ u_int32_t ix; *iptr = x*one; if (x != x) /* NaN */ return x; GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */ return x; } } wcc-0.0.2/src/wsh/openlibm/src/k_cos.c0000644000175000017500000000552613122010155016163 0ustar philphil /* @(#)k_cos.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_cos.c,v 1.12 2008/02/19 12:54:14 bde Exp $"); /* * __kernel_cos( x, y ) * kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164 * Input x is assumed to be bounded by ~pi/4 in magnitude. * Input y is the tail of x. * * Algorithm * 1. Since cos(-x) = cos(x), we need only to consider positive x. * 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0. * 3. cos(x) is approximated by a polynomial of degree 14 on * [0,pi/4] * 4 14 * cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x * where the remez error is * * | 2 4 6 8 10 12 14 | -58 * |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2 * | | * * 4 6 8 10 12 14 * 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then * cos(x) ~ 1 - x*x/2 + r * since cos(x+y) ~ cos(x) - sin(x)*y * ~ cos(x) - x*y, * a correction term is necessary in cos(x) and hence * cos(x+y) = 1 - (x*x/2 - (r - x*y)) * For better accuracy, rearrange to * cos(x+y) ~ w + (tmp + (r-x*y)) * where w = 1 - x*x/2 and tmp is a tiny correction term * (1 - x*x/2 == w + tmp exactly in infinite precision). * The exactness of w + tmp in infinite precision depends on w * and tmp having the same precision as x. If they have extra * precision due to compiler bugs, then the extra precision is * only good provided it is retained in all terms of the final * expression for cos(). Retention happens in all cases tested * under FreeBSD, so don't pessimize things by forcibly clipping * any extra precision in w. */ #include #include "math_private.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */ C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */ C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */ C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */ C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */ C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */ OLM_DLLEXPORT double __kernel_cos(double x, double y) { double hz,z,r,w; z = x*x; w = z*z; r = z*(C1+z*(C2+z*C3)) + w*w*(C4+z*(C5+z*C6)); hz = 0.5*z; w = one-hz; return w + (((one-w)-hz) + (z*r-x*y)); } wcc-0.0.2/src/wsh/openlibm/src/s_cbrt.c0000644000175000017500000001015013122010155016326 0ustar philphil/* @(#)s_cbrt.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * Optimized by Bruce D. Evans. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cbrt.c,v 1.17 2011/03/12 16:50:39 kargl Exp $"); #include #include "math_private.h" /* cbrt(x) * Return cube root of x */ static const u_int32_t B1 = 715094163, /* B1 = (1023-1023/3-0.03306235651)*2**20 */ B2 = 696219795; /* B2 = (1023-1023/3-54/3-0.03306235651)*2**20 */ /* |1/cbrt(x) - p(x)| < 2**-23.5 (~[-7.93e-8, 7.929e-8]). */ static const double P0 = 1.87595182427177009643, /* 0x3ffe03e6, 0x0f61e692 */ P1 = -1.88497979543377169875, /* 0xbffe28e0, 0x92f02420 */ P2 = 1.621429720105354466140, /* 0x3ff9f160, 0x4a49d6c2 */ P3 = -0.758397934778766047437, /* 0xbfe844cb, 0xbee751d9 */ P4 = 0.145996192886612446982; /* 0x3fc2b000, 0xd4e4edd7 */ OLM_DLLEXPORT double cbrt(double x) { int32_t hx; union { double value; u_int64_t bits; } u; double r,s,t=0.0,w; u_int32_t sign; u_int32_t high,low; EXTRACT_WORDS(hx,low,x); sign=hx&0x80000000; /* sign= sign(x) */ hx ^=sign; if(hx>=0x7ff00000) return(x+x); /* cbrt(NaN,INF) is itself */ /* * Rough cbrt to 5 bits: * cbrt(2**e*(1+m) ~= 2**(e/3)*(1+(e%3+m)/3) * where e is integral and >= 0, m is real and in [0, 1), and "/" and * "%" are integer division and modulus with rounding towards minus * infinity. The RHS is always >= the LHS and has a maximum relative * error of about 1 in 16. Adding a bias of -0.03306235651 to the * (e%3+m)/3 term reduces the error to about 1 in 32. With the IEEE * floating point representation, for finite positive normal values, * ordinary integer divison of the value in bits magically gives * almost exactly the RHS of the above provided we first subtract the * exponent bias (1023 for doubles) and later add it back. We do the * subtraction virtually to keep e >= 0 so that ordinary integer * division rounds towards minus infinity; this is also efficient. */ if(hx<0x00100000) { /* zero or subnormal? */ if((hx|low)==0) return(x); /* cbrt(0) is itself */ SET_HIGH_WORD(t,0x43500000); /* set t= 2**54 */ t*=x; GET_HIGH_WORD(high,t); INSERT_WORDS(t,sign|((high&0x7fffffff)/3+B2),0); } else INSERT_WORDS(t,sign|(hx/3+B1),0); /* * New cbrt to 23 bits: * cbrt(x) = t*cbrt(x/t**3) ~= t*P(t**3/x) * where P(r) is a polynomial of degree 4 that approximates 1/cbrt(r) * to within 2**-23.5 when |r - 1| < 1/10. The rough approximation * has produced t such than |t/cbrt(x) - 1| ~< 1/32, and cubing this * gives us bounds for r = t**3/x. * * Try to optimize for parallel evaluation as in k_tanf.c. */ r=(t*t)*(t/x); t=t*((P0+r*(P1+r*P2))+((r*r)*r)*(P3+r*P4)); /* * Round t away from zero to 23 bits (sloppily except for ensuring that * the result is larger in magnitude than cbrt(x) but not much more than * 2 23-bit ulps larger). With rounding towards zero, the error bound * would be ~5/6 instead of ~4/6. With a maximum error of 2 23-bit ulps * in the rounded t, the infinite-precision error in the Newton * approximation barely affects third digit in the final error * 0.667; the error in the rounded t can be up to about 3 23-bit ulps * before the final error is larger than 0.667 ulps. */ u.value=t; u.bits=(u.bits+0x80000000)&0xffffffffc0000000ULL; t=u.value; /* one step Newton iteration to 53 bits with error < 0.667 ulps */ s=t*t; /* t*t is exact */ r=x/s; /* error <= 0.5 ulps; |r| < |t| */ w=t+t; /* t+t is exact */ r=(r-t)/(w+r); /* r-t is exact; w+r ~= 3*t */ t=t+t*r; /* error <= 0.5 + 0.5/3 + epsilon */ return(t); } #if (LDBL_MANT_DIG == 53) __weak_reference(cbrt, cbrtl); #endif wcc-0.0.2/src/wsh/openlibm/src/e_pow.c0000644000175000017500000002400113122010155016163 0ustar philphil/* @(#)e_pow.c 1.5 04/04/22 SMI */ /* * ==================================================== * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved. * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_pow.c,v 1.14 2011/10/21 06:26:07 das Exp $"); /* __ieee754_pow(x,y) return x**y * * n * Method: Let x = 2 * (1+f) * 1. Compute and return log2(x) in two pieces: * log2(x) = w1 + w2, * where w1 has 53-24 = 29 bit trailing zeros. * 2. Perform y*log2(x) = n+y' by simulating muti-precision * arithmetic, where |y'|<=0.5. * 3. Return x**y = 2**n*exp(y'*log2) * * Special cases: * 1. (anything) ** 0 is 1 * 2. (anything) ** 1 is itself * 3. (anything) ** NAN is NAN * 4. NAN ** (anything except 0) is NAN * 5. +-(|x| > 1) ** +INF is +INF * 6. +-(|x| > 1) ** -INF is +0 * 7. +-(|x| < 1) ** +INF is +0 * 8. +-(|x| < 1) ** -INF is +INF * 9. +-1 ** +-INF is NAN * 10. +0 ** (+anything except 0, NAN) is +0 * 11. -0 ** (+anything except 0, NAN, odd integer) is +0 * 12. +0 ** (-anything except 0, NAN) is +INF * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF * 14. -0 ** (odd integer) = -( +0 ** (odd integer) ) * 15. +INF ** (+anything except 0,NAN) is +INF * 16. +INF ** (-anything except 0,NAN) is +0 * 17. -INF ** (anything) = -0 ** (-anything) * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer) * 19. (-anything except 0 and inf) ** (non-integer) is NAN * * Accuracy: * pow(x,y) returns x**y nearly rounded. In particular * pow(integer,integer) * always returns the correct integer provided it is * representable. * * Constants : * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include #include "math_private.h" static const double bp[] = {1.0, 1.5,}, dp_h[] = { 0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */ dp_l[] = { 0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */ zero = 0.0, one = 1.0, two = 2.0, two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */ huge = 1.0e300, tiny = 1.0e-300, /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */ L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */ L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */ L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */ L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */ L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */ L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */ P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */ P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */ P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */ P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */ P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */ lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */ lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */ lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */ ovt = 8.0085662595372944372e-0017, /* -(1024-log2(ovfl+.5ulp)) */ cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */ cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */ cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/ ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */ ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2*/ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ OLM_DLLEXPORT double __ieee754_pow(double x, double y) { double z,ax,z_h,z_l,p_h,p_l; double y1,t1,t2,r,s,t,u,v,w; int32_t i,j,k,yisint,n; int32_t hx,hy,ix,iy; u_int32_t lx,ly; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hy,ly,y); ix = hx&0x7fffffff; iy = hy&0x7fffffff; /* y==zero: x**0 = 1 */ if((iy|ly)==0) return one; /* x==1: 1**y = 1, even if y is NaN */ if (hx==0x3ff00000 && lx == 0) return one; /* y!=zero: result is NaN if either arg is NaN */ if(ix > 0x7ff00000 || ((ix==0x7ff00000)&&(lx!=0)) || iy > 0x7ff00000 || ((iy==0x7ff00000)&&(ly!=0))) return (x+0.0)+(y+0.0); /* determine if y is an odd int when x < 0 * yisint = 0 ... y is not an integer * yisint = 1 ... y is an odd int * yisint = 2 ... y is an even int */ yisint = 0; if(hx<0) { if(iy>=0x43400000) yisint = 2; /* even integer y */ else if(iy>=0x3ff00000) { k = (iy>>20)-0x3ff; /* exponent */ if(k>20) { j = ly>>(52-k); if((j<<(52-k))==ly) yisint = 2-(j&1); } else if(ly==0) { j = iy>>(20-k); if((j<<(20-k))==iy) yisint = 2-(j&1); } } } /* special value of y */ if(ly==0) { if (iy==0x7ff00000) { /* y is +-inf */ if(((ix-0x3ff00000)|lx)==0) return one; /* (-1)**+-inf is NaN */ else if (ix >= 0x3ff00000)/* (|x|>1)**+-inf = inf,0 */ return (hy>=0)? y: zero; else /* (|x|<1)**-,+inf = inf,0 */ return (hy<0)?-y: zero; } if(iy==0x3ff00000) { /* y is +-1 */ if(hy<0) return one/x; else return x; } if(hy==0x40000000) return x*x; /* y is 2 */ if(hy==0x40080000) return x*x*x; /* y is 3 */ if(hy==0x40100000) { /* y is 4 */ u = x*x; return u*u; } if(hy==0x3fe00000) { /* y is 0.5 */ if(hx>=0) /* x >= +0 */ return sqrt(x); } } ax = fabs(x); /* special value of x */ if(lx==0) { if(ix==0x7ff00000||ix==0||ix==0x3ff00000){ z = ax; /*x is +-0,+-inf,+-1*/ if(hy<0) z = one/z; /* z = (1/|x|) */ if(hx<0) { if(((ix-0x3ff00000)|yisint)==0) { z = (z-z)/(z-z); /* (-1)**non-int is NaN */ } else if(yisint==1) z = -z; /* (x<0)**odd = -(|x|**odd) */ } return z; } } /* CYGNUS LOCAL + fdlibm-5.3 fix: This used to be n = (hx>>31)+1; but ANSI C says a right shift of a signed negative quantity is implementation defined. */ n = ((u_int32_t)hx>>31)-1; /* (x<0)**(non-int) is NaN */ if((n|yisint)==0) return (x-x)/(x-x); s = one; /* s (sign of result -ve**odd) = -1 else = 1 */ if((n|(yisint-1))==0) s = -one;/* (-ve)**(odd int) */ /* |y| is huge */ if(iy>0x41e00000) { /* if |y| > 2**31 */ if(iy>0x43f00000){ /* if |y| > 2**64, must o/uflow */ if(ix<=0x3fefffff) return (hy<0)? huge*huge:tiny*tiny; if(ix>=0x3ff00000) return (hy>0)? huge*huge:tiny*tiny; } /* over/underflow if x is not close to one */ if(ix<0x3fefffff) return (hy<0)? s*huge*huge:s*tiny*tiny; if(ix>0x3ff00000) return (hy>0)? s*huge*huge:s*tiny*tiny; /* now |1-x| is tiny <= 2**-20, suffice to compute log(x) by x-x^2/2+x^3/3-x^4/4 */ t = ax-one; /* t has 20 trailing zeros */ w = (t*t)*(0.5-t*(0.3333333333333333333333-t*0.25)); u = ivln2_h*t; /* ivln2_h has 21 sig. bits */ v = t*ivln2_l-w*ivln2; t1 = u+v; SET_LOW_WORD(t1,0); t2 = v-(t1-u); } else { double ss,s2,s_h,s_l,t_h,t_l; n = 0; /* take care subnormal number */ if(ix<0x00100000) {ax *= two53; n -= 53; GET_HIGH_WORD(ix,ax); } n += ((ix)>>20)-0x3ff; j = ix&0x000fffff; /* determine interval */ ix = j|0x3ff00000; /* normalize ix */ if(j<=0x3988E) k=0; /* |x|>1)|0x20000000)+0x00080000+(k<<18)); t_l = ax - (t_h-bp[k]); s_l = v*((u-s_h*t_h)-s_h*t_l); /* compute log(ax) */ s2 = ss*ss; r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6))))); r += s_l*(s_h+ss); s2 = s_h*s_h; t_h = 3.0+s2+r; SET_LOW_WORD(t_h,0); t_l = r-((t_h-3.0)-s2); /* u+v = ss*(1+...) */ u = s_h*t_h; v = s_l*t_h+t_l*ss; /* 2/(3log2)*(ss+...) */ p_h = u+v; SET_LOW_WORD(p_h,0); p_l = v-(p_h-u); z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ z_l = cp_l*p_h+p_l*cp+dp_l[k]; /* log2(ax) = (ss+..)*2/(3*log2) = n + dp_h + z_h + z_l */ t = (double)n; t1 = (((z_h+z_l)+dp_h[k])+t); SET_LOW_WORD(t1,0); t2 = z_l-(((t1-t)-dp_h[k])-z_h); } /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */ y1 = y; SET_LOW_WORD(y1,0); p_l = (y-y1)*t1+y*t2; p_h = y1*t1; z = p_l+p_h; EXTRACT_WORDS(j,i,z); if (j>=0x40900000) { /* z >= 1024 */ if(((j-0x40900000)|i)!=0) /* if z > 1024 */ return s*huge*huge; /* overflow */ else { if(p_l+ovt>z-p_h) return s*huge*huge; /* overflow */ } } else if((j&0x7fffffff)>=0x4090cc00 ) { /* z <= -1075 */ if(((j-0xc090cc00)|i)!=0) /* z < -1075 */ return s*tiny*tiny; /* underflow */ else { if(p_l<=z-p_h) return s*tiny*tiny; /* underflow */ } } /* * compute 2**(p_h+p_l) */ i = j&0x7fffffff; k = (i>>20)-0x3ff; n = 0; if(i>0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */ n = j+(0x00100000>>(k+1)); k = ((n&0x7fffffff)>>20)-0x3ff; /* new k for n */ t = zero; SET_HIGH_WORD(t,n&~(0x000fffff>>k)); n = ((n&0x000fffff)|0x00100000)>>(20-k); if(j<0) n = -n; p_h -= t; } t = p_l+p_h; SET_LOW_WORD(t,0); u = t*lg2_h; v = (p_l-(t-p_h))*lg2+t*lg2_l; z = u+v; w = v-(z-u); t = z*z; t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); r = (z*t1)/(t1-two)-(w+z*w); z = one-(r-z); GET_HIGH_WORD(j,z); j += (n<<20); if((j>>20)<=0) z = scalbn(z,n); /* subnormal output */ else SET_HIGH_WORD(z,j); return s*z; } wcc-0.0.2/src/wsh/openlibm/src/s_fminl.c0000644000175000017500000000406113122010155016505 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fminl.c,v 1.1 2004/06/30 07:04:01 das Exp $"); #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT long double fminl(long double x, long double y) { union IEEEl2bits u[2]; u[0].e = x; mask_nbit_l(u[0]); u[1].e = y; mask_nbit_l(u[1]); /* Check for NaNs to avoid raising spurious exceptions. */ if (u[0].bits.exp == 32767 && (u[0].bits.manh | u[0].bits.manl) != 0) return (y); if (u[1].bits.exp == 32767 && (u[1].bits.manh | u[1].bits.manl) != 0) return (x); /* Handle comparisons of signed zeroes. */ if (u[0].bits.sign != u[1].bits.sign) return (u[1].bits.sign ? y : x); return (x < y ? x : y); } wcc-0.0.2/src/wsh/openlibm/src/s_lround.c0000644000175000017500000000500013122010155016675 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" #include #include #include #include "math_private.h" #ifndef type //__FBSDID("$FreeBSD: src/lib/msun/src/s_lround.c,v 1.2 2005/04/08 00:52:16 das Exp $"); #define type double #define roundit round #define dtype long #define DTYPE_MIN LONG_MIN #define DTYPE_MAX LONG_MAX #define fn lround #endif /* * If type has more precision than dtype, the endpoints dtype_(min|max) are * of the form xxx.5; they are "out of range" because lround() rounds away * from 0. On the other hand, if type has less precision than dtype, then * all values that are out of range are integral, so we might as well assume * that everything is in range. At compile time, INRANGE(x) should reduce to * two floating-point comparisons in the former case, or TRUE otherwise. */ static const type dtype_min = DTYPE_MIN - 0.5; static const type dtype_max = DTYPE_MAX + 0.5; #define INRANGE(x) (dtype_max - DTYPE_MAX != 0.5 || \ ((x) > dtype_min && (x) < dtype_max)) OLM_DLLEXPORT dtype fn(type x) { if (INRANGE(x)) { x = roundit(x); return ((dtype)x); } else { feraiseexcept(FE_INVALID); return (DTYPE_MAX); } } wcc-0.0.2/src/wsh/openlibm/src/s_nextafterf.c0000644000175000017500000000332413122010155017547 0ustar philphil/* s_nextafterf.c -- float version of s_nextafter.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_nextafterf.c,v 1.11 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" OLM_DLLEXPORT float nextafterf(float x, float y) { volatile float t; int32_t hx,hy,ix,iy; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hy,y); ix = hx&0x7fffffff; /* |x| */ iy = hy&0x7fffffff; /* |y| */ if((ix>0x7f800000) || /* x is nan */ (iy>0x7f800000)) /* y is nan */ return x+y; if(x==y) return y; /* x=y, return y */ if(ix==0) { /* x == 0 */ SET_FLOAT_WORD(x,(hy&0x80000000)|1);/* return +-minsubnormal */ t = x*x; if(t==x) return t; else return x; /* raise underflow flag */ } if(hx>=0) { /* x > 0 */ if(hx>hy) { /* x > y, x -= ulp */ hx -= 1; } else { /* x < y, x += ulp */ hx += 1; } } else { /* x < 0 */ if(hy>=0||hx>hy){ /* x < y, x -= ulp */ hx -= 1; } else { /* x > y, x += ulp */ hx += 1; } } hy = hx&0x7f800000; if(hy>=0x7f800000) return x+x; /* overflow */ if(hy<0x00800000) { /* underflow */ t = x*x; if(t!=x) { /* raise underflow flag */ SET_FLOAT_WORD(y,hx); return y; } } SET_FLOAT_WORD(x,hx); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_fabs.c0000644000175000017500000000121613122010155016312 0ustar philphil/* @(#)s_fabs.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * fabs(x) returns the absolute value of x. */ #include #include "math_private.h" OLM_DLLEXPORT double fabs(double x) { u_int32_t high; GET_HIGH_WORD(high,x); SET_HIGH_WORD(x,high&0x7fffffff); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_csqrt.c0000644000175000017500000000651313122010155016540 0ustar philphil/*- * Copyright (c) 2007 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_csqrt.c,v 1.4 2008/08/08 00:15:16 das Exp $"); #include #include #include #include "math_private.h" /* * gcc doesn't implement complex multiplication or division correctly, * so we need to handle infinities specially. We turn on this pragma to * notify conforming c99 compilers that the fast-but-incorrect code that * gcc generates is acceptable, since the special cases have already been * handled. */ #ifndef __GNUC__ #pragma STDC CX_LIMITED_RANGE ON #endif /* We risk spurious overflow for components >= DBL_MAX / (1 + sqrt(2)). */ #define THRESH 0x1.a827999fcef32p+1022 OLM_DLLEXPORT double complex csqrt(double complex z) { double complex result; double a, b; double t; int scale; a = creal(z); b = cimag(z); /* Handle special cases. */ if (z == 0) return (CMPLX(0, b)); if (isinf(b)) return (CMPLX(INFINITY, b)); if (isnan(a)) { t = (b - b) / (b - b); /* raise invalid if b is not a NaN */ return (CMPLX(a, t)); /* return NaN + NaN i */ } if (isinf(a)) { /* * csqrt(inf + NaN i) = inf + NaN i * csqrt(inf + y i) = inf + 0 i * csqrt(-inf + NaN i) = NaN +- inf i * csqrt(-inf + y i) = 0 + inf i */ if (signbit(a)) return (CMPLX(fabs(b - b), copysign(a, b))); else return (CMPLX(a, copysign(b - b, b))); } /* * The remaining special case (b is NaN) is handled just fine by * the normal code path below. */ /* Scale to avoid overflow. */ if (fabs(a) >= THRESH || fabs(b) >= THRESH) { a *= 0.25; b *= 0.25; scale = 1; } else { scale = 0; } /* Algorithm 312, CACM vol 10, Oct 1967. */ if (a >= 0) { t = sqrt((a + hypot(a, b)) * 0.5); result = CMPLX(t, b / (2 * t)); } else { t = sqrt((-a + hypot(a, b)) * 0.5); result = CMPLX(fabs(b) / (2 * t), copysign(t, b)); } /* Rescale. */ if (scale) return (result * 2); else return (result); } #if LDBL_MANT_DIG == 53 __weak_reference(csqrt, csqrtl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_cacosh.c0000644000175000017500000000300413122010155016634 0ustar philphil/* $OpenBSD: s_cacosh.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cacosh * * Complex inverse hyperbolic cosine * * * * SYNOPSIS: * * double complex cacosh(); * double complex z, w; * * w = cacosh (z); * * * * DESCRIPTION: * * acosh z = i acos z . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.6e-14 2.1e-15 * */ #include #include #include double complex cacosh(double complex z) { double complex w; w = I * cacos (z); return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(cacoshl, cacosh); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/e_powf.c0000644000175000017500000001716313122010155016344 0ustar philphil/* e_powf.c -- float version of e_pow.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_powf.c,v 1.16 2011/10/21 06:26:07 das Exp $"); #include #include "math_private.h" static const float bp[] = {1.0, 1.5,}, dp_h[] = { 0.0, 5.84960938e-01,}, /* 0x3f15c000 */ dp_l[] = { 0.0, 1.56322085e-06,}, /* 0x35d1cfdc */ zero = 0.0, one = 1.0, two = 2.0, two24 = 16777216.0, /* 0x4b800000 */ huge = 1.0e30, tiny = 1.0e-30, /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */ L1 = 6.0000002384e-01, /* 0x3f19999a */ L2 = 4.2857143283e-01, /* 0x3edb6db7 */ L3 = 3.3333334327e-01, /* 0x3eaaaaab */ L4 = 2.7272811532e-01, /* 0x3e8ba305 */ L5 = 2.3066075146e-01, /* 0x3e6c3255 */ L6 = 2.0697501302e-01, /* 0x3e53f142 */ P1 = 1.6666667163e-01, /* 0x3e2aaaab */ P2 = -2.7777778450e-03, /* 0xbb360b61 */ P3 = 6.6137559770e-05, /* 0x388ab355 */ P4 = -1.6533901999e-06, /* 0xb5ddea0e */ P5 = 4.1381369442e-08, /* 0x3331bb4c */ lg2 = 6.9314718246e-01, /* 0x3f317218 */ lg2_h = 6.93145752e-01, /* 0x3f317200 */ lg2_l = 1.42860654e-06, /* 0x35bfbe8c */ ovt = 4.2995665694e-08, /* -(128-log2(ovfl+.5ulp)) */ cp = 9.6179670095e-01, /* 0x3f76384f =2/(3ln2) */ cp_h = 9.6191406250e-01, /* 0x3f764000 =12b cp */ cp_l = -1.1736857402e-04, /* 0xb8f623c6 =tail of cp_h */ ivln2 = 1.4426950216e+00, /* 0x3fb8aa3b =1/ln2 */ ivln2_h = 1.4426879883e+00, /* 0x3fb8aa00 =16b 1/ln2*/ ivln2_l = 7.0526075433e-06; /* 0x36eca570 =1/ln2 tail*/ OLM_DLLEXPORT float __ieee754_powf(float x, float y) { float z,ax,z_h,z_l,p_h,p_l; float y1,t1,t2,r,s,sn,t,u,v,w; int32_t i,j,k,yisint,n; int32_t hx,hy,ix,iy,is; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hy,y); ix = hx&0x7fffffff; iy = hy&0x7fffffff; /* y==zero: x**0 = 1 */ if(iy==0) return one; /* x==1: 1**y = 1, even if y is NaN */ if (hx==0x3f800000) return one; /* y!=zero: result is NaN if either arg is NaN */ if(ix > 0x7f800000 || iy > 0x7f800000) return (x+0.0F)+(y+0.0F); /* determine if y is an odd int when x < 0 * yisint = 0 ... y is not an integer * yisint = 1 ... y is an odd int * yisint = 2 ... y is an even int */ yisint = 0; if(hx<0) { if(iy>=0x4b800000) yisint = 2; /* even integer y */ else if(iy>=0x3f800000) { k = (iy>>23)-0x7f; /* exponent */ j = iy>>(23-k); if((j<<(23-k))==iy) yisint = 2-(j&1); } } /* special value of y */ if (iy==0x7f800000) { /* y is +-inf */ if (ix==0x3f800000) return one; /* (-1)**+-inf is NaN */ else if (ix > 0x3f800000)/* (|x|>1)**+-inf = inf,0 */ return (hy>=0)? y: zero; else /* (|x|<1)**-,+inf = inf,0 */ return (hy<0)?-y: zero; } if(iy==0x3f800000) { /* y is +-1 */ if(hy<0) return one/x; else return x; } if(hy==0x40000000) return x*x; /* y is 2 */ if(hy==0x40400000) return x*x*x; /* y is 3 */ if(hy==0x40800000) { /* y is 4 */ u = x*x; return u*u; } if(hy==0x3f000000) { /* y is 0.5 */ if(hx>=0) /* x >= +0 */ return __ieee754_sqrtf(x); } ax = fabsf(x); /* special value of x */ if(ix==0x7f800000||ix==0||ix==0x3f800000){ z = ax; /*x is +-0,+-inf,+-1*/ if(hy<0) z = one/z; /* z = (1/|x|) */ if(hx<0) { if(((ix-0x3f800000)|yisint)==0) { z = (z-z)/(z-z); /* (-1)**non-int is NaN */ } else if(yisint==1) z = -z; /* (x<0)**odd = -(|x|**odd) */ } return z; } n = ((u_int32_t)hx>>31)-1; /* (x<0)**(non-int) is NaN */ if((n|yisint)==0) return (x-x)/(x-x); sn = one; /* s (sign of result -ve**odd) = -1 else = 1 */ if((n|(yisint-1))==0) sn = -one;/* (-ve)**(odd int) */ /* |y| is huge */ if(iy>0x4d000000) { /* if |y| > 2**27 */ /* over/underflow if x is not close to one */ if(ix<0x3f7ffff8) return (hy<0)? sn*huge*huge:sn*tiny*tiny; if(ix>0x3f800007) return (hy>0)? sn*huge*huge:sn*tiny*tiny; /* now |1-x| is tiny <= 2**-20, suffice to compute log(x) by x-x^2/2+x^3/3-x^4/4 */ t = ax-1; /* t has 20 trailing zeros */ w = (t*t)*((float)0.5-t*((float)0.333333333333-t*(float)0.25)); u = ivln2_h*t; /* ivln2_h has 16 sig. bits */ v = t*ivln2_l-w*ivln2; t1 = u+v; GET_FLOAT_WORD(is,t1); SET_FLOAT_WORD(t1,is&0xfffff000); t2 = v-(t1-u); } else { float s2,s_h,s_l,t_h,t_l; n = 0; /* take care subnormal number */ if(ix<0x00800000) {ax *= two24; n -= 24; GET_FLOAT_WORD(ix,ax); } n += ((ix)>>23)-0x7f; j = ix&0x007fffff; /* determine interval */ ix = j|0x3f800000; /* normalize ix */ if(j<=0x1cc471) k=0; /* |x|>1)&0xfffff000)|0x20000000; SET_FLOAT_WORD(t_h,is+0x00400000+(k<<21)); t_l = ax - (t_h-bp[k]); s_l = v*((u-s_h*t_h)-s_h*t_l); /* compute log(ax) */ s2 = s*s; r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6))))); r += s_l*(s_h+s); s2 = s_h*s_h; t_h = (float)3.0+s2+r; GET_FLOAT_WORD(is,t_h); SET_FLOAT_WORD(t_h,is&0xfffff000); t_l = r-((t_h-(float)3.0)-s2); /* u+v = s*(1+...) */ u = s_h*t_h; v = s_l*t_h+t_l*s; /* 2/(3log2)*(s+...) */ p_h = u+v; GET_FLOAT_WORD(is,p_h); SET_FLOAT_WORD(p_h,is&0xfffff000); p_l = v-(p_h-u); z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ z_l = cp_l*p_h+p_l*cp+dp_l[k]; /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */ t = (float)n; t1 = (((z_h+z_l)+dp_h[k])+t); GET_FLOAT_WORD(is,t1); SET_FLOAT_WORD(t1,is&0xfffff000); t2 = z_l-(((t1-t)-dp_h[k])-z_h); } /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */ GET_FLOAT_WORD(is,y); SET_FLOAT_WORD(y1,is&0xfffff000); p_l = (y-y1)*t1+y*t2; p_h = y1*t1; z = p_l+p_h; GET_FLOAT_WORD(j,z); if (j>0x43000000) /* if z > 128 */ return sn*huge*huge; /* overflow */ else if (j==0x43000000) { /* if z == 128 */ if(p_l+ovt>z-p_h) return sn*huge*huge; /* overflow */ } else if ((j&0x7fffffff)>0x43160000) /* z <= -150 */ return sn*tiny*tiny; /* underflow */ else if (j==0xc3160000){ /* z == -150 */ if(p_l<=z-p_h) return sn*tiny*tiny; /* underflow */ } /* * compute 2**(p_h+p_l) */ i = j&0x7fffffff; k = (i>>23)-0x7f; n = 0; if(i>0x3f000000) { /* if |z| > 0.5, set n = [z+0.5] */ n = j+(0x00800000>>(k+1)); k = ((n&0x7fffffff)>>23)-0x7f; /* new k for n */ SET_FLOAT_WORD(t,n&~(0x007fffff>>k)); n = ((n&0x007fffff)|0x00800000)>>(23-k); if(j<0) n = -n; p_h -= t; } t = p_l+p_h; GET_FLOAT_WORD(is,t); SET_FLOAT_WORD(t,is&0xffff8000); u = t*lg2_h; v = (p_l-(t-p_h))*lg2+t*lg2_l; z = u+v; w = v-(z-u); t = z*z; t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); r = (z*t1)/(t1-two)-(w+z*w); z = one-(r-z); GET_FLOAT_WORD(j,z); j += (n<<23); if((j>>23)<=0) z = scalbnf(z,n); /* subnormal output */ else SET_FLOAT_WORD(z,j); return sn*z; } wcc-0.0.2/src/wsh/openlibm/src/s_ccoshf.c0000644000175000017500000000633713122010155016655 0ustar philphil/*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Hyperbolic cosine of a complex argument. See s_ccosh.c for details. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ccoshf.c,v 1.2 2011/10/21 06:29:32 das Exp $"); #include #include #include "math_private.h" static const float huge = 0x1p127; OLM_DLLEXPORT float complex ccoshf(float complex z) { float x, y, h; int32_t hx, hy, ix, iy; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hx, x); GET_FLOAT_WORD(hy, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; if (ix < 0x7f800000 && iy < 0x7f800000) { if (iy == 0) return (CMPLXF(coshf(x), x * y)); if (ix < 0x41100000) /* small x: normal case */ return (CMPLXF(coshf(x) * cosf(y), sinhf(x) * sinf(y))); /* |x| >= 9, so cosh(x) ~= exp(|x|) */ if (ix < 0x42b17218) { /* x < 88.7: expf(|x|) won't overflow */ h = expf(fabsf(x)) * 0.5f; return (CMPLXF(h * cosf(y), copysignf(h, x) * sinf(y))); } else if (ix < 0x4340b1e7) { /* x < 192.7: scale to avoid overflow */ z = __ldexp_cexpf(CMPLXF(fabsf(x), y), -1); return (CMPLXF(crealf(z), cimagf(z) * copysignf(1, x))); } else { /* x >= 192.7: the result always overflows */ h = huge * x; return (CMPLXF(h * h * cosf(y), h * sinf(y))); } } if (ix == 0 && iy >= 0x7f800000) return (CMPLXF(y - y, copysignf(0, x * (y - y)))); if (iy == 0 && ix >= 0x7f800000) { if ((hx & 0x7fffff) == 0) return (CMPLXF(x * x, copysignf(0, x) * y)); return (CMPLXF(x * x, copysignf(0, (x + x) * y))); } if (ix < 0x7f800000 && iy >= 0x7f800000) return (CMPLXF(y - y, x * (y - y))); if (ix >= 0x7f800000 && (hx & 0x7fffff) == 0) { if (iy >= 0x7f800000) return (CMPLXF(x * x, x * (y - y))); return (CMPLXF((x * x) * cosf(y), x * sinf(y))); } return (CMPLXF((x * x) * (y - y), (x + x) * (y - y))); } OLM_DLLEXPORT float complex ccosf(float complex z) { return (ccoshf(CMPLXF(-cimagf(z), crealf(z)))); } wcc-0.0.2/src/wsh/openlibm/src/s_isnan.c0000644000175000017500000000401613122010155016510 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_isnan.c,v 1.9 2010/06/12 17:32:05 das Exp $ */ #include #include "fpmath.h" #include "math_private.h" /* Provided by libc */ #if 1 OLM_DLLEXPORT int (isnan) (double d) { union IEEEd2bits u; u.d = d; return (u.bits.exp == 2047 && (u.bits.manl != 0 || u.bits.manh != 0)); } #endif OLM_DLLEXPORT int __isnanf(float f) { union IEEEf2bits u; u.f = f; return (u.bits.exp == 255 && u.bits.man != 0); } #ifdef LONG_DOUBLE OLM_DLLEXPORT int __isnanl(long double e) { union IEEEl2bits u; u.e = e; mask_nbit_l(u); return (u.bits.exp == 32767 && (u.bits.manl != 0 || u.bits.manh != 0)); } #endif __weak_reference(__isnanf, isnanf); wcc-0.0.2/src/wsh/openlibm/src/common.c0000644000175000017500000000015413122010155016345 0ustar philphil#include #include "math_private.h" OLM_DLLEXPORT int isopenlibm(void) { return 1; } wcc-0.0.2/src/wsh/openlibm/src/types-compat.h0000644000175000017500000000041013122010155017502 0ustar philphil#ifndef _TYPES_COMPAT_H_ #define _TYPES_COMPAT_H_ #include #include typedef uint8_t u_int8_t; typedef uint16_t u_int16_t; typedef uint32_t u_int32_t; typedef uint64_t u_int64_t; #endif wcc-0.0.2/src/wsh/openlibm/src/s_asinhf.c0000644000175000017500000000264513122010155016656 0ustar philphil/* s_asinhf.c -- float version of s_asinh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_asinhf.c,v 1.9 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3F800000 */ ln2 = 6.9314718246e-01, /* 0x3f317218 */ huge= 1.0000000000e+30; OLM_DLLEXPORT float asinhf(float x) { float t,w; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) return x+x; /* x is inf or NaN */ if(ix< 0x31800000) { /* |x|<2**-28 */ if(huge+x>one) return x; /* return x inexact except 0 */ } if(ix>0x4d800000) { /* |x| > 2**28 */ w = __ieee754_logf(fabsf(x))+ln2; } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */ t = fabsf(x); w = __ieee754_logf((float)2.0*t+one/(__ieee754_sqrtf(x*x+one)+t)); } else { /* 2.0 > |x| > 2**-28 */ t = x*x; w =log1pf(fabsf(x)+t/(one+__ieee754_sqrtf(one+t))); } if(hx>0) return w; else return -w; } wcc-0.0.2/src/wsh/openlibm/src/s_nextafter.c0000644000175000017500000000420013122010155017373 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_nextafter.c,v 1.12 2008/02/22 02:30:35 das Exp $"); /* IEEE functions * nextafter(x,y) * return the next machine floating-point number of x in the * direction toward y. * Special cases: */ #include #include #include "math_private.h" OLM_DLLEXPORT double nextafter(double x, double y) { volatile double t; int32_t hx,hy,ix,iy; u_int32_t lx,ly; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hy,ly,y); ix = hx&0x7fffffff; /* |x| */ iy = hy&0x7fffffff; /* |y| */ if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */ return x+y; if(x==y) return y; /* x=y, return y */ if((ix|lx)==0) { /* x == 0 */ INSERT_WORDS(x,hy&0x80000000,1); /* return +-minsubnormal */ t = x*x; if(t==x) return t; else return x; /* raise underflow flag */ } if(hx>=0) { /* x > 0 */ if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x < y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } else { /* x < 0 */ if(hy>=0||hx>hy||((hx==hy)&&(lx>ly))){/* x < y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x > y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } hy = hx&0x7ff00000; if(hy>=0x7ff00000) return x+x; /* overflow */ if(hy<0x00100000) { /* underflow */ t = x*x; if(t!=x) { /* raise underflow flag */ INSERT_WORDS(y,hx,lx); return y; } } INSERT_WORDS(x,hx,lx); return x; } #if (LDBL_MANT_DIG == 53) __weak_reference(nextafter, nexttoward); __weak_reference(nextafter, nexttowardl); __weak_reference(nextafter, nextafterl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_sinf.c0000644000175000017500000000443613122010155016345 0ustar philphil/* s_sinf.c -- float version of s_sin.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_sinf.c,v 1.17 2008/02/25 22:19:17 bde Exp $"); #include #include //#define INLINE_KERNEL_COSDF //#define INLINE_KERNEL_SINDF //#define INLINE_REM_PIO2F #include "math_private.h" //#include "e_rem_pio2f.c" //#include "k_cosf.c" //#include "k_sinf.c" /* Small multiples of pi/2 rounded to double precision. */ static const double s1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */ s2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */ s3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */ s4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */ OLM_DLLEXPORT float sinf(float x) { double y; int32_t n, hx, ix; GET_FLOAT_WORD(hx,x); ix = hx & 0x7fffffff; if(ix <= 0x3f490fda) { /* |x| ~<= pi/4 */ if(ix<0x39800000) /* |x| < 2**-12 */ if(((int)x)==0) return x; /* x with inexact if x != 0 */ return __kernel_sindf(x); } if(ix<=0x407b53d1) { /* |x| ~<= 5*pi/4 */ if(ix<=0x4016cbe3) { /* |x| ~<= 3pi/4 */ if(hx>0) return __kernel_cosdf(x - s1pio2); else return -__kernel_cosdf(x + s1pio2); } else return __kernel_sindf((hx > 0 ? s2pio2 : -s2pio2) - x); } if(ix<=0x40e231d5) { /* |x| ~<= 9*pi/4 */ if(ix<=0x40afeddf) { /* |x| ~<= 7*pi/4 */ if(hx>0) return -__kernel_cosdf(x - s3pio2); else return __kernel_cosdf(x + s3pio2); } else return __kernel_sindf(x + (hx > 0 ? -s4pio2 : s4pio2)); } /* sin(Inf or NaN) is NaN */ else if (ix>=0x7f800000) return x-x; /* general argument reduction needed */ else { n = __ieee754_rem_pio2f(x,&y); switch(n&3) { case 0: return __kernel_sindf(y); case 1: return __kernel_cosdf(y); case 2: return __kernel_sindf(-y); default: return -__kernel_cosdf(y); } } } wcc-0.0.2/src/wsh/openlibm/src/s_cargf.c0000644000175000017500000000317613122010155016470 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cargf.c,v 1.1 2007/12/12 23:43:51 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT float cargf(float complex z) { return (atan2f(cimagf(z), crealf(z))); } wcc-0.0.2/src/wsh/openlibm/src/s_log1pf.c0000644000175000017500000000631013122010155016567 0ustar philphil/* s_log1pf.c -- float version of s_log1p.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_log1pf.c,v 1.12 2008/03/29 16:37:59 das Exp $"); #include #include #include "math_private.h" static const float ln2_hi = 6.9313812256e-01, /* 0x3f317180 */ ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */ two25 = 3.355443200e+07, /* 0x4c000000 */ Lp1 = 6.6666668653e-01, /* 3F2AAAAB */ Lp2 = 4.0000000596e-01, /* 3ECCCCCD */ Lp3 = 2.8571429849e-01, /* 3E924925 */ Lp4 = 2.2222198546e-01, /* 3E638E29 */ Lp5 = 1.8183572590e-01, /* 3E3A3325 */ Lp6 = 1.5313838422e-01, /* 3E1CD04F */ Lp7 = 1.4798198640e-01; /* 3E178897 */ static const float zero = 0.0; OLM_DLLEXPORT float log1pf(float x) { float hfsq,f,c,s,z,R,u; int32_t k,hx,hu,ax; GET_FLOAT_WORD(hx,x); ax = hx&0x7fffffff; k = 1; if (hx < 0x3ed413d0) { /* 1+x < sqrt(2)+ */ if(ax>=0x3f800000) { /* x <= -1.0 */ if(x==(float)-1.0) return -two25/zero; /* log1p(-1)=+inf */ else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ } if(ax<0x38000000) { /* |x| < 2**-15 */ if(two25+x>zero /* raise inexact */ &&ax<0x33800000) /* |x| < 2**-24 */ return x; else return x - x*x*(float)0.5; } if(hx>0||hx<=((int32_t)0xbe95f619)) { k=0;f=x;hu=1;} /* sqrt(2)/2- <= 1+x < sqrt(2)+ */ } if (hx >= 0x7f800000) return x+x; if(k!=0) { if(hx<0x5a000000) { STRICT_ASSIGN(float,u,(float)1.0+x); GET_FLOAT_WORD(hu,u); k = (hu>>23)-127; /* correction term */ c = (k>0)? (float)1.0-(u-x):x-(u-(float)1.0); c /= u; } else { u = x; GET_FLOAT_WORD(hu,u); k = (hu>>23)-127; c = 0; } hu &= 0x007fffff; /* * The approximation to sqrt(2) used in thresholds is not * critical. However, the ones used above must give less * strict bounds than the one here so that the k==0 case is * never reached from here, since here we have committed to * using the correction term but don't use it if k==0. */ if(hu<0x3504f4) { /* u < sqrt(2) */ SET_FLOAT_WORD(u,hu|0x3f800000);/* normalize u */ } else { k += 1; SET_FLOAT_WORD(u,hu|0x3f000000); /* normalize u/2 */ hu = (0x00800000-hu)>>2; } f = u-(float)1.0; } hfsq=(float)0.5*f*f; if(hu==0) { /* |f| < 2**-20 */ if(f==zero) { if(k==0) { return zero; } else { c += k*ln2_lo; return k*ln2_hi+c; } } R = hfsq*((float)1.0-(float)0.66666666666666666*f); if(k==0) return f-R; else return k*ln2_hi-((R-(k*ln2_lo+c))-f); } s = f/((float)2.0+f); z = s*s; R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); if(k==0) return f-(hfsq-s*(hfsq+R)); else return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); } wcc-0.0.2/src/wsh/openlibm/src/s_signbit.c0000644000175000017500000000350013122010155017034 0ustar philphil/*- * Copyright (c) 2003 Mike Barcroft * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_signbit.c,v 1.1 2004/07/19 08:16:10 das Exp $ */ #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT int __signbit(double d) { union IEEEd2bits u; u.d = d; return (u.bits.sign); } OLM_DLLEXPORT int __signbitf(float f) { union IEEEf2bits u; u.f = f; return (u.bits.sign); } #ifdef LONG_DOUBLE OLM_DLLEXPORT int __signbitl(long double e) { union IEEEl2bits u; u.e = e; return (u.bits.sign); } #endif wcc-0.0.2/src/wsh/openlibm/src/e_sqrtf.c0000644000175000017500000000360513122010155016524 0ustar philphil/* e_sqrtf.c -- float version of e_sqrt.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include "math_private.h" static const float one = 1.0, tiny=1.0e-30; OLM_DLLEXPORT float __ieee754_sqrtf(float x) { float z; int32_t sign = (int)0x80000000; int32_t ix,s,q,m,t,i; u_int32_t r; GET_FLOAT_WORD(ix,x); /* take care of Inf and NaN */ if((ix&0x7f800000)==0x7f800000) { return x*x+x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf sqrt(-inf)=sNaN */ } /* take care of zero */ if(ix<=0) { if((ix&(~sign))==0) return x;/* sqrt(+-0) = +-0 */ else if(ix<0) return (x-x)/(x-x); /* sqrt(-ve) = sNaN */ } /* normalize x */ m = (ix>>23); if(m==0) { /* subnormal x */ for(i=0;(ix&0x00800000)==0;i++) ix<<=1; m -= i-1; } m -= 127; /* unbias exponent */ ix = (ix&0x007fffff)|0x00800000; if(m&1) /* odd m, double x to make it even */ ix += ix; m >>= 1; /* m = [m/2] */ /* generate sqrt(x) bit by bit */ ix += ix; q = s = 0; /* q = sqrt(x) */ r = 0x01000000; /* r = moving bit from right to left */ while(r!=0) { t = s+r; if(t<=ix) { s = t+r; ix -= t; q += r; } ix += ix; r>>=1; } /* use floating add to find out rounding direction */ if(ix!=0) { z = one-tiny; /* trigger inexact flag */ if (z>=one) { z = one+tiny; if (z>one) q += 2; else q += (q&1); } } ix = (q>>1)+0x3f000000; ix += (m <<23); SET_FLOAT_WORD(z,ix); return z; } wcc-0.0.2/src/wsh/openlibm/src/s_nexttowardf.c0000644000175000017500000000305713122010155017751 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_nexttowardf.c,v 1.3 2011/02/10 07:38:38 das Exp $"); #include #include #include "fpmath.h" #include "math_private.h" #define LDBL_INFNAN_EXP (LDBL_MAX_EXP * 2 - 1) #ifdef LONG_DOUBLE OLM_DLLEXPORT float nexttowardf(float x, long double y) { union IEEEl2bits uy; volatile float t; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; /* |x| */ uy.e = y; if((ix>0x7f800000) || (uy.bits.exp == LDBL_INFNAN_EXP && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) return x+y; /* x or y is nan */ if(x==y) return (float)y; /* x=y, return y */ if(ix==0) { /* x == 0 */ SET_FLOAT_WORD(x,(uy.bits.sign<<31)|1);/* return +-minsubnormal */ t = x*x; if(t==x) return t; else return x; /* raise underflow flag */ } if((hx>=0) ^ (x < y)) /* x -= ulp */ hx -= 1; else /* x += ulp */ hx += 1; ix = hx&0x7f800000; if(ix>=0x7f800000) return x+x; /* overflow */ if(ix<0x00800000) { /* underflow */ t = x*x; if(t!=x) { /* raise underflow flag */ SET_FLOAT_WORD(x,hx); return x; } } SET_FLOAT_WORD(x,hx); return x; } #endif wcc-0.0.2/src/wsh/openlibm/src/e_atan2.c0000644000175000017500000000750413122010155016374 0ustar philphil /* @(#)e_atan2.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_atan2.c,v 1.14 2008/08/02 19:17:00 das Exp $"); /* __ieee754_atan2(y,x) * Method : * 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x). * 2. Reduce x to positive by (if x and y are unexceptional): * ARG (x+iy) = arctan(y/x) ... if x > 0, * ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0, * * Special cases: * * ATAN2((anything), NaN ) is NaN; * ATAN2(NAN , (anything) ) is NaN; * ATAN2(+-0, +(anything but NaN)) is +-0 ; * ATAN2(+-0, -(anything but NaN)) is +-pi ; * ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2; * ATAN2(+-(anything but INF and NaN), +INF) is +-0 ; * ATAN2(+-(anything but INF and NaN), -INF) is +-pi; * ATAN2(+-INF,+INF ) is +-pi/4 ; * ATAN2(+-INF,-INF ) is +-3pi/4; * ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2; * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include #include #include "math_private.h" static volatile double tiny = 1.0e-300; static const double zero = 0.0, pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */ pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */ pi = 3.1415926535897931160E+00; /* 0x400921FB, 0x54442D18 */ static volatile double pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ OLM_DLLEXPORT double __ieee754_atan2(double y, double x) { double z; int32_t k,m,hx,hy,ix,iy; u_int32_t lx,ly; EXTRACT_WORDS(hx,lx,x); ix = hx&0x7fffffff; EXTRACT_WORDS(hy,ly,y); iy = hy&0x7fffffff; if(((ix|((lx|-lx)>>31))>0x7ff00000)|| ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */ return x+y; if(((hx-0x3ff00000)|lx)==0) return atan(y); /* x=1.0 */ m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ /* when y = 0 */ if((iy|ly)==0) { switch(m) { case 0: case 1: return y; /* atan(+-0,+anything)=+-0 */ case 2: return pi+tiny;/* atan(+0,-anything) = pi */ case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */ } } /* when x = 0 */ if((ix|lx)==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* when x is INF */ if(ix==0x7ff00000) { if(iy==0x7ff00000) { switch(m) { case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */ case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */ case 2: return 3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/ case 3: return -3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/ } } else { switch(m) { case 0: return zero ; /* atan(+...,+INF) */ case 1: return -zero ; /* atan(-...,+INF) */ case 2: return pi+tiny ; /* atan(+...,-INF) */ case 3: return -pi-tiny ; /* atan(-...,-INF) */ } } } /* when y is INF */ if(iy==0x7ff00000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* compute y/x */ k = (iy-ix)>>20; if(k > 60) { /* |y/x| > 2**60 */ z=pi_o_2+0.5*pi_lo; m&=1; } else if(hx<0&&k<-60) z=0.0; /* 0 > |y|/x > -2**-60 */ else z=atan(fabs(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ case 1: return -z ; /* atan(-,+) */ case 2: return pi-(z-pi_lo);/* atan(+,-) */ default: /* case 3 */ return (z-pi_lo)-pi;/* atan(-,-) */ } } #if LDBL_MANT_DIG == 53 __weak_reference(atan2, atan2l); #endif wcc-0.0.2/src/wsh/openlibm/src/s_cacosf.c0000644000175000017500000000267113122010155016643 0ustar philphil/* $OpenBSD: s_cacosf.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cacosf() * * Complex circular arc cosine * * * * SYNOPSIS: * * void cacosf(); * cmplxf z, w; * * cacosf( &z, &w ); * * * * DESCRIPTION: * * * w = arccos z = PI/2 - arcsin z. * * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 9.2e-6 1.2e-6 * */ #include #include float complex cacosf(float complex z) { float complex w; w = casinf( z ); w = ((float)M_PI_2 - crealf (w)) - cimagf (w) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/w_cabsf.c0000644000175000017500000000046013122010155016461 0ustar philphil/* * cabsf() wrapper for hypotf(). * * Written by J.T. Conklin, * Placed into the Public Domain, 1994. */ #include #include #include "math_private.h" OLM_DLLEXPORT float cabsf(z) float complex z; { return hypotf(crealf(z), cimagf(z)); } wcc-0.0.2/src/wsh/openlibm/src/s_cosf.c0000644000175000017500000000445513122010155016341 0ustar philphil/* s_cosf.c -- float version of s_cos.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cosf.c,v 1.18 2008/02/25 22:19:17 bde Exp $"); #include #include //#define INLINE_KERNEL_COSDF //#define INLINE_KERNEL_SINDF //#define INLINE_REM_PIO2F #include "math_private.h" //#include "e_rem_pio2f.c" //#include "k_cosf.c" //#include "k_sinf.c" /* Small multiples of pi/2 rounded to double precision. */ static const double c1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */ c2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */ c3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */ c4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */ OLM_DLLEXPORT float cosf(float x) { double y; int32_t n, hx, ix; GET_FLOAT_WORD(hx,x); ix = hx & 0x7fffffff; if(ix <= 0x3f490fda) { /* |x| ~<= pi/4 */ if(ix<0x39800000) /* |x| < 2**-12 */ if(((int)x)==0) return 1.0; /* 1 with inexact if x != 0 */ return __kernel_cosdf(x); } if(ix<=0x407b53d1) { /* |x| ~<= 5*pi/4 */ if(ix<=0x4016cbe3) { /* |x| ~> 3*pi/4 */ if(hx>0) return __kernel_sindf(c1pio2 - x); else return __kernel_sindf(x + c1pio2); } else return -__kernel_cosdf(x + (hx > 0 ? -c2pio2 : c2pio2)); } if(ix<=0x40e231d5) { /* |x| ~<= 9*pi/4 */ if(ix<=0x40afeddf) { /* |x| ~> 7*pi/4 */ if(hx>0) return __kernel_sindf(x - c3pio2); else return __kernel_sindf(-c3pio2 - x); } else return __kernel_cosdf(x + (hx > 0 ? -c4pio2 : c4pio2)); } /* cos(Inf or NaN) is NaN */ else if (ix>=0x7f800000) return x-x; /* general argument reduction needed */ else { n = __ieee754_rem_pio2f(x,&y); switch(n&3) { case 0: return __kernel_cosdf(y); case 1: return __kernel_sindf(-y); case 2: return -__kernel_cosdf(y); default: return __kernel_sindf(y); } } } wcc-0.0.2/src/wsh/openlibm/src/s_lrintl.c0000644000175000017500000000034213122010155016702 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_lrintl.c,v 1.1 2008/01/14 02:12:06 das Exp $"); #define type long double #define roundit rintl #define dtype long #define fn lrintl #include "s_lrint.c" wcc-0.0.2/src/wsh/openlibm/src/s_logbl.c0000644000175000017500000000237213122010155016502 0ustar philphil/* * From: @(#)s_ilogb.c 5.1 93/09/24 * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT long double logbl(long double x) { union IEEEl2bits u; unsigned long m; int b; u.e = x; if (u.bits.exp == 0) { if ((u.bits.manl | u.bits.manh) == 0) { /* x == 0 */ u.bits.sign = 1; return (1.0L / u.e); } /* denormalized */ if (u.bits.manh == 0) { m = 1lu << (LDBL_MANL_SIZE - 1); for (b = LDBL_MANH_SIZE; !(u.bits.manl & m); m >>= 1) b++; } else { m = 1lu << (LDBL_MANH_SIZE - 1); for (b = 0; !(u.bits.manh & m); m >>= 1) b++; } #ifdef LDBL_IMPLICIT_NBIT b++; #endif return ((long double)(LDBL_MIN_EXP - b - 1)); } if (u.bits.exp < (LDBL_MAX_EXP << 1) - 1) /* normal */ return ((long double)(u.bits.exp - LDBL_MAX_EXP + 1)); else /* +/- inf or nan */ return (x * x); } wcc-0.0.2/src/wsh/openlibm/src/s_nexttoward.c0000644000175000017500000000355013122010155017601 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_nexttoward.c,v 1.3 2011/02/10 07:38:13 das Exp $"); /* * We assume that a long double has a 15-bit exponent. On systems * where long double is the same as double, nexttoward() is an alias * for nextafter(), so we don't use this routine. */ #include #include #include "fpmath.h" #include "math_private.h" #if LDBL_MAX_EXP != 0x4000 #error "Unsupported long double format" #endif OLM_DLLEXPORT double nexttoward(double x, long double y) { union IEEEl2bits uy; volatile double t; int32_t hx,ix; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); ix = hx&0x7fffffff; /* |x| */ uy.e = y; if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || (uy.bits.exp == 0x7fff && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) return x+y; /* x or y is nan */ if(x==y) return (double)y; /* x=y, return y */ if(x==0.0) { INSERT_WORDS(x,uy.bits.sign<<31,1); /* return +-minsubnormal */ t = x*x; if(t==x) return t; else return x; /* raise underflow flag */ } if((hx>0.0) ^ (x < y)) { /* x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x += ulp */ lx += 1; if(lx==0) hx += 1; } ix = hx&0x7ff00000; if(ix>=0x7ff00000) return x+x; /* overflow */ if(ix<0x00100000) { /* underflow */ t = x*x; if(t!=x) { /* raise underflow flag */ INSERT_WORDS(x,hx,lx); return x; } } INSERT_WORDS(x,hx,lx); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_lroundf.c0000644000175000017500000000042613122010155017052 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_lroundf.c,v 1.2 2005/04/08 00:52:27 das Exp $"); #define type float #define roundit roundf #define dtype long #define DTYPE_MIN LONG_MIN #define DTYPE_MAX LONG_MAX #define fn lroundf #include "s_lround.c" wcc-0.0.2/src/wsh/openlibm/src/s_ilogb.c0000644000175000017500000000234713122010155016501 0ustar philphil/* @(#)s_ilogb.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ilogb.c,v 1.10 2008/02/22 02:30:35 das Exp $"); /* ilogb(double x) * return the binary exponent of non-zero x * ilogb(0) = FP_ILOGB0 * ilogb(NaN) = FP_ILOGBNAN (no signal is raised) * ilogb(inf) = INT_MAX (no signal is raised) */ #include #include #include "math_private.h" OLM_DLLEXPORT int ilogb(double x) { int32_t hx,lx,ix; EXTRACT_WORDS(hx,lx,x); hx &= 0x7fffffff; if(hx<0x00100000) { if((hx|lx)==0) return FP_ILOGB0; else /* subnormal x */ if(hx==0) { for (ix = -1043; lx>0; lx<<=1) ix -=1; } else { for (ix = -1022,hx<<=11; hx>0; hx<<=1) ix -=1; } return ix; } else if (hx<0x7ff00000) return (hx>>20)-1023; else if (hx>0x7ff00000 || lx!=0) return FP_ILOGBNAN; else return INT_MAX; } wcc-0.0.2/src/wsh/openlibm/src/s_llrintl.c0000644000175000017500000000035113122010155017056 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_llrintl.c,v 1.1 2008/01/14 02:12:06 das Exp $"); #define type long double #define roundit rintl #define dtype long long #define fn llrintl #include "s_lrint.c" wcc-0.0.2/src/wsh/openlibm/src/s_signgam.c0000644000175000017500000000016113122010155017022 0ustar philphil#include #include "math_private.h" #ifndef OPENLIBM_ONLY_THREAD_SAFE int signgam = 0; #endif wcc-0.0.2/src/wsh/openlibm/src/e_log2f.c0000644000175000017500000000471413122010155016400 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_log2f.c,v 1.5 2011/10/15 05:23:28 das Exp $"); /* * Float version of e_log2.c. See the latter for most comments. */ #include #include "math_private.h" #include "k_logf.h" // VBS #define float_t float static const float two25 = 3.3554432000e+07, /* 0x4c000000 */ ivln2hi = 1.4428710938e+00, /* 0x3fb8b000 */ ivln2lo = -1.7605285393e-04; /* 0xb9389ad4 */ static const float zero = 0.0; OLM_DLLEXPORT float __ieee754_log2f(float x) { float f,hfsq,hi,lo,r,y; int32_t i,k,hx; GET_FLOAT_WORD(hx,x); k=0; if (hx < 0x00800000) { /* x < 2**-126 */ if ((hx&0x7fffffff)==0) return -two25/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 25; x *= two25; /* subnormal number, scale up x */ GET_FLOAT_WORD(hx,x); } if (hx >= 0x7f800000) return x+x; if (hx == 0x3f800000) return zero; /* log(1) = +0 */ k += (hx>>23)-127; hx &= 0x007fffff; i = (hx+(0x4afb0d))&0x800000; SET_FLOAT_WORD(x,hx|(i^0x3f800000)); /* normalize x or x/2 */ k += (i>>23); y = (float)k; f = x - (float)1.0; hfsq = (float)0.5*f*f; r = k_log1pf(f); /* * We no longer need to avoid falling into the multi-precision * calculations due to compiler bugs breaking Dekker's theorem. * Keep avoiding this as an optimization. See e_log2.c for more * details (some details are here only because the optimization * is not yet available in double precision). * * Another compiler bug turned up. With gcc on i386, * (ivln2lo + ivln2hi) would be evaluated in float precision * despite runtime evaluations using double precision. So we * must cast one of its terms to float_t. This makes the whole * expression have type float_t, so return is forced to waste * time clobbering its extra precision. */ if (sizeof(float_t) > sizeof(float)) return (r - hfsq + f) * ((float_t)ivln2lo + ivln2hi) + y; hi = f - hfsq; GET_FLOAT_WORD(hx,hi); SET_FLOAT_WORD(hi,hx&0xfffff000); lo = (f - hi) - hfsq + r; return (lo+hi)*ivln2lo + lo*ivln2hi + hi*ivln2hi + y; } wcc-0.0.2/src/wsh/openlibm/src/s_tan.c0000644000175000017500000000416313122010155016165 0ustar philphil/* @(#)s_tan.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_tan.c,v 1.13 2011/02/10 07:37:50 das Exp $"); /* tan(x) * Return tangent function of x. * * kernel function: * __kernel_tan ... tangent function on [-pi/4,pi/4] * __ieee754_rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 * in [-pi/4 , +pi/4], and let n = k mod 4. * We have * * n sin(x) cos(x) tan(x) * ---------------------------------------------------------- * 0 S C T * 1 C -S -1/T * 2 -S -C T * 3 -C S -1/T * ---------------------------------------------------------- * * Special cases: * Let trig be any of sin, cos, or tan. * trig(+-INF) is NaN, with signals; * trig(NaN) is that NaN; * * Accuracy: * TRIG(x) returns trig(x) nearly rounded */ #include #include //#define INLINE_REM_PIO2 #include "math_private.h" //#include "e_rem_pio2.c" OLM_DLLEXPORT double tan(double x) { double y[2],z=0.0; int32_t n, ix; /* High word of x. */ GET_HIGH_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3fe921fb) { if(ix<0x3e400000) /* x < 2**-27 */ if((int)x==0) return x; /* generate inexact */ return __kernel_tan(x,z,1); } /* tan(Inf or NaN) is NaN */ else if (ix>=0x7ff00000) return x-x; /* NaN */ /* argument reduction needed */ else { n = __ieee754_rem_pio2(x,y); return __kernel_tan(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even -1 -- n odd */ } } #if (LDBL_MANT_DIG == 53) __weak_reference(tan, tanl); #endif wcc-0.0.2/src/wsh/openlibm/src/e_lgammal.c0000644000175000017500000000034013122010155016770 0ustar philphil#include "cdefs-compat.h" #include #include "math_private.h" OLM_DLLEXPORT long double lgammal(long double x) { #ifdef OPENLIBM_ONLY_THREAD_SAFE int signgam; #endif return (lgammal_r(x, &signgam)); } wcc-0.0.2/src/wsh/openlibm/src/s_cosl.c0000644000175000017500000000505113122010155016340 0ustar philphil/*- * Copyright (c) 2007 Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cosl.c,v 1.3 2011/05/30 19:41:28 kargl Exp $"); /* * Limited testing on pseudorandom numbers drawn within [-2e8:4e8] shows * an accuracy of <= 0.7412 ULP. */ #include #include #include "math_private.h" #if LDBL_MANT_DIG == 64 #include "../ld80/e_rem_pio2l.h" #elif LDBL_MANT_DIG == 113 #include "../ld128/e_rem_pio2l.h" #else #error "Unsupported long double format" #endif OLM_DLLEXPORT long double cosl(long double x) { union IEEEl2bits z; int e0; long double y[2]; long double hi, lo; z.e = x; z.bits.sign = 0; /* If x = +-0 or x is a subnormal number, then cos(x) = 1 */ if (z.bits.exp == 0) return (1.0); /* If x = NaN or Inf, then cos(x) = NaN. */ if (z.bits.exp == 32767) return ((x - x) / (x - x)); /* Optimize the case where x is already within range. */ if (z.e < M_PI_4) return (__kernel_cosl(z.e, 0)); e0 = __ieee754_rem_pio2l(x, y); hi = y[0]; lo = y[1]; switch (e0 & 3) { case 0: hi = __kernel_cosl(hi, lo); break; case 1: hi = - __kernel_sinl(hi, lo, 1); break; case 2: hi = - __kernel_cosl(hi, lo); break; case 3: hi = __kernel_sinl(hi, lo, 1); break; } return (hi); } wcc-0.0.2/src/wsh/openlibm/src/s_cprojl.c0000644000175000017500000000334513122010155016675 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cprojl.c,v 1.1 2008/08/07 15:07:48 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT long double complex cprojl(long double complex z) { if (!isinf(creall(z)) && !isinf(cimagl(z))) return (z); else return (CMPLXL(INFINITY, copysignl(0.0, cimagl(z)))); } wcc-0.0.2/src/wsh/openlibm/src/s_ctanhf.c0000644000175000017500000000476013122010155016651 0ustar philphil/*- * Copyright (c) 2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Hyperbolic tangent of a complex argument z. See s_ctanh.c for details. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ctanhf.c,v 1.2 2011/10/21 06:30:16 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT float complex ctanhf(float complex z) { float x, y; float t, beta, s, rho, denom; u_int32_t hx, ix; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hx, x); ix = hx & 0x7fffffff; if (ix >= 0x7f800000) { if (ix & 0x7fffff) return (CMPLXF(x, (y == 0 ? y : x * y))); SET_FLOAT_WORD(x, hx - 0x40000000); return (CMPLXF(x, copysignf(0, isinf(y) ? y : sinf(y) * cosf(y)))); } if (!isfinite(y)) return (CMPLXF(y - y, y - y)); if (ix >= 0x41300000) { /* x >= 11 */ float exp_mx = expf(-fabsf(x)); return (CMPLXF(copysignf(1, x), 4 * sinf(y) * cosf(y) * exp_mx * exp_mx)); } t = tanf(y); beta = 1.0 + t * t; s = sinhf(x); rho = sqrtf(1 + s * s); denom = 1 + beta * s * s; return (CMPLXF((beta * rho * s) / denom, t / denom)); } OLM_DLLEXPORT float complex ctanf(float complex z) { z = ctanhf(CMPLXF(-cimagf(z), crealf(z))); return (CMPLXF(cimagf(z), -crealf(z))); } wcc-0.0.2/src/wsh/openlibm/src/s_expm1.c0000644000175000017500000001626013122010155016436 0ustar philphil/* @(#)s_expm1.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_expm1.c,v 1.12 2011/10/21 06:26:38 das Exp $"); /* expm1(x) * Returns exp(x)-1, the exponential of x minus 1. * * Method * 1. Argument reduction: * Given x, find r and integer k such that * * x = k*ln2 + r, |r| <= 0.5*ln2 ~ 0.34658 * * Here a correction term c will be computed to compensate * the error in r when rounded to a floating-point number. * * 2. Approximating expm1(r) by a special rational function on * the interval [0,0.34658]: * Since * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 - r^4/360 + ... * we define R1(r*r) by * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 * R1(r*r) * That is, * R1(r**2) = 6/r *((exp(r)+1)/(exp(r)-1) - 2/r) * = 6/r * ( 1 + 2.0*(1/(exp(r)-1) - 1/r)) * = 1 - r^2/60 + r^4/2520 - r^6/100800 + ... * We use a special Reme algorithm on [0,0.347] to generate * a polynomial of degree 5 in r*r to approximate R1. The * maximum error of this polynomial approximation is bounded * by 2**-61. In other words, * R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5 * where Q1 = -1.6666666666666567384E-2, * Q2 = 3.9682539681370365873E-4, * Q3 = -9.9206344733435987357E-6, * Q4 = 2.5051361420808517002E-7, * Q5 = -6.2843505682382617102E-9; * z = r*r, * with error bounded by * | 5 | -61 * | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2 * | | * * expm1(r) = exp(r)-1 is then computed by the following * specific way which minimize the accumulation rounding error: * 2 3 * r r [ 3 - (R1 + R1*r/2) ] * expm1(r) = r + --- + --- * [--------------------] * 2 2 [ 6 - r*(3 - R1*r/2) ] * * To compensate the error in the argument reduction, we use * expm1(r+c) = expm1(r) + c + expm1(r)*c * ~ expm1(r) + c + r*c * Thus c+r*c will be added in as the correction terms for * expm1(r+c). Now rearrange the term to avoid optimization * screw up: * ( 2 2 ) * ({ ( r [ R1 - (3 - R1*r/2) ] ) } r ) * expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- ) * ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 ) * ( ) * * = r - E * 3. Scale back to obtain expm1(x): * From step 1, we have * expm1(x) = either 2^k*[expm1(r)+1] - 1 * = or 2^k*[expm1(r) + (1-2^-k)] * 4. Implementation notes: * (A). To save one multiplication, we scale the coefficient Qi * to Qi*2^i, and replace z by (x^2)/2. * (B). To achieve maximum accuracy, we compute expm1(x) by * (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf) * (ii) if k=0, return r-E * (iii) if k=-1, return 0.5*(r-E)-0.5 * (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E) * else return 1.0+2.0*(r-E); * (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1) * (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else * (vii) return 2^k(1-((E+2^-k)-r)) * * Special cases: * expm1(INF) is INF, expm1(NaN) is NaN; * expm1(-INF) is -1, and * for finite argument, only expm1(0)=0 is exact. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Misc. info. * For IEEE double * if x > 7.09782712893383973096e+02 then expm1(x) overflow * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include #include #include "math_private.h" static const double one = 1.0, huge = 1.0e+300, tiny = 1.0e-300, o_threshold = 7.09782712893383973096e+02,/* 0x40862E42, 0xFEFA39EF */ ln2_hi = 6.93147180369123816490e-01,/* 0x3fe62e42, 0xfee00000 */ ln2_lo = 1.90821492927058770002e-10,/* 0x3dea39ef, 0x35793c76 */ invln2 = 1.44269504088896338700e+00,/* 0x3ff71547, 0x652b82fe */ /* Scaled Q's: Qn_here = 2**n * Qn_above, for R(2*z) where z = hxs = x*x/2: */ Q1 = -3.33333333333331316428e-02, /* BFA11111 111110F4 */ Q2 = 1.58730158725481460165e-03, /* 3F5A01A0 19FE5585 */ Q3 = -7.93650757867487942473e-05, /* BF14CE19 9EAADBB7 */ Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ OLM_DLLEXPORT double expm1(double x) { double y,hi,lo,c,t,e,hxs,hfx,r1,twopk; int32_t k,xsb; u_int32_t hx; GET_HIGH_WORD(hx,x); xsb = hx&0x80000000; /* sign bit of x */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out huge and non-finite argument */ if(hx >= 0x4043687A) { /* if |x|>=56*ln2 */ if(hx >= 0x40862E42) { /* if |x|>=709.78... */ if(hx>=0x7ff00000) { u_int32_t low; GET_LOW_WORD(low,x); if(((hx&0xfffff)|low)!=0) return x+x; /* NaN */ else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ } if(x > o_threshold) return huge*huge; /* overflow */ } if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */ if(x+tiny<0.0) /* raise inexact */ return tiny-one; /* return -1 */ } } /* argument reduction */ if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */ if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */ if(xsb==0) {hi = x - ln2_hi; lo = ln2_lo; k = 1;} else {hi = x + ln2_hi; lo = -ln2_lo; k = -1;} } else { k = invln2*x+((xsb==0)?0.5:-0.5); t = k; hi = x - t*ln2_hi; /* t*ln2_hi is exact here */ lo = t*ln2_lo; } STRICT_ASSIGN(double, x, hi - lo); c = (hi-x)-lo; } else if(hx < 0x3c900000) { /* when |x|<2**-54, return x */ t = huge+x; /* return x with inexact flags when x!=0 */ return x - (t-(huge+x)); } else k = 0; /* x is now in primary range */ hfx = 0.5*x; hxs = x*hfx; r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5)))); t = 3.0-r1*hfx; e = hxs*((r1-t)/(6.0 - x*t)); if(k==0) return x - (x*e-hxs); /* c is 0 */ else { INSERT_WORDS(twopk,0x3ff00000+(k<<20),0); /* 2^k */ e = (x*(e-c)-c); e -= hxs; if(k== -1) return 0.5*(x-e)-0.5; if(k==1) { if(x < -0.25) return -2.0*(e-(x+0.5)); else return one+2.0*(x-e); } if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */ y = one-(e-x); if (k == 1024) y = y*2.0*0x1p1023; else y = y*twopk; return y-one; } t = one; if(k<20) { SET_HIGH_WORD(t,0x3ff00000 - (0x200000>>k)); /* t=1-2^-k */ y = t-(e-x); y = y*twopk; } else { SET_HIGH_WORD(t,((0x3ff-k)<<20)); /* 2^-k */ y = x-(e+t); y += one; y = y*twopk; } } return y; } wcc-0.0.2/src/wsh/openlibm/src/s_isinf.c0000644000175000017500000000367613122010155016523 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * */ #include #include "fpmath.h" #include "math_private.h" /* Provided by libc */ #if 1 OLM_DLLEXPORT int (isinf) (double d) { union IEEEd2bits u; u.d = d; return (u.bits.exp == 2047 && u.bits.manl == 0 && u.bits.manh == 0); } #endif OLM_DLLEXPORT int __isinff(float f) { union IEEEf2bits u; u.f = f; return (u.bits.exp == 255 && u.bits.man == 0); } #ifdef LONG_DOUBLE OLM_DLLEXPORT int __isinfl(long double e) { union IEEEl2bits u; u.e = e; mask_nbit_l(u); return (u.bits.exp == 32767 && u.bits.manl == 0 && u.bits.manh == 0); } #endif __weak_reference(__isinff, isinff); wcc-0.0.2/src/wsh/openlibm/src/Make.files0000644000175000017500000000551713122010155016622 0ustar philphil$(CUR_SRCS) = common.c \ e_acos.c e_acosf.c e_acosh.c e_acoshf.c e_asin.c e_asinf.c \ e_atan2.c e_atan2f.c e_atanh.c e_atanhf.c e_cosh.c e_coshf.c e_exp.c \ e_expf.c e_fmod.c e_fmodf.c \ e_hypot.c e_hypotf.c e_j0.c e_j0f.c e_j1.c e_j1f.c \ e_jn.c e_jnf.c e_lgamma.c e_lgamma_r.c e_lgammaf.c e_lgammaf_r.c \ e_log.c e_log10.c e_log10f.c e_log2.c e_log2f.c e_logf.c \ e_pow.c e_powf.c e_remainder.c e_remainderf.c \ e_rem_pio2.c e_rem_pio2f.c \ e_sinh.c e_sinhf.c e_sqrt.c e_sqrtf.c \ k_cos.c k_exp.c k_expf.c k_rem_pio2.c k_sin.c k_tan.c \ k_cosf.c k_sinf.c k_tanf.c \ s_asinh.c s_asinhf.c s_atan.c s_atanf.c s_carg.c s_cargf.c \ s_cbrt.c s_cbrtf.c s_ceil.c s_ceilf.c \ s_copysign.c s_copysignf.c s_cos.c s_cosf.c \ s_csqrt.c s_csqrtf.c s_erf.c s_erff.c \ s_exp2.c s_exp2f.c s_expm1.c s_expm1f.c s_fabs.c s_fabsf.c s_fdim.c \ s_floor.c s_floorf.c s_fma.c s_fmaf.c \ s_fmax.c s_fmaxf.c s_fmin.c \ s_fminf.c s_fpclassify.c \ s_frexp.c s_frexpf.c s_ilogb.c s_ilogbf.c \ s_isinf.c s_isfinite.c s_isnormal.c s_isnan.c \ s_llrint.c s_llrintf.c s_llround.c s_llroundf.c \ s_log1p.c s_log1pf.c s_logb.c s_logbf.c s_lrint.c s_lrintf.c \ s_lround.c s_lroundf.c s_modf.c s_modff.c \ s_nearbyint.c s_nextafter.c s_nextafterf.c \ s_nexttowardf.c s_remquo.c s_remquof.c \ s_rint.c s_rintf.c s_round.c s_roundf.c \ s_scalbln.c s_scalbn.c s_scalbnf.c s_signbit.c \ s_signgam.c s_sin.c s_sincos.c \ s_sinf.c s_sincosf.c s_tan.c s_tanf.c s_tanh.c s_tanhf.c s_tgammaf.c \ s_trunc.c s_truncf.c s_cpow.c s_cpowf.c \ w_cabs.c w_cabsf.c ifneq ($(OS), WINNT) $(CUR_SRCS) += s_nan.c endif ifneq ($(ARCH), arm) ifneq ($(ARCH), powerpc) # C99 long double functions $(CUR_SRCS) += s_copysignl.c s_fabsl.c s_llrintl.c s_lrintl.c s_modfl.c # If long double != double use these; otherwise, we alias the double versions. $(CUR_SRCS) += e_acosl.c e_asinl.c e_atan2l.c e_fmodl.c \ s_fmaxl.c s_fminl.c s_ilogbl.c \ e_hypotl.c e_lgammal.c e_remainderl.c e_sqrtl.c \ s_atanl.c s_ceill.c s_cosl.c s_cprojl.c \ s_csqrtl.c s_floorl.c s_fmal.c \ s_frexpl.c s_logbl.c s_nexttoward.c \ s_remquol.c s_roundl.c s_lroundl.c s_llroundl.c \ s_cpowl.c s_cargl.c \ s_sinl.c s_sincosl.c s_tanl.c s_truncl.c w_cabsl.c \ s_nextafterl.c s_rintl.c s_scalbnl.c polevll.c \ s_casinl.c s_ctanl.c \ s_cimagl.c s_conjl.c s_creall.c s_cacoshl.c s_catanhl.c s_casinhl.c \ s_catanl.c s_csinl.c s_cacosl.c s_cexpl.c s_csinhl.c s_ccoshl.c \ s_clogl.c s_ctanhl.c s_ccosl.c s_cbrtl.c endif endif # C99 complex functions $(CUR_SRCS) += s_ccosh.c s_ccoshf.c s_cexp.c s_cexpf.c \ s_cimag.c s_cimagf.c \ s_conj.c s_conjf.c \ s_cproj.c s_cprojf.c s_creal.c s_crealf.c \ s_csinh.c s_csinhf.c s_ctanh.c s_ctanhf.c \ s_cacos.c s_cacosf.c \ s_cacosh.c s_cacoshf.c \ s_casin.c s_casinf.c s_casinh.c s_casinhf.c \ s_catan.c s_catanf.c s_catanh.c s_catanhf.c \ s_clog.c s_clogf.c wcc-0.0.2/src/wsh/openlibm/src/math_private.h0000644000175000017500000002052213122010155017546 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * from: @(#)fdlibm.h 5.1 93/09/24 * $FreeBSD: src/lib/msun/src/math_private.h,v 1.34 2011/10/21 06:27:56 das Exp $ */ #ifndef _MATH_PRIVATE_H_ #define _MATH_PRIVATE_H_ #include #include "cdefs-compat.h" #include "types-compat.h" #include "fpmath.h" #include #include "math_private_openbsd.h" /* * The original fdlibm code used statements like: * n0 = ((*(int*)&one)>>29)^1; * index of high word * * ix0 = *(n0+(int*)&x); * high word of x * * ix1 = *((1-n0)+(int*)&x); * low word of x * * to dig two 32 bit words out of the 64 bit IEEE floating point * value. That is non-ANSI, and, moreover, the gcc instruction * scheduler gets it wrong. We instead use the following macros. * Unlike the original code, we determine the endianness at compile * time, not at run time; I don't see much benefit to selecting * endianness at run time. */ /* * A union which permits us to convert between a double and two 32 bit * ints. */ #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__ typedef union { double value; struct { u_int32_t msw; u_int32_t lsw; } parts; struct { u_int64_t w; } xparts; } ieee_double_shape_type; #endif #if __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__ typedef union { double value; struct { u_int32_t lsw; u_int32_t msw; } parts; struct { u_int64_t w; } xparts; } ieee_double_shape_type; #endif /* Get two 32 bit ints from a double. */ #define EXTRACT_WORDS(ix0,ix1,d) \ do { \ ieee_double_shape_type ew_u; \ ew_u.value = (d); \ (ix0) = ew_u.parts.msw; \ (ix1) = ew_u.parts.lsw; \ } while (0) /* Get a 64-bit int from a double. */ #define EXTRACT_WORD64(ix,d) \ do { \ ieee_double_shape_type ew_u; \ ew_u.value = (d); \ (ix) = ew_u.xparts.w; \ } while (0) /* Get the more significant 32 bit int from a double. */ #define GET_HIGH_WORD(i,d) \ do { \ ieee_double_shape_type gh_u; \ gh_u.value = (d); \ (i) = gh_u.parts.msw; \ } while (0) /* Get the less significant 32 bit int from a double. */ #define GET_LOW_WORD(i,d) \ do { \ ieee_double_shape_type gl_u; \ gl_u.value = (d); \ (i) = gl_u.parts.lsw; \ } while (0) /* Set a double from two 32 bit ints. */ #define INSERT_WORDS(d,ix0,ix1) \ do { \ ieee_double_shape_type iw_u; \ iw_u.parts.msw = (ix0); \ iw_u.parts.lsw = (ix1); \ (d) = iw_u.value; \ } while (0) /* Set a double from a 64-bit int. */ #define INSERT_WORD64(d,ix) \ do { \ ieee_double_shape_type iw_u; \ iw_u.xparts.w = (ix); \ (d) = iw_u.value; \ } while (0) /* Set the more significant 32 bits of a double from an int. */ #define SET_HIGH_WORD(d,v) \ do { \ ieee_double_shape_type sh_u; \ sh_u.value = (d); \ sh_u.parts.msw = (v); \ (d) = sh_u.value; \ } while (0) /* Set the less significant 32 bits of a double from an int. */ #define SET_LOW_WORD(d,v) \ do { \ ieee_double_shape_type sl_u; \ sl_u.value = (d); \ sl_u.parts.lsw = (v); \ (d) = sl_u.value; \ } while (0) /* * A union which permits us to convert between a float and a 32 bit * int. */ typedef union { float value; /* FIXME: Assumes 32 bit int. */ unsigned int word; } ieee_float_shape_type; /* Get a 32 bit int from a float. */ #define GET_FLOAT_WORD(i,d) \ do { \ ieee_float_shape_type gf_u; \ gf_u.value = (d); \ (i) = gf_u.word; \ } while (0) /* Set a float from a 32 bit int. */ #define SET_FLOAT_WORD(d,i) \ do { \ ieee_float_shape_type sf_u; \ sf_u.word = (i); \ (d) = sf_u.value; \ } while (0) /* Get expsign as a 16 bit int from a long double. */ #define GET_LDBL_EXPSIGN(i,d) \ do { \ union IEEEl2bits ge_u; \ ge_u.e = (d); \ (i) = ge_u.xbits.expsign; \ } while (0) /* Set expsign of a long double from a 16 bit int. */ #define SET_LDBL_EXPSIGN(d,v) \ do { \ union IEEEl2bits se_u; \ se_u.e = (d); \ se_u.xbits.expsign = (v); \ (d) = se_u.e; \ } while (0) //VBS #define STRICT_ASSIGN(type, lval, rval) ((lval) = (rval)) /* VBS #ifdef FLT_EVAL_METHOD // Attempt to get strict C99 semantics for assignment with non-C99 compilers. #if FLT_EVAL_METHOD == 0 || __GNUC__ == 0 #define STRICT_ASSIGN(type, lval, rval) ((lval) = (rval)) #else #define STRICT_ASSIGN(type, lval, rval) do { \ volatile type __lval; \ \ if (sizeof(type) >= sizeof(double)) \ (lval) = (rval); \ else { \ __lval = (rval); \ (lval) = __lval; \ } \ } while (0) #endif #endif */ /* * Common routine to process the arguments to nan(), nanf(), and nanl(). */ void __scan_nan(u_int32_t *__words, int __num_words, const char *__s); #ifdef __GNUCLIKE_ASM /* Asm versions of some functions. */ #ifdef __amd64__ static __inline int irint(double x) { int n; __asm__("cvtsd2si %1,%0" : "=r" (n) : "x" (x)); return (n); } #define HAVE_EFFICIENT_IRINT #endif #ifdef __i386__ static __inline int irint(double x) { int n; __asm__("fistl %0" : "=m" (n) : "t" (x)); return (n); } #define HAVE_EFFICIENT_IRINT #endif #endif /* __GNUCLIKE_ASM */ /* * ieee style elementary functions * * We rename functions here to improve other sources' diffability * against fdlibm. */ #define __ieee754_sqrt sqrt #define __ieee754_acos acos #define __ieee754_acosh acosh #define __ieee754_log log #define __ieee754_log2 log2 #define __ieee754_atanh atanh #define __ieee754_asin asin #define __ieee754_atan2 atan2 #define __ieee754_exp exp #define __ieee754_cosh cosh #define __ieee754_fmod fmod #define __ieee754_pow pow #define __ieee754_lgamma lgamma #define __ieee754_lgamma_r lgamma_r #define __ieee754_log10 log10 #define __ieee754_sinh sinh #define __ieee754_hypot hypot #define __ieee754_j0 j0 #define __ieee754_j1 j1 #define __ieee754_y0 y0 #define __ieee754_y1 y1 #define __ieee754_jn jn #define __ieee754_yn yn #define __ieee754_remainder remainder #define __ieee754_sqrtf sqrtf #define __ieee754_acosf acosf #define __ieee754_acoshf acoshf #define __ieee754_logf logf #define __ieee754_atanhf atanhf #define __ieee754_asinf asinf #define __ieee754_atan2f atan2f #define __ieee754_expf expf #define __ieee754_coshf coshf #define __ieee754_fmodf fmodf #define __ieee754_powf powf #define __ieee754_lgammaf lgammaf #define __ieee754_lgammaf_r lgammaf_r #define __ieee754_log10f log10f #define __ieee754_log2f log2f #define __ieee754_sinhf sinhf #define __ieee754_hypotf hypotf #define __ieee754_j0f j0f #define __ieee754_j1f j1f #define __ieee754_y0f y0f #define __ieee754_y1f y1f #define __ieee754_jnf jnf #define __ieee754_ynf ynf #define __ieee754_remainderf remainderf /* fdlibm kernel function */ int __kernel_rem_pio2(double*,double*,int,int,int); /* double precision kernel functions */ #ifdef INLINE_REM_PIO2 __inline #endif int __ieee754_rem_pio2(double,double*); double __kernel_sin(double,double,int); double __kernel_cos(double,double); double __kernel_tan(double,double,int); double __ldexp_exp(double,int); double complex __ldexp_cexp(double complex,int); /* float precision kernel functions */ #ifdef INLINE_REM_PIO2F __inline #endif int __ieee754_rem_pio2f(float,double*); #ifdef INLINE_KERNEL_SINDF __inline #endif float __kernel_sindf(double); #ifdef INLINE_KERNEL_COSDF __inline #endif float __kernel_cosdf(double); #ifdef INLINE_KERNEL_TANDF __inline #endif float __kernel_tandf(double,int); float __ldexp_expf(float,int); float complex __ldexp_cexpf(float complex,int); /* long double precision kernel functions */ long double __kernel_sinl(long double, long double, int); long double __kernel_cosl(long double, long double); long double __kernel_tanl(long double, long double, int); #undef OLM_DLLEXPORT #ifdef _WIN32 # ifdef IMPORT_EXPORTS # define OLM_DLLEXPORT __declspec(dllimport) # else # define OLM_DLLEXPORT __declspec(dllexport) # endif #else #define OLM_DLLEXPORT __attribute__ ((visibility("default"))) #endif #endif /* !_MATH_PRIVATE_H_ */ wcc-0.0.2/src/wsh/openlibm/src/s_fmaf.c0000644000175000017500000000516313122010155016315 0ustar philphil/*- * Copyright (c) 2005-2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fmaf.c,v 1.3 2011/10/15 04:16:58 das Exp $"); #include #include #include "math_private.h" /* * Fused multiply-add: Compute x * y + z with a single rounding error. * * A double has more than twice as much precision than a float, so * direct double-precision arithmetic suffices, except where double * rounding occurs. */ OLM_DLLEXPORT float fmaf(float x, float y, float z) { double xy, result; u_int32_t hr, lr; xy = (double)x * y; result = xy + z; EXTRACT_WORDS(hr, lr, result); /* Common case: The double precision result is fine. */ if ((lr & 0x1fffffff) != 0x10000000 || /* not a halfway case */ (hr & 0x7ff00000) == 0x7ff00000 || /* NaN */ result - xy == z || /* exact */ fegetround() != FE_TONEAREST) /* not round-to-nearest */ return (result); /* * If result is inexact, and exactly halfway between two float values, * we need to adjust the low-order bit in the direction of the error. */ fesetround(FE_TOWARDZERO); volatile double vxy = xy; /* XXX work around gcc CSE bug */ double adjusted_result = vxy + z; fesetround(FE_TONEAREST); if (result == adjusted_result) SET_LOW_WORD(adjusted_result, lr + 1); return (adjusted_result); } wcc-0.0.2/src/wsh/openlibm/src/s_isfinite.c0000644000175000017500000000353013122010155017212 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_isfinite.c,v 1.1 2004/07/09 03:32:39 das Exp $ */ #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT int __isfinite(double d) { union IEEEd2bits u; u.d = d; return (u.bits.exp != 2047); } OLM_DLLEXPORT int __isfinitef(float f) { union IEEEf2bits u; u.f = f; return (u.bits.exp != 255); } #ifdef LONG_DOUBLE OLM_DLLEXPORT int __isfinitel(long double e) { union IEEEl2bits u; u.e = e; return (u.bits.exp != 32767); } #endif wcc-0.0.2/src/wsh/openlibm/src/s_ctanl.c0000644000175000017500000000655013122010155016506 0ustar philphil/* $OpenBSD: s_ctanl.c,v 1.3 2011/07/20 21:02:51 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ctanl() * * Complex circular tangent * * * * SYNOPSIS: * * long double complex ctanl(); * long double complex z, w; * * w = ctanl( z ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * sin 2x + i sinh 2y * w = --------------------. * cos 2x + cosh 2y * * On the real axis the denominator is zero at odd multiples * of PI/2. The denominator is evaluated by its Taylor * series near these points. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5200 7.1e-17 1.6e-17 * IEEE -10,+10 30000 7.2e-16 1.2e-16 * Also tested by ctan * ccot = 1 and catan(ctan(z)) = z. */ #include #include #include #if LDBL_MANT_DIG == 64 static const long double MACHEPL= 5.42101086242752217003726400434970855712890625E-20L; #elif LDBL_MANT_DIG == 113 static const long double MACHEPL = 9.629649721936179265279889712924636592690508e-35L; #endif static const long double PIL = 3.141592653589793238462643383279502884197169L; static const long double DP1 = 3.14159265358979323829596852490908531763125L; static const long double DP2 = 1.6667485837041756656403424829301998703007e-19L; static const long double DP3 = 1.8830410776607851167459095484560349402753e-39L; static long double redupil(long double x) { long double t; long i; t = x / PIL; if (t >= 0.0L) t += 0.5L; else t -= 0.5L; i = t; /* the multiple */ t = i; t = ((x - t * DP1) - t * DP2) - t * DP3; return (t); } static long double ctansl(long double complex z) { long double f, x, x2, y, y2, rn, t; long double d; x = fabsl(2.0L * creall(z)); y = fabsl(2.0L * cimagl(z)); x = redupil(x); x = x * x; y = y * y; x2 = 1.0L; y2 = 1.0L; f = 1.0L; rn = 0.0L; d = 0.0L; do { rn += 1.0L; f *= rn; rn += 1.0L; f *= rn; x2 *= x; y2 *= y; t = y2 + x2; t /= f; d += t; rn += 1.0L; f *= rn; rn += 1.0L; f *= rn; x2 *= x; y2 *= y; t = y2 - x2; t /= f; d += t; } while (fabsl(t/d) > MACHEPL); return(d); } long double complex ctanl(long double complex z) { long double complex w; long double d, x, y; x = creall(z); y = cimagl(z); d = cosl(2.0L * x) + coshl(2.0L * y); if (fabsl(d) < 0.25L) { d = fabsl(d); d = ctansl(z); } if (d == 0.0L) { /*mtherr( "ctan", OVERFLOW );*/ w = LDBL_MAX + LDBL_MAX * I; return (w); } w = sinl(2.0L * x) / d + (sinhl(2.0L * y) / d) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_conj.c0000644000175000017500000000305713122010155016335 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_conj.c,v 1.2 2008/08/07 14:39:56 das Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT double complex conj(double complex z) { return (CMPLX(creal(z), -cimag(z))); } wcc-0.0.2/src/wsh/openlibm/src/bsd_cdefs.h0000644000175000017500000000727413122010155017010 0ustar philphil/*- * Copyright (c) 1991, 1993 * The Regents of the University of California. All rights reserved. * * This code is derived from software contributed to Berkeley by * Berkeley Software Design, Inc. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)cdefs.h 8.8 (Berkeley) 1/9/95 * $FreeBSD: src/sys/sys/cdefs.h,v 1.114 2011/02/18 21:44:53 nwhitehorn Exp $ */ /* Do not redefine macros if the system provides them in sys/cdefs.h. * The two macros correspond to different platforms. */ #ifndef _BSD_CDEFS_H_ #define _BSD_CDEFS_H_ /* * This code has been put in place to help reduce the addition of * compiler specific defines in FreeBSD code. It helps to aid in * having a compiler-agnostic source tree. */ #if defined(__GNUC__) || defined(__INTEL_COMPILER) #if __GNUC__ >= 3 || defined(__INTEL_COMPILER) #define __GNUCLIKE_ASM 3 #else #define __GNUCLIKE_ASM 2 #endif #define __CC_SUPPORTS___INLINE__ 1 #endif /* __GNUC__ || __INTEL_COMPILER */ #if defined(__STDC__) || defined(__cplusplus) #define __volatile volatile #if defined(__cplusplus) #define __inline inline /* convert to C++ keyword */ #else #if !defined(__CC_SUPPORTS___INLINE) #define __inline /* delete GCC keyword */ #endif /* ! __CC_SUPPORTS___INLINE */ #endif /* !__cplusplus */ #else /* !(__STDC__ || __cplusplus) */ #if !defined(__CC_SUPPORTS___INLINE) #define __inline #define __volatile #endif /* !__CC_SUPPORTS___INLINE */ #endif /* !(__STDC__ || __cplusplus) */ /* * Macro to test if we're using a specific version of gcc or later. */ #if defined(__GNUC__) && !defined(__INTEL_COMPILER) #define __GNUC_PREREQ__(ma, mi) \ (__GNUC__ > (ma) || __GNUC__ == (ma) && __GNUC_MINOR__ >= (mi)) #else #define __GNUC_PREREQ__(ma, mi) 0 #endif /* * Compiler-dependent macro to help declare pure (no side effects) functions. * It is null except for versions of gcc that are known to support the features * properly (old versions of gcc-2 supported the dead and pure features * in a different (wrong) way), and for icc. If we do not provide an implementation * for a given compiler, let the compile fail if it is told to use * a feature that we cannot live without. */ #if !defined(__pure2) && (__GNUC_PREREQ__(2, 7) || defined(__INTEL_COMPILER)) #define __pure2 __attribute__((__const__)) #endif #endif /* !_BSD_CDEFS_H_ */ wcc-0.0.2/src/wsh/openlibm/src/k_sinf.c0000644000175000017500000000250113122010155016324 0ustar philphil/* k_sinf.c -- float version of k_sin.c * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef INLINE_KERNEL_SINDF #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_sinf.c,v 1.16 2009/06/03 08:16:34 ed Exp $"); #endif #include #include "math_private.h" /* |sin(x)/x - s(x)| < 2**-37.5 (~[-4.89e-12, 4.824e-12]). */ static const double S1 = -0x15555554cbac77.0p-55, /* -0.166666666416265235595 */ S2 = 0x111110896efbb2.0p-59, /* 0.0083333293858894631756 */ S3 = -0x1a00f9e2cae774.0p-65, /* -0.000198393348360966317347 */ S4 = 0x16cd878c3b46a7.0p-71; /* 0.0000027183114939898219064 */ #ifndef INLINE_KERNEL_SINDF extern #endif //__inline float OLM_DLLEXPORT float __kernel_sindf(double x) { double r, s, w, z; /* Try to optimize for parallel evaluation as in k_tanf.c. */ z = x*x; w = z*z; r = S3+z*S4; s = z*x; return (x + s*(S1+z*S2)) + s*w*r; } wcc-0.0.2/src/wsh/openlibm/src/s_fmin.c0000644000175000017500000000376313122010155016341 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fmin.c,v 1.1 2004/06/30 07:04:01 das Exp $"); #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT double fmin(double x, double y) { union IEEEd2bits u[2]; u[0].d = x; u[1].d = y; /* Check for NaNs to avoid raising spurious exceptions. */ if (u[0].bits.exp == 2047 && (u[0].bits.manh | u[0].bits.manl) != 0) return (y); if (u[1].bits.exp == 2047 && (u[1].bits.manh | u[1].bits.manl) != 0) return (x); /* Handle comparisons of signed zeroes. */ if (u[0].bits.sign != u[1].bits.sign) return (u[u[1].bits.sign].d); return (x < y ? x : y); } wcc-0.0.2/src/wsh/openlibm/src/s_frexpf.c0000644000175000017500000000216613122010155016676 0ustar philphil/* s_frexpf.c -- float version of s_frexp.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_frexpf.c,v 1.10 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" static const float two25 = 3.3554432000e+07; /* 0x4c000000 */ OLM_DLLEXPORT float frexpf(float x, int *eptr) { int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; *eptr = 0; if(ix>=0x7f800000||(ix==0)) return x; /* 0,inf,nan */ if (ix<0x00800000) { /* subnormal */ x *= two25; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; *eptr = -25; } *eptr += (ix>>23)-126; hx = (hx&0x807fffff)|0x3f000000; SET_FLOAT_WORD(x,hx); return x; } wcc-0.0.2/src/wsh/openlibm/src/e_jn.c0000644000175000017500000001614413122010155015776 0ustar philphil /* @(#)e_jn.c 1.4 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_jn.c,v 1.11 2010/11/13 10:54:10 uqs Exp $"); /* * __ieee754_jn(n, x), __ieee754_yn(n, x) * floating point Bessel's function of the 1st and 2nd kind * of order n * * Special cases: * y0(0)=y1(0)=yn(n,0) = -inf with division by zero signal; * y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal. * Note 2. About jn(n,x), yn(n,x) * For n=0, j0(x) is called, * for n=1, j1(x) is called, * for nx, a continued fraction approximation to * j(n,x)/j(n-1,x) is evaluated and then backward * recursion is used starting from a supposed value * for j(n,x). The resulting value of j(0,x) is * compared with the actual value to correct the * supposed value of j(n,x). * * yn(n,x) is similar in all respects, except * that forward recursion is used for all * values of n>1. * */ #include #include "math_private.h" static const double invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */ one = 1.00000000000000000000e+00; /* 0x3FF00000, 0x00000000 */ static const double zero = 0.00000000000000000000e+00; OLM_DLLEXPORT double __ieee754_jn(int n, double x) { int32_t i,hx,ix,lx, sgn; double a, b, temp, di; double z, w; /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) * Thus, J(-n,x) = J(n,-x) */ EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* if J(n,NaN) is NaN */ if((ix|((u_int32_t)(lx|-lx))>>31)>0x7ff00000) return x+x; if(n<0){ n = -n; x = -x; hx ^= 0x80000000; } if(n==0) return(__ieee754_j0(x)); if(n==1) return(__ieee754_j1(x)); sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */ x = fabs(x); if((ix|lx)==0||ix>=0x7ff00000) /* if x is 0 or inf */ b = zero; else if((double)n<=x) { /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ if(ix>=0x52D00000) { /* x > 2**302 */ /* (x >> n**2) * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Let s=sin(x), c=cos(x), * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then * * n sin(xn)*sqt2 cos(xn)*sqt2 * ---------------------------------- * 0 s-c c+s * 1 -s-c -c+s * 2 -s+c -c-s * 3 s+c c-s */ switch(n&3) { case 0: temp = cos(x)+sin(x); break; case 1: temp = -cos(x)+sin(x); break; case 2: temp = -cos(x)-sin(x); break; case 3: temp = cos(x)-sin(x); break; } b = invsqrtpi*temp/sqrt(x); } else { a = __ieee754_j0(x); b = __ieee754_j1(x); for(i=1;i33) /* underflow */ b = zero; else { temp = x*0.5; b = temp; for (a=one,i=2;i<=n;i++) { a *= (double)i; /* a = n! */ b *= temp; /* b = (x/2)^n */ } b = b/a; } } else { /* use backward recurrence */ /* x x^2 x^2 * J(n,x)/J(n-1,x) = ---- ------ ------ ..... * 2n - 2(n+1) - 2(n+2) * * 1 1 1 * (for large x) = ---- ------ ------ ..... * 2n 2(n+1) 2(n+2) * -- - ------ - ------ - * x x x * * Let w = 2n/x and h=2/x, then the above quotient * is equal to the continued fraction: * 1 * = ----------------------- * 1 * w - ----------------- * 1 * w+h - --------- * w+2h - ... * * To determine how many terms needed, let * Q(0) = w, Q(1) = w(w+h) - 1, * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), * When Q(k) > 1e4 good for single * When Q(k) > 1e9 good for double * When Q(k) > 1e17 good for quadruple */ /* determine k */ double t,v; double q0,q1,h,tmp; int32_t k,m; w = (n+n)/(double)x; h = 2.0/(double)x; q0 = w; z = w+h; q1 = w*z - 1.0; k=1; while(q1<1.0e9) { k += 1; z += h; tmp = z*q1 - q0; q0 = q1; q1 = tmp; } m = n+n; for(t=zero, i = 2*(n+k); i>=m; i -= 2) t = one/(i/x-t); a = t; b = one; /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) * Hence, if n*(log(2n/x)) > ... * single 8.8722839355e+01 * double 7.09782712893383973096e+02 * long double 1.1356523406294143949491931077970765006170e+04 * then recurrent value may overflow and the result is * likely underflow to zero */ tmp = n; v = two/x; tmp = tmp*__ieee754_log(fabs(v*tmp)); if(tmp<7.09782712893383973096e+02) { for(i=n-1,di=(double)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; } } else { for(i=n-1,di=(double)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; /* scale b to avoid spurious overflow */ if(b>1e100) { a /= b; t /= b; b = one; } } } z = __ieee754_j0(x); w = __ieee754_j1(x); if (fabs(z) >= fabs(w)) b = (t*z/b); else b = (t*w/a); } } if(sgn==1) return -b; else return b; } OLM_DLLEXPORT double __ieee754_yn(int n, double x) { int32_t i,hx,ix,lx; int32_t sign; double a, b, temp; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* if Y(n,NaN) is NaN */ if((ix|((u_int32_t)(lx|-lx))>>31)>0x7ff00000) return x+x; if((ix|lx)==0) return -one/zero; if(hx<0) return zero/zero; sign = 1; if(n<0){ n = -n; sign = 1 - ((n&1)<<1); } if(n==0) return(__ieee754_y0(x)); if(n==1) return(sign*__ieee754_y1(x)); if(ix==0x7ff00000) return zero; if(ix>=0x52D00000) { /* x > 2**302 */ /* (x >> n**2) * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Let s=sin(x), c=cos(x), * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then * * n sin(xn)*sqt2 cos(xn)*sqt2 * ---------------------------------- * 0 s-c c+s * 1 -s-c -c+s * 2 -s+c -c-s * 3 s+c c-s */ switch(n&3) { case 0: temp = sin(x)-cos(x); break; case 1: temp = -sin(x)-cos(x); break; case 2: temp = -sin(x)+cos(x); break; case 3: temp = sin(x)+cos(x); break; } b = invsqrtpi*temp/sqrt(x); } else { u_int32_t high; a = __ieee754_y0(x); b = __ieee754_y1(x); /* quit if b is -inf */ GET_HIGH_WORD(high,b); for(i=1;i0) return b; else return -b; } wcc-0.0.2/src/wsh/openlibm/src/e_log2.c0000644000175000017500000000715613122010155016235 0ustar philphil /* @(#)e_log10.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_log2.c,v 1.4 2011/10/15 05:23:28 das Exp $"); /* * Return the base 2 logarithm of x. See e_log.c and k_log.h for most * comments. * * This reduces x to {k, 1+f} exactly as in e_log.c, then calls the kernel, * then does the combining and scaling steps * log2(x) = (f - 0.5*f*f + k_log1p(f)) / ln2 + k * in not-quite-routine extra precision. */ #include #include "math_private.h" #include "k_log.h" static const double two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ ivln2hi = 1.44269504072144627571e+00, /* 0x3ff71547, 0x65200000 */ ivln2lo = 1.67517131648865118353e-10; /* 0x3de705fc, 0x2eefa200 */ static const double zero = 0.0; OLM_DLLEXPORT double __ieee754_log2(double x) { double f,hfsq,hi,lo,r,val_hi,val_lo,w,y; int32_t i,k,hx; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); k=0; if (hx < 0x00100000) { /* x < 2**-1022 */ if (((hx&0x7fffffff)|lx)==0) return -two54/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 54; x *= two54; /* subnormal number, scale up x */ GET_HIGH_WORD(hx,x); } if (hx >= 0x7ff00000) return x+x; if (hx == 0x3ff00000 && lx == 0) return zero; /* log(1) = +0 */ k += (hx>>20)-1023; hx &= 0x000fffff; i = (hx+0x95f64)&0x100000; SET_HIGH_WORD(x,hx|(i^0x3ff00000)); /* normalize x or x/2 */ k += (i>>20); y = (double)k; f = x - 1.0; hfsq = 0.5*f*f; r = k_log1p(f); /* * f-hfsq must (for args near 1) be evaluated in extra precision * to avoid a large cancellation when x is near sqrt(2) or 1/sqrt(2). * This is fairly efficient since f-hfsq only depends on f, so can * be evaluated in parallel with R. Not combining hfsq with R also * keeps R small (though not as small as a true `lo' term would be), * so that extra precision is not needed for terms involving R. * * Compiler bugs involving extra precision used to break Dekker's * theorem for spitting f-hfsq as hi+lo, unless double_t was used * or the multi-precision calculations were avoided when double_t * has extra precision. These problems are now automatically * avoided as a side effect of the optimization of combining the * Dekker splitting step with the clear-low-bits step. * * y must (for args near sqrt(2) and 1/sqrt(2)) be added in extra * precision to avoid a very large cancellation when x is very near * these values. Unlike the above cancellations, this problem is * specific to base 2. It is strange that adding +-1 is so much * harder than adding +-ln2 or +-log10_2. * * This uses Dekker's theorem to normalize y+val_hi, so the * compiler bugs are back in some configurations, sigh. And I * don't want to used double_t to avoid them, since that gives a * pessimization and the support for avoiding the pessimization * is not yet available. * * The multi-precision calculations for the multiplications are * routine. */ hi = f - hfsq; SET_LOW_WORD(hi,0); lo = (f - hi) - hfsq + r; val_hi = hi*ivln2hi; val_lo = (lo+hi)*ivln2lo + lo*ivln2hi; /* spadd(val_hi, val_lo, y), except for not using double_t: */ w = y + val_hi; val_lo += (y - w) + val_hi; val_hi = w; return val_lo + val_hi; } wcc-0.0.2/src/wsh/openlibm/src/e_asin.c0000644000175000017500000000722313122010155016317 0ustar philphil /* @(#)e_asin.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_asin.c,v 1.15 2011/02/10 07:37:50 das Exp $"); /* __ieee754_asin(x) * Method : * Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ... * we approximate asin(x) on [0,0.5] by * asin(x) = x + x*x^2*R(x^2) * where * R(x^2) is a rational approximation of (asin(x)-x)/x^3 * and its remez error is bounded by * |(asin(x)-x)/x^3 - R(x^2)| < 2^(-58.75) * * For x in [0.5,1] * asin(x) = pi/2-2*asin(sqrt((1-x)/2)) * Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2; * then for x>0.98 * asin(x) = pi/2 - 2*(s+s*z*R(z)) * = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo) * For x<=0.98, let pio4_hi = pio2_hi/2, then * f = hi part of s; * c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z) * and * asin(x) = pi/2 - 2*(s+s*z*R(z)) * = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo) * = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c)) * * Special cases: * if x is NaN, return x itself; * if |x|>1, return NaN with invalid signal. * */ #include #include #include "math_private.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ huge = 1.000e+300, pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */ pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */ pio4_hi = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */ /* coefficient for R(x^2) */ pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */ pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */ pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */ pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */ pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */ pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */ qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */ qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */ qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */ qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */ OLM_DLLEXPORT double __ieee754_asin(double x) { double t=0.0,w,p,q,c,r,s; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>= 0x3ff00000) { /* |x|>= 1 */ u_int32_t lx; GET_LOW_WORD(lx,x); if(((ix-0x3ff00000)|lx)==0) /* asin(1)=+-pi/2 with inexact */ return x*pio2_hi+x*pio2_lo; return (x-x)/(x-x); /* asin(|x|>1) is NaN */ } else if (ix<0x3fe00000) { /* |x|<0.5 */ if(ix<0x3e500000) { /* if |x| < 2**-26 */ if(huge+x>one) return x;/* return x with inexact if x!=0*/ } t = x*x; p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5))))); q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4))); w = p/q; return x+x*w; } /* 1> |x|>= 0.5 */ w = one-fabs(x); t = w*0.5; p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5))))); q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4))); s = sqrt(t); if(ix>=0x3FEF3333) { /* if |x| > 0.975 */ w = p/q; t = pio2_hi-(2.0*(s+s*w)-pio2_lo); } else { w = s; SET_LOW_WORD(w,0); c = (t-w*w)/(s+w); r = p/q; p = 2.0*s*r-(pio2_lo-2.0*c); q = pio4_hi-2.0*w; t = pio4_hi-(p-q); } if(hx>0) return t; else return -t; } #if LDBL_MANT_DIG == 53 __weak_reference(asin, asinl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_ilogbf.c0000644000175000017500000000205313122010155016641 0ustar philphil/* s_ilogbf.c -- float version of s_ilogb.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ilogbf.c,v 1.8 2008/02/22 02:30:35 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT int ilogbf(float x) { int32_t hx,ix; GET_FLOAT_WORD(hx,x); hx &= 0x7fffffff; if(hx<0x00800000) { if(hx==0) return FP_ILOGB0; else /* subnormal x */ for (ix = -126,hx<<=8; hx>0; hx<<=1) ix -=1; return ix; } else if (hx<0x7f800000) return (hx>>23)-127; else if (hx>0x7f800000) return FP_ILOGBNAN; else return INT_MAX; } wcc-0.0.2/src/wsh/openlibm/src/s_rintf.c0000644000175000017500000000247113122010155016525 0ustar philphil/* s_rintf.c -- float version of s_rint.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_rintf.c,v 1.12 2008/02/22 02:30:35 das Exp $"); #include #include #include #include "math_private.h" static const float TWO23[2]={ 8.3886080000e+06, /* 0x4b000000 */ -8.3886080000e+06, /* 0xcb000000 */ }; OLM_DLLEXPORT float rintf(float x) { int32_t i0,j0,sx; float w,t; GET_FLOAT_WORD(i0,x); sx = (i0>>31)&1; j0 = ((i0>>23)&0xff)-0x7f; if(j0<23) { if(j0<0) { if((i0&0x7fffffff)==0) return x; STRICT_ASSIGN(float,w,TWO23[sx]+x); t = w-TWO23[sx]; GET_FLOAT_WORD(i0,t); SET_FLOAT_WORD(t,(i0&0x7fffffff)|(sx<<31)); return t; } STRICT_ASSIGN(float,w,TWO23[sx]+x); return w-TWO23[sx]; } if(j0==0x80) return x+x; /* inf or NaN */ else return x; /* x is integral */ } wcc-0.0.2/src/wsh/openlibm/src/s_csinh.c0000644000175000017500000001172213122010155016506 0ustar philphil/*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Hyperbolic sine of a complex argument z = x + i y. * * sinh(z) = sinh(x+iy) * = sinh(x) cos(y) + i cosh(x) sin(y). * * Exceptional values are noted in the comments within the source code. * These values and the return value were taken from n1124.pdf. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_csinh.c,v 1.2 2011/10/21 06:29:32 das Exp $"); #include #include #include "math_private.h" static const double huge = 0x1p1023; OLM_DLLEXPORT double complex csinh(double complex z) { double x, y, h; int32_t hx, hy, ix, iy, lx, ly; x = creal(z); y = cimag(z); EXTRACT_WORDS(hx, lx, x); EXTRACT_WORDS(hy, ly, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; /* Handle the nearly-non-exceptional cases where x and y are finite. */ if (ix < 0x7ff00000 && iy < 0x7ff00000) { if ((iy | ly) == 0) return (CMPLX(sinh(x), y)); if (ix < 0x40360000) /* small x: normal case */ return (CMPLX(sinh(x) * cos(y), cosh(x) * sin(y))); /* |x| >= 22, so cosh(x) ~= exp(|x|) */ if (ix < 0x40862e42) { /* x < 710: exp(|x|) won't overflow */ h = exp(fabs(x)) * 0.5; return (CMPLX(copysign(h, x) * cos(y), h * sin(y))); } else if (ix < 0x4096bbaa) { /* x < 1455: scale to avoid overflow */ z = __ldexp_cexp(CMPLX(fabs(x), y), -1); return (CMPLX(creal(z) * copysign(1, x), cimag(z))); } else { /* x >= 1455: the result always overflows */ h = huge * x; return (CMPLX(h * cos(y), h * h * sin(y))); } } /* * sinh(+-0 +- I Inf) = sign(d(+-0, dNaN))0 + I dNaN. * The sign of 0 in the result is unspecified. Choice = normally * the same as dNaN. Raise the invalid floating-point exception. * * sinh(+-0 +- I NaN) = sign(d(+-0, NaN))0 + I d(NaN). * The sign of 0 in the result is unspecified. Choice = normally * the same as d(NaN). */ if ((ix | lx) == 0 && iy >= 0x7ff00000) return (CMPLX(copysign(0, x * (y - y)), y - y)); /* * sinh(+-Inf +- I 0) = +-Inf + I +-0. * * sinh(NaN +- I 0) = d(NaN) + I +-0. */ if ((iy | ly) == 0 && ix >= 0x7ff00000) { if (((hx & 0xfffff) | lx) == 0) return (CMPLX(x, y)); return (CMPLX(x, copysign(0, y))); } /* * sinh(x +- I Inf) = dNaN + I dNaN. * Raise the invalid floating-point exception for finite nonzero x. * * sinh(x + I NaN) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero x. Choice = don't raise (except for signaling NaNs). */ if (ix < 0x7ff00000 && iy >= 0x7ff00000) return (CMPLX(y - y, x * (y - y))); /* * sinh(+-Inf + I NaN) = +-Inf + I d(NaN). * The sign of Inf in the result is unspecified. Choice = normally * the same as d(NaN). * * sinh(+-Inf +- I Inf) = +Inf + I dNaN. * The sign of Inf in the result is unspecified. Choice = always +. * Raise the invalid floating-point exception. * * sinh(+-Inf + I y) = +-Inf cos(y) + I Inf sin(y) */ if (ix >= 0x7ff00000 && ((hx & 0xfffff) | lx) == 0) { if (iy >= 0x7ff00000) return (CMPLX(x * x, x * (y - y))); return (CMPLX(x * cos(y), INFINITY * sin(y))); } /* * sinh(NaN + I NaN) = d(NaN) + I d(NaN). * * sinh(NaN +- I Inf) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception. * Choice = raise. * * sinh(NaN + I y) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero y. Choice = don't raise (except for signaling NaNs). */ return (CMPLX((x * x) * (y - y), (x + x) * (y - y))); } OLM_DLLEXPORT double complex csin(double complex z) { /* csin(z) = -I * csinh(I * z) */ z = csinh(CMPLX(-cimag(z), creal(z))); return (CMPLX(cimag(z), -creal(z))); } wcc-0.0.2/src/wsh/openlibm/src/s_fpclassify.c0000644000175000017500000000500413122010155017541 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * */ #include #include "math_private.h" #include "fpmath.h" OLM_DLLEXPORT int __fpclassifyd(double d) { union IEEEd2bits u; u.d = d; if (u.bits.exp == 2047) { if (u.bits.manl == 0 && u.bits.manh == 0) { return FP_INFINITE; } else { return FP_NAN; } } else if (u.bits.exp != 0) { return FP_NORMAL; } else if (u.bits.manl == 0 && u.bits.manh == 0) { return FP_ZERO; } else { return FP_SUBNORMAL; } } OLM_DLLEXPORT int __fpclassifyf(float f) { union IEEEf2bits u; u.f = f; if (u.bits.exp == 255) { if (u.bits.man == 0) { return FP_INFINITE; } else { return FP_NAN; } } else if (u.bits.exp != 0) { return FP_NORMAL; } else if (u.bits.man == 0) { return FP_ZERO; } else { return FP_SUBNORMAL; } } #ifdef LONG_DOUBLE OLM_DLLEXPORT int __fpclassifyl(long double e) { union IEEEl2bits u; u.e = e; mask_nbit_l(u); if (u.bits.exp == 32767) { if (u.bits.manl == 0 && u.bits.manh == 0) { return FP_INFINITE; } else { return FP_NAN; } } else if (u.bits.exp != 0) { return FP_NORMAL; } else if (u.bits.manl == 0 && u.bits.manh == 0) { return FP_ZERO; } else { return FP_SUBNORMAL; } } #endif wcc-0.0.2/src/wsh/openlibm/src/s_csin.c0000644000175000017500000000375513122010155016345 0ustar philphil/* $OpenBSD: s_csin.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* csin() * * Complex circular sine * * * * SYNOPSIS: * * double complex csin(); * double complex z, w; * * w = csin (z); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = sin x cosh y + i cos x sinh y. * * csin(z) = -i csinh(iz). * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8400 5.3e-17 1.3e-17 * IEEE -10,+10 30000 3.8e-16 1.0e-16 * Also tested by csin(casin(z)) = z. * */ #include #include #include /* calculate cosh and sinh */ static void cchsh(double x, double *c, double *s) { double e, ei; if (fabs(x) <= 0.5) { *c = cosh(x); *s = sinh(x); } else { e = exp(x); ei = 0.5/e; e = 0.5 * e; *s = e - ei; *c = e + ei; } } double complex csin(double complex z) { double complex w; double ch, sh; cchsh( cimag (z), &ch, &sh ); w = sin (creal(z)) * ch + (cos (creal(z)) * sh) * I; return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(csinl, csin); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_rint.c0000644000175000017500000000465713122010155016367 0ustar philphil/* @(#)s_rint.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_rint.c,v 1.16 2008/02/22 02:30:35 das Exp $"); /* * rint(x) * Return x rounded to integral value according to the prevailing * rounding mode. * Method: * Using floating addition. * Exception: * Inexact flag raised if x not equal to rint(x). */ #include #include #include "math_private.h" static const double TWO52[2]={ 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */ -4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */ }; OLM_DLLEXPORT double rint(double x) { int32_t i0,j0,sx; u_int32_t i,i1; double w,t; EXTRACT_WORDS(i0,i1,x); sx = (i0>>31)&1; j0 = ((i0>>20)&0x7ff)-0x3ff; if(j0<20) { if(j0<0) { if(((i0&0x7fffffff)|i1)==0) return x; i1 |= (i0&0x0fffff); i0 &= 0xfffe0000; i0 |= ((i1|-i1)>>12)&0x80000; SET_HIGH_WORD(x,i0); STRICT_ASSIGN(double,w,TWO52[sx]+x); t = w-TWO52[sx]; GET_HIGH_WORD(i0,t); SET_HIGH_WORD(t,(i0&0x7fffffff)|(sx<<31)); return t; } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) return x; /* x is integral */ i>>=1; if(((i0&i)|i1)!=0) { /* * Some bit is set after the 0.5 bit. To avoid the * possibility of errors from double rounding in * w = TWO52[sx]+x, adjust the 0.25 bit to a lower * guard bit. We do this for all j0<=51. The * adjustment is trickiest for j0==18 and j0==19 * since then it spans the word boundary. */ if(j0==19) i1 = 0x40000000; else if(j0==18) i1 = 0x80000000; else i0 = (i0&(~i))|((0x20000)>>j0); } } } else if (j0>51) { if(j0==0x400) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) return x; /* x is integral */ i>>=1; if((i1&i)!=0) i1 = (i1&(~i))|((0x40000000)>>(j0-20)); } INSERT_WORDS(x,i0,i1); STRICT_ASSIGN(double,w,TWO52[sx]+x); return w-TWO52[sx]; } #if (LDBL_MANT_DIG == 53) __weak_reference(rint, rintl); #endif wcc-0.0.2/src/wsh/openlibm/src/e_hypot.c0000644000175000017500000000656213122010155016535 0ustar philphil /* @(#)e_hypot.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_hypot.c,v 1.14 2011/10/15 07:00:28 das Exp $"); /* __ieee754_hypot(x,y) * * Method : * If (assume round-to-nearest) z=x*x+y*y * has error less than sqrt(2)/2 ulp, than * sqrt(z) has error less than 1 ulp (exercise). * * So, compute sqrt(x*x+y*y) with some care as * follows to get the error below 1 ulp: * * Assume x>y>0; * (if possible, set rounding to round-to-nearest) * 1. if x > 2y use * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y * where x1 = x with lower 32 bits cleared, x2 = x-x1; else * 2. if x <= 2y use * t1*y1+((x-y)*(x-y)+(t1*y2+t2*y)) * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1, * y1= y with lower 32 bits chopped, y2 = y-y1. * * NOTE: scaling may be necessary if some argument is too * large or too tiny * * Special cases: * hypot(x,y) is INF if x or y is +INF or -INF; else * hypot(x,y) is NAN if x or y is NAN. * * Accuracy: * hypot(x,y) returns sqrt(x^2+y^2) with error less * than 1 ulps (units in the last place) */ #include #include #include "math_private.h" OLM_DLLEXPORT double __ieee754_hypot(double x, double y) { double a,b,t1,t2,y1,y2,w; int32_t j,k,ha,hb; GET_HIGH_WORD(ha,x); ha &= 0x7fffffff; GET_HIGH_WORD(hb,y); hb &= 0x7fffffff; if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} a = fabs(a); b = fabs(b); if((ha-hb)>0x3c00000) {return a+b;} /* x/y > 2**60 */ k=0; if(ha > 0x5f300000) { /* a>2**500 */ if(ha >= 0x7ff00000) { /* Inf or NaN */ u_int32_t low; /* Use original arg order iff result is NaN; quieten sNaNs. */ w = fabs(x+0.0)-fabs(y+0.0); GET_LOW_WORD(low,a); if(((ha&0xfffff)|low)==0) w = a; GET_LOW_WORD(low,b); if(((hb^0x7ff00000)|low)==0) w = b; return w; } /* scale a and b by 2**-600 */ ha -= 0x25800000; hb -= 0x25800000; k += 600; SET_HIGH_WORD(a,ha); SET_HIGH_WORD(b,hb); } if(hb < 0x20b00000) { /* b < 2**-500 */ if(hb <= 0x000fffff) { /* subnormal b or 0 */ u_int32_t low; GET_LOW_WORD(low,b); if((hb|low)==0) return a; t1=0; SET_HIGH_WORD(t1,0x7fd00000); /* t1=2^1022 */ b *= t1; a *= t1; k -= 1022; } else { /* scale a and b by 2^600 */ ha += 0x25800000; /* a *= 2^600 */ hb += 0x25800000; /* b *= 2^600 */ k -= 600; SET_HIGH_WORD(a,ha); SET_HIGH_WORD(b,hb); } } /* medium size a and b */ w = a-b; if (w>b) { t1 = 0; SET_HIGH_WORD(t1,ha); t2 = a-t1; w = sqrt(t1*t1-(b*(-b)-t2*(a+t1))); } else { a = a+a; y1 = 0; SET_HIGH_WORD(y1,hb); y2 = b - y1; t1 = 0; SET_HIGH_WORD(t1,ha+0x00100000); t2 = a - t1; w = sqrt(t1*y1-(w*(-w)-(t1*y2+t2*b))); } if(k!=0) { u_int32_t high; t1 = 1.0; GET_HIGH_WORD(high,t1); SET_HIGH_WORD(t1,high+(k<<20)); return t1*w; } else return w; } #if LDBL_MANT_DIG == 53 __weak_reference(hypot, hypotl); #endif wcc-0.0.2/src/wsh/openlibm/src/k_tanf.c0000644000175000017500000000411213122010155016315 0ustar philphil/* k_tanf.c -- float version of k_tan.c * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved. * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef INLINE_KERNEL_TANDF #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_tanf.c,v 1.23 2009/06/03 08:16:34 ed Exp $"); #endif #include #include "math_private.h" /* |tan(x)/x - t(x)| < 2**-25.5 (~[-2e-08, 2e-08]). */ static const double T[] = { 0x15554d3418c99f.0p-54, /* 0.333331395030791399758 */ 0x1112fd38999f72.0p-55, /* 0.133392002712976742718 */ 0x1b54c91d865afe.0p-57, /* 0.0533812378445670393523 */ 0x191df3908c33ce.0p-58, /* 0.0245283181166547278873 */ 0x185dadfcecf44e.0p-61, /* 0.00297435743359967304927 */ 0x1362b9bf971bcd.0p-59, /* 0.00946564784943673166728 */ }; #ifndef INLINE_KERNEL_TANDF extern #endif //__inline float OLM_DLLEXPORT float __kernel_tandf(double x, int iy) { double z,r,w,s,t,u; z = x*x; /* * Split up the polynomial into small independent terms to give * opportunities for parallel evaluation. The chosen splitting is * micro-optimized for Athlons (XP, X64). It costs 2 multiplications * relative to Horner's method on sequential machines. * * We add the small terms from lowest degree up for efficiency on * non-sequential machines (the lowest degree terms tend to be ready * earlier). Apart from this, we don't care about order of * operations, and don't need to to care since we have precision to * spare. However, the chosen splitting is good for accuracy too, * and would give results as accurate as Horner's method if the * small terms were added from highest degree down. */ r = T[4]+z*T[5]; t = T[2]+z*T[3]; w = z*z; s = z*x; u = T[0]+z*T[1]; r = (x+s*u)+(s*w)*(t+w*r); if(iy==1) return r; else return -1.0/r; } wcc-0.0.2/src/wsh/openlibm/src/k_rem_pio2.c0000644000175000017500000003715313122010155017114 0ustar philphil /* @(#)k_rem_pio2.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_rem_pio2.c,v 1.11 2008/02/25 11:43:20 bde Exp $"); /* * __kernel_rem_pio2(x,y,e0,nx,prec) * double x[],y[]; int e0,nx,prec; * * __kernel_rem_pio2 return the last three digits of N with * y = x - N*pi/2 * so that |y| < pi/2. * * The method is to compute the integer (mod 8) and fraction parts of * (2/pi)*x without doing the full multiplication. In general we * skip the part of the product that are known to be a huge integer ( * more accurately, = 0 mod 8 ). Thus the number of operations are * independent of the exponent of the input. * * (2/pi) is represented by an array of 24-bit integers in ipio2[]. * * Input parameters: * x[] The input value (must be positive) is broken into nx * pieces of 24-bit integers in double precision format. * x[i] will be the i-th 24 bit of x. The scaled exponent * of x[0] is given in input parameter e0 (i.e., x[0]*2^e0 * match x's up to 24 bits. * * Example of breaking a double positive z into x[0]+x[1]+x[2]: * e0 = ilogb(z)-23 * z = scalbn(z,-e0) * for i = 0,1,2 * x[i] = floor(z) * z = (z-x[i])*2**24 * * * y[] ouput result in an array of double precision numbers. * The dimension of y[] is: * 24-bit precision 1 * 53-bit precision 2 * 64-bit precision 2 * 113-bit precision 3 * The actual value is the sum of them. Thus for 113-bit * precison, one may have to do something like: * * long double t,w,r_head, r_tail; * t = (long double)y[2] + (long double)y[1]; * w = (long double)y[0]; * r_head = t+w; * r_tail = w - (r_head - t); * * e0 The exponent of x[0]. Must be <= 16360 or you need to * expand the ipio2 table. * * nx dimension of x[] * * prec an integer indicating the precision: * 0 24 bits (single) * 1 53 bits (double) * 2 64 bits (extended) * 3 113 bits (quad) * * External function: * double scalbn(), floor(); * * * Here is the description of some local variables: * * jk jk+1 is the initial number of terms of ipio2[] needed * in the computation. The minimum and recommended value * for jk is 3,4,4,6 for single, double, extended, and quad. * jk+1 must be 2 larger than you might expect so that our * recomputation test works. (Up to 24 bits in the integer * part (the 24 bits of it that we compute) and 23 bits in * the fraction part may be lost to cancelation before we * recompute.) * * jz local integer variable indicating the number of * terms of ipio2[] used. * * jx nx - 1 * * jv index for pointing to the suitable ipio2[] for the * computation. In general, we want * ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8 * is an integer. Thus * e0-3-24*jv >= 0 or (e0-3)/24 >= jv * Hence jv = max(0,(e0-3)/24). * * jp jp+1 is the number of terms in PIo2[] needed, jp = jk. * * q[] double array with integral value, representing the * 24-bits chunk of the product of x and 2/pi. * * q0 the corresponding exponent of q[0]. Note that the * exponent for q[i] would be q0-24*i. * * PIo2[] double precision array, obtained by cutting pi/2 * into 24 bits chunks. * * f[] ipio2[] in floating point * * iq[] integer array by breaking up q[] in 24-bits chunk. * * fq[] final product of x*(2/pi) in fq[0],..,fq[jk] * * ih integer. If >0 it indicates q[] is >= 0.5, hence * it also indicates the *sign* of the result. * */ /* * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include #include #include "math_private.h" static const int init_jk[] = {3,4,4,6}; /* initial value for jk */ /* * Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi * * integer array, contains the (24*i)-th to (24*i+23)-th * bit of 2/pi after binary point. The corresponding * floating value is * * ipio2[i] * 2^(-24(i+1)). * * NB: This table must have at least (e0-3)/24 + jk terms. * For quad precision (e0 <= 16360, jk = 6), this is 686. */ static const int32_t ipio2[] = { 0xA2F983, 0x6E4E44, 0x1529FC, 0x2757D1, 0xF534DD, 0xC0DB62, 0x95993C, 0x439041, 0xFE5163, 0xABDEBB, 0xC561B7, 0x246E3A, 0x424DD2, 0xE00649, 0x2EEA09, 0xD1921C, 0xFE1DEB, 0x1CB129, 0xA73EE8, 0x8235F5, 0x2EBB44, 0x84E99C, 0x7026B4, 0x5F7E41, 0x3991D6, 0x398353, 0x39F49C, 0x845F8B, 0xBDF928, 0x3B1FF8, 0x97FFDE, 0x05980F, 0xEF2F11, 0x8B5A0A, 0x6D1F6D, 0x367ECF, 0x27CB09, 0xB74F46, 0x3F669E, 0x5FEA2D, 0x7527BA, 0xC7EBE5, 0xF17B3D, 0x0739F7, 0x8A5292, 0xEA6BFB, 0x5FB11F, 0x8D5D08, 0x560330, 0x46FC7B, 0x6BABF0, 0xCFBC20, 0x9AF436, 0x1DA9E3, 0x91615E, 0xE61B08, 0x659985, 0x5F14A0, 0x68408D, 0xFFD880, 0x4D7327, 0x310606, 0x1556CA, 0x73A8C9, 0x60E27B, 0xC08C6B, #if LDBL_MAX_EXP > 1024 #if LDBL_MAX_EXP > 16384 #error "ipio2 table needs to be expanded" #endif 0x47C419, 0xC367CD, 0xDCE809, 0x2A8359, 0xC4768B, 0x961CA6, 0xDDAF44, 0xD15719, 0x053EA5, 0xFF0705, 0x3F7E33, 0xE832C2, 0xDE4F98, 0x327DBB, 0xC33D26, 0xEF6B1E, 0x5EF89F, 0x3A1F35, 0xCAF27F, 0x1D87F1, 0x21907C, 0x7C246A, 0xFA6ED5, 0x772D30, 0x433B15, 0xC614B5, 0x9D19C3, 0xC2C4AD, 0x414D2C, 0x5D000C, 0x467D86, 0x2D71E3, 0x9AC69B, 0x006233, 0x7CD2B4, 0x97A7B4, 0xD55537, 0xF63ED7, 0x1810A3, 0xFC764D, 0x2A9D64, 0xABD770, 0xF87C63, 0x57B07A, 0xE71517, 0x5649C0, 0xD9D63B, 0x3884A7, 0xCB2324, 0x778AD6, 0x23545A, 0xB91F00, 0x1B0AF1, 0xDFCE19, 0xFF319F, 0x6A1E66, 0x615799, 0x47FBAC, 0xD87F7E, 0xB76522, 0x89E832, 0x60BFE6, 0xCDC4EF, 0x09366C, 0xD43F5D, 0xD7DE16, 0xDE3B58, 0x929BDE, 0x2822D2, 0xE88628, 0x4D58E2, 0x32CAC6, 0x16E308, 0xCB7DE0, 0x50C017, 0xA71DF3, 0x5BE018, 0x34132E, 0x621283, 0x014883, 0x5B8EF5, 0x7FB0AD, 0xF2E91E, 0x434A48, 0xD36710, 0xD8DDAA, 0x425FAE, 0xCE616A, 0xA4280A, 0xB499D3, 0xF2A606, 0x7F775C, 0x83C2A3, 0x883C61, 0x78738A, 0x5A8CAF, 0xBDD76F, 0x63A62D, 0xCBBFF4, 0xEF818D, 0x67C126, 0x45CA55, 0x36D9CA, 0xD2A828, 0x8D61C2, 0x77C912, 0x142604, 0x9B4612, 0xC459C4, 0x44C5C8, 0x91B24D, 0xF31700, 0xAD43D4, 0xE54929, 0x10D5FD, 0xFCBE00, 0xCC941E, 0xEECE70, 0xF53E13, 0x80F1EC, 0xC3E7B3, 0x28F8C7, 0x940593, 0x3E71C1, 0xB3092E, 0xF3450B, 0x9C1288, 0x7B20AB, 0x9FB52E, 0xC29247, 0x2F327B, 0x6D550C, 0x90A772, 0x1FE76B, 0x96CB31, 0x4A1679, 0xE27941, 0x89DFF4, 0x9794E8, 0x84E6E2, 0x973199, 0x6BED88, 0x365F5F, 0x0EFDBB, 0xB49A48, 0x6CA467, 0x427271, 0x325D8D, 0xB8159F, 0x09E5BC, 0x25318D, 0x3974F7, 0x1C0530, 0x010C0D, 0x68084B, 0x58EE2C, 0x90AA47, 0x02E774, 0x24D6BD, 0xA67DF7, 0x72486E, 0xEF169F, 0xA6948E, 0xF691B4, 0x5153D1, 0xF20ACF, 0x339820, 0x7E4BF5, 0x6863B2, 0x5F3EDD, 0x035D40, 0x7F8985, 0x295255, 0xC06437, 0x10D86D, 0x324832, 0x754C5B, 0xD4714E, 0x6E5445, 0xC1090B, 0x69F52A, 0xD56614, 0x9D0727, 0x50045D, 0xDB3BB4, 0xC576EA, 0x17F987, 0x7D6B49, 0xBA271D, 0x296996, 0xACCCC6, 0x5414AD, 0x6AE290, 0x89D988, 0x50722C, 0xBEA404, 0x940777, 0x7030F3, 0x27FC00, 0xA871EA, 0x49C266, 0x3DE064, 0x83DD97, 0x973FA3, 0xFD9443, 0x8C860D, 0xDE4131, 0x9D3992, 0x8C70DD, 0xE7B717, 0x3BDF08, 0x2B3715, 0xA0805C, 0x93805A, 0x921110, 0xD8E80F, 0xAF806C, 0x4BFFDB, 0x0F9038, 0x761859, 0x15A562, 0xBBCB61, 0xB989C7, 0xBD4010, 0x04F2D2, 0x277549, 0xF6B6EB, 0xBB22DB, 0xAA140A, 0x2F2689, 0x768364, 0x333B09, 0x1A940E, 0xAA3A51, 0xC2A31D, 0xAEEDAF, 0x12265C, 0x4DC26D, 0x9C7A2D, 0x9756C0, 0x833F03, 0xF6F009, 0x8C402B, 0x99316D, 0x07B439, 0x15200C, 0x5BC3D8, 0xC492F5, 0x4BADC6, 0xA5CA4E, 0xCD37A7, 0x36A9E6, 0x9492AB, 0x6842DD, 0xDE6319, 0xEF8C76, 0x528B68, 0x37DBFC, 0xABA1AE, 0x3115DF, 0xA1AE00, 0xDAFB0C, 0x664D64, 0xB705ED, 0x306529, 0xBF5657, 0x3AFF47, 0xB9F96A, 0xF3BE75, 0xDF9328, 0x3080AB, 0xF68C66, 0x15CB04, 0x0622FA, 0x1DE4D9, 0xA4B33D, 0x8F1B57, 0x09CD36, 0xE9424E, 0xA4BE13, 0xB52333, 0x1AAAF0, 0xA8654F, 0xA5C1D2, 0x0F3F0B, 0xCD785B, 0x76F923, 0x048B7B, 0x721789, 0x53A6C6, 0xE26E6F, 0x00EBEF, 0x584A9B, 0xB7DAC4, 0xBA66AA, 0xCFCF76, 0x1D02D1, 0x2DF1B1, 0xC1998C, 0x77ADC3, 0xDA4886, 0xA05DF7, 0xF480C6, 0x2FF0AC, 0x9AECDD, 0xBC5C3F, 0x6DDED0, 0x1FC790, 0xB6DB2A, 0x3A25A3, 0x9AAF00, 0x9353AD, 0x0457B6, 0xB42D29, 0x7E804B, 0xA707DA, 0x0EAA76, 0xA1597B, 0x2A1216, 0x2DB7DC, 0xFDE5FA, 0xFEDB89, 0xFDBE89, 0x6C76E4, 0xFCA906, 0x70803E, 0x156E85, 0xFF87FD, 0x073E28, 0x336761, 0x86182A, 0xEABD4D, 0xAFE7B3, 0x6E6D8F, 0x396795, 0x5BBF31, 0x48D784, 0x16DF30, 0x432DC7, 0x356125, 0xCE70C9, 0xB8CB30, 0xFD6CBF, 0xA200A4, 0xE46C05, 0xA0DD5A, 0x476F21, 0xD21262, 0x845CB9, 0x496170, 0xE0566B, 0x015299, 0x375550, 0xB7D51E, 0xC4F133, 0x5F6E13, 0xE4305D, 0xA92E85, 0xC3B21D, 0x3632A1, 0xA4B708, 0xD4B1EA, 0x21F716, 0xE4698F, 0x77FF27, 0x80030C, 0x2D408D, 0xA0CD4F, 0x99A520, 0xD3A2B3, 0x0A5D2F, 0x42F9B4, 0xCBDA11, 0xD0BE7D, 0xC1DB9B, 0xBD17AB, 0x81A2CA, 0x5C6A08, 0x17552E, 0x550027, 0xF0147F, 0x8607E1, 0x640B14, 0x8D4196, 0xDEBE87, 0x2AFDDA, 0xB6256B, 0x34897B, 0xFEF305, 0x9EBFB9, 0x4F6A68, 0xA82A4A, 0x5AC44F, 0xBCF82D, 0x985AD7, 0x95C7F4, 0x8D4D0D, 0xA63A20, 0x5F57A4, 0xB13F14, 0x953880, 0x0120CC, 0x86DD71, 0xB6DEC9, 0xF560BF, 0x11654D, 0x6B0701, 0xACB08C, 0xD0C0B2, 0x485551, 0x0EFB1E, 0xC37295, 0x3B06A3, 0x3540C0, 0x7BDC06, 0xCC45E0, 0xFA294E, 0xC8CAD6, 0x41F3E8, 0xDE647C, 0xD8649B, 0x31BED9, 0xC397A4, 0xD45877, 0xC5E369, 0x13DAF0, 0x3C3ABA, 0x461846, 0x5F7555, 0xF5BDD2, 0xC6926E, 0x5D2EAC, 0xED440E, 0x423E1C, 0x87C461, 0xE9FD29, 0xF3D6E7, 0xCA7C22, 0x35916F, 0xC5E008, 0x8DD7FF, 0xE26A6E, 0xC6FDB0, 0xC10893, 0x745D7C, 0xB2AD6B, 0x9D6ECD, 0x7B723E, 0x6A11C6, 0xA9CFF7, 0xDF7329, 0xBAC9B5, 0x5100B7, 0x0DB2E2, 0x24BA74, 0x607DE5, 0x8AD874, 0x2C150D, 0x0C1881, 0x94667E, 0x162901, 0x767A9F, 0xBEFDFD, 0xEF4556, 0x367ED9, 0x13D9EC, 0xB9BA8B, 0xFC97C4, 0x27A831, 0xC36EF1, 0x36C594, 0x56A8D8, 0xB5A8B4, 0x0ECCCF, 0x2D8912, 0x34576F, 0x89562C, 0xE3CE99, 0xB920D6, 0xAA5E6B, 0x9C2A3E, 0xCC5F11, 0x4A0BFD, 0xFBF4E1, 0x6D3B8E, 0x2C86E2, 0x84D4E9, 0xA9B4FC, 0xD1EEEF, 0xC9352E, 0x61392F, 0x442138, 0xC8D91B, 0x0AFC81, 0x6A4AFB, 0xD81C2F, 0x84B453, 0x8C994E, 0xCC2254, 0xDC552A, 0xD6C6C0, 0x96190B, 0xB8701A, 0x649569, 0x605A26, 0xEE523F, 0x0F117F, 0x11B5F4, 0xF5CBFC, 0x2DBC34, 0xEEBC34, 0xCC5DE8, 0x605EDD, 0x9B8E67, 0xEF3392, 0xB817C9, 0x9B5861, 0xBC57E1, 0xC68351, 0x103ED8, 0x4871DD, 0xDD1C2D, 0xA118AF, 0x462C21, 0xD7F359, 0x987AD9, 0xC0549E, 0xFA864F, 0xFC0656, 0xAE79E5, 0x362289, 0x22AD38, 0xDC9367, 0xAAE855, 0x382682, 0x9BE7CA, 0xA40D51, 0xB13399, 0x0ED7A9, 0x480569, 0xF0B265, 0xA7887F, 0x974C88, 0x36D1F9, 0xB39221, 0x4A827B, 0x21CF98, 0xDC9F40, 0x5547DC, 0x3A74E1, 0x42EB67, 0xDF9DFE, 0x5FD45E, 0xA4677B, 0x7AACBA, 0xA2F655, 0x23882B, 0x55BA41, 0x086E59, 0x862A21, 0x834739, 0xE6E389, 0xD49EE5, 0x40FB49, 0xE956FF, 0xCA0F1C, 0x8A59C5, 0x2BFA94, 0xC5C1D3, 0xCFC50F, 0xAE5ADB, 0x86C547, 0x624385, 0x3B8621, 0x94792C, 0x876110, 0x7B4C2A, 0x1A2C80, 0x12BF43, 0x902688, 0x893C78, 0xE4C4A8, 0x7BDBE5, 0xC23AC4, 0xEAF426, 0x8A67F7, 0xBF920D, 0x2BA365, 0xB1933D, 0x0B7CBD, 0xDC51A4, 0x63DD27, 0xDDE169, 0x19949A, 0x9529A8, 0x28CE68, 0xB4ED09, 0x209F44, 0xCA984E, 0x638270, 0x237C7E, 0x32B90F, 0x8EF5A7, 0xE75614, 0x08F121, 0x2A9DB5, 0x4D7E6F, 0x5119A5, 0xABF9B5, 0xD6DF82, 0x61DD96, 0x023616, 0x9F3AC4, 0xA1A283, 0x6DED72, 0x7A8D39, 0xA9B882, 0x5C326B, 0x5B2746, 0xED3400, 0x7700D2, 0x55F4FC, 0x4D5901, 0x8071E0, #endif }; static const double PIo2[] = { 1.57079625129699707031e+00, /* 0x3FF921FB, 0x40000000 */ 7.54978941586159635335e-08, /* 0x3E74442D, 0x00000000 */ 5.39030252995776476554e-15, /* 0x3CF84698, 0x80000000 */ 3.28200341580791294123e-22, /* 0x3B78CC51, 0x60000000 */ 1.27065575308067607349e-29, /* 0x39F01B83, 0x80000000 */ 1.22933308981111328932e-36, /* 0x387A2520, 0x40000000 */ 2.73370053816464559624e-44, /* 0x36E38222, 0x80000000 */ 2.16741683877804819444e-51, /* 0x3569F31D, 0x00000000 */ }; static const double zero = 0.0, one = 1.0, two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */ twon24 = 5.96046447753906250000e-08; /* 0x3E700000, 0x00000000 */ OLM_DLLEXPORT int __kernel_rem_pio2(double *x, double *y, int e0, int nx, int prec) { int32_t jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih; double z,fw,f[20],fq[20],q[20]; /* initialize jk*/ jk = init_jk[prec]; jp = jk; /* determine jx,jv,q0, note that 3>q0 */ jx = nx-1; jv = (e0-3)/24; if(jv<0) jv=0; q0 = e0-24*(jv+1); /* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */ j = jv-jx; m = jx+jk; for(i=0;i<=m;i++,j++) f[i] = (j<0)? zero : (double) ipio2[j]; /* compute q[0],q[1],...q[jk] */ for (i=0;i<=jk;i++) { for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw; } jz = jk; recompute: /* distill q[] into iq[] reversingly */ for(i=0,j=jz,z=q[jz];j>0;i++,j--) { fw = (double)((int32_t)(twon24* z)); iq[i] = (int32_t)(z-two24*fw); z = q[j-1]+fw; } /* compute n */ z = scalbn(z,q0); /* actual value of z */ z -= 8.0*floor(z*0.125); /* trim off integer >= 8 */ n = (int32_t) z; z -= (double)n; ih = 0; if(q0>0) { /* need iq[jz-1] to determine n */ i = (iq[jz-1]>>(24-q0)); n += i; iq[jz-1] -= i<<(24-q0); ih = iq[jz-1]>>(23-q0); } else if(q0==0) ih = iq[jz-1]>>23; else if(z>=0.5) ih=2; if(ih>0) { /* q > 0.5 */ n += 1; carry = 0; for(i=0;i0) { /* rare case: chance is 1 in 12 */ switch(q0) { case 1: iq[jz-1] &= 0x7fffff; break; case 2: iq[jz-1] &= 0x3fffff; break; } } if(ih==2) { z = one - z; if(carry!=0) z -= scalbn(one,q0); } } /* check if recomputation is needed */ if(z==zero) { j = 0; for (i=jz-1;i>=jk;i--) j |= iq[i]; if(j==0) { /* need recomputation */ for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */ for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */ f[jx+i] = (double) ipio2[jv+i]; for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw; } jz += k; goto recompute; } } /* chop off zero terms */ if(z==0.0) { jz -= 1; q0 -= 24; while(iq[jz]==0) { jz--; q0-=24;} } else { /* break z into 24-bit if necessary */ z = scalbn(z,-q0); if(z>=two24) { fw = (double)((int32_t)(twon24*z)); iq[jz] = (int32_t)(z-two24*fw); jz += 1; q0 += 24; iq[jz] = (int32_t) fw; } else iq[jz] = (int32_t) z ; } /* convert integer "bit" chunk to floating-point value */ fw = scalbn(one,q0); for(i=jz;i>=0;i--) { q[i] = fw*(double)iq[i]; fw*=twon24; } /* compute PIo2[0,...,jp]*q[jz,...,0] */ for(i=jz;i>=0;i--) { for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k]; fq[jz-i] = fw; } /* compress fq[] into y[] */ switch(prec) { case 0: fw = 0.0; for (i=jz;i>=0;i--) fw += fq[i]; y[0] = (ih==0)? fw: -fw; break; case 1: case 2: fw = 0.0; for (i=jz;i>=0;i--) fw += fq[i]; STRICT_ASSIGN(double,fw,fw); y[0] = (ih==0)? fw: -fw; fw = fq[0]-fw; for (i=1;i<=jz;i++) fw += fq[i]; y[1] = (ih==0)? fw: -fw; break; case 3: /* painful */ for (i=jz;i>0;i--) { fw = fq[i-1]+fq[i]; fq[i] += fq[i-1]-fw; fq[i-1] = fw; } for (i=jz;i>1;i--) { fw = fq[i-1]+fq[i]; fq[i] += fq[i-1]-fw; fq[i-1] = fw; } for (fw=0.0,i=jz;i>=2;i--) fw += fq[i]; if(ih==0) { y[0] = fq[0]; y[1] = fq[1]; y[2] = fw; } else { y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw; } } return n&7; } wcc-0.0.2/src/wsh/openlibm/src/w_cabsl.c0000644000175000017500000000074413122010155016474 0ustar philphil/* * cabs() wrapper for hypot(). * * Written by J.T. Conklin, * Placed into the Public Domain, 1994. * * Modified by Steven G. Kargl for the long double type. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/w_cabsl.c,v 1.1 2008/03/30 20:02:03 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT long double cabsl(long double complex z) { return hypotl(creall(z), cimagl(z)); } wcc-0.0.2/src/wsh/openlibm/src/s_llroundf.c0000644000175000017500000000043713122010155017230 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_llroundf.c,v 1.2 2005/04/08 00:52:27 das Exp $"); #define type float #define roundit roundf #define dtype long long #define DTYPE_MIN LLONG_MIN #define DTYPE_MAX LLONG_MAX #define fn llroundf #include "s_lround.c" wcc-0.0.2/src/wsh/openlibm/src/k_sin.c0000644000175000017500000000455413122010155016170 0ustar philphil /* @(#)k_sin.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_sin.c,v 1.11 2008/02/19 12:54:14 bde Exp $"); /* __kernel_sin( x, y, iy) * kernel sin function on ~[-pi/4, pi/4] (except on -0), pi/4 ~ 0.7854 * Input x is assumed to be bounded by ~pi/4 in magnitude. * Input y is the tail of x. * Input iy indicates whether y is 0. (if iy=0, y assume to be 0). * * Algorithm * 1. Since sin(-x) = -sin(x), we need only to consider positive x. * 2. Callers must return sin(-0) = -0 without calling here since our * odd polynomial is not evaluated in a way that preserves -0. * Callers may do the optimization sin(x) ~ x for tiny x. * 3. sin(x) is approximated by a polynomial of degree 13 on * [0,pi/4] * 3 13 * sin(x) ~ x + S1*x + ... + S6*x * where * * |sin(x) 2 4 6 8 10 12 | -58 * |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2 * | x | * * 4. sin(x+y) = sin(x) + sin'(x')*y * ~ sin(x) + (1-x*x/2)*y * For better accuracy, let * 3 2 2 2 2 * r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6)))) * then 3 2 * sin(x) = x + (S1*x + (x *(r-y/2)+y)) */ #include #include "math_private.h" static const double half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */ S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */ S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */ S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */ S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */ S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */ OLM_DLLEXPORT double __kernel_sin(double x, double y, int iy) { double z,r,v,w; z = x*x; w = z*z; r = S2+z*(S3+z*S4) + z*w*(S5+z*S6); v = z*x; if(iy==0) return x+v*(S1+z*r); else return x-((z*(half*y-v*r)-y)-v*S1); } wcc-0.0.2/src/wsh/openlibm/src/s_cexp.c0000644000175000017500000000567313122010155016351 0ustar philphil/*- * Copyright (c) 2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cexp.c,v 1.3 2011/10/21 06:27:56 das Exp $"); #include #include #include "math_private.h" static const u_int32_t exp_ovfl = 0x40862e42, /* high bits of MAX_EXP * ln2 ~= 710 */ cexp_ovfl = 0x4096b8e4; /* (MAX_EXP - MIN_DENORM_EXP) * ln2 */ OLM_DLLEXPORT double complex cexp(double complex z) { double x, y, exp_x; u_int32_t hx, hy, lx, ly; x = creal(z); y = cimag(z); EXTRACT_WORDS(hy, ly, y); hy &= 0x7fffffff; /* cexp(x + I 0) = exp(x) + I 0 */ if ((hy | ly) == 0) return (CMPLX(exp(x), y)); EXTRACT_WORDS(hx, lx, x); /* cexp(0 + I y) = cos(y) + I sin(y) */ if (((hx & 0x7fffffff) | lx) == 0) return (CMPLX(cos(y), sin(y))); if (hy >= 0x7ff00000) { if (lx != 0 || (hx & 0x7fffffff) != 0x7ff00000) { /* cexp(finite|NaN +- I Inf|NaN) = NaN + I NaN */ return (CMPLX(y - y, y - y)); } else if (hx & 0x80000000) { /* cexp(-Inf +- I Inf|NaN) = 0 + I 0 */ return (CMPLX(0.0, 0.0)); } else { /* cexp(+Inf +- I Inf|NaN) = Inf + I NaN */ return (CMPLX(x, y - y)); } } if (hx >= exp_ovfl && hx <= cexp_ovfl) { /* * x is between 709.7 and 1454.3, so we must scale to avoid * overflow in exp(x). */ return (__ldexp_cexp(z, 0)); } else { /* * Cases covered here: * - x < exp_ovfl and exp(x) won't overflow (common case) * - x > cexp_ovfl, so exp(x) * s overflows for all s > 0 * - x = +-Inf (generated by exp()) * - x = NaN (spurious inexact exception from y) */ exp_x = exp(x); return (CMPLX(exp_x * cos(y), exp_x * sin(y))); } } wcc-0.0.2/src/wsh/openlibm/src/e_cosh.c0000644000175000017500000000434113122010155016317 0ustar philphil /* @(#)e_cosh.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_cosh.c,v 1.10 2011/10/21 06:28:47 das Exp $"); /* __ieee754_cosh(x) * Method : * mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2 * 1. Replace x by |x| (cosh(x) = cosh(-x)). * 2. * [ exp(x) - 1 ]^2 * 0 <= x <= ln2/2 : cosh(x) := 1 + ------------------- * 2*exp(x) * * exp(x) + 1/exp(x) * ln2/2 <= x <= 22 : cosh(x) := ------------------- * 2 * 22 <= x <= lnovft : cosh(x) := exp(x)/2 * lnovft <= x <= ln2ovft: cosh(x) := exp(x/2)/2 * exp(x/2) * ln2ovft < x : cosh(x) := huge*huge (overflow) * * Special cases: * cosh(x) is |x| if x is +INF, -INF, or NaN. * only cosh(0)=1 is exact for finite x. */ #include #include "math_private.h" static const double one = 1.0, half=0.5, huge = 1.0e300; OLM_DLLEXPORT double __ieee754_cosh(double x) { double t,w; int32_t ix; /* High word of |x|. */ GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; /* x is INF or NaN */ if(ix>=0x7ff00000) return x*x; /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */ if(ix<0x3fd62e43) { t = expm1(fabs(x)); w = one+t; if (ix<0x3c800000) return w; /* cosh(tiny) = 1 */ return one+(t*t)/(w+w); } /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */ if (ix < 0x40360000) { t = __ieee754_exp(fabs(x)); return half*t+half/t; } /* |x| in [22, log(maxdouble)] return half*exp(|x|) */ if (ix < 0x40862E42) return half*__ieee754_exp(fabs(x)); /* |x| in [log(maxdouble), overflowthresold] */ if (ix<=0x408633CE) return __ldexp_exp(fabs(x), -1); /* |x| > overflowthresold, cosh(x) overflow */ return huge*huge; } wcc-0.0.2/src/wsh/openlibm/src/e_coshf.c0000644000175000017500000000304713122010155016467 0ustar philphil/* e_coshf.c -- float version of e_cosh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_coshf.c,v 1.9 2011/10/21 06:28:47 das Exp $"); #include #include "math_private.h" static const float one = 1.0, half=0.5, huge = 1.0e30; OLM_DLLEXPORT float __ieee754_coshf(float x) { float t,w; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; /* x is INF or NaN */ if(ix>=0x7f800000) return x*x; /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */ if(ix<0x3eb17218) { t = expm1f(fabsf(x)); w = one+t; if (ix<0x39800000) return one; /* cosh(tiny) = 1 */ return one+(t*t)/(w+w); } /* |x| in [0.5*ln2,9], return (exp(|x|)+1/exp(|x|))/2; */ if (ix < 0x41100000) { t = __ieee754_expf(fabsf(x)); return half*t+half/t; } /* |x| in [9, log(maxfloat)] return half*exp(|x|) */ if (ix < 0x42b17217) return half*__ieee754_expf(fabsf(x)); /* |x| in [log(maxfloat), overflowthresold] */ if (ix<=0x42b2d4fc) return __ldexp_expf(fabsf(x), -1); /* |x| > overflowthresold, cosh(x) overflow */ return huge*huge; } wcc-0.0.2/src/wsh/openlibm/src/e_atanh.c0000644000175000017500000000322313122010155016454 0ustar philphil /* @(#)e_atanh.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_atanh.c,v 1.8 2008/02/22 02:30:34 das Exp $"); /* __ieee754_atanh(x) * Method : * 1.Reduced x to positive by atanh(-x) = -atanh(x) * 2.For x>=0.5 * 1 2x x * atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) * 2 1 - x 1 - x * * For x<0.5 * atanh(x) = 0.5*log1p(2x+2x*x/(1-x)) * * Special cases: * atanh(x) is NaN if |x| > 1 with signal; * atanh(NaN) is that NaN with no signal; * atanh(+-1) is +-INF with signal. * */ #include #include "math_private.h" static const double one = 1.0, huge = 1e300; static const double zero = 0.0; OLM_DLLEXPORT double __ieee754_atanh(double x) { double t; int32_t hx,ix; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); ix = hx&0x7fffffff; if ((ix|((lx|(-lx))>>31))>0x3ff00000) /* |x|>1 */ return (x-x)/(x-x); if(ix==0x3ff00000) return x/zero; if(ix<0x3e300000&&(huge+x)>zero) return x; /* x<2**-28 */ SET_HIGH_WORD(x,ix); if(ix<0x3fe00000) { /* x < 0.5 */ t = x+x; t = 0.5*log1p(t+t*x/(one-x)); } else t = 0.5*log1p((x+x)/(one-x)); if(hx>=0) return t; else return -t; } wcc-0.0.2/src/wsh/openlibm/src/s_ctanf.c0000644000175000017500000000550313122010155016475 0ustar philphil/* $OpenBSD: s_ctanf.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ctanf() * * Complex circular tangent * * * * SYNOPSIS: * * void ctanf(); * cmplxf z, w; * * ctanf( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * sin 2x + i sinh 2y * w = --------------------. * cos 2x + cosh 2y * * On the real axis the denominator is zero at odd multiples * of PI/2. The denominator is evaluated by its Taylor * series near these points. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 3.3e-7 5.1e-8 */ #include #include #define MACHEPF 3.0e-8 #define MAXNUMF 1.0e38f static const double DP1 = 3.140625; static const double DP2 = 9.67502593994140625E-4; static const double DP3 = 1.509957990978376432E-7; static float _redupif(float xx) { float x, t; long i; x = xx; t = x/(float)M_PI; if(t >= 0.0) t += 0.5; else t -= 0.5; i = t; /* the multiple */ t = i; t = ((x - t * DP1) - t * DP2) - t * DP3; return(t); } /* Taylor series expansion for cosh(2y) - cos(2x) */ static float _ctansf(float complex z) { float f, x, x2, y, y2, rn, t, d; x = fabsf(2.0f * crealf(z)); y = fabsf(2.0f * cimagf(z)); x = _redupif(x); x = x * x; y = y * y; x2 = 1.0f; y2 = 1.0f; f = 1.0f; rn = 0.0f; d = 0.0f; do { rn += 1.0f; f *= rn; rn += 1.0f; f *= rn; x2 *= x; y2 *= y; t = y2 + x2; t /= f; d += t; rn += 1.0f; f *= rn; rn += 1.0f; f *= rn; x2 *= x; y2 *= y; t = y2 - x2; t /= f; d += t; } while (fabsf(t/d) > MACHEPF) ; return(d); } float complex ctanf(float complex z) { float complex w; float d; d = cosf( 2.0f * crealf(z) ) + coshf( 2.0f * cimagf(z) ); if(fabsf(d) < 0.25f) d = _ctansf(z); if (d == 0.0f) { /*mtherr( "ctanf", OVERFLOW );*/ w = MAXNUMF + MAXNUMF * I; return (w); } w = sinf (2.0f * crealf(z)) / d + (sinhf (2.0f * cimagf(z)) / d) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/e_remainderf.c0000644000175000017500000000302313122010155017473 0ustar philphil/* e_remainderf.c -- float version of e_remainder.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_remainderf.c,v 1.8 2008/02/12 17:11:36 bde Exp $"); #include #include "math_private.h" static const float zero = 0.0; OLM_DLLEXPORT float __ieee754_remainderf(float x, float p) { int32_t hx,hp; u_int32_t sx; float p_half; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hp,p); sx = hx&0x80000000; hp &= 0x7fffffff; hx &= 0x7fffffff; /* purge off exception values */ if(hp==0) return (x*p)/(x*p); /* p = 0 */ if((hx>=0x7f800000)|| /* x not finite */ ((hp>0x7f800000))) /* p is NaN */ return ((long double)x*p)/((long double)x*p); if (hp<=0x7effffff) x = __ieee754_fmodf(x,p+p); /* now x < 2p */ if ((hx-hp)==0) return zero*x; x = fabsf(x); p = fabsf(p); if (hp<0x01000000) { if(x+x>p) { x-=p; if(x+x>=p) x -= p; } } else { p_half = (float)0.5*p; if(x>p_half) { x-=p; if(x>=p_half) x -= p; } } GET_FLOAT_WORD(hx,x); if ((hx&0x7fffffff)==0) hx = 0; SET_FLOAT_WORD(x,hx^sx); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_scalbnl.c0000644000175000017500000000366313122010155017025 0ustar philphil/* @(#)s_scalbn.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * scalbnl (long double x, int n) * scalbnl(x,n) returns x* 2**n computed by exponent * manipulation rather than by actually performing an * exponentiation or a multiplication. */ /* * We assume that a long double has a 15-bit exponent. On systems * where long double is the same as double, scalbnl() is an alias * for scalbn(), so we don't use this routine. */ #include "cdefs-compat.h" #include #include #include "fpmath.h" #include "math_private.h" #if LDBL_MAX_EXP != 0x4000 #error "Unsupported long double format" #endif static const long double huge = 0x1p16000L, tiny = 0x1p-16000L; OLM_DLLEXPORT long double scalbnl (long double x, int n) { union IEEEl2bits u; int k; u.e = x; k = u.bits.exp; /* extract exponent */ if (k==0) { /* 0 or subnormal x */ if ((u.bits.manh|u.bits.manl)==0) return x; /* +-0 */ u.e *= 0x1p+128; k = u.bits.exp - 128; if (n< -50000) return tiny*x; /*underflow*/ } if (k==0x7fff) return x+x; /* NaN or Inf */ k = k+n; if (k >= 0x7fff) return huge*copysignl(huge,x); /* overflow */ if (k > 0) /* normal result */ {u.bits.exp = k; return u.e;} if (k <= -128) { if (n > 50000) /* in case integer overflow in n+k */ return huge*copysign(huge,x); /*overflow*/ else return tiny*copysign(tiny,x); /*underflow*/ } k += 128; /* subnormal result */ u.bits.exp = k; return u.e*0x1p-128; } __strong_reference(scalbnl, ldexpl); wcc-0.0.2/src/wsh/openlibm/src/e_atan2l.c0000644000175000017500000000700213122010155016541 0ustar philphil /* @(#)e_atan2.c 1.3 95/01/18 */ /* FreeBSD: head/lib/msun/src/e_atan2.c 176451 2008-02-22 02:30:36Z das */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_atan2l.c,v 1.3 2008/08/02 19:17:00 das Exp $"); /* * See comments in e_atan2.c. * Converted to long double by David Schultz . */ #include #include #include "invtrig.h" #include "math_private.h" static volatile long double tiny = 1.0e-300; static const long double zero = 0.0; #ifdef __i386__ /* XXX Work around the fact that gcc truncates long double constants on i386 */ static volatile double pi1 = 3.14159265358979311600e+00, /* 0x1.921fb54442d18p+1 */ pi2 = 1.22514845490862001043e-16; /* 0x1.1a80000000000p-53 */ #define pi ((long double)pi1 + pi2) #else static const long double pi = 3.14159265358979323846264338327950280e+00L; #endif OLM_DLLEXPORT long double atan2l(long double y, long double x) { union IEEEl2bits ux, uy; long double z; int32_t k,m; int16_t exptx, expsignx, expty, expsigny; uy.e = y; expsigny = uy.xbits.expsign; expty = expsigny & 0x7fff; ux.e = x; expsignx = ux.xbits.expsign; exptx = expsignx & 0x7fff; if ((exptx==BIAS+LDBL_MAX_EXP && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl)!=0) || /* x is NaN */ (expty==BIAS+LDBL_MAX_EXP && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)!=0)) /* y is NaN */ return x+y; if (expsignx==BIAS && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl)==0) return atanl(y); /* x=1.0 */ m = ((expsigny>>15)&1)|((expsignx>>14)&2); /* 2*sign(x)+sign(y) */ /* when y = 0 */ if(expty==0 && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)==0) { switch(m) { case 0: case 1: return y; /* atan(+-0,+anything)=+-0 */ case 2: return pi+tiny;/* atan(+0,-anything) = pi */ case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */ } } /* when x = 0 */ if(exptx==0 && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl)==0) return (expsigny<0)? -pio2_hi-tiny: pio2_hi+tiny; /* when x is INF */ if(exptx==BIAS+LDBL_MAX_EXP) { if(expty==BIAS+LDBL_MAX_EXP) { switch(m) { case 0: return pio2_hi*0.5+tiny;/* atan(+INF,+INF) */ case 1: return -pio2_hi*0.5-tiny;/* atan(-INF,+INF) */ case 2: return 1.5*pio2_hi+tiny;/*atan(+INF,-INF)*/ case 3: return -1.5*pio2_hi-tiny;/*atan(-INF,-INF)*/ } } else { switch(m) { case 0: return zero ; /* atan(+...,+INF) */ case 1: return -zero ; /* atan(-...,+INF) */ case 2: return pi+tiny ; /* atan(+...,-INF) */ case 3: return -pi-tiny ; /* atan(-...,-INF) */ } } } /* when y is INF */ if(expty==BIAS+LDBL_MAX_EXP) return (expsigny<0)? -pio2_hi-tiny: pio2_hi+tiny; /* compute y/x */ k = expty-exptx; if(k > LDBL_MANT_DIG+2) { /* |y/x| huge */ z=pio2_hi+pio2_lo; m&=1; } else if(expsignx<0&&k<-LDBL_MANT_DIG-2) z=0.0; /* |y/x| tiny, x<0 */ else z=atanl(fabsl(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ case 1: return -z ; /* atan(-,+) */ case 2: return pi-(z-pi_lo);/* atan(+,-) */ default: /* case 3 */ return (z-pi_lo)-pi;/* atan(-,-) */ } } wcc-0.0.2/src/wsh/openlibm/src/s_cimag.c0000644000175000017500000000303013122010155016453 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_cimag.c,v 1.3 2009/03/14 18:24:15 das Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT double cimag(double complex z) { return (__imag__ z); } wcc-0.0.2/src/wsh/openlibm/src/s_ceilf.c0000644000175000017500000000252113122010155016461 0ustar philphil/* s_ceilf.c -- float version of s_ceil.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ceilf.c,v 1.8 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" static const float huge = 1.0e30; OLM_DLLEXPORT float ceilf(float x) { int32_t i0,j0; u_int32_t i; GET_FLOAT_WORD(i0,x); j0 = ((i0>>23)&0xff)-0x7f; if(j0<23) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */ if(i0<0) {i0=0x80000000;} else if(i0!=0) { i0=0x3f800000;} } } else { i = (0x007fffff)>>j0; if((i0&i)==0) return x; /* x is integral */ if(huge+x>(float)0.0) { /* raise inexact flag */ if(i0>0) i0 += (0x00800000)>>j0; i0 &= (~i); } } } else { if(j0==0x80) return x+x; /* inf or NaN */ else return x; /* x is integral */ } SET_FLOAT_WORD(x,i0); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_fma.c0000644000175000017500000001755413122010155016156 0ustar philphil/*- * Copyright (c) 2005-2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fma.c,v 1.8 2011/10/21 06:30:43 das Exp $"); #include #include #include #include "math_private.h" /* * A struct dd represents a floating-point number with twice the precision * of a double. We maintain the invariant that "hi" stores the 53 high-order * bits of the result. */ struct dd { double hi; double lo; }; /* * Compute a+b exactly, returning the exact result in a struct dd. We assume * that both a and b are finite, but make no assumptions about their relative * magnitudes. */ static inline struct dd dd_add(double a, double b) { struct dd ret; double s; ret.hi = a + b; s = ret.hi - a; ret.lo = (a - (ret.hi - s)) + (b - s); return (ret); } /* * Compute a+b, with a small tweak: The least significant bit of the * result is adjusted into a sticky bit summarizing all the bits that * were lost to rounding. This adjustment negates the effects of double * rounding when the result is added to another number with a higher * exponent. For an explanation of round and sticky bits, see any reference * on FPU design, e.g., * * J. Coonen. An Implementation Guide to a Proposed Standard for * Floating-Point Arithmetic. Computer, vol. 13, no. 1, Jan 1980. */ static inline double add_adjusted(double a, double b) { struct dd sum; u_int64_t hibits, lobits; sum = dd_add(a, b); if (sum.lo != 0) { EXTRACT_WORD64(hibits, sum.hi); if ((hibits & 1) == 0) { /* hibits += (int)copysign(1.0, sum.hi * sum.lo) */ EXTRACT_WORD64(lobits, sum.lo); hibits += 1 - ((hibits ^ lobits) >> 62); INSERT_WORD64(sum.hi, hibits); } } return (sum.hi); } /* * Compute ldexp(a+b, scale) with a single rounding error. It is assumed * that the result will be subnormal, and care is taken to ensure that * double rounding does not occur. */ static inline double add_and_denormalize(double a, double b, int scale) { struct dd sum; u_int64_t hibits, lobits; int bits_lost; sum = dd_add(a, b); /* * If we are losing at least two bits of accuracy to denormalization, * then the first lost bit becomes a round bit, and we adjust the * lowest bit of sum.hi to make it a sticky bit summarizing all the * bits in sum.lo. With the sticky bit adjusted, the hardware will * break any ties in the correct direction. * * If we are losing only one bit to denormalization, however, we must * break the ties manually. */ if (sum.lo != 0) { EXTRACT_WORD64(hibits, sum.hi); bits_lost = -((int)(hibits >> 52) & 0x7ff) - scale + 1; if ((bits_lost != 1) ^ (int)(hibits & 1)) { /* hibits += (int)copysign(1.0, sum.hi * sum.lo) */ EXTRACT_WORD64(lobits, sum.lo); hibits += 1 - (((hibits ^ lobits) >> 62) & 2); INSERT_WORD64(sum.hi, hibits); } } return (ldexp(sum.hi, scale)); } /* * Compute a*b exactly, returning the exact result in a struct dd. We assume * that both a and b are normalized, so no underflow or overflow will occur. * The current rounding mode must be round-to-nearest. */ static inline struct dd dd_mul(double a, double b) { static const double split = 0x1p27 + 1.0; struct dd ret; double ha, hb, la, lb, p, q; p = a * split; ha = a - p; ha += p; la = a - ha; p = b * split; hb = b - p; hb += p; lb = b - hb; p = ha * hb; q = ha * lb + la * hb; ret.hi = p + q; ret.lo = p - ret.hi + q + la * lb; return (ret); } /* * Fused multiply-add: Compute x * y + z with a single rounding error. * * We use scaling to avoid overflow/underflow, along with the * canonical precision-doubling technique adapted from: * * Dekker, T. A Floating-Point Technique for Extending the * Available Precision. Numer. Math. 18, 224-242 (1971). * * This algorithm is sensitive to the rounding precision. FPUs such * as the i387 must be set in double-precision mode if variables are * to be stored in FP registers in order to avoid incorrect results. * This is the default on FreeBSD, but not on many other systems. * * Hardware instructions should be used on architectures that support it, * since this implementation will likely be several times slower. */ OLM_DLLEXPORT double fma(double x, double y, double z) { double xs, ys, zs, adj; struct dd xy, r; int oround; int ex, ey, ez; int spread; /* * Handle special cases. The order of operations and the particular * return values here are crucial in handling special cases involving * infinities, NaNs, overflows, and signed zeroes correctly. */ if (x == 0.0 || y == 0.0) return (x * y + z); if (z == 0.0) return (x * y); if (!isfinite(x) || !isfinite(y)) return (x * y + z); if (!isfinite(z)) return (z); xs = frexp(x, &ex); ys = frexp(y, &ey); zs = frexp(z, &ez); oround = fegetround(); spread = ex + ey - ez; /* * If x * y and z are many orders of magnitude apart, the scaling * will overflow, so we handle these cases specially. Rounding * modes other than FE_TONEAREST are painful. */ if (spread < -DBL_MANT_DIG) { feraiseexcept(FE_INEXACT); if (!isnormal(z)) feraiseexcept(FE_UNDERFLOW); switch (oround) { case FE_TONEAREST: return (z); case FE_TOWARDZERO: if ((x > 0.0) ^ (y < 0.0) ^ (z < 0.0)) return (z); else return (nextafter(z, 0)); case FE_DOWNWARD: if ((x > 0.0) ^ (y < 0.0)) return (z); else return (nextafter(z, -INFINITY)); default: /* FE_UPWARD */ if ((x > 0.0) ^ (y < 0.0)) return (nextafter(z, INFINITY)); else return (z); } } if (spread <= DBL_MANT_DIG * 2) zs = ldexp(zs, -spread); else zs = copysign(DBL_MIN, zs); fesetround(FE_TONEAREST); /* * Basic approach for round-to-nearest: * * (xy.hi, xy.lo) = x * y (exact) * (r.hi, r.lo) = xy.hi + z (exact) * adj = xy.lo + r.lo (inexact; low bit is sticky) * result = r.hi + adj (correctly rounded) */ xy = dd_mul(xs, ys); r = dd_add(xy.hi, zs); spread = ex + ey; if (r.hi == 0.0) { /* * When the addends cancel to 0, ensure that the result has * the correct sign. */ fesetround(oround); volatile double vzs = zs; /* XXX gcc CSE bug workaround */ return (xy.hi + vzs + ldexp(xy.lo, spread)); } if (oround != FE_TONEAREST) { /* * There is no need to worry about double rounding in directed * rounding modes. */ fesetround(oround); adj = r.lo + xy.lo; return (ldexp(r.hi + adj, spread)); } adj = add_adjusted(r.lo, xy.lo); if (spread + ilogb(r.hi) > -1023) return (ldexp(r.hi + adj, spread)); else return (add_and_denormalize(r.hi, adj, spread)); } #if (LDBL_MANT_DIG == 53) __weak_reference(fma, fmal); #endif wcc-0.0.2/src/wsh/openlibm/src/e_rem_pio2f.c0000644000175000017500000000424313122010155017246 0ustar philphil/* e_rem_pio2f.c -- float version of e_rem_pio2.c * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Debugged and optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_rem_pio2f.c,v 1.32 2009/06/03 08:16:34 ed Exp $"); /* __ieee754_rem_pio2f(x,y) * * return the remainder of x rem pi/2 in *y * use double precision for everything except passing x * use __kernel_rem_pio2() for large x */ #include #include #include "math_private.h" /* * invpio2: 53 bits of 2/pi * pio2_1: first 33 bit of pi/2 * pio2_1t: pi/2 - pio2_1 */ static const double invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ pio2_1 = 1.57079631090164184570e+00, /* 0x3FF921FB, 0x50000000 */ pio2_1t = 1.58932547735281966916e-08; /* 0x3E5110b4, 0x611A6263 */ __inline int __ieee754_rem_pio2f(float x, double *y) { double w,r,fn; double tx[1],ty[1]; float z; int32_t e0,n,ix,hx; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; /* 33+53 bit pi is good enough for medium size */ if(ix<0x4dc90fdb) { /* |x| ~< 2^28*(pi/2), medium size */ /* Use a specialized rint() to get fn. Assume round-to-nearest. */ STRICT_ASSIGN(double,fn,x*invpio2+0x1.8p52); fn = fn-0x1.8p52; #ifdef HAVE_EFFICIENT_IRINT n = irint(fn); #else n = (int32_t)fn; #endif r = x-fn*pio2_1; w = fn*pio2_1t; *y = r-w; return n; } /* * all other (large) arguments */ if(ix>=0x7f800000) { /* x is inf or NaN */ *y=x-x; return 0; } /* set z = scalbn(|x|,ilogb(|x|)-23) */ e0 = (ix>>23)-150; /* e0 = ilogb(|x|)-23; */ SET_FLOAT_WORD(z, ix - ((int32_t)(e0<<23))); tx[0] = z; n = __kernel_rem_pio2(tx,ty,e0,1,0); if(hx<0) {*y = -ty[0]; return -n;} *y = ty[0]; return n; } wcc-0.0.2/src/wsh/openlibm/src/k_log.h0000644000175000017500000000663213122010155016164 0ustar philphil /* @(#)e_log.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_log.h,v 1.2 2011/10/15 05:23:28 das Exp $"); /* * k_log1p(f): * Return log(1+f) - f for 1+f in ~[sqrt(2)/2, sqrt(2)]. * * The following describes the overall strategy for computing * logarithms in base e. The argument reduction and adding the final * term of the polynomial are done by the caller for increased accuracy * when different bases are used. * * Method : * 1. Argument Reduction: find k and f such that * x = 2^k * (1+f), * where sqrt(2)/2 < 1+f < sqrt(2) . * * 2. Approximation of log(1+f). * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s) * = 2s + 2/3 s**3 + 2/5 s**5 + ....., * = 2s + s*R * We use a special Reme algorithm on [0,0.1716] to generate * a polynomial of degree 14 to approximate R The maximum error * of this polynomial approximation is bounded by 2**-58.45. In * other words, * 2 4 6 8 10 12 14 * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s * (the values of Lg1 to Lg7 are listed in the program) * and * | 2 14 | -58.45 * | Lg1*s +...+Lg7*s - R(z) | <= 2 * | | * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2. * In order to guarantee error in log below 1ulp, we compute log * by * log(1+f) = f - s*(f - R) (if f is not too large) * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy) * * 3. Finally, log(x) = k*ln2 + log(1+f). * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo))) * Here ln2 is split into two floating point number: * ln2_hi + ln2_lo, * where n*ln2_hi is always exact for |n| < 2000. * * Special cases: * log(x) is NaN with signal if x < 0 (including -INF) ; * log(+INF) is +INF; log(0) is -INF with signal; * log(NaN) is that NaN with no signal. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ static const double Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */ Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */ Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */ Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ /* * We always inline k_log1p(), since doing so produces a * substantial performance improvement (~40% on amd64). */ static inline double k_log1p(double f) { double hfsq,s,z,R,w,t1,t2; s = f/(2.0+f); z = s*s; w = z*z; t1= w*(Lg2+w*(Lg4+w*Lg6)); t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7))); R = t2+t1; hfsq=0.5*f*f; return s*(hfsq+R); } wcc-0.0.2/src/wsh/openlibm/src/s_floor.c0000644000175000017500000000351713122010155016526 0ustar philphil/* @(#)s_floor.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_floor.c,v 1.11 2008/02/15 07:01:40 bde Exp $"); /* * floor(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to floor(x). */ #include #include #include "math_private.h" static const double huge = 1.0e300; OLM_DLLEXPORT double floor(double x) { int32_t i0,i1,j0; u_int32_t i,j; EXTRACT_WORDS(i0,i1,x); j0 = ((i0>>20)&0x7ff)-0x3ff; if(j0<20) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ if(i0>=0) {i0=i1=0;} else if(((i0&0x7fffffff)|i1)!=0) { i0=0xbff00000;i1=0;} } } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0<0) i0 += (0x00100000)>>j0; i0 &= (~i); i1=0; } } } else if (j0>51) { if(j0==0x400) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0<0) { if(j0==20) i0+=1; else { j = i1+(1<<(52-j0)); if(j * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" #include #include #include "math_private.h" #ifndef type //__FBSDID("$FreeBSD: src/lib/msun/src/s_lrint.c,v 1.1 2005/01/11 23:12:55 das Exp $"); #define type double #define roundit rint #define dtype long #define fn lrint #endif /* * C99 says we should not raise a spurious inexact exception when an * invalid exception is raised. Unfortunately, the set of inputs * that overflows depends on the rounding mode when 'dtype' has more * significant bits than 'type'. Hence, we bend over backwards for the * sake of correctness; an MD implementation could be more efficient. */ OLM_DLLEXPORT dtype fn(type x) { fenv_t env; dtype d; feholdexcept(&env); d = (dtype)roundit(x); if (fetestexcept(FE_INVALID)) feclearexcept(FE_INEXACT); feupdateenv(&env); return (d); } wcc-0.0.2/src/wsh/openlibm/src/e_atan2f.c0000644000175000017500000000532413122010155016540 0ustar philphil/* e_atan2f.c -- float version of e_atan2.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_atan2f.c,v 1.12 2008/08/03 17:39:54 das Exp $"); #include #include "math_private.h" static volatile float tiny = 1.0e-30; static const float zero = 0.0, pi_o_4 = 7.8539818525e-01, /* 0x3f490fdb */ pi_o_2 = 1.5707963705e+00, /* 0x3fc90fdb */ pi = 3.1415927410e+00; /* 0x40490fdb */ static volatile float pi_lo = -8.7422776573e-08; /* 0xb3bbbd2e */ OLM_DLLEXPORT float __ieee754_atan2f(float y, float x) { float z; int32_t k,m,hx,hy,ix,iy; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; GET_FLOAT_WORD(hy,y); iy = hy&0x7fffffff; if((ix>0x7f800000)|| (iy>0x7f800000)) /* x or y is NaN */ return x+y; if(hx==0x3f800000) return atanf(y); /* x=1.0 */ m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ /* when y = 0 */ if(iy==0) { switch(m) { case 0: case 1: return y; /* atan(+-0,+anything)=+-0 */ case 2: return pi+tiny;/* atan(+0,-anything) = pi */ case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */ } } /* when x = 0 */ if(ix==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* when x is INF */ if(ix==0x7f800000) { if(iy==0x7f800000) { switch(m) { case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */ case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */ case 2: return (float)3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/ case 3: return (float)-3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/ } } else { switch(m) { case 0: return zero ; /* atan(+...,+INF) */ case 1: return -zero ; /* atan(-...,+INF) */ case 2: return pi+tiny ; /* atan(+...,-INF) */ case 3: return -pi-tiny ; /* atan(-...,-INF) */ } } } /* when y is INF */ if(iy==0x7f800000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* compute y/x */ k = (iy-ix)>>23; if(k > 26) { /* |y/x| > 2**26 */ z=pi_o_2+(float)0.5*pi_lo; m&=1; } else if(k<-26&&hx<0) z=0.0; /* 0 > |y|/x > -2**-26 */ else z=atanf(fabsf(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ case 1: return -z ; /* atan(-,+) */ case 2: return pi-(z-pi_lo);/* atan(+,-) */ default: /* case 3 */ return (z-pi_lo)-pi;/* atan(-,-) */ } } wcc-0.0.2/src/wsh/openlibm/src/e_asinf.c0000644000175000017500000000325213122010155016463 0ustar philphil/* e_asinf.c -- float version of e_asin.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_asinf.c,v 1.13 2008/08/08 00:21:27 das Exp $"); #include #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3F800000 */ huge = 1.000e+30, /* coefficient for R(x^2) */ pS0 = 1.6666586697e-01, pS1 = -4.2743422091e-02, pS2 = -8.6563630030e-03, qS1 = -7.0662963390e-01; static const double pio2 = 1.570796326794896558e+00; OLM_DLLEXPORT float __ieee754_asinf(float x) { double s; float t,w,p,q; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x3f800000) { /* |x| >= 1 */ if(ix==0x3f800000) /* |x| == 1 */ return x*pio2; /* asin(+-1) = +-pi/2 with inexact */ return (x-x)/(x-x); /* asin(|x|>1) is NaN */ } else if (ix<0x3f000000) { /* |x|<0.5 */ if(ix<0x39800000) { /* |x| < 2**-12 */ if(huge+x>one) return x;/* return x with inexact if x!=0*/ } t = x*x; p = t*(pS0+t*(pS1+t*pS2)); q = one+t*qS1; w = p/q; return x+x*w; } /* 1> |x|>= 0.5 */ w = one-fabsf(x); t = w*(float)0.5; p = t*(pS0+t*(pS1+t*pS2)); q = one+t*qS1; s = sqrt(t); w = p/q; t = pio2-2.0*(s+s*w); if(hx>0) return t; else return -t; } wcc-0.0.2/src/wsh/openlibm/src/s_sin.c0000644000175000017500000000442313122010155016173 0ustar philphil/* @(#)s_sin.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_sin.c,v 1.13 2011/02/10 07:37:50 das Exp $"); /* sin(x) * Return sine function of x. * * kernel function: * __kernel_sin ... sine function on [-pi/4,pi/4] * __kernel_cos ... cose function on [-pi/4,pi/4] * __ieee754_rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 * in [-pi/4 , +pi/4], and let n = k mod 4. * We have * * n sin(x) cos(x) tan(x) * ---------------------------------------------------------- * 0 S C T * 1 C -S -1/T * 2 -S -C T * 3 -C S -1/T * ---------------------------------------------------------- * * Special cases: * Let trig be any of sin, cos, or tan. * trig(+-INF) is NaN, with signals; * trig(NaN) is that NaN; * * Accuracy: * TRIG(x) returns trig(x) nearly rounded */ #include #include //#define INLINE_REM_PIO2 #include "math_private.h" //#include "e_rem_pio2.c" OLM_DLLEXPORT double sin(double x) { double y[2],z=0.0; int32_t n, ix; /* High word of x. */ GET_HIGH_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3fe921fb) { if(ix<0x3e500000) /* |x| < 2**-26 */ {if((int)x==0) return x;} /* generate inexact */ return __kernel_sin(x,z,0); } /* sin(Inf or NaN) is NaN */ else if (ix>=0x7ff00000) return x-x; /* argument reduction needed */ else { n = __ieee754_rem_pio2(x,y); switch(n&3) { case 0: return __kernel_sin(y[0],y[1],1); case 1: return __kernel_cos(y[0],y[1]); case 2: return -__kernel_sin(y[0],y[1],1); default: return -__kernel_cos(y[0],y[1]); } } } #if (LDBL_MANT_DIG == 53) __weak_reference(sin, sinl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_fminf.c0000644000175000017500000000371013122010155016477 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fminf.c,v 1.1 2004/06/30 07:04:01 das Exp $"); #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT float fminf(float x, float y) { union IEEEf2bits u[2]; u[0].f = x; u[1].f = y; /* Check for NaNs to avoid raising spurious exceptions. */ if (u[0].bits.exp == 255 && u[0].bits.man != 0) return (y); if (u[1].bits.exp == 255 && u[1].bits.man != 0) return (x); /* Handle comparisons of signed zeroes. */ if (u[0].bits.sign != u[1].bits.sign) return (u[u[1].bits.sign].f); return (x < y ? x : y); } wcc-0.0.2/src/wsh/openlibm/src/s_exp2.c0000644000175000017500000003410213122010155016255 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_exp2.c,v 1.7 2008/02/22 02:27:34 das Exp $"); #include #include #include "math_private.h" #define TBLBITS 8 #define TBLSIZE (1 << TBLBITS) static const double huge = 0x1p1000, redux = 0x1.8p52 / TBLSIZE, P1 = 0x1.62e42fefa39efp-1, P2 = 0x1.ebfbdff82c575p-3, P3 = 0x1.c6b08d704a0a6p-5, P4 = 0x1.3b2ab88f70400p-7, P5 = 0x1.5d88003875c74p-10; static volatile double twom1000 = 0x1p-1000; static const double tbl[TBLSIZE * 2] = { /* exp2(z + eps) eps */ 0x1.6a09e667f3d5dp-1, 0x1.9880p-44, 0x1.6b052fa751744p-1, 0x1.8000p-50, 0x1.6c012750bd9fep-1, -0x1.8780p-45, 0x1.6cfdcddd476bfp-1, 0x1.ec00p-46, 0x1.6dfb23c651a29p-1, -0x1.8000p-50, 0x1.6ef9298593ae3p-1, -0x1.c000p-52, 0x1.6ff7df9519386p-1, -0x1.fd80p-45, 0x1.70f7466f42da3p-1, -0x1.c880p-45, 0x1.71f75e8ec5fc3p-1, 0x1.3c00p-46, 0x1.72f8286eacf05p-1, -0x1.8300p-44, 0x1.73f9a48a58152p-1, -0x1.0c00p-47, 0x1.74fbd35d7ccfcp-1, 0x1.f880p-45, 0x1.75feb564267f1p-1, 0x1.3e00p-47, 0x1.77024b1ab6d48p-1, -0x1.7d00p-45, 0x1.780694fde5d38p-1, -0x1.d000p-50, 0x1.790b938ac1d00p-1, 0x1.3000p-49, 0x1.7a11473eb0178p-1, -0x1.d000p-49, 0x1.7b17b0976d060p-1, 0x1.0400p-45, 0x1.7c1ed0130c133p-1, 0x1.0000p-53, 0x1.7d26a62ff8636p-1, -0x1.6900p-45, 0x1.7e2f336cf4e3bp-1, -0x1.2e00p-47, 0x1.7f3878491c3e8p-1, -0x1.4580p-45, 0x1.80427543e1b4ep-1, 0x1.3000p-44, 0x1.814d2add1071ap-1, 0x1.f000p-47, 0x1.82589994ccd7ep-1, -0x1.1c00p-45, 0x1.8364c1eb942d0p-1, 0x1.9d00p-45, 0x1.8471a4623cab5p-1, 0x1.7100p-43, 0x1.857f4179f5bbcp-1, 0x1.2600p-45, 0x1.868d99b4491afp-1, -0x1.2c40p-44, 0x1.879cad931a395p-1, -0x1.3000p-45, 0x1.88ac7d98a65b8p-1, -0x1.a800p-45, 0x1.89bd0a4785800p-1, -0x1.d000p-49, 0x1.8ace5422aa223p-1, 0x1.3280p-44, 0x1.8be05bad619fap-1, 0x1.2b40p-43, 0x1.8cf3216b54383p-1, -0x1.ed00p-45, 0x1.8e06a5e08664cp-1, -0x1.0500p-45, 0x1.8f1ae99157807p-1, 0x1.8280p-45, 0x1.902fed0282c0ep-1, -0x1.cb00p-46, 0x1.9145b0b91ff96p-1, -0x1.5e00p-47, 0x1.925c353aa2ff9p-1, 0x1.5400p-48, 0x1.93737b0cdc64ap-1, 0x1.7200p-46, 0x1.948b82b5f98aep-1, -0x1.9000p-47, 0x1.95a44cbc852cbp-1, 0x1.5680p-45, 0x1.96bdd9a766f21p-1, -0x1.6d00p-44, 0x1.97d829fde4e2ap-1, -0x1.1000p-47, 0x1.98f33e47a23a3p-1, 0x1.d000p-45, 0x1.9a0f170ca0604p-1, -0x1.8a40p-44, 0x1.9b2bb4d53ff89p-1, 0x1.55c0p-44, 0x1.9c49182a3f15bp-1, 0x1.6b80p-45, 0x1.9d674194bb8c5p-1, -0x1.c000p-49, 0x1.9e86319e3238ep-1, 0x1.7d00p-46, 0x1.9fa5e8d07f302p-1, 0x1.6400p-46, 0x1.a0c667b5de54dp-1, -0x1.5000p-48, 0x1.a1e7aed8eb8f6p-1, 0x1.9e00p-47, 0x1.a309bec4a2e27p-1, 0x1.ad80p-45, 0x1.a42c980460a5dp-1, -0x1.af00p-46, 0x1.a5503b23e259bp-1, 0x1.b600p-47, 0x1.a674a8af46213p-1, 0x1.8880p-44, 0x1.a799e1330b3a7p-1, 0x1.1200p-46, 0x1.a8bfe53c12e8dp-1, 0x1.6c00p-47, 0x1.a9e6b5579fcd2p-1, -0x1.9b80p-45, 0x1.ab0e521356fb8p-1, 0x1.b700p-45, 0x1.ac36bbfd3f381p-1, 0x1.9000p-50, 0x1.ad5ff3a3c2780p-1, 0x1.4000p-49, 0x1.ae89f995ad2a3p-1, -0x1.c900p-45, 0x1.afb4ce622f367p-1, 0x1.6500p-46, 0x1.b0e07298db790p-1, 0x1.fd40p-45, 0x1.b20ce6c9a89a9p-1, 0x1.2700p-46, 0x1.b33a2b84f1a4bp-1, 0x1.d470p-43, 0x1.b468415b747e7p-1, -0x1.8380p-44, 0x1.b59728de5593ap-1, 0x1.8000p-54, 0x1.b6c6e29f1c56ap-1, 0x1.ad00p-47, 0x1.b7f76f2fb5e50p-1, 0x1.e800p-50, 0x1.b928cf22749b2p-1, -0x1.4c00p-47, 0x1.ba5b030a10603p-1, -0x1.d700p-47, 0x1.bb8e0b79a6f66p-1, 0x1.d900p-47, 0x1.bcc1e904bc1ffp-1, 0x1.2a00p-47, 0x1.bdf69c3f3a16fp-1, -0x1.f780p-46, 0x1.bf2c25bd71db8p-1, -0x1.0a00p-46, 0x1.c06286141b2e9p-1, -0x1.1400p-46, 0x1.c199bdd8552e0p-1, 0x1.be00p-47, 0x1.c2d1cd9fa64eep-1, -0x1.9400p-47, 0x1.c40ab5fffd02fp-1, -0x1.ed00p-47, 0x1.c544778fafd15p-1, 0x1.9660p-44, 0x1.c67f12e57d0cbp-1, -0x1.a100p-46, 0x1.c7ba88988c1b6p-1, -0x1.8458p-42, 0x1.c8f6d9406e733p-1, -0x1.a480p-46, 0x1.ca3405751c4dfp-1, 0x1.b000p-51, 0x1.cb720dcef9094p-1, 0x1.1400p-47, 0x1.ccb0f2e6d1689p-1, 0x1.0200p-48, 0x1.cdf0b555dc412p-1, 0x1.3600p-48, 0x1.cf3155b5bab3bp-1, -0x1.6900p-47, 0x1.d072d4a0789bcp-1, 0x1.9a00p-47, 0x1.d1b532b08c8fap-1, -0x1.5e00p-46, 0x1.d2f87080d8a85p-1, 0x1.d280p-46, 0x1.d43c8eacaa203p-1, 0x1.1a00p-47, 0x1.d5818dcfba491p-1, 0x1.f000p-50, 0x1.d6c76e862e6a1p-1, -0x1.3a00p-47, 0x1.d80e316c9834ep-1, -0x1.cd80p-47, 0x1.d955d71ff6090p-1, 0x1.4c00p-48, 0x1.da9e603db32aep-1, 0x1.f900p-48, 0x1.dbe7cd63a8325p-1, 0x1.9800p-49, 0x1.dd321f301b445p-1, -0x1.5200p-48, 0x1.de7d5641c05bfp-1, -0x1.d700p-46, 0x1.dfc97337b9aecp-1, -0x1.6140p-46, 0x1.e11676b197d5ep-1, 0x1.b480p-47, 0x1.e264614f5a3e7p-1, 0x1.0ce0p-43, 0x1.e3b333b16ee5cp-1, 0x1.c680p-47, 0x1.e502ee78b3fb4p-1, -0x1.9300p-47, 0x1.e653924676d68p-1, -0x1.5000p-49, 0x1.e7a51fbc74c44p-1, -0x1.7f80p-47, 0x1.e8f7977cdb726p-1, -0x1.3700p-48, 0x1.ea4afa2a490e8p-1, 0x1.5d00p-49, 0x1.eb9f4867ccae4p-1, 0x1.61a0p-46, 0x1.ecf482d8e680dp-1, 0x1.5500p-48, 0x1.ee4aaa2188514p-1, 0x1.6400p-51, 0x1.efa1bee615a13p-1, -0x1.e800p-49, 0x1.f0f9c1cb64106p-1, -0x1.a880p-48, 0x1.f252b376bb963p-1, -0x1.c900p-45, 0x1.f3ac948dd7275p-1, 0x1.a000p-53, 0x1.f50765b6e4524p-1, -0x1.4f00p-48, 0x1.f6632798844fdp-1, 0x1.a800p-51, 0x1.f7bfdad9cbe38p-1, 0x1.abc0p-48, 0x1.f91d802243c82p-1, -0x1.4600p-50, 0x1.fa7c1819e908ep-1, -0x1.b0c0p-47, 0x1.fbdba3692d511p-1, -0x1.0e00p-51, 0x1.fd3c22b8f7194p-1, -0x1.0de8p-46, 0x1.fe9d96b2a23eep-1, 0x1.e430p-49, 0x1.0000000000000p+0, 0x0.0000p+0, 0x1.00b1afa5abcbep+0, -0x1.3400p-52, 0x1.0163da9fb3303p+0, -0x1.2170p-46, 0x1.02168143b0282p+0, 0x1.a400p-52, 0x1.02c9a3e77806cp+0, 0x1.f980p-49, 0x1.037d42e11bbcap+0, -0x1.7400p-51, 0x1.04315e86e7f89p+0, 0x1.8300p-50, 0x1.04e5f72f65467p+0, -0x1.a3f0p-46, 0x1.059b0d315855ap+0, -0x1.2840p-47, 0x1.0650a0e3c1f95p+0, 0x1.1600p-48, 0x1.0706b29ddf71ap+0, 0x1.5240p-46, 0x1.07bd42b72a82dp+0, -0x1.9a00p-49, 0x1.0874518759bd0p+0, 0x1.6400p-49, 0x1.092bdf66607c8p+0, -0x1.0780p-47, 0x1.09e3ecac6f383p+0, -0x1.8000p-54, 0x1.0a9c79b1f3930p+0, 0x1.fa00p-48, 0x1.0b5586cf988fcp+0, -0x1.ac80p-48, 0x1.0c0f145e46c8ap+0, 0x1.9c00p-50, 0x1.0cc922b724816p+0, 0x1.5200p-47, 0x1.0d83b23395dd8p+0, -0x1.ad00p-48, 0x1.0e3ec32d3d1f3p+0, 0x1.bac0p-46, 0x1.0efa55fdfa9a6p+0, -0x1.4e80p-47, 0x1.0fb66affed2f0p+0, -0x1.d300p-47, 0x1.1073028d7234bp+0, 0x1.1500p-48, 0x1.11301d0125b5bp+0, 0x1.c000p-49, 0x1.11edbab5e2af9p+0, 0x1.6bc0p-46, 0x1.12abdc06c31d5p+0, 0x1.8400p-49, 0x1.136a814f2047dp+0, -0x1.ed00p-47, 0x1.1429aaea92de9p+0, 0x1.8e00p-49, 0x1.14e95934f3138p+0, 0x1.b400p-49, 0x1.15a98c8a58e71p+0, 0x1.5300p-47, 0x1.166a45471c3dfp+0, 0x1.3380p-47, 0x1.172b83c7d5211p+0, 0x1.8d40p-45, 0x1.17ed48695bb9fp+0, -0x1.5d00p-47, 0x1.18af9388c8d93p+0, -0x1.c880p-46, 0x1.1972658375d66p+0, 0x1.1f00p-46, 0x1.1a35beb6fcba7p+0, 0x1.0480p-46, 0x1.1af99f81387e3p+0, -0x1.7390p-43, 0x1.1bbe084045d54p+0, 0x1.4e40p-45, 0x1.1c82f95281c43p+0, -0x1.a200p-47, 0x1.1d4873168b9b2p+0, 0x1.3800p-49, 0x1.1e0e75eb44031p+0, 0x1.ac00p-49, 0x1.1ed5022fcd938p+0, 0x1.1900p-47, 0x1.1f9c18438cdf7p+0, -0x1.b780p-46, 0x1.2063b88628d8fp+0, 0x1.d940p-45, 0x1.212be3578a81ep+0, 0x1.8000p-50, 0x1.21f49917ddd41p+0, 0x1.b340p-45, 0x1.22bdda2791323p+0, 0x1.9f80p-46, 0x1.2387a6e7561e7p+0, -0x1.9c80p-46, 0x1.2451ffb821427p+0, 0x1.2300p-47, 0x1.251ce4fb2a602p+0, -0x1.3480p-46, 0x1.25e85711eceb0p+0, 0x1.2700p-46, 0x1.26b4565e27d16p+0, 0x1.1d00p-46, 0x1.2780e341de00fp+0, 0x1.1ee0p-44, 0x1.284dfe1f5633ep+0, -0x1.4c00p-46, 0x1.291ba7591bb30p+0, -0x1.3d80p-46, 0x1.29e9df51fdf09p+0, 0x1.8b00p-47, 0x1.2ab8a66d10e9bp+0, -0x1.27c0p-45, 0x1.2b87fd0dada3ap+0, 0x1.a340p-45, 0x1.2c57e39771af9p+0, -0x1.0800p-46, 0x1.2d285a6e402d9p+0, -0x1.ed00p-47, 0x1.2df961f641579p+0, -0x1.4200p-48, 0x1.2ecafa93e2ecfp+0, -0x1.4980p-45, 0x1.2f9d24abd8822p+0, -0x1.6300p-46, 0x1.306fe0a31b625p+0, -0x1.2360p-44, 0x1.31432edeea50bp+0, -0x1.0df8p-40, 0x1.32170fc4cd7b8p+0, -0x1.2480p-45, 0x1.32eb83ba8e9a2p+0, -0x1.5980p-45, 0x1.33c08b2641766p+0, 0x1.ed00p-46, 0x1.3496266e3fa27p+0, -0x1.c000p-50, 0x1.356c55f929f0fp+0, -0x1.0d80p-44, 0x1.36431a2de88b9p+0, 0x1.2c80p-45, 0x1.371a7373aaa39p+0, 0x1.0600p-45, 0x1.37f26231e74fep+0, -0x1.6600p-46, 0x1.38cae6d05d838p+0, -0x1.ae00p-47, 0x1.39a401b713ec3p+0, -0x1.4720p-43, 0x1.3a7db34e5a020p+0, 0x1.8200p-47, 0x1.3b57fbfec6e95p+0, 0x1.e800p-44, 0x1.3c32dc313a8f2p+0, 0x1.f800p-49, 0x1.3d0e544ede122p+0, -0x1.7a00p-46, 0x1.3dea64c1234bbp+0, 0x1.6300p-45, 0x1.3ec70df1c4eccp+0, -0x1.8a60p-43, 0x1.3fa4504ac7e8cp+0, -0x1.cdc0p-44, 0x1.40822c367a0bbp+0, 0x1.5b80p-45, 0x1.4160a21f72e95p+0, 0x1.ec00p-46, 0x1.423fb27094646p+0, -0x1.3600p-46, 0x1.431f5d950a920p+0, 0x1.3980p-45, 0x1.43ffa3f84b9ebp+0, 0x1.a000p-48, 0x1.44e0860618919p+0, -0x1.6c00p-48, 0x1.45c2042a7d201p+0, -0x1.bc00p-47, 0x1.46a41ed1d0016p+0, -0x1.2800p-46, 0x1.4786d668b3326p+0, 0x1.0e00p-44, 0x1.486a2b5c13c00p+0, -0x1.d400p-45, 0x1.494e1e192af04p+0, 0x1.c200p-47, 0x1.4a32af0d7d372p+0, -0x1.e500p-46, 0x1.4b17dea6db801p+0, 0x1.7800p-47, 0x1.4bfdad53629e1p+0, -0x1.3800p-46, 0x1.4ce41b817c132p+0, 0x1.0800p-47, 0x1.4dcb299fddddbp+0, 0x1.c700p-45, 0x1.4eb2d81d8ab96p+0, -0x1.ce00p-46, 0x1.4f9b2769d2d02p+0, 0x1.9200p-46, 0x1.508417f4531c1p+0, -0x1.8c00p-47, 0x1.516daa2cf662ap+0, -0x1.a000p-48, 0x1.5257de83f51eap+0, 0x1.a080p-43, 0x1.5342b569d4edap+0, -0x1.6d80p-45, 0x1.542e2f4f6ac1ap+0, -0x1.2440p-44, 0x1.551a4ca5d94dbp+0, 0x1.83c0p-43, 0x1.56070dde9116bp+0, 0x1.4b00p-45, 0x1.56f4736b529dep+0, 0x1.15a0p-43, 0x1.57e27dbe2c40ep+0, -0x1.9e00p-45, 0x1.58d12d497c76fp+0, -0x1.3080p-45, 0x1.59c0827ff0b4cp+0, 0x1.dec0p-43, 0x1.5ab07dd485427p+0, -0x1.4000p-51, 0x1.5ba11fba87af4p+0, 0x1.0080p-44, 0x1.5c9268a59460bp+0, -0x1.6c80p-45, 0x1.5d84590998e3fp+0, 0x1.69a0p-43, 0x1.5e76f15ad20e1p+0, -0x1.b400p-46, 0x1.5f6a320dcebcap+0, 0x1.7700p-46, 0x1.605e1b976dcb8p+0, 0x1.6f80p-45, 0x1.6152ae6cdf715p+0, 0x1.1000p-47, 0x1.6247eb03a5531p+0, -0x1.5d00p-46, 0x1.633dd1d1929b5p+0, -0x1.2d00p-46, 0x1.6434634ccc313p+0, -0x1.a800p-49, 0x1.652b9febc8efap+0, -0x1.8600p-45, 0x1.6623882553397p+0, 0x1.1fe0p-40, 0x1.671c1c708328ep+0, -0x1.7200p-44, 0x1.68155d44ca97ep+0, 0x1.6800p-49, 0x1.690f4b19e9471p+0, -0x1.9780p-45, }; /* * exp2(x): compute the base 2 exponential of x * * Accuracy: Peak error < 0.503 ulp for normalized results. * * Method: (accurate tables) * * Reduce x: * x = 2**k + y, for integer k and |y| <= 1/2. * Thus we have exp2(x) = 2**k * exp2(y). * * Reduce y: * y = i/TBLSIZE + z - eps[i] for integer i near y * TBLSIZE. * Thus we have exp2(y) = exp2(i/TBLSIZE) * exp2(z - eps[i]), * with |z - eps[i]| <= 2**-9 + 2**-39 for the table used. * * We compute exp2(i/TBLSIZE) via table lookup and exp2(z - eps[i]) via * a degree-5 minimax polynomial with maximum error under 1.3 * 2**-61. * The values in exp2t[] and eps[] are chosen such that * exp2t[i] = exp2(i/TBLSIZE + eps[i]), and eps[i] is a small offset such * that exp2t[i] is accurate to 2**-64. * * Note that the range of i is +-TBLSIZE/2, so we actually index the tables * by i0 = i + TBLSIZE/2. For cache efficiency, exp2t[] and eps[] are * virtual tables, interleaved in the real table tbl[]. * * This method is due to Gal, with many details due to Gal and Bachelis: * * Gal, S. and Bachelis, B. An Accurate Elementary Mathematical Library * for the IEEE Floating Point Standard. TOMS 17(1), 26-46 (1991). */ OLM_DLLEXPORT double exp2(double x) { double r, t, twopk, twopkp1000, z; u_int32_t hx, ix, lx, i0; int k; /* Filter out exceptional cases. */ GET_HIGH_WORD(hx,x); ix = hx & 0x7fffffff; /* high word of |x| */ if(ix >= 0x40900000) { /* |x| >= 1024 */ if(ix >= 0x7ff00000) { GET_LOW_WORD(lx,x); if(((ix & 0xfffff) | lx) != 0 || (hx & 0x80000000) == 0) return (x + x); /* x is NaN or +Inf */ else return (0.0); /* x is -Inf */ } if(x >= 0x1.0p10) return (huge * huge); /* overflow */ if(x <= -0x1.0ccp10) return (twom1000 * twom1000); /* underflow */ } else if (ix < 0x3c900000) { /* |x| < 0x1p-54 */ return (1.0 + x); } /* Reduce x, computing z, i0, and k. */ STRICT_ASSIGN(double, t, x + redux); GET_LOW_WORD(i0, t); i0 += TBLSIZE / 2; k = (i0 >> TBLBITS) << 20; i0 = (i0 & (TBLSIZE - 1)) << 1; t -= redux; z = x - t; /* Compute r = exp2(y) = exp2t[i0] * p(z - eps[i]). */ t = tbl[i0]; /* exp2t[i0] */ z -= tbl[i0 + 1]; /* eps[i0] */ if (k >= -(1021 << 20)) INSERT_WORDS(twopk, 0x3ff00000 + k, 0); else INSERT_WORDS(twopkp1000, 0x3ff00000 + k + (1000 << 20), 0); r = t + t * z * (P1 + z * (P2 + z * (P3 + z * (P4 + z * P5)))); /* Scale by 2**(k>>20). */ if(k >= -(1021 << 20)) { if (k == 1024 << 20) return (r * 2.0 * 0x1p1023); return (r * twopk); } else { return (r * twopkp1000 * twom1000); } } #if (LDBL_MANT_DIG == 53) __weak_reference(exp2, exp2l); #endif wcc-0.0.2/src/wsh/openlibm/src/s_nan.c0000644000175000017500000000727313122010155016164 0ustar philphil/*- * Copyright (c) 2007 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_nan.c,v 1.2 2007/12/18 23:46:32 das Exp $ */ //VBS //#include #include #include #include #include #include //for memset #include "math_private.h" #if !defined(__APPLE__) && !defined(__FreeBSD__) static __inline int digittoint(int c) { if ('0' <= c && c <= '9') return (c - '0'); else if ('A' <= c && c <= 'F') return (c - 'A' + 10); else if ('a' <= c && c <= 'f') return (c - 'a' + 10); return 0; } #endif /* * Scan a string of hexadecimal digits (the format nan(3) expects) and * make a bit array (using the local endianness). We stop when we * encounter an invalid character, NUL, etc. If we overflow, we do * the same as gcc's __builtin_nan(), namely, discard the high order bits. * * The format this routine accepts needs to be compatible with what is used * in contrib/gdtoa/hexnan.c (for strtod/scanf) and what is used in * __builtin_nan(). In fact, we're only 100% compatible for strings we * consider valid, so we might be violating the C standard. But it's * impossible to use nan(3) portably anyway, so this seems good enough. */ OLM_DLLEXPORT void __scan_nan(u_int32_t *words, int num_words, const char *s) { int si; /* index into s */ int bitpos; /* index into words (in bits) */ memset(words, 0, num_words * sizeof(u_int32_t)); /* Allow a leading '0x'. (It's expected, but redundant.) */ if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X')) s += 2; /* Scan forwards in the string, looking for the end of the sequence. */ for (si = 0; isxdigit(s[si]); si++) ; /* Scan backwards, filling in the bits in words[] as we go. */ #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ for (bitpos = 0; bitpos < 32 * num_words; bitpos += 4) { #else for (bitpos = 32 * num_words - 4; bitpos >= 0; bitpos -= 4) { #endif if (--si < 0) break; words[bitpos / 32] |= digittoint(s[si]) << (bitpos % 32); } } OLM_DLLEXPORT double nan(const char *s) { union { double d; u_int32_t bits[2]; } u; __scan_nan(u.bits, 2, s); #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ u.bits[1] |= 0x7ff80000; #else u.bits[0] |= 0x7ff80000; #endif return (u.d); } OLM_DLLEXPORT float nanf(const char *s) { union { float f; u_int32_t bits[1]; } u; __scan_nan(u.bits, 1, s); u.bits[0] |= 0x7fc00000; return (u.f); } #if (LDBL_MANT_DIG == 53) __weak_reference(nan, nanl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_ctanhl.c0000644000175000017500000000307013122010155016650 0ustar philphil/* $OpenBSD: s_ctanhl.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ctanhl * * Complex hyperbolic tangent * * * * SYNOPSIS: * * long double complex ctanhl(); * long double complex z, w; * * w = ctanhl (z); * * * * DESCRIPTION: * * tanh z = (sinh 2x + i sin 2y) / (cosh 2x + cos 2y) . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.7e-14 2.4e-16 * */ #include #include long double complex ctanhl(long double complex z) { long double complex w; long double x, y, d; x = creall(z); y = cimagl(z); d = coshl(2.0L * x) + cosl(2.0L * y); w = sinhl(2.0L * x) / d + (sinl(2.0L * y) / d) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_catan.c0000644000175000017500000000555113122010155016473 0ustar philphil/* $OpenBSD: s_catan.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* catan() * * Complex circular arc tangent * * * * SYNOPSIS: * * double complex catan(); * double complex z, w; * * w = catan (z); * * * * DESCRIPTION: * * If * z = x + iy, * * then * 1 ( 2x ) * Re w = - arctan(-----------) + k PI * 2 ( 2 2) * (1 - x - y ) * * ( 2 2) * 1 (x + (y+1) ) * Im w = - log(------------) * 4 ( 2 2) * (x + (y-1) ) * * Where k is an arbitrary integer. * * catan(z) = -i catanh(iz). * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5900 1.3e-16 7.8e-18 * IEEE -10,+10 30000 2.3e-15 8.5e-17 * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2, * had peak relative error 1.5e-16, rms relative error * 2.9e-17. See also clog(). */ #include #include #include #define MAXNUM 1.0e308 static const double DP1 = 3.14159265160560607910E0; static const double DP2 = 1.98418714791870343106E-9; static const double DP3 = 1.14423774522196636802E-17; static double _redupi(double x) { double t; long i; t = x/M_PI; if(t >= 0.0) t += 0.5; else t -= 0.5; i = t; /* the multiple */ t = i; t = ((x - t * DP1) - t * DP2) - t * DP3; return (t); } double complex catan(double complex z) { double complex w; double a, t, x, x2, y; x = creal (z); y = cimag (z); if ((x == 0.0) && (y > 1.0)) goto ovrf; x2 = x * x; a = 1.0 - x2 - (y * y); if (a == 0.0) goto ovrf; t = 0.5 * atan2 (2.0 * x, a); w = _redupi (t); t = y - 1.0; a = x2 + (t * t); if (a == 0.0) goto ovrf; t = y + 1.0; a = (x2 + (t * t))/a; w = w + (0.25 * log (a)) * I; return (w); ovrf: /*mtherr ("catan", OVERFLOW);*/ w = MAXNUM + MAXNUM * I; return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(catanl, catan); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_scalbnf.c0000644000175000017500000000326313122010155017013 0ustar philphil/* s_scalbnf.c -- float version of s_scalbn.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" #include #include "math_private.h" static const float two25 = 3.355443200e+07, /* 0x4c000000 */ twom25 = 2.9802322388e-08, /* 0x33000000 */ huge = 1.0e+30, tiny = 1.0e-30; OLM_DLLEXPORT float scalbnf (float x, int n) { int32_t k,ix; GET_FLOAT_WORD(ix,x); k = (ix&0x7f800000)>>23; /* extract exponent */ if (k==0) { /* 0 or subnormal x */ if ((ix&0x7fffffff)==0) return x; /* +-0 */ x *= two25; GET_FLOAT_WORD(ix,x); k = ((ix&0x7f800000)>>23) - 25; if (n< -50000) return tiny*x; /*underflow*/ } if (k==0xff) return x+x; /* NaN or Inf */ k = k+n; if (k > 0xfe) return huge*copysignf(huge,x); /* overflow */ if (k > 0) /* normal result */ {SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23)); return x;} if (k <= -25) { if (n > 50000) /* in case integer overflow in n+k */ return huge*copysignf(huge,x); /*overflow*/ else return tiny*copysignf(tiny,x); /*underflow*/ } k += 25; /* subnormal result */ SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23)); return x*twom25; } __strong_reference(scalbnf, ldexpf); wcc-0.0.2/src/wsh/openlibm/src/e_log10f.c0000644000175000017500000000401613122010155016452 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_log10f.c,v 1.13 2011/10/16 05:36:23 das Exp $"); /* * Float version of e_log10.c. See the latter for most comments. */ #include #include "math_private.h" #include "k_logf.h" // VBS #define float_t float static const float two25 = 3.3554432000e+07, /* 0x4c000000 */ ivln10hi = 4.3432617188e-01, /* 0x3ede6000 */ ivln10lo = -3.1689971365e-05, /* 0xb804ead9 */ log10_2hi = 3.0102920532e-01, /* 0x3e9a2080 */ log10_2lo = 7.9034151668e-07; /* 0x355427db */ static const float zero = 0.0; OLM_DLLEXPORT float __ieee754_log10f(float x) { float f,hfsq,hi,lo,r,y; int32_t i,k,hx; GET_FLOAT_WORD(hx,x); k=0; if (hx < 0x00800000) { /* x < 2**-126 */ if ((hx&0x7fffffff)==0) return -two25/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 25; x *= two25; /* subnormal number, scale up x */ GET_FLOAT_WORD(hx,x); } if (hx >= 0x7f800000) return x+x; if (hx == 0x3f800000) return zero; /* log(1) = +0 */ k += (hx>>23)-127; hx &= 0x007fffff; i = (hx+(0x4afb0d))&0x800000; SET_FLOAT_WORD(x,hx|(i^0x3f800000)); /* normalize x or x/2 */ k += (i>>23); y = (float)k; f = x - (float)1.0; hfsq = (float)0.5*f*f; r = k_log1pf(f); /* See e_log2f.c and e_log2.c for details. */ if (sizeof(float_t) > sizeof(float)) return (r - hfsq + f) * ((float_t)ivln10lo + ivln10hi) + y * ((float_t)log10_2lo + log10_2hi); hi = f - hfsq; GET_FLOAT_WORD(hx,hi); SET_FLOAT_WORD(hi,hx&0xfffff000); lo = (f - hi) - hfsq + r; return y*log10_2lo + (lo+hi)*ivln10lo + lo*ivln10hi + hi*ivln10hi + y*log10_2hi; } wcc-0.0.2/src/wsh/openlibm/src/s_clog.c0000644000175000017500000000400413122010155016321 0ustar philphil/* $OpenBSD: s_clog.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* clog.c * * Complex natural logarithm * * * * SYNOPSIS: * * double complex clog(); * double complex z, w; * * w = clog (z); * * * * DESCRIPTION: * * Returns complex logarithm to the base e (2.718...) of * the complex argument x. * * If z = x + iy, r = sqrt( x**2 + y**2 ), * then * w = log(r) + i arctan(y/x). * * The arctangent ranges from -PI to +PI. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 7000 8.5e-17 1.9e-17 * IEEE -10,+10 30000 5.0e-15 1.1e-16 * * Larger relative error can be observed for z near 1 +i0. * In IEEE arithmetic the peak absolute error is 5.2e-16, rms * absolute error 1.0e-16. */ #include #include #include double complex clog(double complex z) { double complex w; double p, rr; /*rr = sqrt( z->r * z->r + z->i * z->i );*/ rr = cabs(z); p = log(rr); rr = atan2 (cimag (z), creal (z)); w = p + rr * I; return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(clogl, clog); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_casinf.c0000644000175000017500000000520513122010155016644 0ustar philphil/* $OpenBSD: s_casinf.c,v 1.3 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* casinf() * * Complex circular arc sine * * * * SYNOPSIS: * * void casinf(); * cmplxf z, w; * * casinf( &z, &w ); * * * * DESCRIPTION: * * Inverse complex sine: * * 2 * w = -i clog( iz + csqrt( 1 - z ) ). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.1e-5 1.5e-6 * Larger relative error can be observed for z near zero. * */ #include #include float complex casinf(float complex z) { float complex w; float x, y; static float complex ca, ct, zz, z2; /* float cn, n; static float a, b, s, t, u, v, y2; static cmplxf sum; */ x = crealf(z); y = cimagf(z); if(y == 0.0f) { if(fabsf(x) > 1.0f) { w = (float)M_PI_2 + 0.0f * I; /*mtherr( "casinf", DOMAIN );*/ } else { w = asinf (x) + 0.0f * I; } return (w); } /* Power series expansion */ /* b = cabsf(z); if(b < 0.125) { z2.r = (x - y) * (x + y); z2.i = 2.0 * x * y; cn = 1.0; n = 1.0; ca.r = x; ca.i = y; sum.r = x; sum.i = y; do { ct.r = z2.r * ca.r - z2.i * ca.i; ct.i = z2.r * ca.i + z2.i * ca.r; ca.r = ct.r; ca.i = ct.i; cn *= n; n += 1.0; cn /= n; n += 1.0; b = cn/n; ct.r *= b; ct.i *= b; sum.r += ct.r; sum.i += ct.i; b = fabsf(ct.r) + fabsf(ct.i); } while(b > MACHEPF); w->r = sum.r; w->i = sum.i; return; } */ ca = x + y * I; ct = ca * I; /* iz */ /* sqrt( 1 - z*z) */ /* cmul( &ca, &ca, &zz ) */ /*x * x - y * y */ zz = (x - y) * (x + y) + (2.0f * x * y) * I; zz = 1.0f - crealf(zz) - cimagf(zz) * I; z2 = csqrtf (zz); zz = ct + z2; zz = clogf (zz); /* multiply by 1/i = -i */ w = zz * (-1.0f * I); return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_cexpf.c0000644000175000017500000000563113122010155016511 0ustar philphil/*- * Copyright (c) 2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cexpf.c,v 1.3 2011/10/21 06:27:56 das Exp $"); #include #include #include "math_private.h" static const u_int32_t exp_ovfl = 0x42b17218, /* MAX_EXP * ln2 ~= 88.722839355 */ cexp_ovfl = 0x43400074; /* (MAX_EXP - MIN_DENORM_EXP) * ln2 */ OLM_DLLEXPORT float complex cexpf(float complex z) { float x, y, exp_x; u_int32_t hx, hy; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hy, y); hy &= 0x7fffffff; /* cexp(x + I 0) = exp(x) + I 0 */ if (hy == 0) return (CMPLXF(expf(x), y)); GET_FLOAT_WORD(hx, x); /* cexp(0 + I y) = cos(y) + I sin(y) */ if ((hx & 0x7fffffff) == 0) return (CMPLXF(cosf(y), sinf(y))); if (hy >= 0x7f800000) { if ((hx & 0x7fffffff) != 0x7f800000) { /* cexp(finite|NaN +- I Inf|NaN) = NaN + I NaN */ return (CMPLXF(y - y, y - y)); } else if (hx & 0x80000000) { /* cexp(-Inf +- I Inf|NaN) = 0 + I 0 */ return (CMPLXF(0.0, 0.0)); } else { /* cexp(+Inf +- I Inf|NaN) = Inf + I NaN */ return (CMPLXF(x, y - y)); } } if (hx >= exp_ovfl && hx <= cexp_ovfl) { /* * x is between 88.7 and 192, so we must scale to avoid * overflow in expf(x). */ return (__ldexp_cexpf(z, 0)); } else { /* * Cases covered here: * - x < exp_ovfl and exp(x) won't overflow (common case) * - x > cexp_ovfl, so exp(x) * s overflows for all s > 0 * - x = +-Inf (generated by exp()) * - x = NaN (spurious inexact exception from y) */ exp_x = expf(x); return (CMPLXF(exp_x * cosf(y), exp_x * sinf(y))); } } wcc-0.0.2/src/wsh/openlibm/src/s_cbrtf.c0000644000175000017500000000370713122010155016506 0ustar philphil/* s_cbrtf.c -- float version of s_cbrt.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Debugged and optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cbrtf.c,v 1.18 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" /* cbrtf(x) * Return cube root of x */ static const unsigned B1 = 709958130, /* B1 = (127-127.0/3-0.03306235651)*2**23 */ B2 = 642849266; /* B2 = (127-127.0/3-24/3-0.03306235651)*2**23 */ OLM_DLLEXPORT float cbrtf(float x) { double r,T; float t; int32_t hx; u_int32_t sign; u_int32_t high; GET_FLOAT_WORD(hx,x); sign=hx&0x80000000; /* sign= sign(x) */ hx ^=sign; if(hx>=0x7f800000) return(x+x); /* cbrt(NaN,INF) is itself */ /* rough cbrt to 5 bits */ if(hx<0x00800000) { /* zero or subnormal? */ if(hx==0) return(x); /* cbrt(+-0) is itself */ SET_FLOAT_WORD(t,0x4b800000); /* set t= 2**24 */ t*=x; GET_FLOAT_WORD(high,t); SET_FLOAT_WORD(t,sign|((high&0x7fffffff)/3+B2)); } else SET_FLOAT_WORD(t,sign|(hx/3+B1)); /* * First step Newton iteration (solving t*t-x/t == 0) to 16 bits. In * double precision so that its terms can be arranged for efficiency * without causing overflow or underflow. */ T=t; r=T*T*T; T=T*((double)x+x+r)/(x+r+r); /* * Second step Newton iteration to 47 bits. In double precision for * efficiency and accuracy. */ r=T*T*T; T=T*((double)x+x+r)/(x+r+r); /* rounding to 24 bits is perfect in round-to-nearest mode */ return(T); } wcc-0.0.2/src/wsh/openlibm/src/s_frexpl.c0000644000175000017500000000407013122010155016700 0ustar philphil/*- * Copyright (c) 2004-2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_frexpl.c,v 1.1 2005/03/07 04:54:51 das Exp $ */ #include #include #include "fpmath.h" #include "math_private.h" #if LDBL_MAX_EXP != 0x4000 #error "Unsupported long double format" #endif OLM_DLLEXPORT long double frexpl(long double x, int *ex) { union IEEEl2bits u; u.e = x; switch (u.bits.exp) { case 0: /* 0 or subnormal */ if ((u.bits.manl | u.bits.manh) == 0) { *ex = 0; } else { u.e *= 0x1.0p514; *ex = u.bits.exp - 0x4200; u.bits.exp = 0x3ffe; } break; case 0x7fff: /* infinity or NaN; value of *ex is unspecified */ break; default: /* normal */ *ex = u.bits.exp - 0x3ffe; u.bits.exp = 0x3ffe; break; } return (u.e); } wcc-0.0.2/src/wsh/openlibm/src/s_casinh.c0000644000175000017500000000302113122010155016640 0ustar philphil/* $OpenBSD: s_casinh.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* casinh * * Complex inverse hyperbolic sine * * * * SYNOPSIS: * * double complex casinh(); * double complex z, w; * * w = casinh (z); * * * * DESCRIPTION: * * casinh z = -i casin iz . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.8e-14 2.6e-15 * */ #include #include #include double complex casinh(double complex z) { double complex w; w = -1.0 * I * casin (z * I); return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(casinhl, casinh); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/e_j0.c0000644000175000017500000003500313122010155015673 0ustar philphil /* @(#)e_j0.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_j0.c,v 1.9 2008/02/22 02:30:35 das Exp $"); /* __ieee754_j0(x), __ieee754_y0(x) * Bessel function of the first and second kinds of order zero. * Method -- j0(x): * 1. For tiny x, we use j0(x) = 1 - x^2/4 + x^4/64 - ... * 2. Reduce x to |x| since j0(x)=j0(-x), and * for x in (0,2) * j0(x) = 1-z/4+ z^2*R0/S0, where z = x*x; * (precision: |j0-1+z/4-z^2R0/S0 |<2**-63.67 ) * for x in (2,inf) * j0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)-q0(x)*sin(x0)) * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) * as follow: * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) * = 1/sqrt(2) * (cos(x) + sin(x)) * sin(x0) = sin(x)cos(pi/4)-cos(x)sin(pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * (To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one.) * * 3 Special cases * j0(nan)= nan * j0(0) = 1 * j0(inf) = 0 * * Method -- y0(x): * 1. For x<2. * Since * y0(x) = 2/pi*(j0(x)*(ln(x/2)+Euler) + x^2/4 - ...) * therefore y0(x)-2/pi*j0(x)*ln(x) is an even function. * We use the following function to approximate y0, * y0(x) = U(z)/V(z) + (2/pi)*(j0(x)*ln(x)), z= x^2 * where * U(z) = u00 + u01*z + ... + u06*z^6 * V(z) = 1 + v01*z + ... + v04*z^4 * with absolute approximation error bounded by 2**-72. * Note: For tiny x, U/V = u0 and j0(x)~1, hence * y0(tiny) = u0 + (2/pi)*ln(tiny), (choose tiny<2**-27) * 2. For x>=2. * y0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)+q0(x)*sin(x0)) * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) * by the method mentioned above. * 3. Special cases: y0(0)=-inf, y0(x<0)=NaN, y0(inf)=0. */ #include #include "math_private.h" static double pzero(double), qzero(double); static const double huge = 1e300, one = 1.0, invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ /* R0/S0 on [0, 2.00] */ R02 = 1.56249999999999947958e-02, /* 0x3F8FFFFF, 0xFFFFFFFD */ R03 = -1.89979294238854721751e-04, /* 0xBF28E6A5, 0xB61AC6E9 */ R04 = 1.82954049532700665670e-06, /* 0x3EBEB1D1, 0x0C503919 */ R05 = -4.61832688532103189199e-09, /* 0xBE33D5E7, 0x73D63FCE */ S01 = 1.56191029464890010492e-02, /* 0x3F8FFCE8, 0x82C8C2A4 */ S02 = 1.16926784663337450260e-04, /* 0x3F1EA6D2, 0xDD57DBF4 */ S03 = 5.13546550207318111446e-07, /* 0x3EA13B54, 0xCE84D5A9 */ S04 = 1.16614003333790000205e-09; /* 0x3E1408BC, 0xF4745D8F */ static const double zero = 0.0; OLM_DLLEXPORT double __ieee754_j0(double x) { double z, s,c,ss,cc,r,u,v; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) return one/(x*x); x = fabs(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sin(x); c = cos(x); ss = s-c; cc = s+c; if(ix<0x7fe00000) { /* make sure x+x not overflow */ z = -cos(x+x); if ((s*c)0x48000000) z = (invsqrtpi*cc)/sqrt(x); else { u = pzero(x); v = qzero(x); z = invsqrtpi*(u*cc-v*ss)/sqrt(x); } return z; } if(ix<0x3f200000) { /* |x| < 2**-13 */ if(huge+x>one) { /* raise inexact if x != 0 */ if(ix<0x3e400000) return one; /* |x|<2**-27 */ else return one - 0.25*x*x; } } z = x*x; r = z*(R02+z*(R03+z*(R04+z*R05))); s = one+z*(S01+z*(S02+z*(S03+z*S04))); if(ix < 0x3FF00000) { /* |x| < 1.00 */ return one + z*(-0.25+(r/s)); } else { u = 0.5*x; return((one+u)*(one-u)+z*(r/s)); } } static const double u00 = -7.38042951086872317523e-02, /* 0xBFB2E4D6, 0x99CBD01F */ u01 = 1.76666452509181115538e-01, /* 0x3FC69D01, 0x9DE9E3FC */ u02 = -1.38185671945596898896e-02, /* 0xBF8C4CE8, 0xB16CFA97 */ u03 = 3.47453432093683650238e-04, /* 0x3F36C54D, 0x20B29B6B */ u04 = -3.81407053724364161125e-06, /* 0xBECFFEA7, 0x73D25CAD */ u05 = 1.95590137035022920206e-08, /* 0x3E550057, 0x3B4EABD4 */ u06 = -3.98205194132103398453e-11, /* 0xBDC5E43D, 0x693FB3C8 */ v01 = 1.27304834834123699328e-02, /* 0x3F8A1270, 0x91C9C71A */ v02 = 7.60068627350353253702e-05, /* 0x3F13ECBB, 0xF578C6C1 */ v03 = 2.59150851840457805467e-07, /* 0x3E91642D, 0x7FF202FD */ v04 = 4.41110311332675467403e-10; /* 0x3DFE5018, 0x3BD6D9EF */ OLM_DLLEXPORT double __ieee754_y0(double x) { double z, s,c,ss,cc,u,v; int32_t hx,ix,lx; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */ if(ix>=0x7ff00000) return one/(x+x*x); if((ix|lx)==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0)) * where x0 = x-pi/4 * Better formula: * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) * = 1/sqrt(2) * (sin(x) + cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ s = sin(x); c = cos(x); ss = s-c; cc = s+c; /* * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) */ if(ix<0x7fe00000) { /* make sure x+x not overflow */ z = -cos(x+x); if ((s*c)0x48000000) z = (invsqrtpi*ss)/sqrt(x); else { u = pzero(x); v = qzero(x); z = invsqrtpi*(u*ss+v*cc)/sqrt(x); } return z; } if(ix<=0x3e400000) { /* x < 2**-27 */ return(u00 + tpi*__ieee754_log(x)); } z = x*x; u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06))))); v = one+z*(v01+z*(v02+z*(v03+z*v04))); return(u/v + tpi*(__ieee754_j0(x)*__ieee754_log(x))); } /* The asymptotic expansions of pzero is * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x. * For x >= 2, We approximate pzero by * pzero(x) = 1 + (R/S) * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10 * S = 1 + pS0*s^2 + ... + pS4*s^10 * and * | pzero(x)-1-R/S | <= 2 ** ( -60.26) */ static const double pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ -7.03124999999900357484e-02, /* 0xBFB1FFFF, 0xFFFFFD32 */ -8.08167041275349795626e+00, /* 0xC02029D0, 0xB44FA779 */ -2.57063105679704847262e+02, /* 0xC0701102, 0x7B19E863 */ -2.48521641009428822144e+03, /* 0xC0A36A6E, 0xCD4DCAFC */ -5.25304380490729545272e+03, /* 0xC0B4850B, 0x36CC643D */ }; static const double pS8[5] = { 1.16534364619668181717e+02, /* 0x405D2233, 0x07A96751 */ 3.83374475364121826715e+03, /* 0x40ADF37D, 0x50596938 */ 4.05978572648472545552e+04, /* 0x40E3D2BB, 0x6EB6B05F */ 1.16752972564375915681e+05, /* 0x40FC810F, 0x8F9FA9BD */ 4.76277284146730962675e+04, /* 0x40E74177, 0x4F2C49DC */ }; static const double pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -1.14125464691894502584e-11, /* 0xBDA918B1, 0x47E495CC */ -7.03124940873599280078e-02, /* 0xBFB1FFFF, 0xE69AFBC6 */ -4.15961064470587782438e+00, /* 0xC010A370, 0xF90C6BBF */ -6.76747652265167261021e+01, /* 0xC050EB2F, 0x5A7D1783 */ -3.31231299649172967747e+02, /* 0xC074B3B3, 0x6742CC63 */ -3.46433388365604912451e+02, /* 0xC075A6EF, 0x28A38BD7 */ }; static const double pS5[5] = { 6.07539382692300335975e+01, /* 0x404E6081, 0x0C98C5DE */ 1.05125230595704579173e+03, /* 0x40906D02, 0x5C7E2864 */ 5.97897094333855784498e+03, /* 0x40B75AF8, 0x8FBE1D60 */ 9.62544514357774460223e+03, /* 0x40C2CCB8, 0xFA76FA38 */ 2.40605815922939109441e+03, /* 0x40A2CC1D, 0xC70BE864 */ }; static const double pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ -2.54704601771951915620e-09, /* 0xBE25E103, 0x6FE1AA86 */ -7.03119616381481654654e-02, /* 0xBFB1FFF6, 0xF7C0E24B */ -2.40903221549529611423e+00, /* 0xC00345B2, 0xAEA48074 */ -2.19659774734883086467e+01, /* 0xC035F74A, 0x4CB94E14 */ -5.80791704701737572236e+01, /* 0xC04D0A22, 0x420A1A45 */ -3.14479470594888503854e+01, /* 0xC03F72AC, 0xA892D80F */ }; static const double pS3[5] = { 3.58560338055209726349e+01, /* 0x4041ED92, 0x84077DD3 */ 3.61513983050303863820e+02, /* 0x40769839, 0x464A7C0E */ 1.19360783792111533330e+03, /* 0x4092A66E, 0x6D1061D6 */ 1.12799679856907414432e+03, /* 0x40919FFC, 0xB8C39B7E */ 1.73580930813335754692e+02, /* 0x4065B296, 0xFC379081 */ }; static const double pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -8.87534333032526411254e-08, /* 0xBE77D316, 0xE927026D */ -7.03030995483624743247e-02, /* 0xBFB1FF62, 0x495E1E42 */ -1.45073846780952986357e+00, /* 0xBFF73639, 0x8A24A843 */ -7.63569613823527770791e+00, /* 0xC01E8AF3, 0xEDAFA7F3 */ -1.11931668860356747786e+01, /* 0xC02662E6, 0xC5246303 */ -3.23364579351335335033e+00, /* 0xC009DE81, 0xAF8FE70F */ }; static const double pS2[5] = { 2.22202997532088808441e+01, /* 0x40363865, 0x908B5959 */ 1.36206794218215208048e+02, /* 0x4061069E, 0x0EE8878F */ 2.70470278658083486789e+02, /* 0x4070E786, 0x42EA079B */ 1.53875394208320329881e+02, /* 0x40633C03, 0x3AB6FAFF */ 1.46576176948256193810e+01, /* 0x402D50B3, 0x44391809 */ }; /* Note: This function is only called for ix>=0x40000000 (see above) */ static double pzero(double x) { const double *p,*q; double z,r,s; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; assert(ix>=0x40000000 && ix<=0x48000000); if(ix>=0x40200000) {p = pR8; q= pS8;} else if(ix>=0x40122E8B){p = pR5; q= pS5;} else if(ix>=0x4006DB6D){p = pR3; q= pS3;} else {p = pR2; q= pS2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qzero is * -1/8 s + 75/1024 s^3 - ..., where s = 1/x. * We approximate pzero by * qzero(x) = s*(-1.25 + (R/S)) * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10 * S = 1 + qS0*s^2 + ... + qS5*s^12 * and * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22) */ static const double qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ 7.32421874999935051953e-02, /* 0x3FB2BFFF, 0xFFFFFE2C */ 1.17682064682252693899e+01, /* 0x40278952, 0x5BB334D6 */ 5.57673380256401856059e+02, /* 0x40816D63, 0x15301825 */ 8.85919720756468632317e+03, /* 0x40C14D99, 0x3E18F46D */ 3.70146267776887834771e+04, /* 0x40E212D4, 0x0E901566 */ }; static const double qS8[6] = { 1.63776026895689824414e+02, /* 0x406478D5, 0x365B39BC */ 8.09834494656449805916e+03, /* 0x40BFA258, 0x4E6B0563 */ 1.42538291419120476348e+05, /* 0x41016652, 0x54D38C3F */ 8.03309257119514397345e+05, /* 0x412883DA, 0x83A52B43 */ 8.40501579819060512818e+05, /* 0x4129A66B, 0x28DE0B3D */ -3.43899293537866615225e+05, /* 0xC114FD6D, 0x2C9530C5 */ }; static const double qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.84085963594515531381e-11, /* 0x3DB43D8F, 0x29CC8CD9 */ 7.32421766612684765896e-02, /* 0x3FB2BFFF, 0xD172B04C */ 5.83563508962056953777e+00, /* 0x401757B0, 0xB9953DD3 */ 1.35111577286449829671e+02, /* 0x4060E392, 0x0A8788E9 */ 1.02724376596164097464e+03, /* 0x40900CF9, 0x9DC8C481 */ 1.98997785864605384631e+03, /* 0x409F17E9, 0x53C6E3A6 */ }; static const double qS5[6] = { 8.27766102236537761883e+01, /* 0x4054B1B3, 0xFB5E1543 */ 2.07781416421392987104e+03, /* 0x40A03BA0, 0xDA21C0CE */ 1.88472887785718085070e+04, /* 0x40D267D2, 0x7B591E6D */ 5.67511122894947329769e+04, /* 0x40EBB5E3, 0x97E02372 */ 3.59767538425114471465e+04, /* 0x40E19118, 0x1F7A54A0 */ -5.35434275601944773371e+03, /* 0xC0B4EA57, 0xBEDBC609 */ }; static const double qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ 4.37741014089738620906e-09, /* 0x3E32CD03, 0x6ADECB82 */ 7.32411180042911447163e-02, /* 0x3FB2BFEE, 0x0E8D0842 */ 3.34423137516170720929e+00, /* 0x400AC0FC, 0x61149CF5 */ 4.26218440745412650017e+01, /* 0x40454F98, 0x962DAEDD */ 1.70808091340565596283e+02, /* 0x406559DB, 0xE25EFD1F */ 1.66733948696651168575e+02, /* 0x4064D77C, 0x81FA21E0 */ }; static const double qS3[6] = { 4.87588729724587182091e+01, /* 0x40486122, 0xBFE343A6 */ 7.09689221056606015736e+02, /* 0x40862D83, 0x86544EB3 */ 3.70414822620111362994e+03, /* 0x40ACF04B, 0xE44DFC63 */ 6.46042516752568917582e+03, /* 0x40B93C6C, 0xD7C76A28 */ 2.51633368920368957333e+03, /* 0x40A3A8AA, 0xD94FB1C0 */ -1.49247451836156386662e+02, /* 0xC062A7EB, 0x201CF40F */ }; static const double qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.50444444886983272379e-07, /* 0x3E84313B, 0x54F76BDB */ 7.32234265963079278272e-02, /* 0x3FB2BEC5, 0x3E883E34 */ 1.99819174093815998816e+00, /* 0x3FFFF897, 0xE727779C */ 1.44956029347885735348e+01, /* 0x402CFDBF, 0xAAF96FE5 */ 3.16662317504781540833e+01, /* 0x403FAA8E, 0x29FBDC4A */ 1.62527075710929267416e+01, /* 0x403040B1, 0x71814BB4 */ }; static const double qS2[6] = { 3.03655848355219184498e+01, /* 0x403E5D96, 0xF7C07AED */ 2.69348118608049844624e+02, /* 0x4070D591, 0xE4D14B40 */ 8.44783757595320139444e+02, /* 0x408A6645, 0x22B3BF22 */ 8.82935845112488550512e+02, /* 0x408B977C, 0x9C5CC214 */ 2.12666388511798828631e+02, /* 0x406A9553, 0x0E001365 */ -5.31095493882666946917e+00, /* 0xC0153E6A, 0xF8B32931 */ }; /* Note: This function is only called for ix>=0x40000000 (see above) */ static double qzero(double x) { const double *p,*q; double s,r,z; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; assert(ix>=0x40000000 && ix<=0x48000000); if(ix>=0x40200000) {p = qR8; q= qS8;} else if(ix>=0x40122E8B){p = qR5; q= qS5;} else if(ix>=0x4006DB6D){p = qR3; q= qS3;} else {p = qR2; q= qS2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return (-.125 + r/s)/x; } wcc-0.0.2/src/wsh/openlibm/src/polevll.c0000644000175000017500000000453313122010155016537 0ustar philphil/* $OpenBSD: polevll.c,v 1.2 2013/11/12 20:35:09 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* polevll.c * p1evll.c * * Evaluate polynomial * * * * SYNOPSIS: * * int N; * long double x, y, coef[N+1], polevl[]; * * y = polevll( x, coef, N ); * * * * DESCRIPTION: * * Evaluates polynomial of degree N: * * 2 N * y = C + C x + C x +...+ C x * 0 1 2 N * * Coefficients are stored in reverse order: * * coef[0] = C , ..., coef[N] = C . * N 0 * * The function p1evll() assumes that coef[N] = 1.0 and is * omitted from the array. Its calling arguments are * otherwise the same as polevll(). * * * SPEED: * * In the interest of speed, there are no checks for out * of bounds arithmetic. This routine is used by most of * the functions in the library. Depending on available * equipment features, the user may wish to rewrite the * program in microcode or assembly language. * */ #include #include "math_private.h" /* * Polynomial evaluator: * P[0] x^n + P[1] x^(n-1) + ... + P[n] */ long double __polevll(long double x, void *PP, int n) { long double y; long double *P; P = (long double *)PP; y = *P++; do { y = y * x + *P++; } while (--n); return (y); } /* * Polynomial evaluator: * x^n + P[0] x^(n-1) + P[1] x^(n-2) + ... + P[n] */ long double __p1evll(long double x, void *PP, int n) { long double y; long double *P; P = (long double *)PP; n -= 1; y = x + *P++; do { y = y * x + *P++; } while (--n); return (y); } wcc-0.0.2/src/wsh/openlibm/src/e_rem_pio2.c0000644000175000017500000001163013122010155017076 0ustar philphil /* @(#)e_rem_pio2.c 1.4 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * Optimized by Bruce D. Evans. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_rem_pio2.c,v 1.22 2011/06/19 17:07:58 kargl Exp $"); /* __ieee754_rem_pio2(x,y) * * return the remainder of x rem pi/2 in y[0]+y[1] * use __kernel_rem_pio2() */ #include #include #include "math_private.h" /* * invpio2: 53 bits of 2/pi * pio2_1: first 33 bit of pi/2 * pio2_1t: pi/2 - pio2_1 * pio2_2: second 33 bit of pi/2 * pio2_2t: pi/2 - (pio2_1+pio2_2) * pio2_3: third 33 bit of pi/2 * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3) */ static const double zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */ invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ pio2_1 = 1.57079632673412561417e+00, /* 0x3FF921FB, 0x54400000 */ pio2_1t = 6.07710050650619224932e-11, /* 0x3DD0B461, 0x1A626331 */ pio2_2 = 6.07710050630396597660e-11, /* 0x3DD0B461, 0x1A600000 */ pio2_2t = 2.02226624879595063154e-21, /* 0x3BA3198A, 0x2E037073 */ pio2_3 = 2.02226624871116645580e-21, /* 0x3BA3198A, 0x2E000000 */ pio2_3t = 8.47842766036889956997e-32; /* 0x397B839A, 0x252049C1 */ __inline int __ieee754_rem_pio2(double x, double *y) { double z,w,t,r,fn; double tx[3],ty[2]; int32_t e0,i,j,nx,n,ix,hx; u_int32_t low; GET_HIGH_WORD(hx,x); /* high word of x */ ix = hx&0x7fffffff; #if 0 /* Must be handled in caller. */ if(ix<=0x3fe921fb) /* |x| ~<= pi/4 , no need for reduction */ {y[0] = x; y[1] = 0; return 0;} #endif if (ix <= 0x400f6a7a) { /* |x| ~<= 5pi/4 */ if ((ix & 0xfffff) == 0x921fb) /* |x| ~= pi/2 or 2pi/2 */ goto medium; /* cancellation -- use medium case */ if (ix <= 0x4002d97c) { /* |x| ~<= 3pi/4 */ if (hx > 0) { z = x - pio2_1; /* one round good to 85 bits */ y[0] = z - pio2_1t; y[1] = (z-y[0])-pio2_1t; return 1; } else { z = x + pio2_1; y[0] = z + pio2_1t; y[1] = (z-y[0])+pio2_1t; return -1; } } else { if (hx > 0) { z = x - 2*pio2_1; y[0] = z - 2*pio2_1t; y[1] = (z-y[0])-2*pio2_1t; return 2; } else { z = x + 2*pio2_1; y[0] = z + 2*pio2_1t; y[1] = (z-y[0])+2*pio2_1t; return -2; } } } if (ix <= 0x401c463b) { /* |x| ~<= 9pi/4 */ if (ix <= 0x4015fdbc) { /* |x| ~<= 7pi/4 */ if (ix == 0x4012d97c) /* |x| ~= 3pi/2 */ goto medium; if (hx > 0) { z = x - 3*pio2_1; y[0] = z - 3*pio2_1t; y[1] = (z-y[0])-3*pio2_1t; return 3; } else { z = x + 3*pio2_1; y[0] = z + 3*pio2_1t; y[1] = (z-y[0])+3*pio2_1t; return -3; } } else { if (ix == 0x401921fb) /* |x| ~= 4pi/2 */ goto medium; if (hx > 0) { z = x - 4*pio2_1; y[0] = z - 4*pio2_1t; y[1] = (z-y[0])-4*pio2_1t; return 4; } else { z = x + 4*pio2_1; y[0] = z + 4*pio2_1t; y[1] = (z-y[0])+4*pio2_1t; return -4; } } } if(ix<0x413921fb) { /* |x| ~< 2^20*(pi/2), medium size */ medium: /* Use a specialized rint() to get fn. Assume round-to-nearest. */ STRICT_ASSIGN(double,fn,x*invpio2+0x1.8p52); fn = fn-0x1.8p52; #ifdef HAVE_EFFICIENT_IRINT n = irint(fn); #else n = (int32_t)fn; #endif r = x-fn*pio2_1; w = fn*pio2_1t; /* 1st round good to 85 bit */ { u_int32_t high; j = ix>>20; y[0] = r-w; GET_HIGH_WORD(high,y[0]); i = j-((high>>20)&0x7ff); if(i>16) { /* 2nd iteration needed, good to 118 */ t = r; w = fn*pio2_2; r = t-w; w = fn*pio2_2t-((t-r)-w); y[0] = r-w; GET_HIGH_WORD(high,y[0]); i = j-((high>>20)&0x7ff); if(i>49) { /* 3rd iteration need, 151 bits acc */ t = r; /* will cover all possible cases */ w = fn*pio2_3; r = t-w; w = fn*pio2_3t-((t-r)-w); y[0] = r-w; } } } y[1] = (r-y[0])-w; return n; } /* * all other (large) arguments */ if(ix>=0x7ff00000) { /* x is inf or NaN */ y[0]=y[1]=x-x; return 0; } /* set z = scalbn(|x|,ilogb(x)-23) */ GET_LOW_WORD(low,x); e0 = (ix>>20)-1046; /* e0 = ilogb(z)-23; */ INSERT_WORDS(z, ix - ((int32_t)(e0<<20)), low); for(i=0;i<2;i++) { tx[i] = (double)((int32_t)(z)); z = (z-tx[i])*two24; } tx[2] = z; nx = 3; while(tx[nx-1]==zero) nx--; /* skip zero term */ n = __kernel_rem_pio2(tx,ty,e0,nx,1); if(hx<0) {y[0] = -ty[0]; y[1] = -ty[1]; return -n;} y[0] = ty[0]; y[1] = ty[1]; return n; } wcc-0.0.2/src/wsh/openlibm/src/s_csinf.c0000644000175000017500000000337213122010155016506 0ustar philphil/* $OpenBSD: s_csinf.c,v 1.2 2010/07/18 18:42:26 guenther Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* csinf() * * Complex circular sine * * * * SYNOPSIS: * * void csinf(); * cmplxf z, w; * * csinf( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = sin x cosh y + i cos x sinh y. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.9e-7 5.5e-8 * */ #include #include /* calculate cosh and sinh */ static void cchshf(float xx, float *c, float *s) { float x, e, ei; x = xx; if(fabsf(x) <= 0.5f) { *c = coshf(x); *s = sinhf(x); } else { e = expf(x); ei = 0.5f/e; e = 0.5f * e; *s = e - ei; *c = e + ei; } } float complex csinf(float complex z) { float complex w; float ch, sh; cchshf(cimagf(z), &ch, &sh); w = sinf(crealf(z)) * ch + (cosf(crealf(z)) * sh) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_casinl.c0000644000175000017500000000563213122010155016656 0ustar philphil/* $OpenBSD: s_casinl.c,v 1.3 2011/07/20 21:02:51 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* casinl() * * Complex circular arc sine * * * * SYNOPSIS: * * long double complex casinl(); * long double complex z, w; * * w = casinl( z ); * * * * DESCRIPTION: * * Inverse complex sine: * * 2 * w = -i clog( iz + csqrt( 1 - z ) ). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 10100 2.1e-15 3.4e-16 * IEEE -10,+10 30000 2.2e-14 2.7e-15 * Larger relative error can be observed for z near zero. * Also tested by csin(casin(z)) = z. */ #include #include #include #if LDBL_MANT_DIG == 64 static const long double MACHEPL= 5.42101086242752217003726400434970855712890625E-20L; #elif LDBL_MANT_DIG == 113 static const long double MACHEPL = 9.629649721936179265279889712924636592690508e-35L; #endif static const long double PIO2L = 1.570796326794896619231321691639751442098585L; long double complex casinl(long double complex z) { long double complex w; long double x, y, b; static long double complex ca, ct, zz, z2; x = creall(z); y = cimagl(z); if (y == 0.0L) { if (fabsl(x) > 1.0L) { w = PIO2L + 0.0L * I; /*mtherr( "casinl", DOMAIN );*/ } else { w = asinl(x) + 0.0L * I; } return (w); } /* Power series expansion */ b = cabsl(z); if (b < 0.125L) { long double complex sum; long double n, cn; z2 = (x - y) * (x + y) + (2.0L * x * y) * I; cn = 1.0L; n = 1.0L; ca = x + y * I; sum = x + y * I; do { ct = z2 * ca; ca = ct; cn *= n; n += 1.0L; cn /= n; n += 1.0L; b = cn/n; ct *= b; sum += ct; b = cabsl(ct); } while (b > MACHEPL); w = sum; return w; } ca = x + y * I; ct = ca * I; /* iz */ /* sqrt(1 - z*z) */ /* cmul(&ca, &ca, &zz) */ /* x * x - y * y */ zz = (x - y) * (x + y) + (2.0L * x * y) * I; zz = 1.0L - creall(zz) - cimagl(zz) * I; z2 = csqrtl(zz); zz = ct + z2; zz = clogl(zz); /* multiply by 1/i = -i */ w = zz * (-1.0L * I); return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_erff.c0000644000175000017500000001344213122010155016325 0ustar philphil/* s_erff.c -- float version of s_erf.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_erff.c,v 1.8 2008/02/22 02:30:35 das Exp $"); #include #include "math_private.h" static const float tiny = 1e-30, half= 5.0000000000e-01, /* 0x3F000000 */ one = 1.0000000000e+00, /* 0x3F800000 */ two = 2.0000000000e+00, /* 0x40000000 */ /* * Coefficients for approximation to erf on [0,0.84375] */ efx = 1.2837916613e-01, /* 0x3e0375d4 */ efx8= 1.0270333290e+00, /* 0x3f8375d4 */ /* * Domain [0, 0.84375], range ~[-5.4446e-10,5.5197e-10]: * |(erf(x) - x)/x - p(x)/q(x)| < 2**-31. */ pp0 = 1.28379166e-01F, /* 0x1.06eba8p-3 */ pp1 = -3.36030394e-01F, /* -0x1.58185ap-2 */ pp2 = -1.86260219e-03F, /* -0x1.e8451ep-10 */ qq1 = 3.12324286e-01F, /* 0x1.3fd1f0p-2 */ qq2 = 2.16070302e-02F, /* 0x1.620274p-6 */ qq3 = -1.98859419e-03F, /* -0x1.04a626p-9 */ /* * Domain [0.84375, 1.25], range ~[-1.953e-11,1.940e-11]: * |(erf(x) - erx) - p(x)/q(x)| < 2**-36. */ erx = 8.42697144e-01F, /* 0x1.af7600p-1. erf(1) rounded to 16 bits. */ pa0 = 3.64939137e-06F, /* 0x1.e9d022p-19 */ pa1 = 4.15109694e-01F, /* 0x1.a91284p-2 */ pa2 = -1.65179938e-01F, /* -0x1.5249dcp-3 */ pa3 = 1.10914491e-01F, /* 0x1.c64e46p-4 */ qa1 = 6.02074385e-01F, /* 0x1.344318p-1 */ qa2 = 5.35934687e-01F, /* 0x1.126608p-1 */ qa3 = 1.68576106e-01F, /* 0x1.593e6ep-3 */ qa4 = 5.62181212e-02F, /* 0x1.cc89f2p-5 */ /* * Domain [1.25,1/0.35], range ~[-7.043e-10,7.457e-10]: * |log(x*erfc(x)) + x**2 + 0.5625 - r(x)/s(x)| < 2**-30 */ ra0 = -9.87132732e-03F, /* -0x1.4376b2p-7 */ ra1 = -5.53605914e-01F, /* -0x1.1b723cp-1 */ ra2 = -2.17589188e+00F, /* -0x1.1683a0p+1 */ ra3 = -1.43268085e+00F, /* -0x1.6ec42cp+0 */ sa1 = 5.45995426e+00F, /* 0x1.5d6fe4p+2 */ sa2 = 6.69798088e+00F, /* 0x1.acabb8p+2 */ sa3 = 1.43113089e+00F, /* 0x1.6e5e98p+0 */ sa4 = -5.77397496e-02F, /* -0x1.d90108p-5 */ /* * Domain [1/0.35, 11], range ~[-2.264e-13,2.336e-13]: * |log(x*erfc(x)) + x**2 + 0.5625 - r(x)/s(x)| < 2**-42 */ rb0 = -9.86494310e-03F, /* -0x1.434124p-7 */ rb1 = -6.25171244e-01F, /* -0x1.401672p-1 */ rb2 = -6.16498327e+00F, /* -0x1.8a8f16p+2 */ rb3 = -1.66696873e+01F, /* -0x1.0ab70ap+4 */ rb4 = -9.53764343e+00F, /* -0x1.313460p+3 */ sb1 = 1.26884899e+01F, /* 0x1.96081cp+3 */ sb2 = 4.51839523e+01F, /* 0x1.6978bcp+5 */ sb3 = 4.72810211e+01F, /* 0x1.7a3f88p+5 */ sb4 = 8.93033314e+00F; /* 0x1.1dc54ap+3 */ OLM_DLLEXPORT float erff(float x) { int32_t hx,ix,i; float R,S,P,Q,s,y,z,r; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) { /* erf(nan)=nan */ i = ((u_int32_t)hx>>31)<<1; return (float)(1-i)+one/x; /* erf(+-inf)=+-1 */ } if(ix < 0x3f580000) { /* |x|<0.84375 */ if(ix < 0x38800000) { /* |x|<2**-14 */ if (ix < 0x04000000) /* |x|<0x1p-119 */ return (8*x+efx8*x)/8; /* avoid spurious underflow */ return x + efx*x; } z = x*x; r = pp0+z*(pp1+z*pp2); s = one+z*(qq1+z*(qq2+z*qq3)); y = r/s; return x + x*y; } if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */ s = fabsf(x)-one; P = pa0+s*(pa1+s*(pa2+s*pa3)); Q = one+s*(qa1+s*(qa2+s*(qa3+s*qa4))); if(hx>=0) return erx + P/Q; else return -erx - P/Q; } if (ix >= 0x40800000) { /* inf>|x|>=4 */ if(hx>=0) return one-tiny; else return tiny-one; } x = fabsf(x); s = one/(x*x); if(ix< 0x4036DB6E) { /* |x| < 1/0.35 */ R=ra0+s*(ra1+s*(ra2+s*ra3)); S=one+s*(sa1+s*(sa2+s*(sa3+s*sa4))); } else { /* |x| >= 1/0.35 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*rb4))); S=one+s*(sb1+s*(sb2+s*(sb3+s*sb4))); } SET_FLOAT_WORD(z,hx&0xffffe000); r = expf(-z*z-0.5625F)*expf((z-x)*(z+x)+R/S); if(hx>=0) return one-r/x; else return r/x-one; } OLM_DLLEXPORT float erfcf(float x) { int32_t hx,ix; float R,S,P,Q,s,y,z,r; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) { /* erfc(nan)=nan */ /* erfc(+-inf)=0,2 */ return (float)(((u_int32_t)hx>>31)<<1)+one/x; } if(ix < 0x3f580000) { /* |x|<0.84375 */ if(ix < 0x33800000) /* |x|<2**-56 */ return one-x; z = x*x; r = pp0+z*(pp1+z*pp2); s = one+z*(qq1+z*(qq2+z*qq3)); y = r/s; if(hx < 0x3e800000) { /* x<1/4 */ return one-(x+x*y); } else { r = x*y; r += (x-half); return half - r ; } } if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */ s = fabsf(x)-one; P = pa0+s*(pa1+s*(pa2+s*pa3)); Q = one+s*(qa1+s*(qa2+s*(qa3+s*qa4))); if(hx>=0) { z = one-erx; return z - P/Q; } else { z = erx+P/Q; return one+z; } } if (ix < 0x41300000) { /* |x|<28 */ x = fabsf(x); s = one/(x*x); if(ix< 0x4036DB6D) { /* |x| < 1/.35 ~ 2.857143*/ R=ra0+s*(ra1+s*(ra2+s*ra3)); S=one+s*(sa1+s*(sa2+s*(sa3+s*sa4))); } else { /* |x| >= 1/.35 ~ 2.857143 */ if(hx<0&&ix>=0x40a00000) return two-tiny;/* x < -5 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*rb4))); S=one+s*(sb1+s*(sb2+s*(sb3+s*sb4))); } SET_FLOAT_WORD(z,hx&0xffffe000); r = expf(-z*z-0.5625F)*expf((z-x)*(z+x)+R/S); if(hx>0) return r/x; else return two-r/x; } else { if(hx>0) return tiny*tiny; else return two-tiny; } } wcc-0.0.2/src/wsh/openlibm/src/s_atan.c0000644000175000017500000001025513122010155016325 0ustar philphil/* @(#)s_atan.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_atan.c,v 1.13 2011/02/10 07:37:50 das Exp $"); /* atan(x) * Method * 1. Reduce x to positive by atan(x) = -atan(-x). * 2. According to the integer k=4t+0.25 chopped, t=x, the argument * is further reduced to one of the following intervals and the * arctangent of t is evaluated by the corresponding formula: * * [0,7/16] atan(x) = t-t^3*(a1+t^2*(a2+...(a10+t^2*a11)...) * [7/16,11/16] atan(x) = atan(1/2) + atan( (t-0.5)/(1+t/2) ) * [11/16.19/16] atan(x) = atan( 1 ) + atan( (t-1)/(1+t) ) * [19/16,39/16] atan(x) = atan(3/2) + atan( (t-1.5)/(1+1.5t) ) * [39/16,INF] atan(x) = atan(INF) + atan( -1/t ) * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include #include #include "math_private.h" static const double atanhi[] = { 4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */ 7.85398163397448278999e-01, /* atan(1.0)hi 0x3FE921FB, 0x54442D18 */ 9.82793723247329054082e-01, /* atan(1.5)hi 0x3FEF730B, 0xD281F69B */ 1.57079632679489655800e+00, /* atan(inf)hi 0x3FF921FB, 0x54442D18 */ }; static const double atanlo[] = { 2.26987774529616870924e-17, /* atan(0.5)lo 0x3C7A2B7F, 0x222F65E2 */ 3.06161699786838301793e-17, /* atan(1.0)lo 0x3C81A626, 0x33145C07 */ 1.39033110312309984516e-17, /* atan(1.5)lo 0x3C700788, 0x7AF0CBBD */ 6.12323399573676603587e-17, /* atan(inf)lo 0x3C91A626, 0x33145C07 */ }; static const double aT[] = { 3.33333333333329318027e-01, /* 0x3FD55555, 0x5555550D */ -1.99999999998764832476e-01, /* 0xBFC99999, 0x9998EBC4 */ 1.42857142725034663711e-01, /* 0x3FC24924, 0x920083FF */ -1.11111104054623557880e-01, /* 0xBFBC71C6, 0xFE231671 */ 9.09088713343650656196e-02, /* 0x3FB745CD, 0xC54C206E */ -7.69187620504482999495e-02, /* 0xBFB3B0F2, 0xAF749A6D */ 6.66107313738753120669e-02, /* 0x3FB10D66, 0xA0D03D51 */ -5.83357013379057348645e-02, /* 0xBFADDE2D, 0x52DEFD9A */ 4.97687799461593236017e-02, /* 0x3FA97B4B, 0x24760DEB */ -3.65315727442169155270e-02, /* 0xBFA2B444, 0x2C6A6C2F */ 1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */ }; static const double one = 1.0, huge = 1.0e300; OLM_DLLEXPORT double atan(double x) { double w,s1,s2,z; int32_t ix,hx,id; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x44100000) { /* if |x| >= 2^66 */ u_int32_t low; GET_LOW_WORD(low,x); if(ix>0x7ff00000|| (ix==0x7ff00000&&(low!=0))) return x+x; /* NaN */ if(hx>0) return atanhi[3]+*(volatile double *)&atanlo[3]; else return -atanhi[3]-*(volatile double *)&atanlo[3]; } if (ix < 0x3fdc0000) { /* |x| < 0.4375 */ if (ix < 0x3e400000) { /* |x| < 2^-27 */ if(huge+x>one) return x; /* raise inexact */ } id = -1; } else { x = fabs(x); if (ix < 0x3ff30000) { /* |x| < 1.1875 */ if (ix < 0x3fe60000) { /* 7/16 <=|x|<11/16 */ id = 0; x = (2.0*x-one)/(2.0+x); } else { /* 11/16<=|x|< 19/16 */ id = 1; x = (x-one)/(x+one); } } else { if (ix < 0x40038000) { /* |x| < 2.4375 */ id = 2; x = (x-1.5)/(one+1.5*x); } else { /* 2.4375 <= |x| < 2^66 */ id = 3; x = -1.0/x; } }} /* end of argument reduction */ z = x*x; w = z*z; /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */ s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10]))))); s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9])))); if (id<0) return x - x*(s1+s2); else { z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x); return (hx<0)? -z:z; } } #if LDBL_MANT_DIG == 53 __weak_reference(atan, atanl); #endif wcc-0.0.2/src/wsh/openlibm/src/powerpc_fpmath.h0000644000175000017500000000342213122010155020101 0ustar philphil/*- * Copyright (c) 2003 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD$ */ union IEEEl2bits { long double e; struct { unsigned int sign :1; unsigned int exp :11; unsigned int manh :20; unsigned int manl :32; } bits; }; #define mask_nbit_l(u) ((void)0) #define LDBL_IMPLICIT_NBIT #define LDBL_NBIT 0 #define LDBL_MANH_SIZE 20 #define LDBL_MANL_SIZE 32 #define LDBL_TO_ARRAY32(u, a) do { \ (a)[0] = (uint32_t)(u).bits.manl; \ (a)[1] = (uint32_t)(u).bits.manh; \ } while(0) wcc-0.0.2/src/wsh/openlibm/src/s_cpowl.c0000644000175000017500000000357613122010155016536 0ustar philphil/* $OpenBSD: s_cpowl.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cpowl * * Complex power function * * * * SYNOPSIS: * * long double complex cpowl(); * long double complex a, z, w; * * w = cpowl (a, z); * * * * DESCRIPTION: * * Raises complex A to the complex Zth power. * Definition is per AMS55 # 4.2.8, * analytically equivalent to cpow(a,z) = cexp(z clog(a)). * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 9.4e-15 1.5e-15 * */ #include #include #include "math_private.h" OLM_DLLEXPORT long double complex cpowl(long double complex a, long double complex z) { long double complex w; long double x, y, r, theta, absa, arga; x = creall(z); y = cimagl(z); absa = cabsl(a); if (absa == 0.0L) { return (0.0L + 0.0L * I); } arga = cargl(a); r = powl(absa, x); theta = x * arga; if (y != 0.0L) { r = r * expl(-y * arga); theta = theta + y * logl(absa); } w = r * cosl(theta) + (r * sinl(theta)) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_tgammaf.c0000644000175000017500000000350013122010155017011 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_tgammaf.c,v 1.1 2008/02/18 17:27:10 das Exp $"); #include #include "math_private.h" /* * We simply call tgamma() rather than bloating the math library with * a float-optimized version of it. The reason is that tgammaf() is * essentially useless, since the function is superexponential and * floats have very limited range. */ OLM_DLLEXPORT float tgammaf(float x) { return (tgamma(x)); } wcc-0.0.2/src/wsh/openlibm/src/s_llrint.c0000644000175000017500000000034113122010155016701 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_llrint.c,v 1.1 2005/01/11 23:12:55 das Exp $"); #define type double #define roundit rint #define dtype long long #define fn llrint #include "s_lrint.c" wcc-0.0.2/src/wsh/openlibm/src/e_acosf.c0000644000175000017500000000412513122010155016456 0ustar philphil/* e_acosf.c -- float version of e_acos.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_acosf.c,v 1.11 2008/08/03 17:39:54 das Exp $"); #include #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3F800000 */ pi = 3.1415925026e+00, /* 0x40490fda */ pio2_hi = 1.5707962513e+00; /* 0x3fc90fda */ static volatile float pio2_lo = 7.5497894159e-08; /* 0x33a22168 */ static const float pS0 = 1.6666586697e-01, pS1 = -4.2743422091e-02, pS2 = -8.6563630030e-03, qS1 = -7.0662963390e-01; OLM_DLLEXPORT float __ieee754_acosf(float x) { float z,p,q,r,w,s,c,df; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x3f800000) { /* |x| >= 1 */ if(ix==0x3f800000) { /* |x| == 1 */ if(hx>0) return 0.0; /* acos(1) = 0 */ else return pi+(float)2.0*pio2_lo; /* acos(-1)= pi */ } return (x-x)/(x-x); /* acos(|x|>1) is NaN */ } if(ix<0x3f000000) { /* |x| < 0.5 */ if(ix<=0x32800000) return pio2_hi+pio2_lo;/*if|x|<2**-26*/ z = x*x; p = z*(pS0+z*(pS1+z*pS2)); q = one+z*qS1; r = p/q; return pio2_hi - (x - (pio2_lo-x*r)); } else if (hx<0) { /* x < -0.5 */ z = (one+x)*(float)0.5; p = z*(pS0+z*(pS1+z*pS2)); q = one+z*qS1; s = sqrtf(z); r = p/q; w = r*s-pio2_lo; return pi - (float)2.0*(s+w); } else { /* x > 0.5 */ int32_t idf; z = (one-x)*(float)0.5; s = sqrtf(z); df = s; GET_FLOAT_WORD(idf,df); SET_FLOAT_WORD(df,idf&0xfffff000); c = (z-df*df)/(s+df); p = z*(pS0+z*(pS1+z*pS2)); q = one+z*qS1; r = p/q; w = r*s+c; return (float)2.0*(df+w); } } wcc-0.0.2/src/wsh/openlibm/src/s_ctanh.c0000644000175000017500000001046213122010155016477 0ustar philphil/*- * Copyright (c) 2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Hyperbolic tangent of a complex argument z = x + i y. * * The algorithm is from: * * W. Kahan. Branch Cuts for Complex Elementary Functions or Much * Ado About Nothing's Sign Bit. In The State of the Art in * Numerical Analysis, pp. 165 ff. Iserles and Powell, eds., 1987. * * Method: * * Let t = tan(x) * beta = 1/cos^2(y) * s = sinh(x) * rho = cosh(x) * * We have: * * tanh(z) = sinh(z) / cosh(z) * * sinh(x) cos(y) + i cosh(x) sin(y) * = --------------------------------- * cosh(x) cos(y) + i sinh(x) sin(y) * * cosh(x) sinh(x) / cos^2(y) + i tan(y) * = ------------------------------------- * 1 + sinh^2(x) / cos^2(y) * * beta rho s + i t * = ---------------- * 1 + beta s^2 * * Modifications: * * I omitted the original algorithm's handling of overflow in tan(x) after * verifying with nearpi.c that this can't happen in IEEE single or double * precision. I also handle large x differently. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ctanh.c,v 1.2 2011/10/21 06:30:16 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT double complex ctanh(double complex z) { double x, y; double t, beta, s, rho, denom; u_int32_t hx, ix, lx; x = creal(z); y = cimag(z); EXTRACT_WORDS(hx, lx, x); ix = hx & 0x7fffffff; /* * ctanh(NaN + i 0) = NaN + i 0 * * ctanh(NaN + i y) = NaN + i NaN for y != 0 * * The imaginary part has the sign of x*sin(2*y), but there's no * special effort to get this right. * * ctanh(+-Inf +- i Inf) = +-1 +- 0 * * ctanh(+-Inf + i y) = +-1 + 0 sin(2y) for y finite * * The imaginary part of the sign is unspecified. This special * case is only needed to avoid a spurious invalid exception when * y is infinite. */ if (ix >= 0x7ff00000) { if ((ix & 0xfffff) | lx) /* x is NaN */ return (CMPLX(x, (y == 0 ? y : x * y))); SET_HIGH_WORD(x, hx - 0x40000000); /* x = copysign(1, x) */ return (CMPLX(x, copysign(0, isinf(y) ? y : sin(y) * cos(y)))); } /* * ctanh(x + i NAN) = NaN + i NaN * ctanh(x +- i Inf) = NaN + i NaN */ if (!isfinite(y)) return (CMPLX(y - y, y - y)); /* * ctanh(+-huge + i +-y) ~= +-1 +- i 2sin(2y)/exp(2x), using the * approximation sinh^2(huge) ~= exp(2*huge) / 4. * We use a modified formula to avoid spurious overflow. */ if (ix >= 0x40360000) { /* x >= 22 */ double exp_mx = exp(-fabs(x)); return (CMPLX(copysign(1, x), 4 * sin(y) * cos(y) * exp_mx * exp_mx)); } /* Kahan's algorithm */ t = tan(y); beta = 1.0 + t * t; /* = 1 / cos^2(y) */ s = sinh(x); rho = sqrt(1 + s * s); /* = cosh(x) */ denom = 1 + beta * s * s; return (CMPLX((beta * rho * s) / denom, t / denom)); } OLM_DLLEXPORT double complex ctan(double complex z) { /* ctan(z) = -I * ctanh(I * z) */ z = ctanh(CMPLX(-cimag(z), creal(z))); return (CMPLX(cimag(z), -creal(z))); } wcc-0.0.2/src/wsh/openlibm/src/s_truncf.c0000644000175000017500000000246113122010155016703 0ustar philphil/* @(#)s_floor.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_truncf.c,v 1.1 2004/06/20 09:25:43 das Exp $"); /* * truncf(x) * Return x rounded toward 0 to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to truncf(x). */ #include #include "math_private.h" static const float huge = 1.0e30F; OLM_DLLEXPORT float truncf(float x) { int32_t i0,j0; u_int32_t i; GET_FLOAT_WORD(i0,x); j0 = ((i0>>23)&0xff)-0x7f; if(j0<23) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0F) /* |x|<1, so return 0*sign(x) */ i0 &= 0x80000000; } else { i = (0x007fffff)>>j0; if((i0&i)==0) return x; /* x is integral */ if(huge+x>0.0F) /* raise inexact flag */ i0 &= (~i); } } else { if(j0==0x80) return x+x; /* inf or NaN */ else return x; /* x is integral */ } SET_FLOAT_WORD(x,i0); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_catanh.c0000644000175000017500000000304213122010155016634 0ustar philphil/* $OpenBSD: s_catanh.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* catanh * * Complex inverse hyperbolic tangent * * * * SYNOPSIS: * * double complex catanh(); * double complex z, w; * * w = catanh (z); * * * * DESCRIPTION: * * Inverse tanh, equal to -i catan (iz); * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 2.3e-16 6.2e-17 * */ #include #include #include double complex catanh(double complex z) { double complex w; w = -1.0 * I * catan (z * I); return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(catanhl, catanh); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/e_j1f.c0000644000175000017500000002377613122010155016060 0ustar philphil/* e_j1f.c -- float version of e_j1.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include "cdefs-compat.h" #include #include "math_private.h" static float ponef(float), qonef(float); static const float huge = 1e30, one = 1.0, invsqrtpi= 5.6418961287e-01, /* 0x3f106ebb */ tpi = 6.3661974669e-01, /* 0x3f22f983 */ /* R0/S0 on [0,2] */ r00 = -6.2500000000e-02, /* 0xbd800000 */ r01 = 1.4070566976e-03, /* 0x3ab86cfd */ r02 = -1.5995563444e-05, /* 0xb7862e36 */ r03 = 4.9672799207e-08, /* 0x335557d2 */ s01 = 1.9153760746e-02, /* 0x3c9ce859 */ s02 = 1.8594678841e-04, /* 0x3942fab6 */ s03 = 1.1771846857e-06, /* 0x359dffc2 */ s04 = 5.0463624390e-09, /* 0x31ad6446 */ s05 = 1.2354227016e-11; /* 0x2d59567e */ static const float zero = 0.0; OLM_DLLEXPORT float __ieee754_j1f(float x) { float z, s,c,ss,cc,r,u,v,y; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) return one/x; y = fabsf(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sinf(y); c = cosf(y); ss = -s-c; cc = s-c; if(ix<0x7f000000) { /* make sure y+y not overflow */ z = cosf(y+y); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x) * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x) */ if(ix>0x58000000) z = (invsqrtpi*cc)/sqrtf(y); /* |x|>2**49 */ else { u = ponef(y); v = qonef(y); z = invsqrtpi*(u*cc-v*ss)/sqrtf(y); } if(hx<0) return -z; else return z; } if(ix<0x39000000) { /* |x|<2**-13 */ if(huge+x>one) return (float)0.5*x;/* inexact if x!=0 necessary */ } z = x*x; r = z*(r00+z*(r01+z*(r02+z*r03))); s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05)))); r *= x; return(x*(float)0.5+r/s); } static const float U0[5] = { -1.9605709612e-01, /* 0xbe48c331 */ 5.0443872809e-02, /* 0x3d4e9e3c */ -1.9125689287e-03, /* 0xbafaaf2a */ 2.3525259166e-05, /* 0x37c5581c */ -9.1909917899e-08, /* 0xb3c56003 */ }; static const float V0[5] = { 1.9916731864e-02, /* 0x3ca3286a */ 2.0255257550e-04, /* 0x3954644b */ 1.3560879779e-06, /* 0x35b602d4 */ 6.2274145840e-09, /* 0x31d5f8eb */ 1.6655924903e-11, /* 0x2d9281cf */ }; OLM_DLLEXPORT float __ieee754_y1f(float x) { float z, s,c,ss,cc,u,v; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */ if(ix>=0x7f800000) return one/(x+x*x); if(ix==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sinf(x); c = cosf(x); ss = -s-c; cc = s-c; if(ix<0x7f000000) { /* make sure x+x not overflow */ z = cosf(x+x); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0)) * where x0 = x-3pi/4 * Better formula: * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = -1/sqrt(2) * (cos(x) + sin(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ if(ix>0x58000000) z = (invsqrtpi*ss)/sqrtf(x); /* |x|>2**49 */ else { u = ponef(x); v = qonef(x); z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); } return z; } if(ix<=0x33000000) { /* x < 2**-25 */ return(-tpi/x); } z = x*x; u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4]))); v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4])))); return(x*(u/v) + tpi*(__ieee754_j1f(x)*__ieee754_logf(x)-one/x)); } /* For x >= 8, the asymptotic expansions of pone is * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x. * We approximate pone by * pone(x) = 1 + (R/S) * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10 * S = 1 + ps0*s^2 + ... + ps4*s^10 * and * | pone(x)-1-R/S | <= 2 ** ( -60.06) */ static const float pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ 1.1718750000e-01, /* 0x3df00000 */ 1.3239480972e+01, /* 0x4153d4ea */ 4.1205184937e+02, /* 0x43ce06a3 */ 3.8747453613e+03, /* 0x45722bed */ 7.9144794922e+03, /* 0x45f753d6 */ }; static const float ps8[5] = { 1.1420736694e+02, /* 0x42e46a2c */ 3.6509309082e+03, /* 0x45642ee5 */ 3.6956207031e+04, /* 0x47105c35 */ 9.7602796875e+04, /* 0x47bea166 */ 3.0804271484e+04, /* 0x46f0a88b */ }; static const float pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.3199052094e-11, /* 0x2d68333f */ 1.1718749255e-01, /* 0x3defffff */ 6.8027510643e+00, /* 0x40d9b023 */ 1.0830818176e+02, /* 0x42d89dca */ 5.1763616943e+02, /* 0x440168b7 */ 5.2871520996e+02, /* 0x44042dc6 */ }; static const float ps5[5] = { 5.9280597687e+01, /* 0x426d1f55 */ 9.9140142822e+02, /* 0x4477d9b1 */ 5.3532670898e+03, /* 0x45a74a23 */ 7.8446904297e+03, /* 0x45f52586 */ 1.5040468750e+03, /* 0x44bc0180 */ }; static const float pr3[6] = { 3.0250391081e-09, /* 0x314fe10d */ 1.1718686670e-01, /* 0x3defffab */ 3.9329774380e+00, /* 0x407bb5e7 */ 3.5119403839e+01, /* 0x420c7a45 */ 9.1055007935e+01, /* 0x42b61c2a */ 4.8559066772e+01, /* 0x42423c7c */ }; static const float ps3[5] = { 3.4791309357e+01, /* 0x420b2a4d */ 3.3676245117e+02, /* 0x43a86198 */ 1.0468714600e+03, /* 0x4482dbe3 */ 8.9081134033e+02, /* 0x445eb3ed */ 1.0378793335e+02, /* 0x42cf936c */ }; static const float pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.0771083225e-07, /* 0x33e74ea8 */ 1.1717621982e-01, /* 0x3deffa16 */ 2.3685150146e+00, /* 0x401795c0 */ 1.2242610931e+01, /* 0x4143e1bc */ 1.7693971634e+01, /* 0x418d8d41 */ 5.0735230446e+00, /* 0x40a25a4d */ }; static const float ps2[5] = { 2.1436485291e+01, /* 0x41ab7dec */ 1.2529022980e+02, /* 0x42fa9499 */ 2.3227647400e+02, /* 0x436846c7 */ 1.1767937469e+02, /* 0x42eb5bd7 */ 8.3646392822e+00, /* 0x4105d590 */ }; static float ponef(float x) { const float *p,*q; float z,r,s; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x41000000) {p = pr8; q= ps8;} else if(ix>=0x409173eb){p = pr5; q= ps5;} else if(ix>=0x4036d917){p = pr3; q= ps3;} else {p = pr2; q= ps2;} /* ix>=0x40000000 */ z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qone is * 3/8 s - 105/1024 s^3 - ..., where s = 1/x. * We approximate pone by * qone(x) = s*(0.375 + (R/S)) * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10 * S = 1 + qs1*s^2 + ... + qs6*s^12 * and * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13) */ static const float qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ -1.0253906250e-01, /* 0xbdd20000 */ -1.6271753311e+01, /* 0xc1822c8d */ -7.5960174561e+02, /* 0xc43de683 */ -1.1849806641e+04, /* 0xc639273a */ -4.8438511719e+04, /* 0xc73d3683 */ }; static const float qs8[6] = { 1.6139537048e+02, /* 0x43216537 */ 7.8253862305e+03, /* 0x45f48b17 */ 1.3387534375e+05, /* 0x4802bcd6 */ 7.1965775000e+05, /* 0x492fb29c */ 6.6660125000e+05, /* 0x4922be94 */ -2.9449025000e+05, /* 0xc88fcb48 */ }; static const float qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -2.0897993405e-11, /* 0xadb7d219 */ -1.0253904760e-01, /* 0xbdd1fffe */ -8.0564479828e+00, /* 0xc100e736 */ -1.8366960144e+02, /* 0xc337ab6b */ -1.3731937256e+03, /* 0xc4aba633 */ -2.6124443359e+03, /* 0xc523471c */ }; static const float qs5[6] = { 8.1276550293e+01, /* 0x42a28d98 */ 1.9917987061e+03, /* 0x44f8f98f */ 1.7468484375e+04, /* 0x468878f8 */ 4.9851425781e+04, /* 0x4742bb6d */ 2.7948074219e+04, /* 0x46da5826 */ -4.7191835938e+03, /* 0xc5937978 */ }; static const float qr3[6] = { -5.0783124372e-09, /* 0xb1ae7d4f */ -1.0253783315e-01, /* 0xbdd1ff5b */ -4.6101160049e+00, /* 0xc0938612 */ -5.7847221375e+01, /* 0xc267638e */ -2.2824453735e+02, /* 0xc3643e9a */ -2.1921012878e+02, /* 0xc35b35cb */ }; static const float qs3[6] = { 4.7665153503e+01, /* 0x423ea91e */ 6.7386511230e+02, /* 0x4428775e */ 3.3801528320e+03, /* 0x45534272 */ 5.5477290039e+03, /* 0x45ad5dd5 */ 1.9031191406e+03, /* 0x44ede3d0 */ -1.3520118713e+02, /* 0xc3073381 */ }; static const float qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -1.7838172539e-07, /* 0xb43f8932 */ -1.0251704603e-01, /* 0xbdd1f475 */ -2.7522056103e+00, /* 0xc0302423 */ -1.9663616180e+01, /* 0xc19d4f16 */ -4.2325313568e+01, /* 0xc2294d1f */ -2.1371921539e+01, /* 0xc1aaf9b2 */ }; static const float qs2[6] = { 2.9533363342e+01, /* 0x41ec4454 */ 2.5298155212e+02, /* 0x437cfb47 */ 7.5750280762e+02, /* 0x443d602e */ 7.3939318848e+02, /* 0x4438d92a */ 1.5594900513e+02, /* 0x431bf2f2 */ -4.9594988823e+00, /* 0xc09eb437 */ }; static float qonef(float x) { const float *p,*q; float s,r,z; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x41000000) {p = qr8; q= qs8;} else if(ix>=0x409173eb){p = qr5; q= qs5;} else if(ix>=0x4036d917){p = qr3; q= qs3;} else {p = qr2; q= qs2;} /* ix>=0x40000000 */ z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return ((float).375 + r/s)/x; } wcc-0.0.2/src/wsh/openlibm/src/s_crealf.c0000644000175000017500000000302113122010155016627 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_crealf.c,v 1.1 2004/05/30 09:21:56 stefanf Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT float crealf(float complex z) { return z; } wcc-0.0.2/src/wsh/openlibm/src/s_fmaxf.c0000644000175000017500000000371013122010155016501 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fmaxf.c,v 1.1 2004/06/30 07:04:01 das Exp $"); #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT float fmaxf(float x, float y) { union IEEEf2bits u[2]; u[0].f = x; u[1].f = y; /* Check for NaNs to avoid raising spurious exceptions. */ if (u[0].bits.exp == 255 && u[0].bits.man != 0) return (y); if (u[1].bits.exp == 255 && u[1].bits.man != 0) return (x); /* Handle comparisons of signed zeroes. */ if (u[0].bits.sign != u[1].bits.sign) return (u[u[0].bits.sign].f); return (x > y ? x : y); } wcc-0.0.2/src/wsh/openlibm/src/s_modfl.c0000644000175000017500000000671513122010155016511 0ustar philphil/*- * Copyright (c) 2007 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * Derived from s_modf.c, which has the following Copyright: * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * $FreeBSD: src/lib/msun/src/s_modfl.c,v 1.1 2007/01/07 07:54:21 das Exp $ */ #include #include #include "fpmath.h" #include "math_private.h" #if LDBL_MANL_SIZE > 32 #define MASK ((u_int64_t)-1) #else #define MASK ((u_int32_t)-1) #endif /* Return the last n bits of a word, representing the fractional part. */ #define GETFRAC(bits, n) ((bits) & ~(MASK << (n))) /* The number of fraction bits in manh, not counting the integer bit */ #define HIBITS (LDBL_MANT_DIG - LDBL_MANL_SIZE) static const long double zero[] = { 0.0L, -0.0L }; OLM_DLLEXPORT long double modfl(long double x, long double *iptr) { union IEEEl2bits ux; int e; ux.e = x; e = ux.bits.exp - LDBL_MAX_EXP + 1; if (e < HIBITS) { /* Integer part is in manh. */ if (e < 0) { /* |x|<1 */ *iptr = zero[ux.bits.sign]; return (x); } else { if ((GETFRAC(ux.bits.manh, HIBITS - 1 - e) | ux.bits.manl) == 0) { /* X is an integer. */ *iptr = x; return (zero[ux.bits.sign]); } else { /* Clear all but the top e+1 bits. */ ux.bits.manh >>= HIBITS - 1 - e; ux.bits.manh <<= HIBITS - 1 - e; ux.bits.manl = 0; *iptr = ux.e; return (x - ux.e); } } } else if (e >= LDBL_MANT_DIG - 1) { /* x has no fraction part. */ *iptr = x; if (x != x) /* Handle NaNs. */ return (x); return (zero[ux.bits.sign]); } else { /* Fraction part is in manl. */ if (GETFRAC(ux.bits.manl, LDBL_MANT_DIG - 1 - e) == 0) { /* x is integral. */ *iptr = x; return (zero[ux.bits.sign]); } else { /* Clear all but the top e+1 bits. */ ux.bits.manl >>= LDBL_MANT_DIG - 1 - e; ux.bits.manl <<= LDBL_MANT_DIG - 1 - e; *iptr = ux.e; return (x - ux.e); } } } wcc-0.0.2/src/wsh/openlibm/src/s_cabs.c0000644000175000017500000000213713122010155016312 0ustar philphil/* $OpenBSD: s_cabs.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Martynas Venckus * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include #include double cabs(double complex z) { return hypot(__real__ z, __imag__ z); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(cabsl, cabs); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_modf.c0000644000175000017500000000355113122010155016330 0ustar philphil/* @(#)s_modf.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * modf(double x, double *iptr) * return fraction part of x, and return x's integral part in *iptr. * Method: * Bit twiddling. * * Exception: * No exception. */ #include #include "math_private.h" static const double one = 1.0; OLM_DLLEXPORT double modf(double x, double *iptr) { int32_t i0,i1,j0; u_int32_t i; EXTRACT_WORDS(i0,i1,x); j0 = ((i0>>20)&0x7ff)-0x3ff; /* exponent of x */ if(j0<20) { /* integer part in high x */ if(j0<0) { /* |x|<1 */ INSERT_WORDS(*iptr,i0&0x80000000,0); /* *iptr = +-0 */ return x; } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) { /* x is integral */ u_int32_t high; *iptr = x; GET_HIGH_WORD(high,x); INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ return x; } else { INSERT_WORDS(*iptr,i0&(~i),0); return x - *iptr; } } } else if (j0>51) { /* no fraction part */ u_int32_t high; if (j0 == 0x400) { /* inf/NaN */ *iptr = x; return 0.0 / x; } *iptr = x*one; GET_HIGH_WORD(high,x); INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ return x; } else { /* fraction part in low x */ i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) { /* x is integral */ u_int32_t high; *iptr = x; GET_HIGH_WORD(high,x); INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ return x; } else { INSERT_WORDS(*iptr,i0,i1&(~i)); return x - *iptr; } } } wcc-0.0.2/src/wsh/openlibm/src/s_fmal.c0000644000175000017500000001652213122010155016324 0ustar philphil/*- * Copyright (c) 2005-2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fmal.c,v 1.7 2011/10/21 06:30:43 das Exp $"); #include #include #include #include "fpmath.h" #include "math_private.h" /* * A struct dd represents a floating-point number with twice the precision * of a long double. We maintain the invariant that "hi" stores the high-order * bits of the result. */ struct dd { long double hi; long double lo; }; /* * Compute a+b exactly, returning the exact result in a struct dd. We assume * that both a and b are finite, but make no assumptions about their relative * magnitudes. */ static inline struct dd dd_add(long double a, long double b) { struct dd ret; long double s; ret.hi = a + b; s = ret.hi - a; ret.lo = (a - (ret.hi - s)) + (b - s); return (ret); } /* * Compute a+b, with a small tweak: The least significant bit of the * result is adjusted into a sticky bit summarizing all the bits that * were lost to rounding. This adjustment negates the effects of double * rounding when the result is added to another number with a higher * exponent. For an explanation of round and sticky bits, see any reference * on FPU design, e.g., * * J. Coonen. An Implementation Guide to a Proposed Standard for * Floating-Point Arithmetic. Computer, vol. 13, no. 1, Jan 1980. */ static inline long double add_adjusted(long double a, long double b) { struct dd sum; union IEEEl2bits u; sum = dd_add(a, b); if (sum.lo != 0) { u.e = sum.hi; if ((u.bits.manl & 1) == 0) sum.hi = nextafterl(sum.hi, INFINITY * sum.lo); } return (sum.hi); } /* * Compute ldexp(a+b, scale) with a single rounding error. It is assumed * that the result will be subnormal, and care is taken to ensure that * double rounding does not occur. */ static inline long double add_and_denormalize(long double a, long double b, int scale) { struct dd sum; int bits_lost; union IEEEl2bits u; sum = dd_add(a, b); /* * If we are losing at least two bits of accuracy to denormalization, * then the first lost bit becomes a round bit, and we adjust the * lowest bit of sum.hi to make it a sticky bit summarizing all the * bits in sum.lo. With the sticky bit adjusted, the hardware will * break any ties in the correct direction. * * If we are losing only one bit to denormalization, however, we must * break the ties manually. */ if (sum.lo != 0) { u.e = sum.hi; bits_lost = -u.bits.exp - scale + 1; if ((bits_lost != 1) ^ (int)(u.bits.manl & 1)) sum.hi = nextafterl(sum.hi, INFINITY * sum.lo); } return (ldexp(sum.hi, scale)); } /* * Compute a*b exactly, returning the exact result in a struct dd. We assume * that both a and b are normalized, so no underflow or overflow will occur. * The current rounding mode must be round-to-nearest. */ static inline struct dd dd_mul(long double a, long double b) { #if LDBL_MANT_DIG == 64 static const long double split = 0x1p32L + 1.0; #elif LDBL_MANT_DIG == 113 static const long double split = 0x1p57L + 1.0; #endif struct dd ret; long double ha, hb, la, lb, p, q; p = a * split; ha = a - p; ha += p; la = a - ha; p = b * split; hb = b - p; hb += p; lb = b - hb; p = ha * hb; q = ha * lb + la * hb; ret.hi = p + q; ret.lo = p - ret.hi + q + la * lb; return (ret); } /* * Fused multiply-add: Compute x * y + z with a single rounding error. * * We use scaling to avoid overflow/underflow, along with the * canonical precision-doubling technique adapted from: * * Dekker, T. A Floating-Point Technique for Extending the * Available Precision. Numer. Math. 18, 224-242 (1971). */ OLM_DLLEXPORT long double fmal(long double x, long double y, long double z) { long double xs, ys, zs, adj; struct dd xy, r; int oround; int ex, ey, ez; int spread; /* * Handle special cases. The order of operations and the particular * return values here are crucial in handling special cases involving * infinities, NaNs, overflows, and signed zeroes correctly. */ if (x == 0.0 || y == 0.0) return (x * y + z); if (z == 0.0) return (x * y); if (!isfinite(x) || !isfinite(y)) return (x * y + z); if (!isfinite(z)) return (z); xs = frexpl(x, &ex); ys = frexpl(y, &ey); zs = frexpl(z, &ez); oround = fegetround(); spread = ex + ey - ez; /* * If x * y and z are many orders of magnitude apart, the scaling * will overflow, so we handle these cases specially. Rounding * modes other than FE_TONEAREST are painful. */ if (spread < -LDBL_MANT_DIG) { feraiseexcept(FE_INEXACT); if (!isnormal(z)) feraiseexcept(FE_UNDERFLOW); switch (oround) { case FE_TONEAREST: return (z); case FE_TOWARDZERO: if ((x > 0.0) ^ (y < 0.0) ^ (z < 0.0)) return (z); else return (nextafterl(z, 0)); case FE_DOWNWARD: if ((x > 0.0) ^ (y < 0.0)) return (z); else return (nextafterl(z, -INFINITY)); default: /* FE_UPWARD */ if ((x > 0.0) ^ (y < 0.0)) return (nextafterl(z, INFINITY)); else return (z); } } if (spread <= LDBL_MANT_DIG * 2) zs = ldexpl(zs, -spread); else zs = copysignl(LDBL_MIN, zs); fesetround(FE_TONEAREST); /* * Basic approach for round-to-nearest: * * (xy.hi, xy.lo) = x * y (exact) * (r.hi, r.lo) = xy.hi + z (exact) * adj = xy.lo + r.lo (inexact; low bit is sticky) * result = r.hi + adj (correctly rounded) */ xy = dd_mul(xs, ys); r = dd_add(xy.hi, zs); spread = ex + ey; if (r.hi == 0.0) { /* * When the addends cancel to 0, ensure that the result has * the correct sign. */ fesetround(oround); volatile long double vzs = zs; /* XXX gcc CSE bug workaround */ return (xy.hi + vzs + ldexpl(xy.lo, spread)); } if (oround != FE_TONEAREST) { /* * There is no need to worry about double rounding in directed * rounding modes. */ fesetround(oround); adj = r.lo + xy.lo; return (ldexpl(r.hi + adj, spread)); } adj = add_adjusted(r.lo, xy.lo); if (spread + ilogbl(r.hi) > -16383) return (ldexpl(r.hi + adj, spread)); else return (add_and_denormalize(r.hi, adj, spread)); } wcc-0.0.2/src/wsh/openlibm/src/s_cacoshf.c0000644000175000017500000000260613122010155017011 0ustar philphil/* $OpenBSD: s_cacoshf.c,v 1.1 2008/09/07 20:36:09 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cacoshf * * Complex inverse hyperbolic cosine * * * * SYNOPSIS: * * float complex cacoshf(); * float complex z, w; * * w = cacoshf (z); * * * * DESCRIPTION: * * acosh z = i acos z . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.6e-14 2.1e-15 * */ #include #include float complex cacoshf(float complex z) { float complex w; w = I * cacosf (z); return (w); } wcc-0.0.2/src/wsh/openlibm/src/cdefs-compat.h0000644000175000017500000000373413122010155017436 0ustar philphil#ifndef _CDEFS_COMPAT_H_ #define _CDEFS_COMPAT_H_ #if defined(__cplusplus) #define __BEGIN_DECLS extern "C" { #define __END_DECLS } #else #define __BEGIN_DECLS #define __END_DECLS #endif #ifdef __GNUC__ #ifndef __strong_reference #ifdef __APPLE__ #define __strong_reference(sym,aliassym) __weak_reference(sym,aliassym) #else #define __strong_reference(sym,aliassym) \ OLM_DLLEXPORT extern __typeof (sym) aliassym __attribute__ ((__alias__ (#sym))); #endif /* __APPLE__ */ #endif /* __strong_reference */ #ifndef __weak_reference #ifdef __ELF__ #ifdef __STDC__ #define __weak_reference(sym,alias) \ __asm__(".weak " #alias); \ __asm__(".equ " #alias ", " #sym) #define __warn_references(sym,msg) \ __asm__(".section .gnu.warning." #sym); \ __asm__(".asciz \"" msg "\""); \ __asm__(".previous") #else #define __weak_reference(sym,alias) \ __asm__(".weak alias"); \ __asm__(".equ alias, sym") #define __warn_references(sym,msg) \ __asm__(".section .gnu.warning.sym"); \ __asm__(".asciz \"msg\""); \ __asm__(".previous") #endif /* __STDC__ */ #elif defined(__clang__) /* CLANG */ #ifdef __STDC__ #define __weak_reference(sym,alias) \ __asm__(".weak_reference " #alias); \ __asm__(".set " #alias ", " #sym) #else #define __weak_reference(sym,alias) \ __asm__(".weak_reference alias");\ __asm__(".set alias, sym") #endif #else /* !__ELF__ */ #ifdef __STDC__ #define __weak_reference(sym,alias) \ __asm__(".stabs \"_" #alias "\",11,0,0,0"); \ __asm__(".stabs \"_" #sym "\",1,0,0,0") #define __warn_references(sym,msg) \ __asm__(".stabs \"" msg "\",30,0,0,0"); \ __asm__(".stabs \"_" #sym "\",1,0,0,0") #else #define __weak_reference(sym,alias) \ __asm__(".stabs \"_/**/alias\",11,0,0,0"); \ __asm__(".stabs \"_/**/sym\",1,0,0,0") #define __warn_references(sym,msg) \ __asm__(".stabs msg,30,0,0,0"); \ __asm__(".stabs \"_/**/sym\",1,0,0,0") #endif /* __STDC__ */ #endif /* __ELF__ */ #endif /* __weak_reference */ #endif /* __GNUC__ */ #endif /* _CDEFS_COMPAT_H_ */ wcc-0.0.2/src/wsh/openlibm/src/s_cimagl.c0000644000175000017500000000304413122010155016634 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_cimagl.c,v 1.3 2009/03/14 18:24:15 das Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT long double cimagl(long double complex z) { return (__imag__ z); } wcc-0.0.2/src/wsh/openlibm/src/s_roundl.c0000644000175000017500000000336013122010155016704 0ustar philphil/*- * Copyright (c) 2003, Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_roundl.c,v 1.2 2005/12/02 13:45:06 bde Exp $"); #include #include "math_private.h" OLM_DLLEXPORT long double roundl(long double x) { long double t; if (!isfinite(x)) return (x); if (x >= 0.0) { t = floorl(x); if (t - x <= -0.5) t += 1.0; return (t); } else { t = floorl(-x); if (t + x <= -0.5) t += 1.0; return (-t); } } wcc-0.0.2/src/wsh/openlibm/src/e_lgammaf.c0000644000175000017500000000166413122010155016774 0ustar philphil/* e_lgammaf.c -- float version of e_lgamma.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_lgammaf.c,v 1.8 2008/02/22 02:30:35 das Exp $"); /* __ieee754_lgammaf(x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_lgammaf_r */ #include #include "math_private.h" OLM_DLLEXPORT float __ieee754_lgammaf(float x) { #ifdef OPENLIBM_ONLY_THREAD_SAFE int signgam; #endif return __ieee754_lgammaf_r(x,&signgam); } wcc-0.0.2/src/wsh/openlibm/src/s_sincosl.c0000644000175000017500000000132113122010155017046 0ustar philphil/* s_sincosl.c -- long double version of s_sincos.c * * Copyright (C) 2013 Elliot Saba * Developed at the University of Washington * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" #include #include #include "math_private.h" #if LDBL_MANT_DIG == 64 #include "../ld80/e_rem_pio2l.h" #elif LDBL_MANT_DIG == 113 #include "../ld128/e_rem_pio2l.h" #else #error "Unsupported long double format" #endif OLM_DLLEXPORT void sincosl( long double x, long double * s, long double * c ) { *s = cosl( x ); *c = sinl( x ); } wcc-0.0.2/src/wsh/openlibm/src/s_cargl.c0000644000175000017500000000321713122010155016472 0ustar philphil/*- * Copyright (c) 2005-2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cargl.c,v 1.1 2008/07/31 22:41:26 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT long double cargl(long double complex z) { return (atan2l(cimagl(z), creall(z))); } wcc-0.0.2/src/wsh/openlibm/src/k_tan.c0000644000175000017500000001001013122010155016141 0ustar philphil/* @(#)k_tan.c 1.5 04/04/22 SMI */ /* * ==================================================== * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved. * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* INDENT OFF */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_tan.c,v 1.13 2008/02/22 02:30:35 das Exp $"); /* __kernel_tan( x, y, k ) * kernel tan function on ~[-pi/4, pi/4] (except on -0), pi/4 ~ 0.7854 * Input x is assumed to be bounded by ~pi/4 in magnitude. * Input y is the tail of x. * Input k indicates whether tan (if k = 1) or -1/tan (if k = -1) is returned. * * Algorithm * 1. Since tan(-x) = -tan(x), we need only to consider positive x. * 2. Callers must return tan(-0) = -0 without calling here since our * odd polynomial is not evaluated in a way that preserves -0. * Callers may do the optimization tan(x) ~ x for tiny x. * 3. tan(x) is approximated by a odd polynomial of degree 27 on * [0,0.67434] * 3 27 * tan(x) ~ x + T1*x + ... + T13*x * where * * |tan(x) 2 4 26 | -59.2 * |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2 * | x | * * Note: tan(x+y) = tan(x) + tan'(x)*y * ~ tan(x) + (1+x*x)*y * Therefore, for better accuracy in computing tan(x+y), let * 3 2 2 2 2 * r = x *(T2+x *(T3+x *(...+x *(T12+x *T13)))) * then * 3 2 * tan(x+y) = x + (T1*x + (x *(r+y)+y)) * * 4. For x in [0.67434,pi/4], let y = pi/4 - x, then * tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y)) * = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y))) */ #include #include "math_private.h" static const double xxx[] = { 3.33333333333334091986e-01, /* 3FD55555, 55555563 */ 1.33333333333201242699e-01, /* 3FC11111, 1110FE7A */ 5.39682539762260521377e-02, /* 3FABA1BA, 1BB341FE */ 2.18694882948595424599e-02, /* 3F9664F4, 8406D637 */ 8.86323982359930005737e-03, /* 3F8226E3, E96E8493 */ 3.59207910759131235356e-03, /* 3F6D6D22, C9560328 */ 1.45620945432529025516e-03, /* 3F57DBC8, FEE08315 */ 5.88041240820264096874e-04, /* 3F4344D8, F2F26501 */ 2.46463134818469906812e-04, /* 3F3026F7, 1A8D1068 */ 7.81794442939557092300e-05, /* 3F147E88, A03792A6 */ 7.14072491382608190305e-05, /* 3F12B80F, 32F0A7E9 */ -1.85586374855275456654e-05, /* BEF375CB, DB605373 */ 2.59073051863633712884e-05, /* 3EFB2A70, 74BF7AD4 */ /* one */ 1.00000000000000000000e+00, /* 3FF00000, 00000000 */ /* pio4 */ 7.85398163397448278999e-01, /* 3FE921FB, 54442D18 */ /* pio4lo */ 3.06161699786838301793e-17 /* 3C81A626, 33145C07 */ }; #define one xxx[13] #define pio4 xxx[14] #define pio4lo xxx[15] #define T xxx /* INDENT ON */ double __kernel_tan(double x, double y, int iy) { double z, r, v, w, s; int32_t ix, hx; GET_HIGH_WORD(hx,x); ix = hx & 0x7fffffff; /* high word of |x| */ if (ix >= 0x3FE59428) { /* |x| >= 0.6744 */ if (hx < 0) { x = -x; y = -y; } z = pio4 - x; w = pio4lo - y; x = z + w; y = 0.0; } z = x * x; w = z * z; /* * Break x^5*(T[1]+x^2*T[2]+...) into * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) + * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12])) */ r = T[1] + w * (T[3] + w * (T[5] + w * (T[7] + w * (T[9] + w * T[11])))); v = z * (T[2] + w * (T[4] + w * (T[6] + w * (T[8] + w * (T[10] + w * T[12]))))); s = z * x; r = y + z * (s * (r + v) + y); r += T[0] * s; w = x + r; if (ix >= 0x3FE59428) { v = (double) iy; return (double) (1 - ((hx >> 30) & 2)) * (v - 2.0 * (x - (w * w / (w + v) - r))); } if (iy == 1) return w; else { /* * if allow error up to 2 ulp, simply return * -1.0 / (x+r) here */ /* compute -1.0 / (x+r) accurately */ double a, t; z = w; SET_LOW_WORD(z,0); v = r - (z - x); /* z+v = r+x */ t = a = -1.0 / w; /* a = -1.0/w */ SET_LOW_WORD(t,0); s = 1.0 + t * z; return t + a * (s + t * v); } } wcc-0.0.2/src/wsh/openlibm/src/e_sqrtl.c0000644000175000017500000001060013122010155016523 0ustar philphil/*- * Copyright (c) 2007 Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_sqrtl.c,v 1.1 2008/03/02 01:47:58 das Exp $"); #include #include #include #include "fpmath.h" #include "math_private.h" /* Return (x + ulp) for normal positive x. Assumes no overflow. */ static inline long double inc(long double x) { union IEEEl2bits u; u.e = x; if (++u.bits.manl == 0) { if (++u.bits.manh == 0) { u.bits.exp++; u.bits.manh |= LDBL_NBIT; } } return (u.e); } /* Return (x - ulp) for normal positive x. Assumes no underflow. */ static inline long double dec(long double x) { union IEEEl2bits u; u.e = x; if (u.bits.manl-- == 0) { if (u.bits.manh-- == LDBL_NBIT) { u.bits.exp--; u.bits.manh |= LDBL_NBIT; } } return (u.e); } #ifndef __GNUC__ #pragma STDC FENV_ACCESS ON #endif /* * This is slow, but simple and portable. You should use hardware sqrt * if possible. */ OLM_DLLEXPORT long double sqrtl(long double x) { union IEEEl2bits u; int k, r; long double lo, xn; fenv_t env; u.e = x; /* If x = NaN, then sqrt(x) = NaN. */ /* If x = Inf, then sqrt(x) = Inf. */ /* If x = -Inf, then sqrt(x) = NaN. */ if (u.bits.exp == LDBL_MAX_EXP * 2 - 1) return (x * x + x); /* If x = +-0, then sqrt(x) = +-0. */ if ((u.bits.manh | u.bits.manl | u.bits.exp) == 0) return (x); /* If x < 0, then raise invalid and return NaN */ if (u.bits.sign) return ((x - x) / (x - x)); feholdexcept(&env); if (u.bits.exp == 0) { /* Adjust subnormal numbers. */ u.e *= 0x1.0p514; k = -514; } else { k = 0; } /* * u.e is a normal number, so break it into u.e = e*2^n where * u.e = (2*e)*2^2k for odd n and u.e = (4*e)*2^2k for even n. */ if ((u.bits.exp - 0x3ffe) & 1) { /* n is odd. */ k += u.bits.exp - 0x3fff; /* 2k = n - 1. */ u.bits.exp = 0x3fff; /* u.e in [1,2). */ } else { k += u.bits.exp - 0x4000; /* 2k = n - 2. */ u.bits.exp = 0x4000; /* u.e in [2,4). */ } /* * Newton's iteration. * Split u.e into a high and low part to achieve additional precision. */ xn = sqrt(u.e); /* 53-bit estimate of sqrtl(x). */ #if LDBL_MANT_DIG > 100 xn = (xn + (u.e / xn)) * 0.5; /* 106-bit estimate. */ #endif lo = u.e; u.bits.manl = 0; /* Zero out lower bits. */ lo = (lo - u.e) / xn; /* Low bits divided by xn. */ xn = xn + (u.e / xn); /* High portion of estimate. */ u.e = xn + lo; /* Combine everything. */ u.bits.exp += (k >> 1) - 1; feclearexcept(FE_INEXACT); r = fegetround(); fesetround(FE_TOWARDZERO); /* Set to round-toward-zero. */ xn = x / u.e; /* Chopped quotient (inexact?). */ if (!fetestexcept(FE_INEXACT)) { /* Quotient is exact. */ if (xn == u.e) { fesetenv(&env); return (u.e); } /* Round correctly for inputs like x = y**2 - ulp. */ xn = dec(xn); /* xn = xn - ulp. */ } if (r == FE_TONEAREST) { xn = inc(xn); /* xn = xn + ulp. */ } else if (r == FE_UPWARD) { u.e = inc(u.e); /* u.e = u.e + ulp. */ xn = inc(xn); /* xn = xn + ulp. */ } u.e = u.e + xn; /* Chopped sum. */ feupdateenv(&env); /* Restore env and raise inexact */ u.bits.exp--; return (u.e); } wcc-0.0.2/src/wsh/openlibm/src/i386_fpmath.h0000644000175000017500000000373013122010155017115 0ustar philphil/*- * Copyright (c) 2002, 2003 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/libc/i386/_fpmath.h,v 1.6 2008/01/17 16:39:06 bde Exp $ */ union IEEEl2bits { long double e; struct { unsigned int manl :32; unsigned int manh :32; unsigned int exp :15; unsigned int sign :1; unsigned int junk :16; } bits; struct { unsigned long long man :64; unsigned int expsign :16; unsigned int junk :16; } xbits; }; #define LDBL_NBIT 0x80000000 #define mask_nbit_l(u) ((u).bits.manh &= ~LDBL_NBIT) #define LDBL_MANH_SIZE 32 #define LDBL_MANL_SIZE 32 #define LDBL_TO_ARRAY32(u, a) do { \ (a)[0] = (uint32_t)(u).bits.manl; \ (a)[1] = (uint32_t)(u).bits.manh; \ } while (0) wcc-0.0.2/src/wsh/openlibm/src/s_casin.c0000644000175000017500000000544313122010155016502 0ustar philphil/* $OpenBSD: s_casin.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* casin() * * Complex circular arc sine * * * * SYNOPSIS: * * double complex casin(); * double complex z, w; * * w = casin (z); * * * * DESCRIPTION: * * Inverse complex sine: * * 2 * w = -i clog( iz + csqrt( 1 - z ) ). * * casin(z) = -i casinh(iz) * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 10100 2.1e-15 3.4e-16 * IEEE -10,+10 30000 2.2e-14 2.7e-15 * Larger relative error can be observed for z near zero. * Also tested by csin(casin(z)) = z. */ #include #include #include double complex casin(double complex z) { double complex w; static double complex ca, ct, zz, z2; double x, y; x = creal (z); y = cimag (z); if (y == 0.0) { if (fabs(x) > 1.0) { w = M_PI_2 + 0.0 * I; /*mtherr ("casin", DOMAIN);*/ } else { w = asin (x) + 0.0 * I; } return (w); } /* Power series expansion */ /* b = cabs(z); if( b < 0.125 ) { z2.r = (x - y) * (x + y); z2.i = 2.0 * x * y; cn = 1.0; n = 1.0; ca.r = x; ca.i = y; sum.r = x; sum.i = y; do { ct.r = z2.r * ca.r - z2.i * ca.i; ct.i = z2.r * ca.i + z2.i * ca.r; ca.r = ct.r; ca.i = ct.i; cn *= n; n += 1.0; cn /= n; n += 1.0; b = cn/n; ct.r *= b; ct.i *= b; sum.r += ct.r; sum.i += ct.i; b = fabs(ct.r) + fabs(ct.i); } while( b > MACHEP ); w->r = sum.r; w->i = sum.i; return; } */ ca = x + y * I; ct = ca * I; /* sqrt( 1 - z*z) */ /* cmul( &ca, &ca, &zz ) */ /*x * x - y * y */ zz = (x - y) * (x + y) + (2.0 * x * y) * I; zz = 1.0 - creal(zz) - cimag(zz) * I; z2 = csqrt (zz); zz = ct + z2; zz = clog (zz); /* multiply by 1/i = -i */ w = zz * (-1.0 * I); return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(casinl, casin); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_clogl.c0000644000175000017500000000365313122010155016506 0ustar philphil/* $OpenBSD: s_clogl.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* clogl.c * * Complex natural logarithm * * * * SYNOPSIS: * * long double complex clogl(); * long double complex z, w; * * w = clogl( z ); * * * * DESCRIPTION: * * Returns complex logarithm to the base e (2.718...) of * the complex argument x. * * If z = x + iy, r = sqrt( x**2 + y**2 ), * then * w = log(r) + i arctan(y/x). * * The arctangent ranges from -PI to +PI. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 7000 8.5e-17 1.9e-17 * IEEE -10,+10 30000 5.0e-15 1.1e-16 * * Larger relative error can be observed for z near 1 +i0. * In IEEE arithmetic the peak absolute error is 5.2e-16, rms * absolute error 1.0e-16. */ #include #include long double complex clogl(long double complex z) { long double complex w; long double p, rr; /*rr = sqrt(z->r * z->r + z->i * z->i);*/ p = cabsl(z); p = logl(p); rr = atan2l(cimagl(z), creall(z)); w = p + rr * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_cpow.c0000644000175000017500000000371413122010155016354 0ustar philphil/* $OpenBSD: s_cpow.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cpow * * Complex power function * * * * SYNOPSIS: * * double complex cpow(); * double complex a, z, w; * * w = cpow (a, z); * * * * DESCRIPTION: * * Raises complex A to the complex Zth power. * Definition is per AMS55 # 4.2.8, * analytically equivalent to cpow(a,z) = cexp(z clog(a)). * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 9.4e-15 1.5e-15 * */ #include #include #include #include "math_private.h" OLM_DLLEXPORT double complex cpow(double complex a, double complex z) { double complex w; double x, y, r, theta, absa, arga; x = creal (z); y = cimag (z); absa = cabs (a); if (absa == 0.0) { return (0.0 + 0.0 * I); } arga = carg (a); r = pow (absa, x); theta = x * arga; if (y != 0.0) { r = r * exp (-y * arga); theta = theta + y * log (absa); } w = r * cos (theta) + (r * sin (theta)) * I; return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(cpowl, cpow); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_cexpl.c0000644000175000017500000000326713122010155016522 0ustar philphil/* $OpenBSD: s_cexpl.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cexpl() * * Complex exponential function * * * * SYNOPSIS: * * long double complex cexpl(); * long double complex z, w; * * w = cexpl( z ); * * * * DESCRIPTION: * * Returns the exponential of the complex argument z * into the complex result w. * * If * z = x + iy, * r = exp(x), * * then * * w = r cos y + i r sin y. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8700 3.7e-17 1.1e-17 * IEEE -10,+10 30000 3.0e-16 8.7e-17 * */ #include #include long double complex cexpl(long double complex z) { long double complex w; long double r; r = expl(creall(z)); w = r * cosl(cimagl(z)) + (r * sinl(cimagl(z))) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_llround.c0000644000175000017500000000043513122010155017060 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_llround.c,v 1.2 2005/04/08 00:52:27 das Exp $"); #define type double #define roundit round #define dtype long long #define DTYPE_MIN LLONG_MIN #define DTYPE_MAX LLONG_MAX #define fn llround #include "s_lround.c" wcc-0.0.2/src/wsh/openlibm/src/s_cacos.c0000644000175000017500000000316213122010155016471 0ustar philphil/* $OpenBSD: s_cacos.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cacos() * * Complex circular arc cosine * * * * SYNOPSIS: * * double complex cacos(); * double complex z, w; * * w = cacos (z); * * * * DESCRIPTION: * * * w = arccos z = PI/2 - arcsin z. * * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5200 1.6e-15 2.8e-16 * IEEE -10,+10 30000 1.8e-14 2.2e-15 */ #include #include #include double complex cacos(double complex z) { double complex w; w = casin (z); w = (M_PI_2 - creal (w)) - cimag (w) * I; return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(cacosl, cacos); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_fmax.c0000644000175000017500000000376313122010155016343 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fmax.c,v 1.1 2004/06/30 07:04:01 das Exp $"); #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT double fmax(double x, double y) { union IEEEd2bits u[2]; u[0].d = x; u[1].d = y; /* Check for NaNs to avoid raising spurious exceptions. */ if (u[0].bits.exp == 2047 && (u[0].bits.manh | u[0].bits.manl) != 0) return (y); if (u[1].bits.exp == 2047 && (u[1].bits.manh | u[1].bits.manl) != 0) return (x); /* Handle comparisons of signed zeroes. */ if (u[0].bits.sign != u[1].bits.sign) return (u[u[0].bits.sign].d); return (x > y ? x : y); } wcc-0.0.2/src/wsh/openlibm/src/s_tanhf.c0000644000175000017500000000271513122010155016504 0ustar philphil/* s_tanhf.c -- float version of s_tanh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_tanhf.c,v 1.9 2008/02/22 02:30:36 das Exp $"); #include #include "math_private.h" static const float one=1.0, two=2.0, tiny = 1.0e-30, huge = 1.0e30; OLM_DLLEXPORT float tanhf(float x) { float t,z; int32_t jx,ix; GET_FLOAT_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7f800000) { if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */ else return one/x-one; /* tanh(NaN) = NaN */ } /* |x| < 9 */ if (ix < 0x41100000) { /* |x|<9 */ if (ix<0x39800000) { /* |x|<2**-12 */ if(huge+x>one) return x; /* tanh(tiny) = tiny with inexact */ } if (ix>=0x3f800000) { /* |x|>=1 */ t = expm1f(two*fabsf(x)); z = one - two/(t+two); } else { t = expm1f(-two*fabsf(x)); z= -t/(t+two); } /* |x| >= 9, return +-1 */ } else { z = one - tiny; /* raise inexact flag */ } return (jx>=0)? z: -z; } wcc-0.0.2/src/wsh/openlibm/src/s_creal.c0000644000175000017500000000302113122010155016461 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_creal.c,v 1.1 2004/05/30 09:21:56 stefanf Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT double creal(double complex z) { return z; } wcc-0.0.2/src/wsh/openlibm/src/s_sincosf.c0000644000175000017500000000711313122010155017045 0ustar philphil/* s_sincosf.c -- float version of s_sincos.c * * Copyright (C) 2013 Elliot Saba * Developed at the University of Washington * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" #include #include //#define INLINE_KERNEL_COSDF //#define INLINE_KERNEL_SINDF //#define INLINE_REM_PIO2F #include "math_private.h" //#include "e_rem_pio2f.c" //#include "k_cosf.c" //#include "k_sinf.c" /* Constants used in shortcircuits in sincosf */ static const double sc1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */ sc2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */ sc3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */ sc4pio2 = 4*M_PI_2, /* 0x401921FB, 0x54442D18 */ /* Constants used in polynomial approximation of sin/cos */ one = 1.0, S1 = -0x15555554cbac77.0p-55, /* -0.166666666416265235595 */ S2 = 0x111110896efbb2.0p-59, /* 0.0083333293858894631756 */ S3 = -0x1a00f9e2cae774.0p-65, /* -0.000198393348360966317347 */ S4 = 0x16cd878c3b46a7.0p-71, /* 0.0000027183114939898219064 */ C0 = -0x1ffffffd0c5e81.0p-54, /* -0.499999997251031003120 */ C1 = 0x155553e1053a42.0p-57, /* 0.0416666233237390631894 */ C2 = -0x16c087e80f1e27.0p-62, /* -0.00138867637746099294692 */ C3 = 0x199342e0ee5069.0p-68; /* 0.0000243904487962774090654 */ static void __kernel_sincosdf( double x, float * s, float * c ) { double r, w, z, v; z = x*x; w = z*z; /* cos-specific computation; equivalent to calling __kernel_cos(x,y) and storing in k_c*/ r = C2+z*C3; double k_c = ((one+z*C0) + w*C1) + (w*z)*r; /* sin-specific computation; equivalent to calling __kernel_sin(x,y,1) and storing in k_s*/ r = S3+z*S4; v = z*x; double k_s = (x + v*(S1+z*S2)) + v*w*r; *c = k_c; *s = k_s; } OLM_DLLEXPORT void sincosf(float x, float * s, float * c) { // Worst approximation of sin and cos NA *s = x; *c = x; double y; float k_c, k_s; int32_t n, hx, ix; GET_FLOAT_WORD(hx,x); ix = hx & 0x7fffffff; if(ix <= 0x3f490fda) { /* |x| ~<= pi/4 */ if(ix<0x39800000) { /* |x| < 2**-12 */ /* Check if x is exactly zero */ if(((int)x)==0) { *s = x; *c = 1.0f; return; } } __kernel_sincosdf(x, s, c); return; } /* |x| ~<= 5*pi/4 */ if (ix<=0x407b53d1) { /* |x| ~<= 3pi/4 */ if(ix<=0x4016cbe3) { if(hx>0) { __kernel_sincosdf( sc1pio2 - x, c, s ); } else { __kernel_sincosdf( sc1pio2 + x, c, &k_s ); *s = -k_s; } } else { if(hx>0) { __kernel_sincosdf( sc2pio2 - x, s, &k_c ); *c = -k_c; } else { __kernel_sincosdf( -sc2pio2 - x, s, &k_c ); *c = -k_c; } } return; } /* |x| ~<= 9*pi/4 */ if(ix<=0x40e231d5) { /* |x| ~> 7*pi/4 */ if(ix<=0x40afeddf) { if(hx>0) { __kernel_sincosdf( x - sc3pio2, c, &k_s ); *s = -k_s; } else { __kernel_sincosdf( x + sc3pio2, &k_c, s ); *c = -k_c; } } else { if( hx > 0 ) { __kernel_sincosdf( x - sc4pio2, s, c ); } else { __kernel_sincosdf( x + sc4pio2, s, c ); } } return; } /* cos(Inf or NaN) is NaN */ else if(ix>=0x7f800000) { *c = *s = x-x; } else { /* general argument reduction needed */ n = __ieee754_rem_pio2f(x,&y); switch(n&3) { case 0: __kernel_sincosdf( y, s, c ); break; case 1: __kernel_sincosdf( -y, c, s ); break; case 2: __kernel_sincosdf( -y, s, &k_c); *c = -k_c; break; default: __kernel_sincosdf( -y, &k_c, &k_s ); *c = -k_c; *s = -k_s; break; } } } wcc-0.0.2/src/wsh/openlibm/src/s_tanh.c0000644000175000017500000000400213122010155016325 0ustar philphil/* @(#)s_tanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_tanh.c,v 1.9 2008/02/22 02:30:36 das Exp $"); /* Tanh(x) * Return the Hyperbolic Tangent of x * * Method : * x -x * e - e * 0. tanh(x) is defined to be ----------- * x -x * e + e * 1. reduce x to non-negative by tanh(-x) = -tanh(x). * 2. 0 <= x < 2**-28 : tanh(x) := x with inexact if x != 0 * -t * 2**-28 <= x < 1 : tanh(x) := -----; t = expm1(-2x) * t + 2 * 2 * 1 <= x < 22 : tanh(x) := 1 - -----; t = expm1(2x) * t + 2 * 22 <= x <= INF : tanh(x) := 1. * * Special cases: * tanh(NaN) is NaN; * only tanh(0)=0 is exact for finite argument. */ #include #include "math_private.h" static const double one = 1.0, two = 2.0, tiny = 1.0e-300, huge = 1.0e300; OLM_DLLEXPORT double tanh(double x) { double t,z; int32_t jx,ix; GET_HIGH_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7ff00000) { if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */ else return one/x-one; /* tanh(NaN) = NaN */ } /* |x| < 22 */ if (ix < 0x40360000) { /* |x|<22 */ if (ix<0x3e300000) { /* |x|<2**-28 */ if(huge+x>one) return x; /* tanh(tiny) = tiny with inexact */ } if (ix>=0x3ff00000) { /* |x|>=1 */ t = expm1(two*fabs(x)); z = one - two/(t+two); } else { t = expm1(-two*fabs(x)); z= -t/(t+two); } /* |x| >= 22, return +-1 */ } else { z = one - tiny; /* raise inexact flag */ } return (jx>=0)? z: -z; } wcc-0.0.2/src/wsh/openlibm/src/s_fdim.c0000644000175000017500000000341213122010155016316 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fdim.c,v 1.1 2004/06/30 07:04:01 das Exp $"); #include #include "math_private.h" #define DECL(type, fn) \ OLM_DLLEXPORT type \ fn(type x, type y) \ { \ \ if (isnan(x)) \ return (x); \ if (isnan(y)) \ return (y); \ return (x > y ? x - y : 0.0); \ } DECL(double, fdim) DECL(float, fdimf) DECL(long double, fdiml) wcc-0.0.2/src/wsh/openlibm/src/s_truncl.c0000644000175000017500000000334413122010155016712 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * From: @(#)s_floor.c 5.1 93/09/24 */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_truncl.c,v 1.9 2008/02/14 15:10:34 bde Exp $"); /* * truncl(x) * Return x rounded toward 0 to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to truncl(x). */ #include #include #include #include "fpmath.h" #include "math_private.h" #ifdef LDBL_IMPLICIT_NBIT #define MANH_SIZE (LDBL_MANH_SIZE + 1) #else #define MANH_SIZE LDBL_MANH_SIZE #endif static const long double huge = 1.0e300; static const float zero[] = { 0.0, -0.0 }; OLM_DLLEXPORT long double truncl(long double x) { union IEEEl2bits u = { .e = x }; int e = u.bits.exp - LDBL_MAX_EXP + 1; if (e < MANH_SIZE - 1) { if (e < 0) { /* raise inexact if x != 0 */ if (huge + x > 0.0) u.e = zero[u.bits.sign]; } else { uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); if (((u.bits.manh & m) | u.bits.manl) == 0) return (x); /* x is integral */ if (huge + x > 0.0) { /* raise inexact flag */ u.bits.manh &= ~m; u.bits.manl = 0; } } } else if (e < LDBL_MANT_DIG - 1) { uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); if ((u.bits.manl & m) == 0) return (x); /* x is integral */ if (huge + x > 0.0) /* raise inexact flag */ u.bits.manl &= ~m; } return (u.e); } wcc-0.0.2/src/wsh/openlibm/src/s_expm1f.c0000644000175000017500000000674413122010155016612 0ustar philphil/* s_expm1f.c -- float version of s_expm1.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_expm1f.c,v 1.12 2011/10/21 06:26:38 das Exp $"); #include #include #include "math_private.h" static const float one = 1.0, huge = 1.0e+30, tiny = 1.0e-30, o_threshold = 8.8721679688e+01,/* 0x42b17180 */ ln2_hi = 6.9313812256e-01,/* 0x3f317180 */ ln2_lo = 9.0580006145e-06,/* 0x3717f7d1 */ invln2 = 1.4426950216e+00,/* 0x3fb8aa3b */ /* * Domain [-0.34568, 0.34568], range ~[-6.694e-10, 6.696e-10]: * |6 / x * (1 + 2 * (1 / (exp(x) - 1) - 1 / x)) - q(x)| < 2**-30.04 * Scaled coefficients: Qn_here = 2**n * Qn_for_q (see s_expm1.c): */ Q1 = -3.3333212137e-2, /* -0x888868.0p-28 */ Q2 = 1.5807170421e-3; /* 0xcf3010.0p-33 */ OLM_DLLEXPORT float expm1f(float x) { float y,hi,lo,c,t,e,hxs,hfx,r1,twopk; int32_t k,xsb; u_int32_t hx; GET_FLOAT_WORD(hx,x); xsb = hx&0x80000000; /* sign bit of x */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out huge and non-finite argument */ if(hx >= 0x4195b844) { /* if |x|>=27*ln2 */ if(hx >= 0x42b17218) { /* if |x|>=88.721... */ if(hx>0x7f800000) return x+x; /* NaN */ if(hx==0x7f800000) return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ if(x > o_threshold) return huge*huge; /* overflow */ } if(xsb!=0) { /* x < -27*ln2, return -1.0 with inexact */ if(x+tiny<(float)0.0) /* raise inexact */ return tiny-one; /* return -1 */ } } /* argument reduction */ if(hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */ if(hx < 0x3F851592) { /* and |x| < 1.5 ln2 */ if(xsb==0) {hi = x - ln2_hi; lo = ln2_lo; k = 1;} else {hi = x + ln2_hi; lo = -ln2_lo; k = -1;} } else { k = invln2*x+((xsb==0)?(float)0.5:(float)-0.5); t = k; hi = x - t*ln2_hi; /* t*ln2_hi is exact here */ lo = t*ln2_lo; } STRICT_ASSIGN(float, x, hi - lo); c = (hi-x)-lo; } else if(hx < 0x33000000) { /* when |x|<2**-25, return x */ t = huge+x; /* return x with inexact flags when x!=0 */ return x - (t-(huge+x)); } else k = 0; /* x is now in primary range */ hfx = (float)0.5*x; hxs = x*hfx; r1 = one+hxs*(Q1+hxs*Q2); t = (float)3.0-r1*hfx; e = hxs*((r1-t)/((float)6.0 - x*t)); if(k==0) return x - (x*e-hxs); /* c is 0 */ else { SET_FLOAT_WORD(twopk,0x3f800000+(k<<23)); /* 2^k */ e = (x*(e-c)-c); e -= hxs; if(k== -1) return (float)0.5*(x-e)-(float)0.5; if(k==1) { if(x < (float)-0.25) return -(float)2.0*(e-(x+(float)0.5)); else return one+(float)2.0*(x-e); } if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */ y = one-(e-x); if (k == 128) y = y*2.0F*0x1p127F; else y = y*twopk; return y-one; } t = one; if(k<23) { SET_FLOAT_WORD(t,0x3f800000 - (0x1000000>>k)); /* t=1-2^-k */ y = t-(e-x); y = y*twopk; } else { SET_FLOAT_WORD(t,((0x7f-k)<<23)); /* 2^-k */ y = x-(e+t); y += one; y = y*twopk; } } return y; } wcc-0.0.2/src/wsh/openlibm/src/e_logf.c0000644000175000017500000000465313122010155016320 0ustar philphil/* e_logf.c -- float version of e_log.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_logf.c,v 1.11 2008/03/29 16:37:59 das Exp $"); #include #include "math_private.h" static const float ln2_hi = 6.9313812256e-01, /* 0x3f317180 */ ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */ two25 = 3.355443200e+07, /* 0x4c000000 */ /* |(log(1+s)-log(1-s))/s - Lg(s)| < 2**-34.24 (~[-4.95e-11, 4.97e-11]). */ Lg1 = 0xaaaaaa.0p-24, /* 0.66666662693 */ Lg2 = 0xccce13.0p-25, /* 0.40000972152 */ Lg3 = 0x91e9ee.0p-25, /* 0.28498786688 */ Lg4 = 0xf89e26.0p-26; /* 0.24279078841 */ static const float zero = 0.0; OLM_DLLEXPORT float __ieee754_logf(float x) { float hfsq,f,s,z,R,w,t1,t2,dk; int32_t k,ix,i,j; GET_FLOAT_WORD(ix,x); k=0; if (ix < 0x00800000) { /* x < 2**-126 */ if ((ix&0x7fffffff)==0) return -two25/zero; /* log(+-0)=-inf */ if (ix<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 25; x *= two25; /* subnormal number, scale up x */ GET_FLOAT_WORD(ix,x); } if (ix >= 0x7f800000) return x+x; k += (ix>>23)-127; ix &= 0x007fffff; i = (ix+(0x95f64<<3))&0x800000; SET_FLOAT_WORD(x,ix|(i^0x3f800000)); /* normalize x or x/2 */ k += (i>>23); f = x-(float)1.0; if((0x007fffff&(0x8000+ix))<0xc000) { /* -2**-9 <= f < 2**-9 */ if(f==zero) { if(k==0) { return zero; } else { dk=(float)k; return dk*ln2_hi+dk*ln2_lo; } } R = f*f*((float)0.5-(float)0.33333333333333333*f); if(k==0) return f-R; else {dk=(float)k; return dk*ln2_hi-((R-dk*ln2_lo)-f);} } s = f/((float)2.0+f); dk = (float)k; z = s*s; i = ix-(0x6147a<<3); w = z*z; j = (0x6b851<<3)-ix; t1= w*(Lg2+w*Lg4); t2= z*(Lg1+w*Lg3); i |= j; R = t2+t1; if(i>0) { hfsq=(float)0.5*f*f; if(k==0) return f-(hfsq-s*(hfsq+R)); else return dk*ln2_hi-((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f); } else { if(k==0) return f-s*(f-R); else return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f); } } wcc-0.0.2/src/wsh/openlibm/src/e_log.c0000644000175000017500000001062413122010155016145 0ustar philphil /* @(#)e_log.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_log.c,v 1.15 2008/03/29 16:37:59 das Exp $"); /* __ieee754_log(x) * Return the logrithm of x * * Method : * 1. Argument Reduction: find k and f such that * x = 2^k * (1+f), * where sqrt(2)/2 < 1+f < sqrt(2) . * * 2. Approximation of log(1+f). * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s) * = 2s + 2/3 s**3 + 2/5 s**5 + ....., * = 2s + s*R * We use a special Reme algorithm on [0,0.1716] to generate * a polynomial of degree 14 to approximate R The maximum error * of this polynomial approximation is bounded by 2**-58.45. In * other words, * 2 4 6 8 10 12 14 * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s * (the values of Lg1 to Lg7 are listed in the program) * and * | 2 14 | -58.45 * | Lg1*s +...+Lg7*s - R(z) | <= 2 * | | * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2. * In order to guarantee error in log below 1ulp, we compute log * by * log(1+f) = f - s*(f - R) (if f is not too large) * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy) * * 3. Finally, log(x) = k*ln2 + log(1+f). * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo))) * Here ln2 is split into two floating point number: * ln2_hi + ln2_lo, * where n*ln2_hi is always exact for |n| < 2000. * * Special cases: * log(x) is NaN with signal if x < 0 (including -INF) ; * log(+INF) is +INF; log(0) is -INF with signal; * log(NaN) is that NaN with no signal. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include #include "math_private.h" static const double ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */ Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */ Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */ Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ static const double zero = 0.0; OLM_DLLEXPORT double __ieee754_log(double x) { double hfsq,f,s,z,R,w,t1,t2,dk; int32_t k,hx,i,j; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); k=0; if (hx < 0x00100000) { /* x < 2**-1022 */ if (((hx&0x7fffffff)|lx)==0) return -two54/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 54; x *= two54; /* subnormal number, scale up x */ GET_HIGH_WORD(hx,x); } if (hx >= 0x7ff00000) return x+x; k += (hx>>20)-1023; hx &= 0x000fffff; i = (hx+0x95f64)&0x100000; SET_HIGH_WORD(x,hx|(i^0x3ff00000)); /* normalize x or x/2 */ k += (i>>20); f = x-1.0; if((0x000fffff&(2+hx))<3) { /* -2**-20 <= f < 2**-20 */ if(f==zero) { if(k==0) { return zero; } else { dk=(double)k; return dk*ln2_hi+dk*ln2_lo; } } R = f*f*(0.5-0.33333333333333333*f); if(k==0) return f-R; else {dk=(double)k; return dk*ln2_hi-((R-dk*ln2_lo)-f);} } s = f/(2.0+f); dk = (double)k; z = s*s; i = hx-0x6147a; w = z*z; j = 0x6b851-hx; t1= w*(Lg2+w*(Lg4+w*Lg6)); t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7))); i |= j; R = t2+t1; if(i>0) { hfsq=0.5*f*f; if(k==0) return f-(hfsq-s*(hfsq+R)); else return dk*ln2_hi-((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f); } else { if(k==0) return f-s*(f-R); else return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f); } } wcc-0.0.2/src/wsh/openlibm/src/s_ceil.c0000644000175000017500000000350313122010155016314 0ustar philphil/* @(#)s_ceil.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ceil.c,v 1.11 2008/02/15 07:01:40 bde Exp $"); /* * ceil(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to ceil(x). */ #include #include #include "math_private.h" static const double huge = 1.0e300; OLM_DLLEXPORT double ceil(double x) { int32_t i0,i1,j0; u_int32_t i,j; EXTRACT_WORDS(i0,i1,x); j0 = ((i0>>20)&0x7ff)-0x3ff; if(j0<20) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ if(i0<0) {i0=0x80000000;i1=0;} else if((i0|i1)!=0) { i0=0x3ff00000;i1=0;} } } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0>0) i0 += (0x00100000)>>j0; i0 &= (~i); i1=0; } } } else if (j0>51) { if(j0==0x400) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0>0) { if(j0==20) i0+=1; else { j = i1 + (1<<(52-j0)); if(j #include "math_private.h" #include "fpmath.h" OLM_DLLEXPORT long double fabsl(long double x) { union IEEEl2bits u; u.e = x; u.bits.sign = 0; return (u.e); } wcc-0.0.2/src/wsh/openlibm/src/s_casinhl.c0000644000175000017500000000266213122010155017026 0ustar philphil/* $OpenBSD: s_casinhl.c,v 1.1 2011/07/08 19:25:31 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* casinhl * * Complex inverse hyperbolic sine * * * * SYNOPSIS: * * long double complex casinhf(); * long double complex z, w; * * w = casinhl (z); * * * * DESCRIPTION: * * casinh z = -i casin iz . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.8e-14 2.6e-15 * */ #include #include long double complex casinhl(long double complex z) { long double complex w; w = -1.0L * I * casinl(z * I); return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_conjl.c0000644000175000017500000000307613122010155016512 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_conjl.c,v 1.2 2008/08/07 14:39:56 das Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT long double complex conjl(long double complex z) { return (CMPLXL(creall(z), -cimagl(z))); } wcc-0.0.2/src/wsh/openlibm/src/s_catanf.c0000644000175000017500000000502013122010155016630 0ustar philphil/* $OpenBSD: s_catanf.c,v 1.2 2010/07/18 18:42:26 guenther Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* catanf() * * Complex circular arc tangent * * * * SYNOPSIS: * * float complex catanf(); * float complex z, w; * * w = catanf( z ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * 1 ( 2x ) * Re w = - arctan(-----------) + k PI * 2 ( 2 2) * (1 - x - y ) * * ( 2 2) * 1 (x + (y+1) ) * Im w = - log(------------) * 4 ( 2 2) * (x + (y-1) ) * * Where k is an arbitrary integer. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 2.3e-6 5.2e-8 * */ #include #include #define MAXNUMF 1.0e38F static const double DP1 = 3.140625; static const double DP2 = 9.67502593994140625E-4; static const double DP3 = 1.509957990978376432E-7; static float _redupif(float xx) { float x, t; long i; x = xx; t = x/(float)M_PI; if(t >= 0.0) t += 0.5; else t -= 0.5; i = t; /* the multiple */ t = i; t = ((x - t * DP1) - t * DP2) - t * DP3; return(t); } float complex catanf(float complex z) { float complex w; float a, t, x, x2, y; x = crealf(z); y = cimagf(z); if((x == 0.0f) && (y > 1.0f)) goto ovrf; x2 = x * x; a = 1.0f - x2 - (y * y); if (a == 0.0f) goto ovrf; t = 0.5f * atan2f(2.0f * x, a); w = _redupif(t); t = y - 1.0f; a = x2 + (t * t); if(a == 0.0f) goto ovrf; t = y + 1.0f; a = (x2 + (t * t))/a; w = w + (0.25f * logf (a)) * I; return (w); ovrf: /*mtherr( "catanf", OVERFLOW );*/ w = MAXNUMF + MAXNUMF * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_ilogbl.c0000644000175000017500000000251013122010155016645 0ustar philphil/* * From: @(#)s_ilogb.c 5.1 93/09/24 * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ilogbl.c,v 1.2 2008/02/22 02:30:35 das Exp $"); #include #include #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT int ilogbl(long double x) { union IEEEl2bits u; unsigned long m; int b; u.e = x; if (u.bits.exp == 0) { if ((u.bits.manl | u.bits.manh) == 0) return (FP_ILOGB0); /* denormalized */ if (u.bits.manh == 0) { m = 1lu << (LDBL_MANL_SIZE - 1); for (b = LDBL_MANH_SIZE; !(u.bits.manl & m); m >>= 1) b++; } else { m = 1lu << (LDBL_MANH_SIZE - 1); for (b = 0; !(u.bits.manh & m); m >>= 1) b++; } #ifdef LDBL_IMPLICIT_NBIT b++; #endif return (LDBL_MIN_EXP - b - 1); } else if (u.bits.exp < (LDBL_MAX_EXP << 1) - 1) return (u.bits.exp - LDBL_MAX_EXP + 1); else if (u.bits.manl != 0 || u.bits.manh != 0) return (FP_ILOGBNAN); else return (INT_MAX); } wcc-0.0.2/src/wsh/openlibm/src/s_cimagf.c0000644000175000017500000000303013122010155016621 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_cimagf.c,v 1.3 2009/03/14 18:24:15 das Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT float cimagf(float complex z) { return (__imag__ z); } wcc-0.0.2/src/wsh/openlibm/src/s_casinhf.c0000644000175000017500000000262413122010155017016 0ustar philphil/* $OpenBSD: s_casinhf.c,v 1.1 2008/09/07 20:36:09 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* casinhf * * Complex inverse hyperbolic sine * * * * SYNOPSIS: * * float complex casinhf(); * float complex z, w; * * w = casinhf (z); * * * * DESCRIPTION: * * casinh z = -i casin iz . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.8e-14 2.6e-15 * */ #include #include float complex casinhf(float complex z) { float complex w; w = -1.0f * I * casinf (z * I); return (w); } wcc-0.0.2/src/wsh/openlibm/src/e_j1.c0000644000175000017500000003443313122010155015702 0ustar philphil /* @(#)e_j1.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_j1.c,v 1.9 2008/02/22 02:30:35 das Exp $"); /* __ieee754_j1(x), __ieee754_y1(x) * Bessel function of the first and second kinds of order zero. * Method -- j1(x): * 1. For tiny x, we use j1(x) = x/2 - x^3/16 + x^5/384 - ... * 2. Reduce x to |x| since j1(x)=-j1(-x), and * for x in (0,2) * j1(x) = x/2 + x*z*R0/S0, where z = x*x; * (precision: |j1/x - 1/2 - R0/S0 |<2**-61.51 ) * for x in (2,inf) * j1(x) = sqrt(2/(pi*x))*(p1(x)*cos(x1)-q1(x)*sin(x1)) * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) * as follow: * cos(x1) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * sin(x1) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = -1/sqrt(2) * (sin(x) + cos(x)) * (To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one.) * * 3 Special cases * j1(nan)= nan * j1(0) = 0 * j1(inf) = 0 * * Method -- y1(x): * 1. screen out x<=0 cases: y1(0)=-inf, y1(x<0)=NaN * 2. For x<2. * Since * y1(x) = 2/pi*(j1(x)*(ln(x/2)+Euler)-1/x-x/2+5/64*x^3-...) * therefore y1(x)-2/pi*j1(x)*ln(x)-1/x is an odd function. * We use the following function to approximate y1, * y1(x) = x*U(z)/V(z) + (2/pi)*(j1(x)*ln(x)-1/x), z= x^2 * where for x in [0,2] (abs err less than 2**-65.89) * U(z) = U0[0] + U0[1]*z + ... + U0[4]*z^4 * V(z) = 1 + v0[0]*z + ... + v0[4]*z^5 * Note: For tiny x, 1/x dominate y1 and hence * y1(tiny) = -2/pi/tiny, (choose tiny<2**-54) * 3. For x>=2. * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) * by method mentioned above. */ #include #include "math_private.h" static double pone(double), qone(double); static const double huge = 1e300, one = 1.0, invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ /* R0/S0 on [0,2] */ r00 = -6.25000000000000000000e-02, /* 0xBFB00000, 0x00000000 */ r01 = 1.40705666955189706048e-03, /* 0x3F570D9F, 0x98472C61 */ r02 = -1.59955631084035597520e-05, /* 0xBEF0C5C6, 0xBA169668 */ r03 = 4.96727999609584448412e-08, /* 0x3E6AAAFA, 0x46CA0BD9 */ s01 = 1.91537599538363460805e-02, /* 0x3F939D0B, 0x12637E53 */ s02 = 1.85946785588630915560e-04, /* 0x3F285F56, 0xB9CDF664 */ s03 = 1.17718464042623683263e-06, /* 0x3EB3BFF8, 0x333F8498 */ s04 = 5.04636257076217042715e-09, /* 0x3E35AC88, 0xC97DFF2C */ s05 = 1.23542274426137913908e-11; /* 0x3DAB2ACF, 0xCFB97ED8 */ static const double zero = 0.0; OLM_DLLEXPORT double __ieee754_j1(double x) { double z, s,c,ss,cc,r,u,v,y; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) return one/x; y = fabs(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sin(y); c = cos(y); ss = -s-c; cc = s-c; if(ix<0x7fe00000) { /* make sure y+y not overflow */ z = cos(y+y); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x) * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x) */ if(ix>0x48000000) z = (invsqrtpi*cc)/sqrt(y); else { u = pone(y); v = qone(y); z = invsqrtpi*(u*cc-v*ss)/sqrt(y); } if(hx<0) return -z; else return z; } if(ix<0x3e400000) { /* |x|<2**-27 */ if(huge+x>one) return 0.5*x;/* inexact if x!=0 necessary */ } z = x*x; r = z*(r00+z*(r01+z*(r02+z*r03))); s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05)))); r *= x; return(x*0.5+r/s); } static const double U0[5] = { -1.96057090646238940668e-01, /* 0xBFC91866, 0x143CBC8A */ 5.04438716639811282616e-02, /* 0x3FA9D3C7, 0x76292CD1 */ -1.91256895875763547298e-03, /* 0xBF5F55E5, 0x4844F50F */ 2.35252600561610495928e-05, /* 0x3EF8AB03, 0x8FA6B88E */ -9.19099158039878874504e-08, /* 0xBE78AC00, 0x569105B8 */ }; static const double V0[5] = { 1.99167318236649903973e-02, /* 0x3F94650D, 0x3F4DA9F0 */ 2.02552581025135171496e-04, /* 0x3F2A8C89, 0x6C257764 */ 1.35608801097516229404e-06, /* 0x3EB6C05A, 0x894E8CA6 */ 6.22741452364621501295e-09, /* 0x3E3ABF1D, 0x5BA69A86 */ 1.66559246207992079114e-11, /* 0x3DB25039, 0xDACA772A */ }; OLM_DLLEXPORT double __ieee754_y1(double x) { double z, s,c,ss,cc,u,v; int32_t hx,ix,lx; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */ if(ix>=0x7ff00000) return one/(x+x*x); if((ix|lx)==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sin(x); c = cos(x); ss = -s-c; cc = s-c; if(ix<0x7fe00000) { /* make sure x+x not overflow */ z = cos(x+x); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0)) * where x0 = x-3pi/4 * Better formula: * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = -1/sqrt(2) * (cos(x) + sin(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ if(ix>0x48000000) z = (invsqrtpi*ss)/sqrt(x); else { u = pone(x); v = qone(x); z = invsqrtpi*(u*ss+v*cc)/sqrt(x); } return z; } if(ix<=0x3c900000) { /* x < 2**-54 */ return(-tpi/x); } z = x*x; u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4]))); v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4])))); return(x*(u/v) + tpi*(__ieee754_j1(x)*__ieee754_log(x)-one/x)); } /* For x >= 8, the asymptotic expansions of pone is * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x. * We approximate pone by * pone(x) = 1 + (R/S) * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10 * S = 1 + ps0*s^2 + ... + ps4*s^10 * and * | pone(x)-1-R/S | <= 2 ** ( -60.06) */ static const double pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ 1.17187499999988647970e-01, /* 0x3FBDFFFF, 0xFFFFFCCE */ 1.32394806593073575129e+01, /* 0x402A7A9D, 0x357F7FCE */ 4.12051854307378562225e+02, /* 0x4079C0D4, 0x652EA590 */ 3.87474538913960532227e+03, /* 0x40AE457D, 0xA3A532CC */ 7.91447954031891731574e+03, /* 0x40BEEA7A, 0xC32782DD */ }; static const double ps8[5] = { 1.14207370375678408436e+02, /* 0x405C8D45, 0x8E656CAC */ 3.65093083420853463394e+03, /* 0x40AC85DC, 0x964D274F */ 3.69562060269033463555e+04, /* 0x40E20B86, 0x97C5BB7F */ 9.76027935934950801311e+04, /* 0x40F7D42C, 0xB28F17BB */ 3.08042720627888811578e+04, /* 0x40DE1511, 0x697A0B2D */ }; static const double pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.31990519556243522749e-11, /* 0x3DAD0667, 0xDAE1CA7D */ 1.17187493190614097638e-01, /* 0x3FBDFFFF, 0xE2C10043 */ 6.80275127868432871736e+00, /* 0x401B3604, 0x6E6315E3 */ 1.08308182990189109773e+02, /* 0x405B13B9, 0x452602ED */ 5.17636139533199752805e+02, /* 0x40802D16, 0xD052D649 */ 5.28715201363337541807e+02, /* 0x408085B8, 0xBB7E0CB7 */ }; static const double ps5[5] = { 5.92805987221131331921e+01, /* 0x404DA3EA, 0xA8AF633D */ 9.91401418733614377743e+02, /* 0x408EFB36, 0x1B066701 */ 5.35326695291487976647e+03, /* 0x40B4E944, 0x5706B6FB */ 7.84469031749551231769e+03, /* 0x40BEA4B0, 0xB8A5BB15 */ 1.50404688810361062679e+03, /* 0x40978030, 0x036F5E51 */ }; static const double pr3[6] = { 3.02503916137373618024e-09, /* 0x3E29FC21, 0xA7AD9EDD */ 1.17186865567253592491e-01, /* 0x3FBDFFF5, 0x5B21D17B */ 3.93297750033315640650e+00, /* 0x400F76BC, 0xE85EAD8A */ 3.51194035591636932736e+01, /* 0x40418F48, 0x9DA6D129 */ 9.10550110750781271918e+01, /* 0x4056C385, 0x4D2C1837 */ 4.85590685197364919645e+01, /* 0x4048478F, 0x8EA83EE5 */ }; static const double ps3[5] = { 3.47913095001251519989e+01, /* 0x40416549, 0xA134069C */ 3.36762458747825746741e+02, /* 0x40750C33, 0x07F1A75F */ 1.04687139975775130551e+03, /* 0x40905B7C, 0x5037D523 */ 8.90811346398256432622e+02, /* 0x408BD67D, 0xA32E31E9 */ 1.03787932439639277504e+02, /* 0x4059F26D, 0x7C2EED53 */ }; static const double pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.07710830106873743082e-07, /* 0x3E7CE9D4, 0xF65544F4 */ 1.17176219462683348094e-01, /* 0x3FBDFF42, 0xBE760D83 */ 2.36851496667608785174e+00, /* 0x4002F2B7, 0xF98FAEC0 */ 1.22426109148261232917e+01, /* 0x40287C37, 0x7F71A964 */ 1.76939711271687727390e+01, /* 0x4031B1A8, 0x177F8EE2 */ 5.07352312588818499250e+00, /* 0x40144B49, 0xA574C1FE */ }; static const double ps2[5] = { 2.14364859363821409488e+01, /* 0x40356FBD, 0x8AD5ECDC */ 1.25290227168402751090e+02, /* 0x405F5293, 0x14F92CD5 */ 2.32276469057162813669e+02, /* 0x406D08D8, 0xD5A2DBD9 */ 1.17679373287147100768e+02, /* 0x405D6B7A, 0xDA1884A9 */ 8.36463893371618283368e+00, /* 0x4020BAB1, 0xF44E5192 */ }; /* Note: This function is only called for ix>=0x40000000 (see above) */ static double pone(double x) { const double *p,*q; double z,r,s; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; assert(ix>=0x40000000 && ix<=0x48000000); if(ix>=0x40200000) {p = pr8; q= ps8;} else if(ix>=0x40122E8B){p = pr5; q= ps5;} else if(ix>=0x4006DB6D){p = pr3; q= ps3;} else {p = pr2; q= ps2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qone is * 3/8 s - 105/1024 s^3 - ..., where s = 1/x. * We approximate pone by * qone(x) = s*(0.375 + (R/S)) * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10 * S = 1 + qs1*s^2 + ... + qs6*s^12 * and * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13) */ static const double qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ -1.02539062499992714161e-01, /* 0xBFBA3FFF, 0xFFFFFDF3 */ -1.62717534544589987888e+01, /* 0xC0304591, 0xA26779F7 */ -7.59601722513950107896e+02, /* 0xC087BCD0, 0x53E4B576 */ -1.18498066702429587167e+04, /* 0xC0C724E7, 0x40F87415 */ -4.84385124285750353010e+04, /* 0xC0E7A6D0, 0x65D09C6A */ }; static const double qs8[6] = { 1.61395369700722909556e+02, /* 0x40642CA6, 0xDE5BCDE5 */ 7.82538599923348465381e+03, /* 0x40BE9162, 0xD0D88419 */ 1.33875336287249578163e+05, /* 0x4100579A, 0xB0B75E98 */ 7.19657723683240939863e+05, /* 0x4125F653, 0x72869C19 */ 6.66601232617776375264e+05, /* 0x412457D2, 0x7719AD5C */ -2.94490264303834643215e+05, /* 0xC111F969, 0x0EA5AA18 */ }; static const double qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -2.08979931141764104297e-11, /* 0xBDB6FA43, 0x1AA1A098 */ -1.02539050241375426231e-01, /* 0xBFBA3FFF, 0xCB597FEF */ -8.05644828123936029840e+00, /* 0xC0201CE6, 0xCA03AD4B */ -1.83669607474888380239e+02, /* 0xC066F56D, 0x6CA7B9B0 */ -1.37319376065508163265e+03, /* 0xC09574C6, 0x6931734F */ -2.61244440453215656817e+03, /* 0xC0A468E3, 0x88FDA79D */ }; static const double qs5[6] = { 8.12765501384335777857e+01, /* 0x405451B2, 0xFF5A11B2 */ 1.99179873460485964642e+03, /* 0x409F1F31, 0xE77BF839 */ 1.74684851924908907677e+04, /* 0x40D10F1F, 0x0D64CE29 */ 4.98514270910352279316e+04, /* 0x40E8576D, 0xAABAD197 */ 2.79480751638918118260e+04, /* 0x40DB4B04, 0xCF7C364B */ -4.71918354795128470869e+03, /* 0xC0B26F2E, 0xFCFFA004 */ }; static const double qr3[6] = { -5.07831226461766561369e-09, /* 0xBE35CFA9, 0xD38FC84F */ -1.02537829820837089745e-01, /* 0xBFBA3FEB, 0x51AEED54 */ -4.61011581139473403113e+00, /* 0xC01270C2, 0x3302D9FF */ -5.78472216562783643212e+01, /* 0xC04CEC71, 0xC25D16DA */ -2.28244540737631695038e+02, /* 0xC06C87D3, 0x4718D55F */ -2.19210128478909325622e+02, /* 0xC06B66B9, 0x5F5C1BF6 */ }; static const double qs3[6] = { 4.76651550323729509273e+01, /* 0x4047D523, 0xCCD367E4 */ 6.73865112676699709482e+02, /* 0x40850EEB, 0xC031EE3E */ 3.38015286679526343505e+03, /* 0x40AA684E, 0x448E7C9A */ 5.54772909720722782367e+03, /* 0x40B5ABBA, 0xA61D54A6 */ 1.90311919338810798763e+03, /* 0x409DBC7A, 0x0DD4DF4B */ -1.35201191444307340817e+02, /* 0xC060E670, 0x290A311F */ }; static const double qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -1.78381727510958865572e-07, /* 0xBE87F126, 0x44C626D2 */ -1.02517042607985553460e-01, /* 0xBFBA3E8E, 0x9148B010 */ -2.75220568278187460720e+00, /* 0xC0060484, 0x69BB4EDA */ -1.96636162643703720221e+01, /* 0xC033A9E2, 0xC168907F */ -4.23253133372830490089e+01, /* 0xC04529A3, 0xDE104AAA */ -2.13719211703704061733e+01, /* 0xC0355F36, 0x39CF6E52 */ }; static const double qs2[6] = { 2.95333629060523854548e+01, /* 0x403D888A, 0x78AE64FF */ 2.52981549982190529136e+02, /* 0x406F9F68, 0xDB821CBA */ 7.57502834868645436472e+02, /* 0x4087AC05, 0xCE49A0F7 */ 7.39393205320467245656e+02, /* 0x40871B25, 0x48D4C029 */ 1.55949003336666123687e+02, /* 0x40637E5E, 0x3C3ED8D4 */ -4.95949898822628210127e+00, /* 0xC013D686, 0xE71BE86B */ }; /* Note: This function is only called for ix>=0x40000000 (see above) */ static double qone(double x) { const double *p,*q; double s,r,z; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; assert(ix>=0x40000000 && ix<=0x48000000); if(ix>=0x40200000) {p = qr8; q= qs8;} else if(ix>=0x40122E8B){p = qr5; q= qs5;} else if(ix>=0x4006DB6D){p = qr3; q= qs3;} else {p = qr2; q= qs2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return (.375 + r/s)/x; } wcc-0.0.2/src/wsh/openlibm/src/e_sinh.c0000644000175000017500000000404513122010155016325 0ustar philphil /* @(#)e_sinh.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_sinh.c,v 1.11 2011/10/21 06:28:47 das Exp $"); /* __ieee754_sinh(x) * Method : * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 * 1. Replace x by |x| (sinh(-x) = -sinh(x)). * 2. * E + E/(E+1) * 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x) * 2 * * 22 <= x <= lnovft : sinh(x) := exp(x)/2 * lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2) * ln2ovft < x : sinh(x) := x*shuge (overflow) * * Special cases: * sinh(x) is |x| if x is +INF, -INF, or NaN. * only sinh(0)=0 is exact for finite x. */ #include #include "math_private.h" static const double one = 1.0, shuge = 1.0e307; OLM_DLLEXPORT double __ieee754_sinh(double x) { double t,h; int32_t ix,jx; /* High word of |x|. */ GET_HIGH_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7ff00000) return x+x; h = 0.5; if (jx<0) h = -h; /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */ if (ix < 0x40360000) { /* |x|<22 */ if (ix<0x3e300000) /* |x|<2**-28 */ if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ t = expm1(fabs(x)); if(ix<0x3ff00000) return h*(2.0*t-t*t/(t+one)); return h*(t+t/(t+one)); } /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */ if (ix < 0x40862E42) return h*__ieee754_exp(fabs(x)); /* |x| in [log(maxdouble), overflowthresold] */ if (ix<=0x408633CE) return h*2.0*__ldexp_exp(fabs(x), -1); /* |x| > overflowthresold, sinh(x) overflow */ return x*shuge; } wcc-0.0.2/src/wsh/openlibm/src/s_fabsf.c0000644000175000017500000000153113122010155016460 0ustar philphil/* s_fabsf.c -- float version of s_fabs.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fabsf.c,v 1.8 2008/02/22 02:30:35 das Exp $"); /* * fabsf(x) returns the absolute value of x. */ #include #include "math_private.h" OLM_DLLEXPORT float fabsf(float x) { u_int32_t ix; GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(x,ix&0x7fffffff); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_ccosl.c0000644000175000017500000000352513122010155016507 0ustar philphil/* $OpenBSD: s_ccosl.c,v 1.2 2011/07/20 19:28:33 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ccosl() * * Complex circular cosine * * * * SYNOPSIS: * * long double complex ccosl(); * long double complex z, w; * * w = ccosl( z ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = cos x cosh y - i sin x sinh y. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8400 4.5e-17 1.3e-17 * IEEE -10,+10 30000 3.8e-16 1.0e-16 */ #include #include static void cchshl(long double x, long double *c, long double *s) { long double e, ei; if(fabsl(x) <= 0.5L) { *c = coshl(x); *s = sinhl(x); } else { e = expl(x); ei = 0.5L/e; e = 0.5L * e; *s = e - ei; *c = e + ei; } } long double complex ccosl(long double complex z) { long double complex w; long double ch, sh; cchshl(cimagl(z), &ch, &sh); w = cosl(creall(z)) * ch + (-sinl(creall(z)) * sh) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_ccos.c0000644000175000017500000000366013122010155016333 0ustar philphil/* $OpenBSD: s_ccos.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ccos() * * Complex circular cosine * * * * SYNOPSIS: * * double complex ccos(); * double complex z, w; * * w = ccos (z); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = cos x cosh y - i sin x sinh y. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8400 4.5e-17 1.3e-17 * IEEE -10,+10 30000 3.8e-16 1.0e-16 */ #include #include #include /* calculate cosh and sinh */ static void _cchsh(double x, double *c, double *s) { double e, ei; if (fabs(x) <= 0.5) { *c = cosh(x); *s = sinh(x); } else { e = exp(x); ei = 0.5/e; e = 0.5 * e; *s = e - ei; *c = e + ei; } } double complex ccos(double complex z) { double complex w; double ch, sh; _cchsh( cimag(z), &ch, &sh ); w = cos(creal (z)) * ch - (sin (creal (z)) * sh) * I; return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(ccosl, ccos); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_scalbn.c0000644000175000017500000000367413122010155016653 0ustar philphil/* @(#)s_scalbn.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * scalbn (double x, int n) * scalbn(x,n) returns x* 2**n computed by exponent * manipulation rather than by actually performing an * exponentiation or a multiplication. */ #include "cdefs-compat.h" #include #include #include "math_private.h" static const double two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */ huge = 1.0e+300, tiny = 1.0e-300; OLM_DLLEXPORT double scalbn (double x, int n) { int32_t k,hx,lx; EXTRACT_WORDS(hx,lx,x); k = (hx&0x7ff00000)>>20; /* extract exponent */ if (k==0) { /* 0 or subnormal x */ if ((lx|(hx&0x7fffffff))==0) return x; /* +-0 */ x *= two54; GET_HIGH_WORD(hx,x); k = ((hx&0x7ff00000)>>20) - 54; if (n< -50000) return tiny*x; /*underflow*/ } if (k==0x7ff) return x+x; /* NaN or Inf */ k = k+n; if (k > 0x7fe) return huge*copysign(huge,x); /* overflow */ if (k > 0) /* normal result */ {SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20)); return x;} if (k <= -54) { if (n > 50000) /* in case integer overflow in n+k */ return huge*copysign(huge,x); /*overflow*/ else return tiny*copysign(tiny,x); /*underflow*/ } k += 54; /* subnormal result */ SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20)); return x*twom54; } #if (LDBL_MANT_DIG == 53) __weak_reference(scalbn, ldexpl); __weak_reference(scalbn, scalbnl); #endif __strong_reference(scalbn, ldexp); wcc-0.0.2/src/wsh/openlibm/src/s_lrintf.c0000644000175000017500000000033413122010155016675 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_lrintf.c,v 1.1 2005/01/11 23:12:55 das Exp $"); #define type float #define roundit rintf #define dtype long #define fn lrintf #include "s_lrint.c" wcc-0.0.2/src/wsh/openlibm/src/e_log10.c0000644000175000017500000000474613122010155016316 0ustar philphil /* @(#)e_log10.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_log10.c,v 1.15 2011/10/15 05:23:28 das Exp $"); /* * Return the base 10 logarithm of x. See e_log.c and k_log.h for most * comments. * * log10(x) = (f - 0.5*f*f + k_log1p(f)) / ln10 + k * log10(2) * in not-quite-routine extra precision. */ #include #include "math_private.h" #include "k_log.h" static const double two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ ivln10hi = 4.34294481878168880939e-01, /* 0x3fdbcb7b, 0x15200000 */ ivln10lo = 2.50829467116452752298e-11, /* 0x3dbb9438, 0xca9aadd5 */ log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */ log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */ static const double zero = 0.0; OLM_DLLEXPORT double __ieee754_log10(double x) { double f,hfsq,hi,lo,r,val_hi,val_lo,w,y,y2; int32_t i,k,hx; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); k=0; if (hx < 0x00100000) { /* x < 2**-1022 */ if (((hx&0x7fffffff)|lx)==0) return -two54/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 54; x *= two54; /* subnormal number, scale up x */ GET_HIGH_WORD(hx,x); } if (hx >= 0x7ff00000) return x+x; if (hx == 0x3ff00000 && lx == 0) return zero; /* log(1) = +0 */ k += (hx>>20)-1023; hx &= 0x000fffff; i = (hx+0x95f64)&0x100000; SET_HIGH_WORD(x,hx|(i^0x3ff00000)); /* normalize x or x/2 */ k += (i>>20); y = (double)k; f = x - 1.0; hfsq = 0.5*f*f; r = k_log1p(f); /* See e_log2.c for most details. */ hi = f - hfsq; SET_LOW_WORD(hi,0); lo = (f - hi) - hfsq + r; val_hi = hi*ivln10hi; y2 = y*log10_2hi; val_lo = y*log10_2lo + (lo+hi)*ivln10lo + lo*ivln10hi; /* * Extra precision in for adding y*log10_2hi is not strictly needed * since there is no very large cancellation near x = sqrt(2) or * x = 1/sqrt(2), but we do it anyway since it costs little on CPUs * with some parallelism and it reduces the error for many args. */ w = y2 + val_hi; val_lo += (y2 - w) + val_hi; val_hi = w; return val_lo + val_hi; } wcc-0.0.2/src/wsh/openlibm/src/e_expf.c0000644000175000017500000000543113122010155016326 0ustar philphil/* e_expf.c -- float version of e_exp.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_expf.c,v 1.16 2011/10/21 06:26:38 das Exp $"); #include #include #include "math_private.h" static const float one = 1.0, halF[2] = {0.5,-0.5,}, huge = 1.0e+30, o_threshold= 8.8721679688e+01, /* 0x42b17180 */ u_threshold= -1.0397208405e+02, /* 0xc2cff1b5 */ ln2HI[2] ={ 6.9314575195e-01, /* 0x3f317200 */ -6.9314575195e-01,}, /* 0xbf317200 */ ln2LO[2] ={ 1.4286067653e-06, /* 0x35bfbe8e */ -1.4286067653e-06,}, /* 0xb5bfbe8e */ invln2 = 1.4426950216e+00, /* 0x3fb8aa3b */ /* * Domain [-0.34568, 0.34568], range ~[-4.278e-9, 4.447e-9]: * |x*(exp(x)+1)/(exp(x)-1) - p(x)| < 2**-27.74 */ P1 = 1.6666625440e-1, /* 0xaaaa8f.0p-26 */ P2 = -2.7667332906e-3; /* -0xb55215.0p-32 */ static volatile float twom100 = 7.8886090522e-31; /* 2**-100=0x0d800000 */ OLM_DLLEXPORT float __ieee754_expf(float x) { float y,hi=0.0,lo=0.0,c,t,twopk; int32_t k=0,xsb; u_int32_t hx; GET_FLOAT_WORD(hx,x); xsb = (hx>>31)&1; /* sign bit of x */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out non-finite argument */ if(hx >= 0x42b17218) { /* if |x|>=88.721... */ if(hx>0x7f800000) return x+x; /* NaN */ if(hx==0x7f800000) return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */ if(x > o_threshold) return huge*huge; /* overflow */ if(x < u_threshold) return twom100*twom100; /* underflow */ } /* argument reduction */ if(hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */ if(hx < 0x3F851592) { /* and |x| < 1.5 ln2 */ hi = x-ln2HI[xsb]; lo=ln2LO[xsb]; k = 1-xsb-xsb; } else { k = invln2*x+halF[xsb]; t = k; hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */ lo = t*ln2LO[0]; } STRICT_ASSIGN(float, x, hi - lo); } else if(hx < 0x39000000) { /* when |x|<2**-14 */ if(huge+x>one) return one+x;/* trigger inexact */ } else k = 0; /* x is now in primary range */ t = x*x; if(k >= -125) SET_FLOAT_WORD(twopk,0x3f800000+(k<<23)); else SET_FLOAT_WORD(twopk,0x3f800000+((k+100)<<23)); c = x - t*(P1+t*P2); if(k==0) return one-((x*c)/(c-(float)2.0)-x); else y = one-((lo-(x*c)/((float)2.0-c))-hi); if(k >= -125) { if(k==128) return y*2.0F*0x1p127F; return y*twopk; } else { return y*twopk*twom100; } } wcc-0.0.2/src/wsh/openlibm/src/s_atanf.c0000644000175000017500000000501513122010155016471 0ustar philphil/* s_atanf.c -- float version of s_atan.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_atanf.c,v 1.10 2008/08/01 01:24:25 das Exp $"); #include #include "math_private.h" static const float atanhi[] = { 4.6364760399e-01, /* atan(0.5)hi 0x3eed6338 */ 7.8539812565e-01, /* atan(1.0)hi 0x3f490fda */ 9.8279368877e-01, /* atan(1.5)hi 0x3f7b985e */ 1.5707962513e+00, /* atan(inf)hi 0x3fc90fda */ }; static const float atanlo[] = { 5.0121582440e-09, /* atan(0.5)lo 0x31ac3769 */ 3.7748947079e-08, /* atan(1.0)lo 0x33222168 */ 3.4473217170e-08, /* atan(1.5)lo 0x33140fb4 */ 7.5497894159e-08, /* atan(inf)lo 0x33a22168 */ }; static const float aT[] = { 3.3333328366e-01, -1.9999158382e-01, 1.4253635705e-01, -1.0648017377e-01, 6.1687607318e-02, }; static const float one = 1.0, huge = 1.0e30; OLM_DLLEXPORT float atanf(float x) { float w,s1,s2,z; int32_t ix,hx,id; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x4c800000) { /* if |x| >= 2**26 */ if(ix>0x7f800000) return x+x; /* NaN */ if(hx>0) return atanhi[3]+*(volatile float *)&atanlo[3]; else return -atanhi[3]-*(volatile float *)&atanlo[3]; } if (ix < 0x3ee00000) { /* |x| < 0.4375 */ if (ix < 0x39800000) { /* |x| < 2**-12 */ if(huge+x>one) return x; /* raise inexact */ } id = -1; } else { x = fabsf(x); if (ix < 0x3f980000) { /* |x| < 1.1875 */ if (ix < 0x3f300000) { /* 7/16 <=|x|<11/16 */ id = 0; x = ((float)2.0*x-one)/((float)2.0+x); } else { /* 11/16<=|x|< 19/16 */ id = 1; x = (x-one)/(x+one); } } else { if (ix < 0x401c0000) { /* |x| < 2.4375 */ id = 2; x = (x-(float)1.5)/(one+(float)1.5*x); } else { /* 2.4375 <= |x| < 2**26 */ id = 3; x = -(float)1.0/x; } }} /* end of argument reduction */ z = x*x; w = z*z; /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */ s1 = z*(aT[0]+w*(aT[2]+w*aT[4])); s2 = w*(aT[1]+w*aT[3]); if (id<0) return x - x*(s1+s2); else { z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x); return (hx<0)? -z:z; } } wcc-0.0.2/src/wsh/openlibm/src/k_cosf.c0000644000175000017500000000252113122010155016321 0ustar philphil/* k_cosf.c -- float version of k_cos.c * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. * Debugged and optimized by Bruce D. Evans. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef INLINE_KERNEL_COSDF #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_cosf.c,v 1.18 2009/06/03 08:16:34 ed Exp $"); #endif #include #include "math_private.h" /* |cos(x) - c(x)| < 2**-34.1 (~[-5.37e-11, 5.295e-11]). */ static const double one = 1.0, C0 = -0x1ffffffd0c5e81.0p-54, /* -0.499999997251031003120 */ C1 = 0x155553e1053a42.0p-57, /* 0.0416666233237390631894 */ C2 = -0x16c087e80f1e27.0p-62, /* -0.00138867637746099294692 */ C3 = 0x199342e0ee5069.0p-68; /* 0.0000243904487962774090654 */ #ifndef INLINE_KERNEL_COSDF extern #endif //__inline float OLM_DLLEXPORT float __kernel_cosdf(double x) { double r, w, z; /* Try to optimize for parallel evaluation as in k_tanf.c. */ z = x*x; w = z*z; r = C2+z*C3; return ((one+z*C0) + w*C1) + (w*z)*r; } wcc-0.0.2/src/wsh/openlibm/src/s_llroundl.c0000644000175000017500000000044513122010155017235 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_llroundl.c,v 1.1 2005/04/08 01:24:08 das Exp $"); #define type long double #define roundit roundl #define dtype long long #define DTYPE_MIN LLONG_MIN #define DTYPE_MAX LLONG_MAX #define fn llroundl #include "s_lround.c" wcc-0.0.2/src/wsh/openlibm/src/s_creall.c0000644000175000017500000000303513122010155016642 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_creall.c,v 1.1 2004/05/30 09:21:56 stefanf Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT long double creall(long double complex z) { return z; } wcc-0.0.2/src/wsh/openlibm/src/k_logf.h0000644000175000017500000000204313122010155016322 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_logf.h,v 1.3 2011/10/15 05:23:28 das Exp $"); /* * Float version of k_log.h. See the latter for most comments. */ static const float /* |(log(1+s)-log(1-s))/s - Lg(s)| < 2**-34.24 (~[-4.95e-11, 4.97e-11]). */ Lg1 = 0xaaaaaa.0p-24, /* 0.66666662693 */ Lg2 = 0xccce13.0p-25, /* 0.40000972152 */ Lg3 = 0x91e9ee.0p-25, /* 0.28498786688 */ Lg4 = 0xf89e26.0p-26; /* 0.24279078841 */ static inline float k_log1pf(float f) { float hfsq,s,z,R,w,t1,t2; s = f/((float)2.0+f); z = s*s; w = z*z; t1= w*(Lg2+w*Lg4); t2= z*(Lg1+w*Lg3); R = t2+t1; hfsq=(float)0.5*f*f; return s*(hfsq+R); } wcc-0.0.2/src/wsh/openlibm/src/e_asinl.c0000644000175000017500000000370013122010155016467 0ustar philphil /* @(#)e_asin.c 1.3 95/01/18 */ /* FreeBSD: head/lib/msun/src/e_asin.c 176451 2008-02-22 02:30:36Z das */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_asinl.c,v 1.2 2008/08/03 17:49:05 das Exp $"); /* * See comments in e_asin.c. * Converted to long double by David Schultz . */ #include #include #include "invtrig.h" #include "math_private.h" static const long double one = 1.00000000000000000000e+00, huge = 1.000e+300; OLM_DLLEXPORT long double asinl(long double x) { union IEEEl2bits u; long double t=0.0,w,p,q,c,r,s; int16_t expsign, expt; u.e = x; expsign = u.xbits.expsign; expt = expsign & 0x7fff; if(expt >= BIAS) { /* |x|>= 1 */ if(expt==BIAS && ((u.bits.manh&~LDBL_NBIT)|u.bits.manl)==0) /* asin(1)=+-pi/2 with inexact */ return x*pio2_hi+x*pio2_lo; return (x-x)/(x-x); /* asin(|x|>1) is NaN */ } else if (exptone) return x;/* return x with inexact if x!=0*/ } t = x*x; p = P(t); q = Q(t); w = p/q; return x+x*w; } /* 1> |x|>= 0.5 */ w = one-fabsl(x); t = w*0.5; p = P(t); q = Q(t); s = sqrtl(t); if(u.bits.manh>=THRESH) { /* if |x| is close to 1 */ w = p/q; t = pio2_hi-(2.0*(s+s*w)-pio2_lo); } else { u.e = s; u.bits.manl = 0; w = u.e; c = (t-w*w)/(s+w); r = p/q; p = 2.0*s*r-(pio2_lo-2.0*c); q = pio4_hi-2.0*w; t = pio4_hi-(p-q); } if(expsign>0) return t; else return -t; } wcc-0.0.2/src/wsh/openlibm/src/s_lroundl.c0000644000175000017500000000043413122010155017057 0ustar philphil#include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_lroundl.c,v 1.1 2005/04/08 01:24:08 das Exp $"); #define type long double #define roundit roundl #define dtype long #define DTYPE_MIN LONG_MIN #define DTYPE_MAX LONG_MAX #define fn lroundl #include "s_lround.c" wcc-0.0.2/src/wsh/openlibm/src/k_exp.c0000644000175000017500000000714213122010155016167 0ustar philphil/*- * Copyright (c) 2011 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/k_exp.c,v 1.1 2011/10/21 06:27:56 das Exp $"); #include #include #include "math_private.h" static const u_int32_t k = 1799; /* constant for reduction */ static const double kln2 = 1246.97177782734161156; /* k * ln2 */ /* * Compute exp(x), scaled to avoid spurious overflow. An exponent is * returned separately in 'expt'. * * Input: ln(DBL_MAX) <= x < ln(2 * DBL_MAX / DBL_MIN_DENORM) ~= 1454.91 * Output: 2**1023 <= y < 2**1024 */ static double __frexp_exp(double x, int *expt) { double exp_x; u_int32_t hx; /* * We use exp(x) = exp(x - kln2) * 2**k, carefully chosen to * minimize |exp(kln2) - 2**k|. We also scale the exponent of * exp_x to MAX_EXP so that the result can be multiplied by * a tiny number without losing accuracy due to denormalization. */ exp_x = exp(x - kln2); GET_HIGH_WORD(hx, exp_x); *expt = (hx >> 20) - (0x3ff + 1023) + k; SET_HIGH_WORD(exp_x, (hx & 0xfffff) | ((0x3ff + 1023) << 20)); return (exp_x); } /* * __ldexp_exp(x, expt) and __ldexp_cexp(x, expt) compute exp(x) * 2**expt. * They are intended for large arguments (real part >= ln(DBL_MAX)) * where care is needed to avoid overflow. * * The present implementation is narrowly tailored for our hyperbolic and * exponential functions. We assume expt is small (0 or -1), and the caller * has filtered out very large x, for which overflow would be inevitable. */ OLM_DLLEXPORT double __ldexp_exp(double x, int expt) { double exp_x, scale; int ex_expt; exp_x = __frexp_exp(x, &ex_expt); expt += ex_expt; INSERT_WORDS(scale, (0x3ff + expt) << 20, 0); return (exp_x * scale); } OLM_DLLEXPORT double complex __ldexp_cexp(double complex z, int expt) { double x, y, exp_x, scale1, scale2; int ex_expt, half_expt; x = creal(z); y = cimag(z); exp_x = __frexp_exp(x, &ex_expt); expt += ex_expt; /* * Arrange so that scale1 * scale2 == 2**expt. We use this to * compensate for scalbn being horrendously slow. */ half_expt = expt / 2; INSERT_WORDS(scale1, (0x3ff + half_expt) << 20, 0); half_expt = expt - half_expt; INSERT_WORDS(scale2, (0x3ff + half_expt) << 20, 0); return (CMPLX(cos(y) * exp_x * scale1 * scale2, sin(y) * exp_x * scale1 * scale2)); } wcc-0.0.2/src/wsh/openlibm/src/e_j0f.c0000644000175000017500000002446013122010155016046 0ustar philphil/* e_j0f.c -- float version of e_j0.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include "cdefs-compat.h" #include #include "math_private.h" static float pzerof(float), qzerof(float); static const float huge = 1e30, one = 1.0, invsqrtpi= 5.6418961287e-01, /* 0x3f106ebb */ tpi = 6.3661974669e-01, /* 0x3f22f983 */ /* R0/S0 on [0, 2.00] */ R02 = 1.5625000000e-02, /* 0x3c800000 */ R03 = -1.8997929874e-04, /* 0xb947352e */ R04 = 1.8295404516e-06, /* 0x35f58e88 */ R05 = -4.6183270541e-09, /* 0xb19eaf3c */ S01 = 1.5619102865e-02, /* 0x3c7fe744 */ S02 = 1.1692678527e-04, /* 0x38f53697 */ S03 = 5.1354652442e-07, /* 0x3509daa6 */ S04 = 1.1661400734e-09; /* 0x30a045e8 */ static const float zero = 0.0; OLM_DLLEXPORT float __ieee754_j0f(float x) { float z, s,c,ss,cc,r,u,v; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) return one/(x*x); x = fabsf(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sinf(x); c = cosf(x); ss = s-c; cc = s+c; if(ix<0x7f000000) { /* make sure x+x not overflow */ z = -cosf(x+x); if ((s*c)0x58000000) z = (invsqrtpi*cc)/sqrtf(x); /* |x|>2**49 */ else { u = pzerof(x); v = qzerof(x); z = invsqrtpi*(u*cc-v*ss)/sqrtf(x); } return z; } if(ix<0x3b000000) { /* |x| < 2**-9 */ if(huge+x>one) { /* raise inexact if x != 0 */ if(ix<0x39800000) return one; /* |x|<2**-12 */ else return one - x*x/4; } } z = x*x; r = z*(R02+z*(R03+z*(R04+z*R05))); s = one+z*(S01+z*(S02+z*(S03+z*S04))); if(ix < 0x3F800000) { /* |x| < 1.00 */ return one + z*((float)-0.25+(r/s)); } else { u = (float)0.5*x; return((one+u)*(one-u)+z*(r/s)); } } static const float u00 = -7.3804296553e-02, /* 0xbd9726b5 */ u01 = 1.7666645348e-01, /* 0x3e34e80d */ u02 = -1.3818567619e-02, /* 0xbc626746 */ u03 = 3.4745343146e-04, /* 0x39b62a69 */ u04 = -3.8140706238e-06, /* 0xb67ff53c */ u05 = 1.9559013964e-08, /* 0x32a802ba */ u06 = -3.9820518410e-11, /* 0xae2f21eb */ v01 = 1.2730483897e-02, /* 0x3c509385 */ v02 = 7.6006865129e-05, /* 0x389f65e0 */ v03 = 2.5915085189e-07, /* 0x348b216c */ v04 = 4.4111031494e-10; /* 0x2ff280c2 */ OLM_DLLEXPORT float __ieee754_y0f(float x) { float z, s,c,ss,cc,u,v; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */ if(ix>=0x7f800000) return one/(x+x*x); if(ix==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0)) * where x0 = x-pi/4 * Better formula: * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) * = 1/sqrt(2) * (sin(x) + cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ s = sinf(x); c = cosf(x); ss = s-c; cc = s+c; /* * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) */ if(ix<0x7f000000) { /* make sure x+x not overflow */ z = -cosf(x+x); if ((s*c)0x58000000) z = (invsqrtpi*ss)/sqrtf(x); /* |x|>2**49 */ else { u = pzerof(x); v = qzerof(x); z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); } return z; } if(ix<=0x39000000) { /* x < 2**-13 */ return(u00 + tpi*__ieee754_logf(x)); } z = x*x; u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06))))); v = one+z*(v01+z*(v02+z*(v03+z*v04))); return(u/v + tpi*(__ieee754_j0f(x)*__ieee754_logf(x))); } /* The asymptotic expansions of pzero is * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x. * For x >= 2, We approximate pzero by * pzero(x) = 1 + (R/S) * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10 * S = 1 + pS0*s^2 + ... + pS4*s^10 * and * | pzero(x)-1-R/S | <= 2 ** ( -60.26) */ static const float pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ -7.0312500000e-02, /* 0xbd900000 */ -8.0816707611e+00, /* 0xc1014e86 */ -2.5706311035e+02, /* 0xc3808814 */ -2.4852163086e+03, /* 0xc51b5376 */ -5.2530439453e+03, /* 0xc5a4285a */ }; static const float pS8[5] = { 1.1653436279e+02, /* 0x42e91198 */ 3.8337448730e+03, /* 0x456f9beb */ 4.0597855469e+04, /* 0x471e95db */ 1.1675296875e+05, /* 0x47e4087c */ 4.7627726562e+04, /* 0x473a0bba */ }; static const float pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -1.1412546255e-11, /* 0xad48c58a */ -7.0312492549e-02, /* 0xbd8fffff */ -4.1596107483e+00, /* 0xc0851b88 */ -6.7674766541e+01, /* 0xc287597b */ -3.3123129272e+02, /* 0xc3a59d9b */ -3.4643338013e+02, /* 0xc3ad3779 */ }; static const float pS5[5] = { 6.0753936768e+01, /* 0x42730408 */ 1.0512523193e+03, /* 0x44836813 */ 5.9789707031e+03, /* 0x45bad7c4 */ 9.6254453125e+03, /* 0x461665c8 */ 2.4060581055e+03, /* 0x451660ee */ }; static const float pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ -2.5470459075e-09, /* 0xb12f081b */ -7.0311963558e-02, /* 0xbd8fffb8 */ -2.4090321064e+00, /* 0xc01a2d95 */ -2.1965976715e+01, /* 0xc1afba52 */ -5.8079170227e+01, /* 0xc2685112 */ -3.1447946548e+01, /* 0xc1fb9565 */ }; static const float pS3[5] = { 3.5856033325e+01, /* 0x420f6c94 */ 3.6151397705e+02, /* 0x43b4c1ca */ 1.1936077881e+03, /* 0x44953373 */ 1.1279968262e+03, /* 0x448cffe6 */ 1.7358093262e+02, /* 0x432d94b8 */ }; static const float pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -8.8753431271e-08, /* 0xb3be98b7 */ -7.0303097367e-02, /* 0xbd8ffb12 */ -1.4507384300e+00, /* 0xbfb9b1cc */ -7.6356959343e+00, /* 0xc0f4579f */ -1.1193166733e+01, /* 0xc1331736 */ -3.2336456776e+00, /* 0xc04ef40d */ }; static const float pS2[5] = { 2.2220300674e+01, /* 0x41b1c32d */ 1.3620678711e+02, /* 0x430834f0 */ 2.7047027588e+02, /* 0x43873c32 */ 1.5387539673e+02, /* 0x4319e01a */ 1.4657617569e+01, /* 0x416a859a */ }; static float pzerof(float x) { const float *p,*q; float z,r,s; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x41000000) {p = pR8; q= pS8;} else if(ix>=0x409173eb){p = pR5; q= pS5;} else if(ix>=0x4036d917){p = pR3; q= pS3;} else {p = pR2; q= pS2;} /* ix>=0x40000000 */ z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qzero is * -1/8 s + 75/1024 s^3 - ..., where s = 1/x. * We approximate pzero by * qzero(x) = s*(-1.25 + (R/S)) * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10 * S = 1 + qS0*s^2 + ... + qS5*s^12 * and * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22) */ static const float qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ 7.3242187500e-02, /* 0x3d960000 */ 1.1768206596e+01, /* 0x413c4a93 */ 5.5767340088e+02, /* 0x440b6b19 */ 8.8591972656e+03, /* 0x460a6cca */ 3.7014625000e+04, /* 0x471096a0 */ }; static const float qS8[6] = { 1.6377603149e+02, /* 0x4323c6aa */ 8.0983447266e+03, /* 0x45fd12c2 */ 1.4253829688e+05, /* 0x480b3293 */ 8.0330925000e+05, /* 0x49441ed4 */ 8.4050156250e+05, /* 0x494d3359 */ -3.4389928125e+05, /* 0xc8a7eb69 */ }; static const float qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.8408595828e-11, /* 0x2da1ec79 */ 7.3242180049e-02, /* 0x3d95ffff */ 5.8356351852e+00, /* 0x40babd86 */ 1.3511157227e+02, /* 0x43071c90 */ 1.0272437744e+03, /* 0x448067cd */ 1.9899779053e+03, /* 0x44f8bf4b */ }; static const float qS5[6] = { 8.2776611328e+01, /* 0x42a58da0 */ 2.0778142090e+03, /* 0x4501dd07 */ 1.8847289062e+04, /* 0x46933e94 */ 5.6751113281e+04, /* 0x475daf1d */ 3.5976753906e+04, /* 0x470c88c1 */ -5.3543427734e+03, /* 0xc5a752be */ }; static const float qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ 4.3774099900e-09, /* 0x3196681b */ 7.3241114616e-02, /* 0x3d95ff70 */ 3.3442313671e+00, /* 0x405607e3 */ 4.2621845245e+01, /* 0x422a7cc5 */ 1.7080809021e+02, /* 0x432acedf */ 1.6673394775e+02, /* 0x4326bbe4 */ }; static const float qS3[6] = { 4.8758872986e+01, /* 0x42430916 */ 7.0968920898e+02, /* 0x44316c1c */ 3.7041481934e+03, /* 0x4567825f */ 6.4604252930e+03, /* 0x45c9e367 */ 2.5163337402e+03, /* 0x451d4557 */ -1.4924745178e+02, /* 0xc3153f59 */ }; static const float qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.5044444979e-07, /* 0x342189db */ 7.3223426938e-02, /* 0x3d95f62a */ 1.9981917143e+00, /* 0x3fffc4bf */ 1.4495602608e+01, /* 0x4167edfd */ 3.1666231155e+01, /* 0x41fd5471 */ 1.6252708435e+01, /* 0x4182058c */ }; static const float qS2[6] = { 3.0365585327e+01, /* 0x41f2ecb8 */ 2.6934811401e+02, /* 0x4386ac8f */ 8.4478375244e+02, /* 0x44533229 */ 8.8293585205e+02, /* 0x445cbbe5 */ 2.1266638184e+02, /* 0x4354aa98 */ -5.3109550476e+00, /* 0xc0a9f358 */ }; static float qzerof(float x) { const float *p,*q; float s,r,z; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x41000000) {p = qR8; q= qS8;} else if(ix>=0x409173eb){p = qR5; q= qS5;} else if(ix>=0x4036d917){p = qR3; q= qS3;} else {p = qR2; q= qS2;} /* ix>=0x40000000 */ z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return (-(float).125 + r/s)/x; } wcc-0.0.2/src/wsh/openlibm/src/s_sinl.c0000644000175000017500000000475013122010155016352 0ustar philphil/*- * Copyright (c) 2007 Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_sinl.c,v 1.3 2011/05/30 19:41:28 kargl Exp $"); #include #include #include "math_private.h" #if LDBL_MANT_DIG == 64 #include "../ld80/e_rem_pio2l.h" #elif LDBL_MANT_DIG == 113 #include "../ld128/e_rem_pio2l.h" #else #error "Unsupported long double format" #endif OLM_DLLEXPORT long double sinl(long double x) { union IEEEl2bits z; int e0, s; long double y[2]; long double hi, lo; z.e = x; s = z.bits.sign; z.bits.sign = 0; /* If x = +-0 or x is a subnormal number, then sin(x) = x */ if (z.bits.exp == 0) return (x); /* If x = NaN or Inf, then sin(x) = NaN. */ if (z.bits.exp == 32767) return ((x - x) / (x - x)); /* Optimize the case where x is already within range. */ if (z.e < M_PI_4) { hi = __kernel_sinl(z.e, 0, 0); return (s ? -hi : hi); } e0 = __ieee754_rem_pio2l(x, y); hi = y[0]; lo = y[1]; switch (e0 & 3) { case 0: hi = __kernel_sinl(hi, lo, 1); break; case 1: hi = __kernel_cosl(hi, lo); break; case 2: hi = - __kernel_sinl(hi, lo, 1); break; case 3: hi = - __kernel_cosl(hi, lo); break; } return (hi); } wcc-0.0.2/src/wsh/openlibm/src/e_jnf.c0000644000175000017500000001144613122010155016144 0ustar philphil/* e_jnf.c -- float version of e_jn.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_jnf.c,v 1.11 2010/11/13 10:54:10 uqs Exp $"); #include #include "math_private.h" static const float two = 2.0000000000e+00, /* 0x40000000 */ one = 1.0000000000e+00; /* 0x3F800000 */ static const float zero = 0.0000000000e+00; OLM_DLLEXPORT float __ieee754_jnf(int n, float x) { int32_t i,hx,ix, sgn; float a, b, temp, di; float z, w; /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) * Thus, J(-n,x) = J(n,-x) */ GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* if J(n,NaN) is NaN */ if(ix>0x7f800000) return x+x; if(n<0){ n = -n; x = -x; hx ^= 0x80000000; } if(n==0) return(__ieee754_j0f(x)); if(n==1) return(__ieee754_j1f(x)); sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */ x = fabsf(x); if(ix==0||ix>=0x7f800000) /* if x is 0 or inf */ b = zero; else if((float)n<=x) { /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ a = __ieee754_j0f(x); b = __ieee754_j1f(x); for(i=1;i33) /* underflow */ b = zero; else { temp = x*(float)0.5; b = temp; for (a=one,i=2;i<=n;i++) { a *= (float)i; /* a = n! */ b *= temp; /* b = (x/2)^n */ } b = b/a; } } else { /* use backward recurrence */ /* x x^2 x^2 * J(n,x)/J(n-1,x) = ---- ------ ------ ..... * 2n - 2(n+1) - 2(n+2) * * 1 1 1 * (for large x) = ---- ------ ------ ..... * 2n 2(n+1) 2(n+2) * -- - ------ - ------ - * x x x * * Let w = 2n/x and h=2/x, then the above quotient * is equal to the continued fraction: * 1 * = ----------------------- * 1 * w - ----------------- * 1 * w+h - --------- * w+2h - ... * * To determine how many terms needed, let * Q(0) = w, Q(1) = w(w+h) - 1, * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), * When Q(k) > 1e4 good for single * When Q(k) > 1e9 good for double * When Q(k) > 1e17 good for quadruple */ /* determine k */ float t,v; float q0,q1,h,tmp; int32_t k,m; w = (n+n)/(float)x; h = (float)2.0/(float)x; q0 = w; z = w+h; q1 = w*z - (float)1.0; k=1; while(q1<(float)1.0e9) { k += 1; z += h; tmp = z*q1 - q0; q0 = q1; q1 = tmp; } m = n+n; for(t=zero, i = 2*(n+k); i>=m; i -= 2) t = one/(i/x-t); a = t; b = one; /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) * Hence, if n*(log(2n/x)) > ... * single 8.8722839355e+01 * double 7.09782712893383973096e+02 * long double 1.1356523406294143949491931077970765006170e+04 * then recurrent value may overflow and the result is * likely underflow to zero */ tmp = n; v = two/x; tmp = tmp*__ieee754_logf(fabsf(v*tmp)); if(tmp<(float)8.8721679688e+01) { for(i=n-1,di=(float)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; } } else { for(i=n-1,di=(float)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; /* scale b to avoid spurious overflow */ if(b>(float)1e10) { a /= b; t /= b; b = one; } } } z = __ieee754_j0f(x); w = __ieee754_j1f(x); if (fabsf(z) >= fabsf(w)) b = (t*z/b); else b = (t*w/a); } } if(sgn==1) return -b; else return b; } OLM_DLLEXPORT float __ieee754_ynf(int n, float x) { int32_t i,hx,ix,ib; int32_t sign; float a, b, temp; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* if Y(n,NaN) is NaN */ if(ix>0x7f800000) return x+x; if(ix==0) return -one/zero; if(hx<0) return zero/zero; sign = 1; if(n<0){ n = -n; sign = 1 - ((n&1)<<1); } if(n==0) return(__ieee754_y0f(x)); if(n==1) return(sign*__ieee754_y1f(x)); if(ix==0x7f800000) return zero; a = __ieee754_y0f(x); b = __ieee754_y1f(x); /* quit if b is -inf */ GET_FLOAT_WORD(ib,b); for(i=1;i0) return b; else return -b; } wcc-0.0.2/src/wsh/openlibm/src/s_isnormal.c0000644000175000017500000000362113122010155017225 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_isnormal.c,v 1.1 2004/07/09 03:32:39 das Exp $ */ #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT int __isnormal(double d) { union IEEEd2bits u; u.d = d; return (u.bits.exp != 0 && u.bits.exp != 2047); } OLM_DLLEXPORT int __isnormalf(float f) { union IEEEf2bits u; u.f = f; return (u.bits.exp != 0 && u.bits.exp != 255); } #ifdef LONG_DOUBLE OLM_DLLEXPORT int __isnormall(long double e) { union IEEEl2bits u; u.e = e; return (u.bits.exp != 0 && u.bits.exp != 32767); } #endif wcc-0.0.2/src/wsh/openlibm/src/e_acos.c0000644000175000017500000000673713122010155016323 0ustar philphil /* @(#)e_acos.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_acos.c,v 1.13 2008/07/31 22:41:26 das Exp $"); /* __ieee754_acos(x) * Method : * acos(x) = pi/2 - asin(x) * acos(-x) = pi/2 + asin(x) * For |x|<=0.5 * acos(x) = pi/2 - (x + x*x^2*R(x^2)) (see asin.c) * For x>0.5 * acos(x) = pi/2 - (pi/2 - 2asin(sqrt((1-x)/2))) * = 2asin(sqrt((1-x)/2)) * = 2s + 2s*z*R(z) ...z=(1-x)/2, s=sqrt(z) * = 2f + (2c + 2s*z*R(z)) * where f=hi part of s, and c = (z-f*f)/(s+f) is the correction term * for f so that f+c ~ sqrt(z). * For x<-0.5 * acos(x) = pi - 2asin(sqrt((1-|x|)/2)) * = pi - 0.5*(s+s*z*R(z)), where z=(1-|x|)/2,s=sqrt(z) * * Special cases: * if x is NaN, return x itself; * if |x|>1, return NaN with invalid signal. * * Function needed: sqrt */ #include #include #include "math_private.h" static const double one= 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */ pio2_hi = 1.57079632679489655800e+00; /* 0x3FF921FB, 0x54442D18 */ static volatile double pio2_lo = 6.12323399573676603587e-17; /* 0x3C91A626, 0x33145C07 */ static const double pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */ pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */ pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */ pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */ pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */ pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */ qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */ qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */ qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */ qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */ OLM_DLLEXPORT double __ieee754_acos(double x) { double z,p,q,r,w,s,c,df; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x3ff00000) { /* |x| >= 1 */ u_int32_t lx; GET_LOW_WORD(lx,x); if(((ix-0x3ff00000)|lx)==0) { /* |x|==1 */ if(hx>0) return 0.0; /* acos(1) = 0 */ else return pi+2.0*pio2_lo; /* acos(-1)= pi */ } return (x-x)/(x-x); /* acos(|x|>1) is NaN */ } if(ix<0x3fe00000) { /* |x| < 0.5 */ if(ix<=0x3c600000) return pio2_hi+pio2_lo;/*if|x|<2**-57*/ z = x*x; p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); r = p/q; return pio2_hi - (x - (pio2_lo-x*r)); } else if (hx<0) { /* x < -0.5 */ z = (one+x)*0.5; p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); s = sqrt(z); r = p/q; w = r*s-pio2_lo; return pi - 2.0*(s+w); } else { /* x > 0.5 */ z = (one-x)*0.5; s = sqrt(z); df = s; SET_LOW_WORD(df,0); c = (z-df*df)/(s+df); p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); r = p/q; w = r*s+c; return 2.0*(df+w); } } #if LDBL_MANT_DIG == 53 __weak_reference(acos, acosl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_rintl.c0000644000175000017500000000664613122010155016543 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_rintl.c,v 1.5 2008/02/22 11:59:05 bde Exp $"); #include #include #include #include "fpmath.h" //VBS #include "math_private.h" #if LDBL_MAX_EXP != 0x4000 /* We also require the usual bias, min exp and expsign packing. */ #error "Unsupported long double format" #endif #define BIAS (LDBL_MAX_EXP - 1) static const float shift[2] = { #if LDBL_MANT_DIG == 64 0x1.0p63, -0x1.0p63 #elif LDBL_MANT_DIG == 113 0x1.0p112, -0x1.0p112 #else #error "Unsupported long double format" #endif }; static const float zero[2] = { 0.0, -0.0 }; OLM_DLLEXPORT long double rintl(long double x) { union IEEEl2bits u; u_int32_t expsign; int ex, sign; u.e = x; expsign = u.xbits.expsign; ex = expsign & 0x7fff; if (ex >= BIAS + LDBL_MANT_DIG - 1) { if (ex == BIAS + LDBL_MAX_EXP) return (x + x); /* Inf, NaN, or unsupported format */ return (x); /* finite and already an integer */ } sign = expsign >> 15; /* * The following code assumes that intermediate results are * evaluated in long double precision. If they are evaluated in * greater precision, double rounding may occur, and if they are * evaluated in less precision (as on i386), results will be * wildly incorrect. */ x += shift[sign]; x -= shift[sign]; /* * If the result is +-0, then it must have the same sign as x, but * the above calculation doesn't always give this. Fix up the sign. */ if (ex < BIAS && x == 0.0L) return (zero[sign]); return (x); } /* * We save and restore the floating-point environment to avoid raising * an inexact exception. We can get away with using fesetenv() * instead of feclearexcept()/feupdateenv() to restore the environment * because the only exception defined for rint() is overflow, and * rounding can't overflow as long as emax >= p. */ #define DECL(type, fn, rint) \ OLM_DLLEXPORT type \ fn(type x) \ { \ type ret; \ fenv_t env; \ \ fegetenv(&env); \ ret = rint(x); \ fesetenv(&env); \ return (ret); \ } DECL(long double, nearbyintl, rintl) wcc-0.0.2/src/wsh/openlibm/src/s_floorf.c0000644000175000017500000000300213122010155016661 0ustar philphil/* s_floorf.c -- float version of s_floor.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_floorf.c,v 1.8 2008/02/22 02:30:35 das Exp $"); /* * floorf(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to floorf(x). */ #include #include "math_private.h" static const float huge = 1.0e30; OLM_DLLEXPORT float floorf(float x) { int32_t i0,j0; u_int32_t i; GET_FLOAT_WORD(i0,x); j0 = ((i0>>23)&0xff)-0x7f; if(j0<23) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */ if(i0>=0) {i0=0;} else if((i0&0x7fffffff)!=0) { i0=0xbf800000;} } } else { i = (0x007fffff)>>j0; if((i0&i)==0) return x; /* x is integral */ if(huge+x>(float)0.0) { /* raise inexact flag */ if(i0<0) i0 += (0x00800000)>>j0; i0 &= (~i); } } } else { if(j0==0x80) return x+x; /* inf or NaN */ else return x; /* x is integral */ } SET_FLOAT_WORD(x,i0); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_csinhf.c0000644000175000017500000000633413122010155016657 0ustar philphil/*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice unmodified, this list of conditions, and the following * disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Hyperbolic sine of a complex argument z. See s_csinh.c for details. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_csinhf.c,v 1.2 2011/10/21 06:29:32 das Exp $"); #include #include #include "math_private.h" static const float huge = 0x1p127; OLM_DLLEXPORT float complex csinhf(float complex z) { float x, y, h; int32_t hx, hy, ix, iy; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hx, x); GET_FLOAT_WORD(hy, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; if (ix < 0x7f800000 && iy < 0x7f800000) { if (iy == 0) return (CMPLXF(sinhf(x), y)); if (ix < 0x41100000) /* small x: normal case */ return (CMPLXF(sinhf(x) * cosf(y), coshf(x) * sinf(y))); /* |x| >= 9, so cosh(x) ~= exp(|x|) */ if (ix < 0x42b17218) { /* x < 88.7: expf(|x|) won't overflow */ h = expf(fabsf(x)) * 0.5f; return (CMPLXF(copysignf(h, x) * cosf(y), h * sinf(y))); } else if (ix < 0x4340b1e7) { /* x < 192.7: scale to avoid overflow */ z = __ldexp_cexpf(CMPLXF(fabsf(x), y), -1); return (CMPLXF(crealf(z) * copysignf(1, x), cimagf(z))); } else { /* x >= 192.7: the result always overflows */ h = huge * x; return (CMPLXF(h * cosf(y), h * h * sinf(y))); } } if (ix == 0 && iy >= 0x7f800000) return (CMPLXF(copysignf(0, x * (y - y)), y - y)); if (iy == 0 && ix >= 0x7f800000) { if ((hx & 0x7fffff) == 0) return (CMPLXF(x, y)); return (CMPLXF(x, copysignf(0, y))); } if (ix < 0x7f800000 && iy >= 0x7f800000) return (CMPLXF(y - y, x * (y - y))); if (ix >= 0x7f800000 && (hx & 0x7fffff) == 0) { if (iy >= 0x7f800000) return (CMPLXF(x * x, x * (y - y))); return (CMPLXF(x * cosf(y), INFINITY * sinf(y))); } return (CMPLXF((x * x) * (y - y), (x + x) * (y - y))); } OLM_DLLEXPORT float complex csinf(float complex z) { z = csinhf(CMPLXF(-cimagf(z), crealf(z))); return (CMPLXF(cimagf(z), -crealf(z))); } wcc-0.0.2/src/wsh/openlibm/src/s_nearbyint.c0000644000175000017500000000415513122010155017377 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_nearbyint.c,v 1.2 2008/01/14 02:12:06 das Exp $"); #include #include #include "math_private.h" /* * We save and restore the floating-point environment to avoid raising * an inexact exception. We can get away with using fesetenv() * instead of feclearexcept()/feupdateenv() to restore the environment * because the only exception defined for rint() is overflow, and * rounding can't overflow as long as emax >= p. */ #define DECL(type, fn, rint) \ OLM_DLLEXPORT type \ fn(type x) \ { \ type ret; \ fenv_t env; \ \ fegetenv(&env); \ ret = rint(x); \ fesetenv(&env); \ return (ret); \ } DECL(double, nearbyint, rint) DECL(float, nearbyintf, rintf) wcc-0.0.2/src/wsh/openlibm/src/s_cos.c0000644000175000017500000000444313122010155016170 0ustar philphil/* @(#)s_cos.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_cos.c,v 1.13 2011/02/10 07:37:50 das Exp $"); /* cos(x) * Return cosine function of x. * * kernel function: * __kernel_sin ... sine function on [-pi/4,pi/4] * __kernel_cos ... cosine function on [-pi/4,pi/4] * __ieee754_rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 * in [-pi/4 , +pi/4], and let n = k mod 4. * We have * * n sin(x) cos(x) tan(x) * ---------------------------------------------------------- * 0 S C T * 1 C -S -1/T * 2 -S -C T * 3 -C S -1/T * ---------------------------------------------------------- * * Special cases: * Let trig be any of sin, cos, or tan. * trig(+-INF) is NaN, with signals; * trig(NaN) is that NaN; * * Accuracy: * TRIG(x) returns trig(x) nearly rounded */ #include #include //#define INLINE_REM_PIO2 #include "math_private.h" //#include "e_rem_pio2.c" OLM_DLLEXPORT double cos(double x) { double y[2],z=0.0; int32_t n, ix; /* High word of x. */ GET_HIGH_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3fe921fb) { if(ix<0x3e46a09e) /* if x < 2**-27 * sqrt(2) */ if(((int)x)==0) return 1.0; /* generate inexact */ return __kernel_cos(x,z); } /* cos(Inf or NaN) is NaN */ else if (ix>=0x7ff00000) return x-x; /* argument reduction needed */ else { n = __ieee754_rem_pio2(x,y); switch(n&3) { case 0: return __kernel_cos(y[0],y[1]); case 1: return -__kernel_sin(y[0],y[1],1); case 2: return -__kernel_cos(y[0],y[1]); default: return __kernel_sin(y[0],y[1],1); } } } #if (LDBL_MANT_DIG == 53) __weak_reference(cos, cosl); #endif wcc-0.0.2/src/wsh/openlibm/src/s_atanl.c0000644000175000017500000000464413122010155016506 0ustar philphil/* @(#)s_atan.c 5.1 93/09/24 */ /* FreeBSD: head/lib/msun/src/s_atan.c 176451 2008-02-22 02:30:36Z das */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_atanl.c,v 1.1 2008/07/31 22:41:26 das Exp $"); /* * See comments in s_atan.c. * Converted to long double by David Schultz . */ #include #include #include "invtrig.h" #include "math_private.h" static const long double one = 1.0, huge = 1.0e300; OLM_DLLEXPORT long double atanl(long double x) { union IEEEl2bits u; long double w,s1,s2,z; int id; int16_t expsign, expt; int32_t expman; u.e = x; expsign = u.xbits.expsign; expt = expsign & 0x7fff; if(expt >= ATAN_CONST) { /* if |x| is large, atan(x)~=pi/2 */ if(expt == BIAS + LDBL_MAX_EXP && ((u.bits.manh&~LDBL_NBIT)|u.bits.manl)!=0) return x+x; /* NaN */ if(expsign>0) return atanhi[3]+atanlo[3]; else return -atanhi[3]-atanlo[3]; } /* Extract the exponent and the first few bits of the mantissa. */ /* XXX There should be a more convenient way to do this. */ expman = (expt << 8) | ((u.bits.manh >> (MANH_SIZE - 9)) & 0xff); if (expman < ((BIAS - 2) << 8) + 0xc0) { /* |x| < 0.4375 */ if (expt < ATAN_LINEAR) { /* if |x| is small, atanl(x)~=x */ if(huge+x>one) return x; /* raise inexact */ } id = -1; } else { x = fabsl(x); if (expman < (BIAS << 8) + 0x30) { /* |x| < 1.1875 */ if (expman < ((BIAS - 1) << 8) + 0x60) { /* 7/16 <=|x|<11/16 */ id = 0; x = (2.0*x-one)/(2.0+x); } else { /* 11/16<=|x|< 19/16 */ id = 1; x = (x-one)/(x+one); } } else { if (expman < ((BIAS + 1) << 8) + 0x38) { /* |x| < 2.4375 */ id = 2; x = (x-1.5)/(one+1.5*x); } else { /* 2.4375 <= |x| < 2^ATAN_CONST */ id = 3; x = -1.0/x; } }} /* end of argument reduction */ z = x*x; w = z*z; /* break sum aT[i]z**(i+1) into odd and even poly */ s1 = z*T_even(w); s2 = w*T_odd(w); if (id<0) return x - x*(s1+s2); else { z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x); return (expsign<0)? -z:z; } } wcc-0.0.2/src/wsh/openlibm/src/e_atanhf.c0000644000175000017500000000232413122010155016623 0ustar philphil/* e_atanhf.c -- float version of e_atanh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_atanhf.c,v 1.7 2008/02/22 02:30:34 das Exp $"); #include #include "math_private.h" static const float one = 1.0, huge = 1e30; static const float zero = 0.0; OLM_DLLEXPORT float __ieee754_atanhf(float x) { float t; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if (ix>0x3f800000) /* |x|>1 */ return (x-x)/(x-x); if(ix==0x3f800000) return x/zero; if(ix<0x31800000&&(huge+x)>zero) return x; /* x<2**-28 */ SET_FLOAT_WORD(x,ix); if(ix<0x3f000000) { /* x < 0.5 */ t = x+x; t = (float)0.5*log1pf(t+t*x/(one-x)); } else t = (float)0.5*log1pf((x+x)/(one-x)); if(hx>=0) return t; else return -t; } wcc-0.0.2/src/wsh/openlibm/src/s_sincos.c0000644000175000017500000001072713122010155016704 0ustar philphil/* @(#)s_sincos.c 5.1 13/07/15 */ /* * ==================================================== * Copyright (C) 2013 Elliot Saba. All rights reserved. * * Developed at the University of Washington. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" /* sincos(x, s, c) * Several applications need sine and cosine of the same * angle x. This function computes both at the same time, * and stores the results in *sin and *cos. * * kernel function: * __kernel_sin ... sine function on [-pi/4,pi/4] * __kernel_cos ... cose function on [-pi/4,pi/4] * __ieee754_rem_pio2 ... argument reduction routine * * Method. * Borrow liberally from s_sin.c and s_cos.c, merging * efforts where applicable and returning their values in * appropriate variables, thereby slightly reducing the * amount of work relative to just calling sin/cos(x) * separately * * Special cases: * Let trig be any of sin, cos, or tan. * sincos(+-INF, s, c) is NaN, with signals; * sincos(NaN, s, c) is that NaN; */ #include #include //#define INLINE_REM_PIO2 #include "math_private.h" //#include "e_rem_pio2.c" /* Constants used in polynomial approximation of sin/cos */ static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */ S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */ S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */ S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */ S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */ S6 = 1.58969099521155010221e-10, /* 0x3DE5D93A, 0x5ACFD57C */ C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */ C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */ C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */ C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */ C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */ C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */ static void __kernel_sincos( double x, double y, int iy, double * k_s, double * k_c ) { /* Inline calculation of sin/cos, as we can save some work, and we will always need to calculate both values, no matter the result of switch */ double z, w, r, v, hz; z = x*x; w = z*z; /* cos-specific computation; equivalent to calling __kernel_cos(x,y) and storing in k_c*/ r = z*(C1+z*(C2+z*C3)) + w*w*(C4+z*(C5+z*C6)); hz = 0.5*z; v = one-hz; *k_c = v + (((one-v)-hz) + (z*r-x*y)); /* sin-specific computation; equivalent to calling __kernel_sin(x,y,1) and storing in k_s*/ r = S2+z*(S3+z*S4) + z*w*(S5+z*S6); v = z*x; if(iy == 0) *k_s = x+v*(S1+z*r); else *k_s = x-((z*(half*y-v*r)-y)-v*S1); } OLM_DLLEXPORT void sincos(double x, double * s, double * c) { double y[2]; int32_t ix; /* Store high word of x in ix */ GET_HIGH_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3fe921fb) { /* Check for small x for sin and cos */ if(ix<0x3e46a09e) { /* Check for exact zero */ if( (int)x==0 ) { *s = x; *c = 1.0; return; } } /* Call kernel function with 0 extra */ __kernel_sincos(x,0.0,0, s, c); } else if( ix >= 0x7ff00000 ) { /* sincos(Inf or NaN) is NaN */ *s = x-x; *c = x-x; } /*argument reduction needed*/ else { double k_c, k_s; /* Calculate remainer, then sub out to kernel */ int32_t n = __ieee754_rem_pio2(x,y); __kernel_sincos( y[0], y[1], 1, &k_s, &k_c ); /* Figure out permutation of sin/cos outputs to true outputs */ switch(n&3) { case 0: *c = k_c; *s = k_s; break; case 1: *c = -k_s; *s = k_c; break; case 2: *c = -k_c; *s = -k_s; break; default: *c = k_s; *s = -k_c; break; } } } #if (LDBL_MANT_DIG == 53) __weak_reference(sincos, sincosl); #endif wcc-0.0.2/src/wsh/openlibm/src/aarch64_fpmath.h0000644000175000017500000000416113122010155017653 0ustar philphil/*- * Copyright (c) 2002, 2003 David Schultz * Copyright (2) 2014 The FreeBSD Foundation * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: head/lib/libc/aarch64/_fpmath.h 281197 2015-04-07 09:52:14Z andrew $ */ union IEEEl2bits { long double e; struct { unsigned long manl :64; unsigned long manh :48; unsigned int exp :15; unsigned int sign :1; } bits; /* TODO andrew: Check the packing here */ struct { unsigned long manl :64; unsigned long manh :48; unsigned int expsign :16; } xbits; }; #define LDBL_NBIT 0 #define LDBL_IMPLICIT_NBIT #define mask_nbit_l(u) ((void)0) #define LDBL_MANH_SIZE 48 #define LDBL_MANL_SIZE 64 #define LDBL_TO_ARRAY32(u, a) do { \ (a)[0] = (uint32_t)(u).bits.manl; \ (a)[1] = (uint32_t)((u).bits.manl >> 32); \ (a)[2] = (uint32_t)(u).bits.manh; \ (a)[3] = (uint32_t)((u).bits.manh >> 32); \ } while(0) wcc-0.0.2/src/wsh/openlibm/src/s_carg.c0000644000175000017500000000317313122010155016317 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_carg.c,v 1.1 2007/12/12 23:43:51 das Exp $"); #include #include #include "math_private.h" OLM_DLLEXPORT double carg(double complex z) { return (atan2(cimag(z), creal(z))); } wcc-0.0.2/src/wsh/openlibm/src/e_fmodf.c0000644000175000017500000000524113122010155016456 0ustar philphil/* e_fmodf.c -- float version of e_fmod.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/e_fmodf.c,v 1.7 2008/02/22 02:30:34 das Exp $"); /* * __ieee754_fmodf(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract */ #include #include "math_private.h" static const float one = 1.0, Zero[] = {0.0, -0.0,}; OLM_DLLEXPORT float __ieee754_fmodf(float x, float y) { int32_t n,hx,hy,hz,ix,iy,sx,i; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hy,y); sx = hx&0x80000000; /* sign of x */ hx ^=sx; /* |x| */ hy &= 0x7fffffff; /* |y| */ /* purge off exception values */ if(hy==0||(hx>=0x7f800000)|| /* y=0,or x not finite */ (hy>0x7f800000)) /* or y is NaN */ return (x*y)/(x*y); if(hx>31]; /* |x|=|y| return x*0*/ /* determine ix = ilogb(x) */ if(hx<0x00800000) { /* subnormal x */ for (ix = -126,i=(hx<<8); i>0; i<<=1) ix -=1; } else ix = (hx>>23)-127; /* determine iy = ilogb(y) */ if(hy<0x00800000) { /* subnormal y */ for (iy = -126,i=(hy<<8); i>=0; i<<=1) iy -=1; } else iy = (hy>>23)-127; /* set up {hx,lx}, {hy,ly} and align y to x */ if(ix >= -126) hx = 0x00800000|(0x007fffff&hx); else { /* subnormal x, shift x to normal */ n = -126-ix; hx = hx<= -126) hy = 0x00800000|(0x007fffff&hy); else { /* subnormal y, shift y to normal */ n = -126-iy; hy = hy<>31]; hx = hz+hz; } } hz=hx-hy; if(hz>=0) {hx=hz;} /* convert back to floating value and restore the sign */ if(hx==0) /* return sign(x)*0 */ return Zero[(u_int32_t)sx>>31]; while(hx<0x00800000) { /* normalize x */ hx = hx+hx; iy -= 1; } if(iy>= -126) { /* normalize output */ hx = ((hx-0x00800000)|((iy+127)<<23)); SET_FLOAT_WORD(x,hx|sx); } else { /* subnormal output */ n = -126 - iy; hx >>= n; SET_FLOAT_WORD(x,hx|sx); x *= one; /* create necessary signal */ } return x; /* exact output */ } wcc-0.0.2/src/wsh/openlibm/src/s_ctan.c0000644000175000017500000000612013122010155016323 0ustar philphil/* $OpenBSD: s_ctan.c,v 1.6 2013/07/03 04:46:36 espie Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* ctan() * * Complex circular tangent * * * * SYNOPSIS: * * double complex ctan(); * double complex z, w; * * w = ctan (z); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * sin 2x + i sinh 2y * w = --------------------. * cos 2x + cosh 2y * * On the real axis the denominator is zero at odd multiples * of PI/2. The denominator is evaluated by its Taylor * series near these points. * * ctan(z) = -i ctanh(iz). * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5200 7.1e-17 1.6e-17 * IEEE -10,+10 30000 7.2e-16 1.2e-16 * Also tested by ctan * ccot = 1 and catan(ctan(z)) = z. */ #include #include #include #define MACHEP 1.1e-16 #define MAXNUM 1.0e308 static const double DP1 = 3.14159265160560607910E0; static const double DP2 = 1.98418714791870343106E-9; static const double DP3 = 1.14423774522196636802E-17; static double _redupi(double x) { double t; long i; t = x/M_PI; if (t >= 0.0) t += 0.5; else t -= 0.5; i = t; /* the multiple */ t = i; t = ((x - t * DP1) - t * DP2) - t * DP3; return (t); } /* Taylor series expansion for cosh(2y) - cos(2x) */ static double _ctans(double complex z) { double f, x, x2, y, y2, rn, t; double d; x = fabs (2.0 * creal (z)); y = fabs (2.0 * cimag(z)); x = _redupi(x); x = x * x; y = y * y; x2 = 1.0; y2 = 1.0; f = 1.0; rn = 0.0; d = 0.0; do { rn += 1.0; f *= rn; rn += 1.0; f *= rn; x2 *= x; y2 *= y; t = y2 + x2; t /= f; d += t; rn += 1.0; f *= rn; rn += 1.0; f *= rn; x2 *= x; y2 *= y; t = y2 - x2; t /= f; d += t; } while (fabs(t/d) > MACHEP) ; return (d); } double complex ctan(double complex z) { double complex w; double d; d = cos (2.0 * creal (z)) + cosh (2.0 * cimag (z)); if (fabs(d) < 0.25) d = _ctans (z); if (d == 0.0) { /*mtherr ("ctan", OVERFLOW);*/ w = MAXNUM + MAXNUM * I; return (w); } w = sin (2.0 * creal(z)) / d + (sinh (2.0 * cimag(z)) / d) * I; return (w); } #if LDBL_MANT_DIG == DBL_MANT_DIG __strong_alias(ctanl, ctan); #endif /* LDBL_MANT_DIG == DBL_MANT_DIG */ wcc-0.0.2/src/wsh/openlibm/src/s_cacosl.c0000644000175000017500000000314513122010155016646 0ustar philphil/* $OpenBSD: s_cacosl.c,v 1.3 2011/07/20 21:02:51 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* cacosl() * * Complex circular arc cosine * * * * SYNOPSIS: * * long double complex cacosl(); * long double complex z, w; * * w = cacosl( z ); * * * * DESCRIPTION: * * * w = arccos z = PI/2 - arcsin z. * * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5200 1.6e-15 2.8e-16 * IEEE -10,+10 30000 1.8e-14 2.2e-15 */ #include #include static const long double PIO2L = 1.570796326794896619231321691639751442098585L; long double complex cacosl(long double complex z) { long double complex w; w = casinl(z); w = (PIO2L - creall(w)) - cimagl(w) * I; return (w); } wcc-0.0.2/src/wsh/openlibm/src/s_remquol.c0000644000175000017500000001074613122010155017073 0ustar philphil/* @(#)e_fmod.c 1.3 95/01/18 */ /*- * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_remquol.c,v 1.2 2008/07/31 20:09:47 das Exp $"); #include #include #include #include "fpmath.h" #include "math_private.h" #define BIAS (LDBL_MAX_EXP - 1) #if LDBL_MANL_SIZE > 32 typedef u_int64_t manl_t; #else typedef u_int32_t manl_t; #endif #if LDBL_MANH_SIZE > 32 typedef u_int64_t manh_t; #else typedef u_int32_t manh_t; #endif /* * These macros add and remove an explicit integer bit in front of the * fractional mantissa, if the architecture doesn't have such a bit by * default already. */ #ifdef LDBL_IMPLICIT_NBIT #define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) #define HFRAC_BITS LDBL_MANH_SIZE #else #define SET_NBIT(hx) (hx) #define HFRAC_BITS (LDBL_MANH_SIZE - 1) #endif #define MANL_SHIFT (LDBL_MANL_SIZE - 1) static const long double Zero[] = {0.0L, -0.0L}; /* * Return the IEEE remainder and set *quo to the last n bits of the * quotient, rounded to the nearest integer. We choose n=31 because * we wind up computing all the integer bits of the quotient anyway as * a side-effect of computing the remainder by the shift and subtract * method. In practice, this is far more bits than are needed to use * remquo in reduction algorithms. * * Assumptions: * - The low part of the mantissa fits in a manl_t exactly. * - The high part of the mantissa fits in an int64_t with enough room * for an explicit integer bit in front of the fractional bits. */ OLM_DLLEXPORT long double remquol(long double x, long double y, int *quo) { union IEEEl2bits ux, uy; int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ manh_t hy; manl_t lx,ly,lz; int ix,iy,n,q,sx,sxy; ux.e = x; uy.e = y; sx = ux.bits.sign; sxy = sx ^ uy.bits.sign; ux.bits.sign = 0; /* |x| */ uy.bits.sign = 0; /* |y| */ x = ux.e; /* purge off exception values */ if((uy.bits.exp|uy.bits.manh|uy.bits.manl)==0 || /* y=0 */ (ux.bits.exp == BIAS + LDBL_MAX_EXP) || /* or x not finite */ (uy.bits.exp == BIAS + LDBL_MAX_EXP && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)!=0)) /* or y is NaN */ return (x*y)/(x*y); if(ux.bits.exp<=uy.bits.exp) { if((ux.bits.exp>MANL_SHIFT); lx = lx+lx;} else {hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; q++;} q <<= 1; } hz=hx-hy;lz=lx-ly; if(lx=0) {hx=hz;lx=lz;q++;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) { /* return sign(x)*0 */ *quo = (sxy ? -q : q); return Zero[sx]; } while(hx<(1ULL<>MANL_SHIFT); lx = lx+lx; iy -= 1; } ux.bits.manh = hx; /* The integer bit is truncated here if needed. */ ux.bits.manl = lx; if (iy < LDBL_MIN_EXP) { ux.bits.exp = iy + (BIAS + 512); ux.e *= 0x1p-512; } else { ux.bits.exp = iy + BIAS; } ux.bits.sign = 0; x = ux.e; fixup: y = fabsl(y); if (y < LDBL_MIN * 2) { if (x+x>y || (x+x==y && (q & 1))) { q++; x-=y; } } else if (x>0.5*y || (x==0.5*y && (q & 1))) { q++; x-=y; } ux.e = x; ux.bits.sign ^= sx; x = ux.e; q &= 0x7fffffff; *quo = (sxy ? -q : q); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_copysignl.c0000644000175000017500000000321313122010155017405 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_copysignl.c,v 1.2 2007/01/07 07:54:21 das Exp $ */ #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT long double copysignl(long double x, long double y) { union IEEEl2bits ux, uy; ux.e = x; uy.e = y; ux.bits.sign = uy.bits.sign; return (ux.e); } wcc-0.0.2/src/wsh/openlibm/src/s_ceill.c0000644000175000017500000000477613122010155016505 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * From: @(#)s_ceil.c 5.1 93/09/24 */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_ceill.c,v 1.9 2008/02/14 15:10:33 bde Exp $"); /* * ceill(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to ceill(x). */ #include #include #include #include "fpmath.h" #include "math_private.h" #ifdef LDBL_IMPLICIT_NBIT #define MANH_SIZE (LDBL_MANH_SIZE + 1) #define INC_MANH(u, c) do { \ u_int64_t o = u.bits.manh; \ u.bits.manh += (c); \ if (u.bits.manh < o) \ u.bits.exp++; \ } while (0) #else #define MANH_SIZE LDBL_MANH_SIZE #define INC_MANH(u, c) do { \ u_int64_t o = u.bits.manh; \ u.bits.manh += (c); \ if (u.bits.manh < o) { \ u.bits.exp++; \ u.bits.manh |= 1llu << (LDBL_MANH_SIZE - 1); \ } \ } while (0) #endif static const long double huge = 1.0e300; OLM_DLLEXPORT long double ceill(long double x) { union IEEEl2bits u = { .e = x }; int e = u.bits.exp - LDBL_MAX_EXP + 1; if (e < MANH_SIZE - 1) { if (e < 0) { /* raise inexact if x != 0 */ if (huge + x > 0.0) if (u.bits.exp > 0 || (u.bits.manh | u.bits.manl) != 0) u.e = u.bits.sign ? -0.0 : 1.0; } else { u_int64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); if (((u.bits.manh & m) | u.bits.manl) == 0) return (x); /* x is integral */ if (!u.bits.sign) { #ifdef LDBL_IMPLICIT_NBIT if (e == 0) u.bits.exp++; else #endif INC_MANH(u, 1llu << (MANH_SIZE - e - 1)); } if (huge + x > 0.0) { /* raise inexact flag */ u.bits.manh &= ~m; u.bits.manl = 0; } } } else if (e < LDBL_MANT_DIG - 1) { u_int64_t m = (u_int64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); if ((u.bits.manl & m) == 0) return (x); /* x is integral */ if (!u.bits.sign) { if (e == MANH_SIZE - 1) INC_MANH(u, 1); else { u_int64_t o = u.bits.manl; u.bits.manl += 1llu << (LDBL_MANT_DIG - e - 1); if (u.bits.manl < o) /* got a carry */ INC_MANH(u, 1); } } if (huge + x > 0.0) /* raise inexact flag */ u.bits.manl &= ~m; } return (u.e); } wcc-0.0.2/src/wsh/openlibm/src/s_copysign.c0000644000175000017500000000161013122010155017230 0ustar philphil/* @(#)s_copysign.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_copysign.c,v 1.10 2008/02/22 02:30:35 das Exp $"); /* * copysign(double x, double y) * copysign(x,y) returns a value with the magnitude of x and * with the sign bit of y. */ #include #include "math_private.h" OLM_DLLEXPORT double copysign(double x, double y) { u_int32_t hx,hy; GET_HIGH_WORD(hx,x); GET_HIGH_WORD(hy,y); SET_HIGH_WORD(x,(hx&0x7fffffff)|(hy&0x80000000)); return x; } wcc-0.0.2/src/wsh/openlibm/src/s_fmaxl.c0000644000175000017500000000406113122010155016507 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_fmaxl.c,v 1.1 2004/06/30 07:04:01 das Exp $"); #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT long double fmaxl(long double x, long double y) { union IEEEl2bits u[2]; u[0].e = x; mask_nbit_l(u[0]); u[1].e = y; mask_nbit_l(u[1]); /* Check for NaNs to avoid raising spurious exceptions. */ if (u[0].bits.exp == 32767 && (u[0].bits.manh | u[0].bits.manl) != 0) return (y); if (u[1].bits.exp == 32767 && (u[1].bits.manh | u[1].bits.manl) != 0) return (x); /* Handle comparisons of signed zeroes. */ if (u[0].bits.sign != u[1].bits.sign) return (u[0].bits.sign ? y : x); return (x > y ? x : y); } wcc-0.0.2/src/wsh/openlibm/src/s_remquo.c0000644000175000017500000000761313122010155016716 0ustar philphil/* @(#)e_fmod.c 1.3 95/01/18 */ /*- * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/src/s_remquo.c,v 1.2 2008/03/30 20:47:26 das Exp $"); #include #include #include "math_private.h" static const double Zero[] = {0.0, -0.0,}; /* * Return the IEEE remainder and set *quo to the last n bits of the * quotient, rounded to the nearest integer. We choose n=31 because * we wind up computing all the integer bits of the quotient anyway as * a side-effect of computing the remainder by the shift and subtract * method. In practice, this is far more bits than are needed to use * remquo in reduction algorithms. */ OLM_DLLEXPORT double remquo(double x, double y, int *quo) { int32_t n,hx,hy,hz,ix,iy,sx,i; u_int32_t lx,ly,lz,q,sxy; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hy,ly,y); sxy = (hx ^ hy) & 0x80000000; sx = hx&0x80000000; /* sign of x */ hx ^=sx; /* |x| */ hy &= 0x7fffffff; /* |y| */ /* purge off exception values */ if((hy|ly)==0||(hx>=0x7ff00000)|| /* y=0,or x not finite */ ((hy|((ly|-ly)>>31))>0x7ff00000)) /* or y is NaN */ return (x*y)/(x*y); if(hx<=hy) { if((hx>31]; /* |x|=|y| return x*0*/ } } /* determine ix = ilogb(x) */ if(hx<0x00100000) { /* subnormal x */ if(hx==0) { for (ix = -1043, i=lx; i>0; i<<=1) ix -=1; } else { for (ix = -1022,i=(hx<<11); i>0; i<<=1) ix -=1; } } else ix = (hx>>20)-1023; /* determine iy = ilogb(y) */ if(hy<0x00100000) { /* subnormal y */ if(hy==0) { for (iy = -1043, i=ly; i>0; i<<=1) iy -=1; } else { for (iy = -1022,i=(hy<<11); i>0; i<<=1) iy -=1; } } else iy = (hy>>20)-1023; /* set up {hx,lx}, {hy,ly} and align y to x */ if(ix >= -1022) hx = 0x00100000|(0x000fffff&hx); else { /* subnormal x, shift x to normal */ n = -1022-ix; if(n<=31) { hx = (hx<>(32-n)); lx <<= n; } else { hx = lx<<(n-32); lx = 0; } } if(iy >= -1022) hy = 0x00100000|(0x000fffff&hy); else { /* subnormal y, shift y to normal */ n = -1022-iy; if(n<=31) { hy = (hy<>(32-n)); ly <<= n; } else { hy = ly<<(n-32); ly = 0; } } /* fix point fmod */ n = ix - iy; q = 0; while(n--) { hz=hx-hy;lz=lx-ly; if(lx>31); lx = lx+lx;} else {hx = hz+hz+(lz>>31); lx = lz+lz; q++;} q <<= 1; } hz=hx-hy;lz=lx-ly; if(lx=0) {hx=hz;lx=lz;q++;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) { /* return sign(x)*0 */ *quo = (sxy ? -q : q); return Zero[(u_int32_t)sx>>31]; } while(hx<0x00100000) { /* normalize x */ hx = hx+hx+(lx>>31); lx = lx+lx; iy -= 1; } if(iy>= -1022) { /* normalize output */ hx = ((hx-0x00100000)|((iy+1023)<<20)); } else { /* subnormal output */ n = -1022 - iy; if(n<=20) { lx = (lx>>n)|((u_int32_t)hx<<(32-n)); hx >>= n; } else if (n<=31) { lx = (hx<<(32-n))|(lx>>n); hx = sx; } else { lx = hx>>(n-32); hx = sx; } } fixup: INSERT_WORDS(x,hx,lx); y = fabs(y); if (y < 0x1p-1021) { if (x+x>y || (x+x==y && (q & 1))) { q++; x-=y; } } else if (x>0.5*y || (x==0.5*y && (q & 1))) { q++; x-=y; } GET_HIGH_WORD(hx,x); SET_HIGH_WORD(x,hx^sx); q &= 0x7fffffff; *quo = (sxy ? -q : q); return x; } #if LDBL_MANT_DIG == 53 __weak_reference(remquo, remquol); #endif wcc-0.0.2/src/wsh/openlibm/src/s_conjf.c0000644000175000017500000000306213122010155016477 0ustar philphil/*- * Copyright (c) 2004 Stefan Farfeleder * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_conjf.c,v 1.2 2008/08/07 14:39:56 das Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT float complex conjf(float complex z) { return (CMPLXF(crealf(z), -cimagf(z))); } wcc-0.0.2/src/wsh/openlibm/test/0000755000175000017500000000000013122010155015101 5ustar philphilwcc-0.0.2/src/wsh/openlibm/test/Makefile0000644000175000017500000000241713122010155016545 0ustar philphilOPENLIBM_HOME=$(abspath ..) include ../Make.inc # Set rpath of tests to builddir for loading shared library OPENLIBM_LIB = -L.. -lopenlibm ifeq ($(OS),Linux) OPENLIBM_LIB += -Wl,-rpath=$(OPENLIBM_HOME) endif all: test-double test-float # test-double-system test-float-system bench: bench-syslibm bench-openlibm test-double: test-double.c libm-test.c $(CC) $(CPPFLAGS) $(CFLAGS) $(CFLAGS_add_TARGET_$(ARCH)) $(LDFLAGS) $@.c -D__BSD_VISIBLE -I ../include -I../src $(OPENLIBM_LIB) -o $@ test-float: test-float.c libm-test.c $(CC) $(CPPFLAGS) $(CFLAGS) $(CFLAGS_add_TARGET_$(ARCH)) $(LDFLAGS) $@.c -D__BSD_VISIBLE -I ../include -I../src $(OPENLIBM_LIB) -o $@ test-double-system: test-double.c libm-test.c $(CC) $(CPPFLAGS) $(CFLAGS) $(CFLAGS_add_TARGET_$(ARCH)) $(LDFLAGS) $< -DSYS_MATH_H -lm -o $@ test-float-system: test-float.c libm-test.c $(CC) $(CPPFLAGS) $(CFLAGS) $(CFLAGS_add_TARGET_$(ARCH)) $(LDFLAGS) $< -DSYS_MATH_H -lm -o $@ bench-openlibm: libm-bench.cpp $(CC) $(CPPFLAGS) $(CFLAGS) $(CFLAGS_add_TARGET_$(ARCH)) $(LDFLAGS) $< $(OPENLIBM_LIB) -o $@ bench-syslibm: libm-bench.cpp $(CC) $(CPPFLAGS) $(CFLAGS) $(CFLAGS_add_TARGET_$(ARCH)) $(LDFLAGS) $< -lm -o $@ clean: rm -fr test-double test-float test-double-system test-float-system bench-openlibm bench-syslibm *.dSYM wcc-0.0.2/src/wsh/openlibm/test/inf_torture.c0000644000175000017500000001075313122010155017613 0ustar philphil#include #include int main(); int main2(); int main3(); int main4(); int main() { printf("+inf:\n"); float fx = (float)INFINITY; unsigned int *fxi = (unsigned int*)&fx; double dx = (double)INFINITY; long unsigned long int *dxi = (long unsigned long int*)&dx; long double ldx = (long double)INFINITY; long unsigned long int *ldxi1 = (long unsigned long int*)&ldx; long unsigned long int *ldxi2 = &(ldxi1[1]); printf("\t\tf d ld\n"); printf("correct:\t%x %x %x\n", isinf(fx), isinf(dx), isinf(ldx)); printf("as floats:\t%x %x %x\n", isinf(*(float*)fxi), isinf(*(float*)dxi), isinf(*(float*)ldxi1)); printf("as double:\t%x %x %x\n", isinf(*(double*)fxi), isinf(*(double*)dxi), isinf(*(double*)ldxi1)); printf("as long double:\t%x %x %x\n", isinf(*(long double*)fxi), isinf(*(long double*)dxi), isinf(*(long double*)ldxi1)); printf("sizes ?4 8 12?:\t%d %d %d\n", (int)sizeof(fx), (int)sizeof(dx), (int)sizeof(ldx)); printf("sizes:\t%d %d %d\n", (int)sizeof(*fxi), (int)sizeof(*dxi), (int)sizeof(*ldxi1)*2); printf("bit repr:\n f: %x\n d: %llx\n ld: %llx%llx\n", *fxi, *dxi, (0xFFFF)&*ldxi2, *ldxi1); printf("\n"); main2(); return 0; } int main2() { printf("-inf:\n"); float fx = (float)-INFINITY; unsigned int *fxi = (unsigned int*)&fx; double dx = (double)-INFINITY; long unsigned long int *dxi = (long unsigned long int*)&dx; long double ldx = (long double)-INFINITY; long unsigned long int *ldxi1 = (long unsigned long int*)&ldx; long unsigned long int *ldxi2 = &(ldxi1[1]); printf("\t\tf d ld\n"); printf("correct:\t%x %x %x\n", isinf(fx), isinf(dx), isinf(ldx)); printf("as floats:\t%x %x %x\n", isinf(*(float*)fxi), isinf(*(float*)dxi), isinf(*(float*)ldxi1)); printf("as double:\t%x %x %x\n", isinf(*(double*)fxi), isinf(*(double*)dxi), isinf(*(double*)ldxi1)); printf("as long double:\t%x %x %x\n", isinf(*(long double*)fxi), isinf(*(long double*)dxi), isinf(*(long double*)ldxi1)); printf("sizes ?4 8 12?:\t%d %d %d\n", (int)sizeof(fx), (int)sizeof(dx), (int)sizeof(ldx)); printf("bit repr:\n f: %x\n d: %llx\n ld: %llx%llx\n", *fxi, *dxi, (0xFFFF)&*ldxi2, *ldxi1); printf("\n"); main3(); return 0; } int main3() { printf("+NaN:\n"); float fx = (float)NAN; unsigned int *fxi = (unsigned int*)&fx; double dx = (double)NAN; long unsigned long int *dxi = (long unsigned long int*)&dx; long double ldx = (long double)NAN; long unsigned long int *ldxi1 = (long unsigned long int*)&ldx; long unsigned long int *ldxi2 = &(ldxi1[1]); printf("\t\tf d ld\n"); printf("correct:\t%x %x %x\n", isnan(fx), isnan(dx), isnan(ldx)); printf("as floats:\t%x %x %x\n", isnan(*(float*)fxi), isnan(*(float*)dxi), isnan(*(float*)ldxi1)); printf("as double:\t%x %x %x\n", isnan(*(double*)fxi), isnan(*(double*)dxi), isnan(*(double*)ldxi1)); printf("as long double:\t%x %x %x\n", isnan(*(long double*)fxi), isnan(*(long double*)dxi), isnan(*(long double*)ldxi1)); printf("sizes ?4 8 12?:\t%d %d %d\n", (int)sizeof(fx), (int)sizeof(dx), (int)sizeof(ldx)); printf("sizes:\t%d %d %d\n", (int)sizeof(*fxi), (int)sizeof(*dxi), (int)sizeof(*ldxi1)*2); printf("bit repr:\n f: %x\n d: %llx\n ld: %llx%llx\n", *fxi, *dxi, (0xFFFF)&*ldxi2, *ldxi1); printf("\n"); main4(); return 0; } int main4() { printf("-NaN:\n"); float fx = (float)-NAN; unsigned int *fxi = (unsigned int*)&fx; double dx = (double)-NAN; long unsigned long int *dxi = (long unsigned long int*)&dx; long double ldx = (long double)-NAN; long unsigned long int *ldxi1 = (long unsigned long int*)&ldx; long unsigned long int *ldxi2 = &(ldxi1[1]); printf("\t\tf d ld\n"); printf("correct:\t%x %x %x\n", isnan(fx), isnan(dx), isnan(ldx)); printf("as floats:\t%x %x %x\n", isnan(*(float*)fxi), isnan(*(float*)dxi), isnan(*(float*)ldxi1)); printf("as double:\t%x %x %x\n", isnan(*(double*)fxi), isnan(*(double*)dxi), isnan(*(double*)ldxi1)); printf("as long double:\t%x %x %x\n", isnan(*(long double*)fxi), isnan(*(long double*)dxi), isnan(*(long double*)ldxi1)); printf("sizes ?4 8 12?:\t%d %d %d\n", (int)sizeof(fx), (int)sizeof(dx), (int)sizeof(ldx)); printf("bit repr:\n f: %x\n d: %llx\n ld: %llx%llx\n", *fxi, *dxi, (0xFFFF)&*ldxi2, *ldxi1); printf("\n"); return 0; } wcc-0.0.2/src/wsh/openlibm/test/libm-bench.cpp0000644000175000017500000000537013122010155017612 0ustar philphil// Copyright (C) Dahua Lin, 2014. Provided under the MIT license. // Benchmark on libm functions #include #include #include #include // Timing facilities #ifdef __MACH__ #include class stimer { public: typedef uint64_t time_type; stimer() { ::mach_timebase_info(&m_baseinfo); } time_type current() const { return ::mach_absolute_time(); } double span(const time_type& t0, const time_type& t1) const { uint64_t d = (m_baseinfo.numer * (t1 - t0)) / m_baseinfo.denom; return static_cast(d) / 1.0e9; } private: mach_timebase_info_data_t m_baseinfo; }; #else class stimer { public: typedef timespec time_type; time_type current() const { time_type t; ::clock_gettime(CLOCK_REALTIME, &t); return t; } double span(const time_type& t0, const time_type& t1) const { return double(t1.tv_sec - t0.tv_sec) + double(t1.tv_nsec - t0.tv_nsec) * 1.0e-9; } }; #endif inline double sec2mps(double s, long n) { return n / (s * 1e6); } const long ARR_LEN = 1024; double a[ARR_LEN]; double b[ARR_LEN]; double r[ARR_LEN]; #define TFUN1(FNAME) \ void test_##FNAME(long n) { \ for (int j = 0; j < ARR_LEN; ++j) r[j] = FNAME(a[j]); \ stimer tm; \ stimer::time_type t0 = tm.current(); \ for(int i = 0; i < n; ++i) { \ for (int j = 0; j < ARR_LEN; ++j) r[j] = FNAME(a[j]); \ } \ double s = tm.span(t0, tm.current()); \ double mps = sec2mps(s, n * ARR_LEN); \ printf(" %-8s: %7.4f MPS\n", #FNAME, mps); } #define TFUN2(FNAME) \ void test_##FNAME(long n) { \ for (int j = 0; j < ARR_LEN; ++j) r[j] = FNAME(a[j], b[j]); \ stimer tm; \ stimer::time_type t0 = tm.current(); \ for(int i = 0; i < n; ++i) { \ for (int j = 0; j < ARR_LEN; ++j) r[j] = FNAME(a[j], b[j]); \ } \ double s = tm.span(t0, tm.current()); \ double mps = sec2mps(s, n * ARR_LEN); \ printf(" %-8s: %7.4f MPS\n", #FNAME, mps); } #define TCALL(FNAME) test_##FNAME(20000) // define benchmark functions TFUN2(pow) TFUN2(hypot) TFUN1(exp) TFUN1(log) TFUN1(log10) TFUN1(sin) TFUN1(cos) TFUN1(tan) TFUN1(asin) TFUN1(acos) TFUN1(atan) TFUN2(atan2) int main(int argc, char *argv[]) { // initialize array contents for (int i = 0; i < ARR_LEN; ++i) { a[i] = rand() / (double) RAND_MAX; b[i] = rand() / (double) RAND_MAX; } TCALL(pow); TCALL(hypot); TCALL(exp); TCALL(log); TCALL(log10); TCALL(sin); TCALL(cos); TCALL(tan); TCALL(asin); TCALL(acos); TCALL(atan); TCALL(atan2); return 0; } wcc-0.0.2/src/wsh/openlibm/test/.gitignore0000644000175000017500000000021113122010155017063 0ustar philphil/test-float /test-float-system /test-float.dSYM /test-double /test-double-system /test-double.dSYM /bench-openlibm /bench-syslibm /*.exe wcc-0.0.2/src/wsh/openlibm/test/test-double.c0000644000175000017500000000245613122010155017503 0ustar philphil/* Copyright (C) 1997, 1999 Free Software Foundation, Inc. This file is part of the GNU C Library. Contributed by Andreas Jaeger , 1997. The GNU C Library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. The GNU C Library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with the GNU C Library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. */ #define FUNC(function) function #define FLOAT double #define TEST_MSG "testing double (without inline functions)\n" #define MATHCONST(x) x #define CHOOSE(Clongdouble,Cdouble,Cfloat,Cinlinelongdouble,Cinlinedouble,Cinlinefloat) Cdouble #define PRINTF_EXPR "e" #define PRINTF_XEXPR "a" #define PRINTF_NEXPR "f" #define TEST_DOUBLE 1 #ifndef __NO_MATH_INLINES # define __NO_MATH_INLINES #endif #include "libm-test.c" wcc-0.0.2/src/wsh/openlibm/test/libm-test.c0000644000175000017500000076470213122010155017165 0ustar philphil/* Copyright (C) 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. This file is part of the GNU C Library. Contributed by Andreas Jaeger , 1997. The GNU C Library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. The GNU C Library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with the GNU C Library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. */ /* Part of testsuite for libm. This file is processed by a perl script. The resulting file has to be included by a master file that defines: Makros: FUNC(function): converts general function name (like cos) to name with correct suffix (e.g. cosl or cosf) MATHCONST(x): like FUNC but for constants (e.g convert 0.0 to 0.0L) FLOAT: floating point type to test - TEST_MSG: informal message to be displayed CHOOSE(Clongdouble,Cdouble,Cfloat,Cinlinelongdouble,Cinlinedouble,Cinlinefloat): chooses one of the parameters as delta for testing equality PRINTF_EXPR Floating point conversion specification to print a variable of type FLOAT with printf. PRINTF_EXPR just contains the specifier, not the percent and width arguments, e.g. "f". PRINTF_XEXPR Like PRINTF_EXPR, but print in hexadecimal format. PRINTF_NEXPR Like PRINTF_EXPR, but print nice. */ /* This testsuite has currently tests for: acos, acosh, asin, asinh, atan, atan2, atanh, cbrt, ceil, copysign, cos, cosh, erf, erfc, exp, exp10, exp2, expm1, fabs, fdim, floor, fma, fmax, fmin, fmod, fpclassify, frexp, gamma, hypot, ilogb, isfinite, isinf, isnan, isnormal, isless, islessequal, isgreater, isgreaterequal, islessgreater, isunordered, j0, j1, jn, ldexp, lgamma, log, log10, log1p, log2, logb, modf, nearbyint, nextafter, pow, remainder, remquo, rint, lrint, llrint, round, lround, llround, scalb, scalbn, scalbln, signbit, sin, sincos, sinh, sqrt, tan, tanh, tgamma, trunc, y0, y1, yn and for the following complex math functions: cabs, cacos, cacosh, carg, casin, casinh, catan, catanh, ccos, ccosh, cexp, clog, cpow, cproj, csin, csinh, csqrt, ctan, ctanh. At the moment the following functions aren't tested: drem, significand, nan Parameter handling is primitive in the moment: --verbose=[0..3] for different levels of output: 0: only error count 1: basic report on failed tests (default) 2: full report on all tests -v for full output (equals --verbose=3) -u for generation of an ULPs file */ /* "Philosophy": This suite tests some aspects of the correct implementation of mathematical functions in libm. Some simple, specific parameters are tested for correctness but there's no exhaustive testing. Handling of specific inputs (e.g. infinity, not-a-number) is also tested. Correct handling of exceptions is checked against. These implemented tests should check all cases that are specified in ISO C99. Exception testing: At the moment only divide-by-zero and invalid exceptions are tested. Overflow/underflow and inexact exceptions aren't checked at the moment. NaN values: There exist signalling and quiet NaNs. This implementation only uses signalling NaN as parameter but does not differenciate between the two kinds of NaNs as result. Inline functions: Inlining functions should give an improvement in speed - but not in precission. The inlined functions return reasonable values for a reasonable range of input values. The result is not necessarily correct for all values and exceptions are not correctly raised in all cases. Problematic input and return values are infinity, not-a-number and minus zero. This suite therefore does not check these specific inputs and the exception handling for inlined mathematical functions - just the "reasonable" values are checked. Beware: The tests might fail for any of the following reasons: - Tests are wrong - Functions are wrong - Floating Point Unit not working properly - Compiler has errors With e.g. gcc 2.7.2.2 the test for cexp fails because of a compiler error. To Do: All parameter should be numbers that can be represented as exact floating point values. Currently some values cannot be represented exactly and therefore the result is not the expected result. */ #ifndef _GNU_SOURCE # define _GNU_SOURCE #endif #include "libm-test-ulps.h" #include #ifdef SYS_MATH_H #include #include #else #include #endif #if 0 /* XXX scp XXX */ #define FE_INEXACT FE_INEXACT #define FE_DIVBYZERO FE_DIVBYZERO #define FE_UNDERFLOW FE_UNDERFLOW #define FE_OVERFLOW FE_OVERFLOW #define FE_INVALID FE_INVALID #endif #include #include #include #include #include #if 0 /* XXX scp XXX */ #include #endif // Some native libm implementations don't have sincos defined, so we have to do it ourselves void FUNC(sincos) (FLOAT x, FLOAT * s, FLOAT * c); #ifdef __APPLE__ #ifdef SYS_MATH_H void sincos(FLOAT x, FLOAT * s, FLOAT * c) { *s = sin(x); *c = cos(x); } #endif #endif /* Possible exceptions */ #define NO_EXCEPTION 0x0 #define INVALID_EXCEPTION 0x1 #define DIVIDE_BY_ZERO_EXCEPTION 0x2 /* The next flags signals that those exceptions are allowed but not required. */ #define INVALID_EXCEPTION_OK 0x4 #define DIVIDE_BY_ZERO_EXCEPTION_OK 0x8 #define EXCEPTIONS_OK INVALID_EXCEPTION_OK+DIVIDE_BY_ZERO_EXCEPTION_OK /* Some special test flags, passed togther with exceptions. */ #define IGNORE_ZERO_INF_SIGN 0x10 /* Various constants (we must supply them precalculated for accuracy). */ #define M_PI_6l .52359877559829887307710723054658383L #define M_E2l 7.389056098930650227230427460575008L #define M_E3l 20.085536923187667740928529654581719L #define M_2_SQRT_PIl 3.5449077018110320545963349666822903L /* 2 sqrt (M_PIl) */ #define M_SQRT_PIl 1.7724538509055160272981674833411451L /* sqrt (M_PIl) */ #define M_LOG_SQRT_PIl 0.57236494292470008707171367567652933L /* log(sqrt(M_PIl)) */ #define M_LOG_2_SQRT_PIl 1.265512123484645396488945797134706L /* log(2*sqrt(M_PIl)) */ #define M_PI_34l (M_PIl - M_PI_4l) /* 3*pi/4 */ #define M_PI_34_LOG10El (M_PIl - M_PI_4l) * M_LOG10El #define M_PI2_LOG10El M_PI_2l * M_LOG10El #define M_PI4_LOG10El M_PI_4l * M_LOG10El #define M_PI_LOG10El M_PIl * M_LOG10El #if 1 /* XXX scp XXX */ # define M_El 2.7182818284590452353602874713526625L /* e */ # define M_LOG2El 1.4426950408889634073599246810018922L /* log_2 e */ # define M_LOG10El 0.4342944819032518276511289189166051L /* log_10 e */ # define M_LN2l 0.6931471805599453094172321214581766L /* log_e 2 */ # define M_LN10l 2.3025850929940456840179914546843642L /* log_e 10 */ # define M_PIl 3.1415926535897932384626433832795029L /* pi */ # define M_PI_2l 1.5707963267948966192313216916397514L /* pi/2 */ # define M_PI_4l 0.7853981633974483096156608458198757L /* pi/4 */ # define M_1_PIl 0.3183098861837906715377675267450287L /* 1/pi */ # define M_2_PIl 0.6366197723675813430755350534900574L /* 2/pi */ # define M_2_SQRTPIl 1.1283791670955125738961589031215452L /* 2/sqrt(pi) */ # define M_SQRT2l 1.4142135623730950488016887242096981L /* sqrt(2) */ # define M_SQRT1_2l 0.7071067811865475244008443621048490L /* 1/sqrt(2) */ #endif static FILE *ulps_file; /* File to document difference. */ static int output_ulps; /* Should ulps printed? */ static int noErrors; /* number of errors */ static int noTests; /* number of tests (without testing exceptions) */ static int noExcTests; /* number of tests for exception flags */ static int noXFails; /* number of expected failures. */ static int noXPasses; /* number of unexpected passes. */ static int verbose; static int output_max_error; /* Should the maximal errors printed? */ static int output_points; /* Should the single function results printed? */ static int ignore_max_ulp; /* Should we ignore max_ulp? */ static FLOAT minus_zero, plus_zero; static FLOAT plus_infty, minus_infty, nan_value; static FLOAT max_error, real_max_error, imag_max_error; #if 0 /* XXX scp XXX */ #define BUILD_COMPLEX(real, imag) \ ({ __complex__ FLOAT __retval; \ __real__ __retval = (real); \ __imag__ __retval = (imag); \ __retval; }) #define BUILD_COMPLEX_INT(real, imag) \ ({ __complex__ int __retval; \ __real__ __retval = (real); \ __imag__ __retval = (imag); \ __retval; }) #endif #define MANT_DIG CHOOSE ((LDBL_MANT_DIG-1), (DBL_MANT_DIG-1), (FLT_MANT_DIG-1), \ (LDBL_MANT_DIG-1), (DBL_MANT_DIG-1), (FLT_MANT_DIG-1)) static void init_max_error (void) { max_error = 0; real_max_error = 0; imag_max_error = 0; feclearexcept (FE_ALL_EXCEPT); } static void set_max_error (FLOAT current, FLOAT *curr_max_error) { if (current > *curr_max_error) *curr_max_error = current; } /* Should the message print to screen? This depends on the verbose flag, and the test status. */ static int print_screen (int ok, int xfail) { if (output_points && (verbose > 1 || (verbose == 1 && ok == xfail))) return 1; return 0; } /* Should the message print to screen? This depends on the verbose flag, and the test status. */ static int print_screen_max_error (int ok, int xfail) { if (output_max_error && (verbose > 1 || ((verbose == 1) && (ok == xfail)))) return 1; return 0; } /* Update statistic counters. */ static void update_stats (int ok, int xfail) { ++noTests; if (ok && xfail) ++noXPasses; else if (!ok && xfail) ++noXFails; else if (!ok && !xfail) ++noErrors; } static void print_ulps (const char *test_name, FLOAT ulp) { if (output_ulps) { fprintf (ulps_file, "Test \"%s\":\n", test_name); fprintf (ulps_file, "%s: % .4" PRINTF_NEXPR "\n", CHOOSE("ldouble", "double", "float", "ildouble", "idouble", "ifloat"), ulp); } } static void print_function_ulps (const char *function_name, FLOAT ulp) { if (output_ulps) { fprintf (ulps_file, "Function: \"%s\":\n", function_name); fprintf (ulps_file, "%s: % .4" PRINTF_NEXPR "\n", CHOOSE("ldouble", "double", "float", "ildouble", "idouble", "ifloat"), ulp); } } #if 0 /* XXX scp XXX */ static void print_complex_function_ulps (const char *function_name, FLOAT real_ulp, FLOAT imag_ulp) { if (output_ulps) { if (real_ulp != 0.0) { fprintf (ulps_file, "Function: Real part of \"%s\":\n", function_name); fprintf (ulps_file, "%s: % .4" PRINTF_NEXPR "\n", CHOOSE("ldouble", "double", "float", "ildouble", "idouble", "ifloat"), real_ulp); } if (imag_ulp != 0.0) { fprintf (ulps_file, "Function: Imaginary part of \"%s\":\n", function_name); fprintf (ulps_file, "%s: % .4" PRINTF_NEXPR "\n", CHOOSE("ldouble", "double", "float", "ildouble", "idouble", "ifloat"), imag_ulp); } } } #endif static void print_max_error (const char *func_name, FLOAT allowed, int xfail) { int ok = 0; if (max_error == 0.0 || (max_error <= allowed && !ignore_max_ulp)) { ok = 1; } if (!ok) print_function_ulps (func_name, max_error); if (print_screen_max_error (ok, xfail)) { printf ("Maximal error of `%s'\n", func_name); printf (" is : % .4" PRINTF_NEXPR " ulp\n", max_error); printf (" accepted: % .4" PRINTF_NEXPR " ulp\n", allowed); } update_stats (ok, xfail); } #if 0 /* XXX scp XXX */ static void print_complex_max_error (const char *func_name, __complex__ FLOAT allowed, __complex__ int xfail) { int ok = 0; if ((real_max_error <= __real__ allowed) && (imag_max_error <= __imag__ allowed)) { ok = 1; } if (!ok) print_complex_function_ulps (func_name, real_max_error, imag_max_error); if (print_screen_max_error (ok, xfail)) { printf ("Maximal error of real part of: %s\n", func_name); printf (" is : % .4" PRINTF_NEXPR " ulp\n", real_max_error); printf (" accepted: % .4" PRINTF_NEXPR " ulp\n", __real__ allowed); printf ("Maximal error of imaginary part of: %s\n", func_name); printf (" is : % .4" PRINTF_NEXPR " ulp\n", imag_max_error); printf (" accepted: % .4" PRINTF_NEXPR " ulp\n", __imag__ allowed); } update_stats (ok, xfail); } #endif /* Test whether a given exception was raised. */ static void test_single_exception (const char *test_name, int exception, int exc_flag, int fe_flag, const char *flag_name) { #ifndef TEST_INLINE int ok = 1; if (exception & exc_flag) { if (fetestexcept (fe_flag)) { if (print_screen (1, 0)) printf ("Pass: %s: Exception \"%s\" set\n", test_name, flag_name); } else { ok = 0; if (print_screen (0, 0)) printf ("Failure: %s: Exception \"%s\" not set\n", test_name, flag_name); } } else { if (fetestexcept (fe_flag)) { ok = 0; if (print_screen (0, 0)) printf ("Failure: %s: Exception \"%s\" set\n", test_name, flag_name); } else { if (print_screen (1, 0)) printf ("%s: Exception \"%s\" not set\n", test_name, flag_name); } } if (!ok) ++noErrors; #endif } /* Test whether exceptions given by EXCEPTION are raised. Ignore thereby allowed but not required exceptions. */ static void test_exceptions (const char *test_name, int exception) { ++noExcTests; #ifdef FE_DIVBYZERO if ((exception & DIVIDE_BY_ZERO_EXCEPTION_OK) == 0) test_single_exception (test_name, exception, DIVIDE_BY_ZERO_EXCEPTION, FE_DIVBYZERO, "Divide by zero"); #endif #ifdef FE_INVALID if ((exception & INVALID_EXCEPTION_OK) == 0) test_single_exception (test_name, exception, INVALID_EXCEPTION, FE_INVALID, "Invalid operation"); #endif feclearexcept (FE_ALL_EXCEPT); } static void check_float_internal (const char *test_name, FLOAT computed, FLOAT expected, FLOAT max_ulp, int xfail, int exceptions, FLOAT *curr_max_error) { int ok = 0; int print_diff = 0; FLOAT diff = 0; FLOAT ulp = 0; test_exceptions (test_name, exceptions); if (isnan (computed) && isnan (expected)) ok = 1; else if (isinf (computed) && isinf (expected)) { /* Test for sign of infinities. */ if ((exceptions & IGNORE_ZERO_INF_SIGN) == 0 && signbit (computed) != signbit (expected)) { ok = 0; printf ("infinity has wrong sign.\n"); } else ok = 1; } /* Don't calc ulp for NaNs or infinities. */ else if (isinf (computed) || isnan (computed) || isinf (expected) || isnan (expected)) ok = 0; else { diff = FUNC(fabs) (computed - expected); /* ilogb (0) isn't allowed. */ if (expected == 0.0) ulp = diff / FUNC(ldexp) (1.0, - MANT_DIG); else ulp = diff / FUNC(ldexp) (1.0, FUNC(ilogb) (expected) - MANT_DIG); set_max_error (ulp, curr_max_error); print_diff = 1; if ((exceptions & IGNORE_ZERO_INF_SIGN) == 0 && computed == 0.0 && expected == 0.0 && signbit(computed) != signbit (expected)) ok = 0; else if (ulp == 0.0 || (ulp <= max_ulp && !ignore_max_ulp)) ok = 1; else { ok = 0; print_ulps (test_name, ulp); } } if (print_screen (ok, xfail)) { if (!ok) printf ("Failure: "); printf ("Test: %s\n", test_name); printf ("Result:\n"); printf (" is: % .20" PRINTF_EXPR " % .20" PRINTF_XEXPR "\n", computed, computed); printf (" should be: % .20" PRINTF_EXPR " % .20" PRINTF_XEXPR "\n", expected, expected); if (print_diff) { printf (" difference: % .20" PRINTF_EXPR " % .20" PRINTF_XEXPR "\n", diff, diff); printf (" ulp : % .4" PRINTF_NEXPR "\n", ulp); printf (" max.ulp : % .4" PRINTF_NEXPR "\n", max_ulp); } } update_stats (ok, xfail); } static void check_float (const char *test_name, FLOAT computed, FLOAT expected, FLOAT max_ulp, int xfail, int exceptions) { check_float_internal (test_name, computed, expected, max_ulp, xfail, exceptions, &max_error); } #if 0 /* XXX scp XXX */ static void check_complex (const char *test_name, __complex__ FLOAT computed, __complex__ FLOAT expected, __complex__ FLOAT max_ulp, __complex__ int xfail, int exception) { FLOAT part_comp, part_exp, part_max_ulp; int part_xfail; char str[200]; sprintf (str, "Real part of: %s", test_name); part_comp = __real__ computed; part_exp = __real__ expected; part_max_ulp = __real__ max_ulp; part_xfail = __real__ xfail; check_float_internal (str, part_comp, part_exp, part_max_ulp, part_xfail, exception, &real_max_error); sprintf (str, "Imaginary part of: %s", test_name); part_comp = __imag__ computed; part_exp = __imag__ expected; part_max_ulp = __imag__ max_ulp; part_xfail = __imag__ xfail; /* Don't check again for exceptions, just pass through the zero/inf sign test. */ check_float_internal (str, part_comp, part_exp, part_max_ulp, part_xfail, exception & IGNORE_ZERO_INF_SIGN, &imag_max_error); } #endif /* Check that computed and expected values are equal (int values). */ static void check_int (const char *test_name, int computed, int expected, int max_ulp, int xfail, int exceptions) { int diff = computed - expected; int ok = 0; test_exceptions (test_name, exceptions); noTests++; if (abs (diff) <= max_ulp) ok = 1; if (!ok) print_ulps (test_name, diff); if (print_screen (ok, xfail)) { if (!ok) printf ("Failure: "); printf ("Test: %s\n", test_name); printf ("Result:\n"); printf (" is: %d\n", computed); printf (" should be: %d\n", expected); } update_stats (ok, xfail); } /* Check that computed and expected values are equal (long int values). */ static void check_long (const char *test_name, long int computed, long int expected, long int max_ulp, int xfail, int exceptions) { long int diff = computed - expected; int ok = 0; test_exceptions (test_name, exceptions); noTests++; if (labs (diff) <= max_ulp) ok = 1; if (!ok) print_ulps (test_name, diff); if (print_screen (ok, xfail)) { if (!ok) printf ("Failure: "); printf ("Test: %s\n", test_name); printf ("Result:\n"); printf (" is: %ld\n", computed); printf (" should be: %ld\n", expected); } update_stats (ok, xfail); } /* Check that computed value is true/false. */ static void check_bool (const char *test_name, int computed, int expected, long int max_ulp, int xfail, int exceptions) { int ok = 0; test_exceptions (test_name, exceptions); noTests++; if ((computed == 0) == (expected == 0)) ok = 1; if (print_screen (ok, xfail)) { if (!ok) printf ("Failure: "); printf ("Test: %s\n", test_name); printf ("Result:\n"); printf (" is: %d\n", computed); printf (" should be: %d\n", expected); } update_stats (ok, xfail); } /* check that computed and expected values are equal (long int values) */ static void check_longlong (const char *test_name, long long int computed, long long int expected, long long int max_ulp, int xfail, int exceptions) { long long int diff = computed - expected; int ok = 0; test_exceptions (test_name, exceptions); noTests++; if (llabs (diff) <= max_ulp) ok = 1; if (!ok) print_ulps (test_name, diff); if (print_screen (ok, xfail)) { if (!ok) printf ("Failure:"); printf ("Test: %s\n", test_name); printf ("Result:\n"); printf (" is: %lld\n", computed); printf (" should be: %lld\n", expected); } update_stats (ok, xfail); } #if 0 /* XXX scp XXX */ /* This is to prevent messages from the SVID libm emulation. */ int matherr (struct exception *x __attribute__ ((unused))) { return 1; } #endif /**************************************************************************** Tests for single functions of libm. Please keep them alphabetically sorted! ****************************************************************************/ static void acos_test (void) { errno = 0; FUNC(acos) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("acos (inf) == NaN plus invalid exception", FUNC(acos) (plus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("acos (-inf) == NaN plus invalid exception", FUNC(acos) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("acos (NaN) == NaN", FUNC(acos) (nan_value), nan_value, 0, 0, 0); /* |x| > 1: */ check_float ("acos (1.1) == NaN plus invalid exception", FUNC(acos) (1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("acos (-1.1) == NaN plus invalid exception", FUNC(acos) (-1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("acos (0) == pi/2", FUNC(acos) (0), M_PI_2l, 0, 0, 0); check_float ("acos (-0) == pi/2", FUNC(acos) (minus_zero), M_PI_2l, 0, 0, 0); check_float ("acos (1) == 0", FUNC(acos) (1), 0, 0, 0, 0); check_float ("acos (-1) == pi", FUNC(acos) (-1), M_PIl, 0, 0, 0); check_float ("acos (0.5) == M_PI_6l*2.0", FUNC(acos) (0.5), M_PI_6l*2.0, 0, 0, 0); check_float ("acos (-0.5) == M_PI_6l*4.0", FUNC(acos) (-0.5), M_PI_6l*4.0, 0, 0, 0); check_float ("acos (0.7) == 0.79539883018414355549096833892476432", FUNC(acos) (0.7L), 0.79539883018414355549096833892476432L, 0, 0, 0); print_max_error ("acos", DELTAacos, 0); } static void acosh_test (void) { errno = 0; FUNC(acosh) (7); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("acosh (inf) == inf", FUNC(acosh) (plus_infty), plus_infty, 0, 0, 0); check_float ("acosh (-inf) == NaN plus invalid exception", FUNC(acosh) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); /* x < 1: */ check_float ("acosh (-1.1) == NaN plus invalid exception", FUNC(acosh) (-1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("acosh (1) == 0", FUNC(acosh) (1), 0, 0, 0, 0); check_float ("acosh (7) == 2.633915793849633417250092694615937", FUNC(acosh) (7), 2.633915793849633417250092694615937L, DELTA16, 0, 0); print_max_error ("acosh", DELTAacosh, 0); } static void asin_test (void) { errno = 0; FUNC(asin) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("asin (inf) == NaN plus invalid exception", FUNC(asin) (plus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("asin (-inf) == NaN plus invalid exception", FUNC(asin) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("asin (NaN) == NaN", FUNC(asin) (nan_value), nan_value, 0, 0, 0); /* asin x == NaN plus invalid exception for |x| > 1. */ check_float ("asin (1.1) == NaN plus invalid exception", FUNC(asin) (1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("asin (-1.1) == NaN plus invalid exception", FUNC(asin) (-1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("asin (0) == 0", FUNC(asin) (0), 0, 0, 0, 0); check_float ("asin (-0) == -0", FUNC(asin) (minus_zero), minus_zero, 0, 0, 0); check_float ("asin (0.5) == pi/6", FUNC(asin) (0.5), M_PI_6l, DELTA24, 0, 0); check_float ("asin (-0.5) == -pi/6", FUNC(asin) (-0.5), -M_PI_6l, DELTA25, 0, 0); check_float ("asin (1.0) == pi/2", FUNC(asin) (1.0), M_PI_2l, DELTA26, 0, 0); check_float ("asin (-1.0) == -pi/2", FUNC(asin) (-1.0), -M_PI_2l, DELTA27, 0, 0); check_float ("asin (0.7) == 0.77539749661075306374035335271498708", FUNC(asin) (0.7L), 0.77539749661075306374035335271498708L, DELTA28, 0, 0); print_max_error ("asin", DELTAasin, 0); } static void asinh_test (void) { errno = 0; FUNC(asinh) (0.7L); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("asinh (0) == 0", FUNC(asinh) (0), 0, 0, 0, 0); check_float ("asinh (-0) == -0", FUNC(asinh) (minus_zero), minus_zero, 0, 0, 0); #ifndef TEST_INLINE check_float ("asinh (inf) == inf", FUNC(asinh) (plus_infty), plus_infty, 0, 0, 0); check_float ("asinh (-inf) == -inf", FUNC(asinh) (minus_infty), minus_infty, 0, 0, 0); #endif check_float ("asinh (NaN) == NaN", FUNC(asinh) (nan_value), nan_value, 0, 0, 0); check_float ("asinh (0.7) == 0.652666566082355786", FUNC(asinh) (0.7L), 0.652666566082355786L, DELTA34, 0, 0); print_max_error ("asinh", DELTAasinh, 0); } static void atan_test (void) { errno = 0; FUNC(atan) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("atan (0) == 0", FUNC(atan) (0), 0, 0, 0, 0); check_float ("atan (-0) == -0", FUNC(atan) (minus_zero), minus_zero, 0, 0, 0); check_float ("atan (inf) == pi/2", FUNC(atan) (plus_infty), M_PI_2l, 0, 0, 0); check_float ("atan (-inf) == -pi/2", FUNC(atan) (minus_infty), -M_PI_2l, 0, 0, 0); check_float ("atan (NaN) == NaN", FUNC(atan) (nan_value), nan_value, 0, 0, 0); check_float ("atan (1) == pi/4", FUNC(atan) (1), M_PI_4l, 0, 0, 0); check_float ("atan (-1) == -pi/4", FUNC(atan) (-1), -M_PI_4l, 0, 0, 0); check_float ("atan (0.7) == 0.61072596438920861654375887649023613", FUNC(atan) (0.7L), 0.61072596438920861654375887649023613L, DELTA42, 0, 0); print_max_error ("atan", DELTAatan, 0); } static void atanh_test (void) { errno = 0; FUNC(atanh) (0.7L); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("atanh (0) == 0", FUNC(atanh) (0), 0, 0, 0, 0); check_float ("atanh (-0) == -0", FUNC(atanh) (minus_zero), minus_zero, 0, 0, 0); check_float ("atanh (1) == inf plus division by zero exception", FUNC(atanh) (1), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("atanh (-1) == -inf plus division by zero exception", FUNC(atanh) (-1), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("atanh (NaN) == NaN", FUNC(atanh) (nan_value), nan_value, 0, 0, 0); /* atanh (x) == NaN plus invalid exception if |x| > 1. */ check_float ("atanh (1.1) == NaN plus invalid exception", FUNC(atanh) (1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("atanh (-1.1) == NaN plus invalid exception", FUNC(atanh) (-1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("atanh (0.7) == 0.8673005276940531944", FUNC(atanh) (0.7L), 0.8673005276940531944L, DELTA50, 0, 0); print_max_error ("atanh", DELTAatanh, 0); } static void atan2_test (void) { errno = 0; FUNC(atan2) (-0, 1); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); /* atan2 (0,x) == 0 for x > 0. */ check_float ("atan2 (0, 1) == 0", FUNC(atan2) (0, 1), 0, 0, 0, 0); /* atan2 (-0,x) == -0 for x > 0. */ check_float ("atan2 (-0, 1) == -0", FUNC(atan2) (minus_zero, 1), minus_zero, 0, 0, 0); check_float ("atan2 (0, 0) == 0", FUNC(atan2) (0, 0), 0, 0, 0, 0); check_float ("atan2 (-0, 0) == -0", FUNC(atan2) (minus_zero, 0), minus_zero, 0, 0, 0); /* atan2 (+0,x) == +pi for x < 0. */ check_float ("atan2 (0, -1) == pi", FUNC(atan2) (0, -1), M_PIl, 0, 0, 0); /* atan2 (-0,x) == -pi for x < 0. */ check_float ("atan2 (-0, -1) == -pi", FUNC(atan2) (minus_zero, -1), -M_PIl, 0, 0, 0); check_float ("atan2 (0, -0) == pi", FUNC(atan2) (0, minus_zero), M_PIl, 0, 0, 0); check_float ("atan2 (-0, -0) == -pi", FUNC(atan2) (minus_zero, minus_zero), -M_PIl, 0, 0, 0); /* atan2 (y,+0) == pi/2 for y > 0. */ check_float ("atan2 (1, 0) == pi/2", FUNC(atan2) (1, 0), M_PI_2l, 0, 0, 0); /* atan2 (y,-0) == pi/2 for y > 0. */ check_float ("atan2 (1, -0) == pi/2", FUNC(atan2) (1, minus_zero), M_PI_2l, 0, 0, 0); /* atan2 (y,+0) == -pi/2 for y < 0. */ check_float ("atan2 (-1, 0) == -pi/2", FUNC(atan2) (-1, 0), -M_PI_2l, 0, 0, 0); /* atan2 (y,-0) == -pi/2 for y < 0. */ check_float ("atan2 (-1, -0) == -pi/2", FUNC(atan2) (-1, minus_zero), -M_PI_2l, 0, 0, 0); /* atan2 (y,inf) == +0 for finite y > 0. */ check_float ("atan2 (1, inf) == 0", FUNC(atan2) (1, plus_infty), 0, 0, 0, 0); /* atan2 (y,inf) == -0 for finite y < 0. */ check_float ("atan2 (-1, inf) == -0", FUNC(atan2) (-1, plus_infty), minus_zero, 0, 0, 0); /* atan2(+inf, x) == pi/2 for finite x. */ check_float ("atan2 (inf, -1) == pi/2", FUNC(atan2) (plus_infty, -1), M_PI_2l, 0, 0, 0); /* atan2(-inf, x) == -pi/2 for finite x. */ check_float ("atan2 (-inf, 1) == -pi/2", FUNC(atan2) (minus_infty, 1), -M_PI_2l, 0, 0, 0); /* atan2 (y,-inf) == +pi for finite y > 0. */ check_float ("atan2 (1, -inf) == pi", FUNC(atan2) (1, minus_infty), M_PIl, 0, 0, 0); /* atan2 (y,-inf) == -pi for finite y < 0. */ check_float ("atan2 (-1, -inf) == -pi", FUNC(atan2) (-1, minus_infty), -M_PIl, 0, 0, 0); check_float ("atan2 (inf, inf) == pi/4", FUNC(atan2) (plus_infty, plus_infty), M_PI_4l, 0, 0, 0); check_float ("atan2 (-inf, inf) == -pi/4", FUNC(atan2) (minus_infty, plus_infty), -M_PI_4l, 0, 0, 0); check_float ("atan2 (inf, -inf) == 3/4 pi", FUNC(atan2) (plus_infty, minus_infty), M_PI_34l, 0, 0, 0); check_float ("atan2 (-inf, -inf) == -3/4 pi", FUNC(atan2) (minus_infty, minus_infty), -M_PI_34l, 0, 0, 0); check_float ("atan2 (NaN, NaN) == NaN", FUNC(atan2) (nan_value, nan_value), nan_value, 0, 0, 0); check_float ("atan2 (0.7, 1) == 0.61072596438920861654375887649023613", FUNC(atan2) (0.7L, 1), 0.61072596438920861654375887649023613L, DELTA74, 0, 0); check_float ("atan2 (-0.7, 1.0) == -0.61072596438920861654375887649023613", FUNC(atan2) (-0.7L, 1.0L), -0.61072596438920861654375887649023613L, 0, 0, 0); check_float ("atan2 (0.7, -1.0) == 2.530866689200584621918884506789267", FUNC(atan2) (0.7L, -1.0L), 2.530866689200584621918884506789267L, 0, 0, 0); check_float ("atan2 (-0.7, -1.0) == -2.530866689200584621918884506789267", FUNC(atan2) (-0.7L, -1.0L), -2.530866689200584621918884506789267L, 0, 0, 0); check_float ("atan2 (0.4, 0.0003) == 1.5700463269355215717704032607580829", FUNC(atan2) (0.4L, 0.0003L), 1.5700463269355215717704032607580829L, DELTA78, 0, 0); check_float ("atan2 (1.4, -0.93) == 2.1571487668237843754887415992772736", FUNC(atan2) (1.4L, -0.93L), 2.1571487668237843754887415992772736L, 0, 0, 0); print_max_error ("atan2", DELTAatan2, 0); } #if 0 /* XXX scp XXX */ static void cabs_test (void) { errno = 0; FUNC(cabs) (BUILD_COMPLEX (0.7L, 12.4L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); /* cabs (x + iy) is specified as hypot (x,y) */ /* cabs (+inf + i x) == +inf. */ check_float ("cabs (inf + 1.0 i) == inf", FUNC(cabs) (BUILD_COMPLEX (plus_infty, 1.0)), plus_infty, 0, 0, 0); /* cabs (-inf + i x) == +inf. */ check_float ("cabs (-inf + 1.0 i) == inf", FUNC(cabs) (BUILD_COMPLEX (minus_infty, 1.0)), plus_infty, 0, 0, 0); check_float ("cabs (-inf + NaN i) == inf", FUNC(cabs) (BUILD_COMPLEX (minus_infty, nan_value)), plus_infty, 0, 0, 0); check_float ("cabs (-inf + NaN i) == inf", FUNC(cabs) (BUILD_COMPLEX (minus_infty, nan_value)), plus_infty, 0, 0, 0); check_float ("cabs (NaN + NaN i) == NaN", FUNC(cabs) (BUILD_COMPLEX (nan_value, nan_value)), nan_value, 0, 0, 0); /* cabs (x,y) == cabs (y,x). */ check_float ("cabs (0.7 + 12.4 i) == 12.419742348374220601176836866763271", FUNC(cabs) (BUILD_COMPLEX (0.7L, 12.4L)), 12.419742348374220601176836866763271L, DELTA85, 0, 0); /* cabs (x,y) == cabs (-x,y). */ check_float ("cabs (-12.4 + 0.7 i) == 12.419742348374220601176836866763271", FUNC(cabs) (BUILD_COMPLEX (-12.4L, 0.7L)), 12.419742348374220601176836866763271L, DELTA86, 0, 0); /* cabs (x,y) == cabs (-y,x). */ check_float ("cabs (-0.7 + 12.4 i) == 12.419742348374220601176836866763271", FUNC(cabs) (BUILD_COMPLEX (-0.7L, 12.4L)), 12.419742348374220601176836866763271L, DELTA87, 0, 0); /* cabs (x,y) == cabs (-x,-y). */ check_float ("cabs (-12.4 - 0.7 i) == 12.419742348374220601176836866763271", FUNC(cabs) (BUILD_COMPLEX (-12.4L, -0.7L)), 12.419742348374220601176836866763271L, DELTA88, 0, 0); /* cabs (x,y) == cabs (-y,-x). */ check_float ("cabs (-0.7 - 12.4 i) == 12.419742348374220601176836866763271", FUNC(cabs) (BUILD_COMPLEX (-0.7L, -12.4L)), 12.419742348374220601176836866763271L, DELTA89, 0, 0); /* cabs (x,0) == fabs (x). */ check_float ("cabs (-0.7 + 0 i) == 0.7", FUNC(cabs) (BUILD_COMPLEX (-0.7L, 0)), 0.7L, 0, 0, 0); check_float ("cabs (0.7 + 0 i) == 0.7", FUNC(cabs) (BUILD_COMPLEX (0.7L, 0)), 0.7L, 0, 0, 0); check_float ("cabs (-1.0 + 0 i) == 1.0", FUNC(cabs) (BUILD_COMPLEX (-1.0L, 0)), 1.0L, 0, 0, 0); check_float ("cabs (1.0 + 0 i) == 1.0", FUNC(cabs) (BUILD_COMPLEX (1.0L, 0)), 1.0L, 0, 0, 0); check_float ("cabs (-5.7e7 + 0 i) == 5.7e7", FUNC(cabs) (BUILD_COMPLEX (-5.7e7L, 0)), 5.7e7L, 0, 0, 0); check_float ("cabs (5.7e7 + 0 i) == 5.7e7", FUNC(cabs) (BUILD_COMPLEX (5.7e7L, 0)), 5.7e7L, 0, 0, 0); check_float ("cabs (0.7 + 1.2 i) == 1.3892443989449804508432547041028554", FUNC(cabs) (BUILD_COMPLEX (0.7L, 1.2L)), 1.3892443989449804508432547041028554L, DELTA96, 0, 0); print_max_error ("cabs", DELTAcabs, 0); } static void cacos_test (void) { errno = 0; FUNC(cacos) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("cacos (0 + 0 i) == pi/2 - 0 i", FUNC(cacos) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (M_PI_2l, minus_zero), 0, 0, 0); check_complex ("cacos (-0 + 0 i) == pi/2 - 0 i", FUNC(cacos) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (M_PI_2l, minus_zero), 0, 0, 0); check_complex ("cacos (-0 - 0 i) == pi/2 + 0.0 i", FUNC(cacos) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (M_PI_2l, 0.0), 0, 0, 0); check_complex ("cacos (0 - 0 i) == pi/2 + 0.0 i", FUNC(cacos) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (M_PI_2l, 0.0), 0, 0, 0); check_complex ("cacos (-inf + inf i) == 3/4 pi - inf i", FUNC(cacos) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (M_PI_34l, minus_infty), 0, 0, 0); check_complex ("cacos (-inf - inf i) == 3/4 pi + inf i", FUNC(cacos) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (M_PI_34l, plus_infty), 0, 0, 0); check_complex ("cacos (inf + inf i) == pi/4 - inf i", FUNC(cacos) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (M_PI_4l, minus_infty), 0, 0, 0); check_complex ("cacos (inf - inf i) == pi/4 + inf i", FUNC(cacos) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (M_PI_4l, plus_infty), 0, 0, 0); check_complex ("cacos (-10.0 + inf i) == pi/2 - inf i", FUNC(cacos) (BUILD_COMPLEX (-10.0, plus_infty)), BUILD_COMPLEX (M_PI_2l, minus_infty), 0, 0, 0); check_complex ("cacos (-10.0 - inf i) == pi/2 + inf i", FUNC(cacos) (BUILD_COMPLEX (-10.0, minus_infty)), BUILD_COMPLEX (M_PI_2l, plus_infty), 0, 0, 0); check_complex ("cacos (0 + inf i) == pi/2 - inf i", FUNC(cacos) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (M_PI_2l, minus_infty), 0, 0, 0); check_complex ("cacos (0 - inf i) == pi/2 + inf i", FUNC(cacos) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (M_PI_2l, plus_infty), 0, 0, 0); check_complex ("cacos (0.1 + inf i) == pi/2 - inf i", FUNC(cacos) (BUILD_COMPLEX (0.1L, plus_infty)), BUILD_COMPLEX (M_PI_2l, minus_infty), 0, 0, 0); check_complex ("cacos (0.1 - inf i) == pi/2 + inf i", FUNC(cacos) (BUILD_COMPLEX (0.1L, minus_infty)), BUILD_COMPLEX (M_PI_2l, plus_infty), 0, 0, 0); check_complex ("cacos (-inf + 0 i) == pi - inf i", FUNC(cacos) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (M_PIl, minus_infty), 0, 0, 0); check_complex ("cacos (-inf - 0 i) == pi + inf i", FUNC(cacos) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (M_PIl, plus_infty), 0, 0, 0); check_complex ("cacos (-inf + 100 i) == pi - inf i", FUNC(cacos) (BUILD_COMPLEX (minus_infty, 100)), BUILD_COMPLEX (M_PIl, minus_infty), 0, 0, 0); check_complex ("cacos (-inf - 100 i) == pi + inf i", FUNC(cacos) (BUILD_COMPLEX (minus_infty, -100)), BUILD_COMPLEX (M_PIl, plus_infty), 0, 0, 0); check_complex ("cacos (inf + 0 i) == 0.0 - inf i", FUNC(cacos) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (0.0, minus_infty), 0, 0, 0); check_complex ("cacos (inf - 0 i) == 0.0 + inf i", FUNC(cacos) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (0.0, plus_infty), 0, 0, 0); check_complex ("cacos (inf + 0.5 i) == 0.0 - inf i", FUNC(cacos) (BUILD_COMPLEX (plus_infty, 0.5)), BUILD_COMPLEX (0.0, minus_infty), 0, 0, 0); check_complex ("cacos (inf - 0.5 i) == 0.0 + inf i", FUNC(cacos) (BUILD_COMPLEX (plus_infty, -0.5)), BUILD_COMPLEX (0.0, plus_infty), 0, 0, 0); check_complex ("cacos (inf + NaN i) == NaN + inf i plus sign of zero/inf not specified", FUNC(cacos) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("cacos (-inf + NaN i) == NaN + inf i plus sign of zero/inf not specified", FUNC(cacos) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("cacos (0 + NaN i) == pi/2 + NaN i", FUNC(cacos) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (M_PI_2l, nan_value), 0, 0, 0); check_complex ("cacos (-0 + NaN i) == pi/2 + NaN i", FUNC(cacos) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (M_PI_2l, nan_value), 0, 0, 0); check_complex ("cacos (NaN + inf i) == NaN - inf i", FUNC(cacos) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (nan_value, minus_infty), 0, 0, 0); check_complex ("cacos (NaN - inf i) == NaN + inf i", FUNC(cacos) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, 0); check_complex ("cacos (10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(cacos) (BUILD_COMPLEX (10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacos (-10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(cacos) (BUILD_COMPLEX (-10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacos (NaN + 0.75 i) == NaN + NaN i plus invalid exception allowed", FUNC(cacos) (BUILD_COMPLEX (nan_value, 0.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacos (NaN - 0.75 i) == NaN + NaN i plus invalid exception allowed", FUNC(cacos) (BUILD_COMPLEX (nan_value, -0.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacos (NaN + NaN i) == NaN + NaN i", FUNC(cacos) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("cacos (0.7 + 1.2 i) == 1.1351827477151551088992008271819053 - 1.0927647857577371459105272080819308 i", FUNC(cacos) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (1.1351827477151551088992008271819053L, -1.0927647857577371459105272080819308L), DELTA130, 0, 0); check_complex ("cacos (-2 - 3 i) == 2.1414491111159960199416055713254211 + 1.9833870299165354323470769028940395 i", FUNC(cacos) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (2.1414491111159960199416055713254211L, 1.9833870299165354323470769028940395L), DELTA131, 0, 0); print_complex_max_error ("cacos", DELTAcacos, 0); } static void cacosh_test (void) { errno = 0; FUNC(cacosh) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("cacosh (0 + 0 i) == 0.0 + pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, 0); check_complex ("cacosh (-0 + 0 i) == 0.0 + pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, 0); check_complex ("cacosh (0 - 0 i) == 0.0 - pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, 0); check_complex ("cacosh (-0 - 0 i) == 0.0 - pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, 0); check_complex ("cacosh (-inf + inf i) == inf + 3/4 pi i", FUNC(cacosh) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_34l), 0, 0, 0); check_complex ("cacosh (-inf - inf i) == inf - 3/4 pi i", FUNC(cacosh) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_34l), 0, 0, 0); check_complex ("cacosh (inf + inf i) == inf + pi/4 i", FUNC(cacosh) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_4l), 0, 0, 0); check_complex ("cacosh (inf - inf i) == inf - pi/4 i", FUNC(cacosh) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_4l), 0, 0, 0); check_complex ("cacosh (-10.0 + inf i) == inf + pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (-10.0, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("cacosh (-10.0 - inf i) == inf - pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (-10.0, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("cacosh (0 + inf i) == inf + pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("cacosh (0 - inf i) == inf - pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("cacosh (0.1 + inf i) == inf + pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (0.1L, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("cacosh (0.1 - inf i) == inf - pi/2 i", FUNC(cacosh) (BUILD_COMPLEX (0.1L, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("cacosh (-inf + 0 i) == inf + pi i", FUNC(cacosh) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (plus_infty, M_PIl), 0, 0, 0); check_complex ("cacosh (-inf - 0 i) == inf - pi i", FUNC(cacosh) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, -M_PIl), 0, 0, 0); check_complex ("cacosh (-inf + 100 i) == inf + pi i", FUNC(cacosh) (BUILD_COMPLEX (minus_infty, 100)), BUILD_COMPLEX (plus_infty, M_PIl), 0, 0, 0); check_complex ("cacosh (-inf - 100 i) == inf - pi i", FUNC(cacosh) (BUILD_COMPLEX (minus_infty, -100)), BUILD_COMPLEX (plus_infty, -M_PIl), 0, 0, 0); check_complex ("cacosh (inf + 0 i) == inf + 0.0 i", FUNC(cacosh) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("cacosh (inf - 0 i) == inf - 0 i", FUNC(cacosh) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("cacosh (inf + 0.5 i) == inf + 0.0 i", FUNC(cacosh) (BUILD_COMPLEX (plus_infty, 0.5)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("cacosh (inf - 0.5 i) == inf - 0 i", FUNC(cacosh) (BUILD_COMPLEX (plus_infty, -0.5)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("cacosh (inf + NaN i) == inf + NaN i", FUNC(cacosh) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("cacosh (-inf + NaN i) == inf + NaN i", FUNC(cacosh) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("cacosh (0 + NaN i) == NaN + NaN i", FUNC(cacosh) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("cacosh (-0 + NaN i) == NaN + NaN i", FUNC(cacosh) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("cacosh (NaN + inf i) == inf + NaN i", FUNC(cacosh) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("cacosh (NaN - inf i) == inf + NaN i", FUNC(cacosh) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("cacosh (10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(cacosh) (BUILD_COMPLEX (10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacosh (-10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(cacosh) (BUILD_COMPLEX (-10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacosh (NaN + 0.75 i) == NaN + NaN i plus invalid exception allowed", FUNC(cacosh) (BUILD_COMPLEX (nan_value, 0.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacosh (NaN - 0.75 i) == NaN + NaN i plus invalid exception allowed", FUNC(cacosh) (BUILD_COMPLEX (nan_value, -0.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cacosh (NaN + NaN i) == NaN + NaN i", FUNC(cacosh) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("cacosh (0.7 + 1.2 i) == 1.0927647857577371459105272080819308 + 1.1351827477151551088992008271819053 i", FUNC(cacosh) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (1.0927647857577371459105272080819308L, 1.1351827477151551088992008271819053L), DELTA165, 0, 0); check_complex ("cacosh (-2 - 3 i) == -1.9833870299165354323470769028940395 + 2.1414491111159960199416055713254211 i", FUNC(cacosh) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-1.9833870299165354323470769028940395L, 2.1414491111159960199416055713254211L), DELTA166, 0, 0); print_complex_max_error ("cacosh", DELTAcacosh, 0); } static void carg_test (void) { init_max_error (); /* carg (x + iy) is specified as atan2 (y, x) */ /* carg (x + i 0) == 0 for x > 0. */ check_float ("carg (2.0 + 0 i) == 0", FUNC(carg) (BUILD_COMPLEX (2.0, 0)), 0, 0, 0, 0); /* carg (x - i 0) == -0 for x > 0. */ check_float ("carg (2.0 - 0 i) == -0", FUNC(carg) (BUILD_COMPLEX (2.0, minus_zero)), minus_zero, 0, 0, 0); check_float ("carg (0 + 0 i) == 0", FUNC(carg) (BUILD_COMPLEX (0, 0)), 0, 0, 0, 0); check_float ("carg (0 - 0 i) == -0", FUNC(carg) (BUILD_COMPLEX (0, minus_zero)), minus_zero, 0, 0, 0); /* carg (x + i 0) == +pi for x < 0. */ check_float ("carg (-2.0 + 0 i) == pi", FUNC(carg) (BUILD_COMPLEX (-2.0, 0)), M_PIl, 0, 0, 0); /* carg (x - i 0) == -pi for x < 0. */ check_float ("carg (-2.0 - 0 i) == -pi", FUNC(carg) (BUILD_COMPLEX (-2.0, minus_zero)), -M_PIl, 0, 0, 0); check_float ("carg (-0 + 0 i) == pi", FUNC(carg) (BUILD_COMPLEX (minus_zero, 0)), M_PIl, 0, 0, 0); check_float ("carg (-0 - 0 i) == -pi", FUNC(carg) (BUILD_COMPLEX (minus_zero, minus_zero)), -M_PIl, 0, 0, 0); /* carg (+0 + i y) == pi/2 for y > 0. */ check_float ("carg (0 + 2.0 i) == pi/2", FUNC(carg) (BUILD_COMPLEX (0, 2.0)), M_PI_2l, 0, 0, 0); /* carg (-0 + i y) == pi/2 for y > 0. */ check_float ("carg (-0 + 2.0 i) == pi/2", FUNC(carg) (BUILD_COMPLEX (minus_zero, 2.0)), M_PI_2l, 0, 0, 0); /* carg (+0 + i y) == -pi/2 for y < 0. */ check_float ("carg (0 - 2.0 i) == -pi/2", FUNC(carg) (BUILD_COMPLEX (0, -2.0)), -M_PI_2l, 0, 0, 0); /* carg (-0 + i y) == -pi/2 for y < 0. */ check_float ("carg (-0 - 2.0 i) == -pi/2", FUNC(carg) (BUILD_COMPLEX (minus_zero, -2.0)), -M_PI_2l, 0, 0, 0); /* carg (inf + i y) == +0 for finite y > 0. */ check_float ("carg (inf + 2.0 i) == 0", FUNC(carg) (BUILD_COMPLEX (plus_infty, 2.0)), 0, 0, 0, 0); /* carg (inf + i y) == -0 for finite y < 0. */ check_float ("carg (inf - 2.0 i) == -0", FUNC(carg) (BUILD_COMPLEX (plus_infty, -2.0)), minus_zero, 0, 0, 0); /* carg(x + i inf) == pi/2 for finite x. */ check_float ("carg (10.0 + inf i) == pi/2", FUNC(carg) (BUILD_COMPLEX (10.0, plus_infty)), M_PI_2l, 0, 0, 0); /* carg(x - i inf) == -pi/2 for finite x. */ check_float ("carg (10.0 - inf i) == -pi/2", FUNC(carg) (BUILD_COMPLEX (10.0, minus_infty)), -M_PI_2l, 0, 0, 0); /* carg (-inf + i y) == +pi for finite y > 0. */ check_float ("carg (-inf + 10.0 i) == pi", FUNC(carg) (BUILD_COMPLEX (minus_infty, 10.0)), M_PIl, 0, 0, 0); /* carg (-inf + i y) == -pi for finite y < 0. */ check_float ("carg (-inf - 10.0 i) == -pi", FUNC(carg) (BUILD_COMPLEX (minus_infty, -10.0)), -M_PIl, 0, 0, 0); check_float ("carg (inf + inf i) == pi/4", FUNC(carg) (BUILD_COMPLEX (plus_infty, plus_infty)), M_PI_4l, 0, 0, 0); check_float ("carg (inf - inf i) == -pi/4", FUNC(carg) (BUILD_COMPLEX (plus_infty, minus_infty)), -M_PI_4l, 0, 0, 0); check_float ("carg (-inf + inf i) == 3 * M_PI_4l", FUNC(carg) (BUILD_COMPLEX (minus_infty, plus_infty)), 3 * M_PI_4l, 0, 0, 0); check_float ("carg (-inf - inf i) == -3 * M_PI_4l", FUNC(carg) (BUILD_COMPLEX (minus_infty, minus_infty)), -3 * M_PI_4l, 0, 0, 0); check_float ("carg (NaN + NaN i) == NaN", FUNC(carg) (BUILD_COMPLEX (nan_value, nan_value)), nan_value, 0, 0, 0); print_max_error ("carg", 0, 0); } static void casin_test (void) { errno = 0; FUNC(casin) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("casin (0 + 0 i) == 0.0 + 0.0 i", FUNC(casin) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("casin (-0 + 0 i) == -0 + 0.0 i", FUNC(casin) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("casin (0 - 0 i) == 0.0 - 0 i", FUNC(casin) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("casin (-0 - 0 i) == -0 - 0 i", FUNC(casin) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("casin (inf + inf i) == pi/4 + inf i", FUNC(casin) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (M_PI_4l, plus_infty), 0, 0, 0); check_complex ("casin (inf - inf i) == pi/4 - inf i", FUNC(casin) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (M_PI_4l, minus_infty), 0, 0, 0); check_complex ("casin (-inf + inf i) == -pi/4 + inf i", FUNC(casin) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (-M_PI_4l, plus_infty), 0, 0, 0); check_complex ("casin (-inf - inf i) == -pi/4 - inf i", FUNC(casin) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (-M_PI_4l, minus_infty), 0, 0, 0); check_complex ("casin (-10.0 + inf i) == -0 + inf i", FUNC(casin) (BUILD_COMPLEX (-10.0, plus_infty)), BUILD_COMPLEX (minus_zero, plus_infty), 0, 0, 0); check_complex ("casin (-10.0 - inf i) == -0 - inf i", FUNC(casin) (BUILD_COMPLEX (-10.0, minus_infty)), BUILD_COMPLEX (minus_zero, minus_infty), 0, 0, 0); check_complex ("casin (0 + inf i) == 0.0 + inf i", FUNC(casin) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (0.0, plus_infty), 0, 0, 0); check_complex ("casin (0 - inf i) == 0.0 - inf i", FUNC(casin) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (0.0, minus_infty), 0, 0, 0); check_complex ("casin (-0 + inf i) == -0 + inf i", FUNC(casin) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (minus_zero, plus_infty), 0, 0, 0); check_complex ("casin (-0 - inf i) == -0 - inf i", FUNC(casin) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (minus_zero, minus_infty), 0, 0, 0); check_complex ("casin (0.1 + inf i) == 0.0 + inf i", FUNC(casin) (BUILD_COMPLEX (0.1L, plus_infty)), BUILD_COMPLEX (0.0, plus_infty), 0, 0, 0); check_complex ("casin (0.1 - inf i) == 0.0 - inf i", FUNC(casin) (BUILD_COMPLEX (0.1L, minus_infty)), BUILD_COMPLEX (0.0, minus_infty), 0, 0, 0); check_complex ("casin (-inf + 0 i) == -pi/2 + inf i", FUNC(casin) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (-M_PI_2l, plus_infty), 0, 0, 0); check_complex ("casin (-inf - 0 i) == -pi/2 - inf i", FUNC(casin) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (-M_PI_2l, minus_infty), 0, 0, 0); check_complex ("casin (-inf + 100 i) == -pi/2 + inf i", FUNC(casin) (BUILD_COMPLEX (minus_infty, 100)), BUILD_COMPLEX (-M_PI_2l, plus_infty), 0, 0, 0); check_complex ("casin (-inf - 100 i) == -pi/2 - inf i", FUNC(casin) (BUILD_COMPLEX (minus_infty, -100)), BUILD_COMPLEX (-M_PI_2l, minus_infty), 0, 0, 0); check_complex ("casin (inf + 0 i) == pi/2 + inf i", FUNC(casin) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (M_PI_2l, plus_infty), 0, 0, 0); check_complex ("casin (inf - 0 i) == pi/2 - inf i", FUNC(casin) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (M_PI_2l, minus_infty), 0, 0, 0); check_complex ("casin (inf + 0.5 i) == pi/2 + inf i", FUNC(casin) (BUILD_COMPLEX (plus_infty, 0.5)), BUILD_COMPLEX (M_PI_2l, plus_infty), 0, 0, 0); check_complex ("casin (inf - 0.5 i) == pi/2 - inf i", FUNC(casin) (BUILD_COMPLEX (plus_infty, -0.5)), BUILD_COMPLEX (M_PI_2l, minus_infty), 0, 0, 0); check_complex ("casin (NaN + inf i) == NaN + inf i", FUNC(casin) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, 0); check_complex ("casin (NaN - inf i) == NaN - inf i", FUNC(casin) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (nan_value, minus_infty), 0, 0, 0); check_complex ("casin (0.0 + NaN i) == 0.0 + NaN i", FUNC(casin) (BUILD_COMPLEX (0.0, nan_value)), BUILD_COMPLEX (0.0, nan_value), 0, 0, 0); check_complex ("casin (-0 + NaN i) == -0 + NaN i", FUNC(casin) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (minus_zero, nan_value), 0, 0, 0); check_complex ("casin (inf + NaN i) == NaN + inf i plus sign of zero/inf not specified", FUNC(casin) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("casin (-inf + NaN i) == NaN + inf i plus sign of zero/inf not specified", FUNC(casin) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("casin (NaN + 10.5 i) == NaN + NaN i plus invalid exception allowed", FUNC(casin) (BUILD_COMPLEX (nan_value, 10.5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casin (NaN - 10.5 i) == NaN + NaN i plus invalid exception allowed", FUNC(casin) (BUILD_COMPLEX (nan_value, -10.5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casin (0.75 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(casin) (BUILD_COMPLEX (0.75, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casin (-0.75 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(casin) (BUILD_COMPLEX (-0.75, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casin (NaN + NaN i) == NaN + NaN i", FUNC(casin) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("casin (0.7 + 1.2 i) == 0.4356135790797415103321208644578462 + 1.0927647857577371459105272080819308 i", FUNC(casin) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.4356135790797415103321208644578462L, 1.0927647857577371459105272080819308L), DELTA225, 0, 0); check_complex ("casin (-2 - 3 i) == -0.57065278432109940071028387968566963 - 1.9833870299165354323470769028940395 i", FUNC(casin) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-0.57065278432109940071028387968566963L, -1.9833870299165354323470769028940395L), DELTA226, 0, 0); print_complex_max_error ("casin", DELTAcasin, 0); } static void casinh_test (void) { errno = 0; FUNC(casinh) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("casinh (0 + 0 i) == 0.0 + 0.0 i", FUNC(casinh) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("casinh (-0 + 0 i) == -0 + 0 i", FUNC(casinh) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_zero, 0), 0, 0, 0); check_complex ("casinh (0 - 0 i) == 0.0 - 0 i", FUNC(casinh) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("casinh (-0 - 0 i) == -0 - 0 i", FUNC(casinh) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("casinh (inf + inf i) == inf + pi/4 i", FUNC(casinh) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_4l), 0, 0, 0); check_complex ("casinh (inf - inf i) == inf - pi/4 i", FUNC(casinh) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_4l), 0, 0, 0); check_complex ("casinh (-inf + inf i) == -inf + pi/4 i", FUNC(casinh) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (minus_infty, M_PI_4l), 0, 0, 0); check_complex ("casinh (-inf - inf i) == -inf - pi/4 i", FUNC(casinh) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (minus_infty, -M_PI_4l), 0, 0, 0); check_complex ("casinh (-10.0 + inf i) == -inf + pi/2 i", FUNC(casinh) (BUILD_COMPLEX (-10.0, plus_infty)), BUILD_COMPLEX (minus_infty, M_PI_2l), 0, 0, 0); check_complex ("casinh (-10.0 - inf i) == -inf - pi/2 i", FUNC(casinh) (BUILD_COMPLEX (-10.0, minus_infty)), BUILD_COMPLEX (minus_infty, -M_PI_2l), 0, 0, 0); check_complex ("casinh (0 + inf i) == inf + pi/2 i", FUNC(casinh) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("casinh (0 - inf i) == inf - pi/2 i", FUNC(casinh) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("casinh (-0 + inf i) == -inf + pi/2 i", FUNC(casinh) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (minus_infty, M_PI_2l), 0, 0, 0); check_complex ("casinh (-0 - inf i) == -inf - pi/2 i", FUNC(casinh) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (minus_infty, -M_PI_2l), 0, 0, 0); check_complex ("casinh (0.1 + inf i) == inf + pi/2 i", FUNC(casinh) (BUILD_COMPLEX (0.1L, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("casinh (0.1 - inf i) == inf - pi/2 i", FUNC(casinh) (BUILD_COMPLEX (0.1L, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("casinh (-inf + 0 i) == -inf + 0.0 i", FUNC(casinh) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (minus_infty, 0.0), 0, 0, 0); check_complex ("casinh (-inf - 0 i) == -inf - 0 i", FUNC(casinh) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (minus_infty, minus_zero), 0, 0, 0); check_complex ("casinh (-inf + 100 i) == -inf + 0.0 i", FUNC(casinh) (BUILD_COMPLEX (minus_infty, 100)), BUILD_COMPLEX (minus_infty, 0.0), 0, 0, 0); check_complex ("casinh (-inf - 100 i) == -inf - 0 i", FUNC(casinh) (BUILD_COMPLEX (minus_infty, -100)), BUILD_COMPLEX (minus_infty, minus_zero), 0, 0, 0); check_complex ("casinh (inf + 0 i) == inf + 0.0 i", FUNC(casinh) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("casinh (inf - 0 i) == inf - 0 i", FUNC(casinh) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("casinh (inf + 0.5 i) == inf + 0.0 i", FUNC(casinh) (BUILD_COMPLEX (plus_infty, 0.5)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("casinh (inf - 0.5 i) == inf - 0 i", FUNC(casinh) (BUILD_COMPLEX (plus_infty, -0.5)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("casinh (inf + NaN i) == inf + NaN i", FUNC(casinh) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("casinh (-inf + NaN i) == -inf + NaN i", FUNC(casinh) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (minus_infty, nan_value), 0, 0, 0); check_complex ("casinh (NaN + 0 i) == NaN + 0.0 i", FUNC(casinh) (BUILD_COMPLEX (nan_value, 0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, 0); check_complex ("casinh (NaN - 0 i) == NaN - 0 i", FUNC(casinh) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, minus_zero), 0, 0, 0); check_complex ("casinh (NaN + inf i) == inf + NaN i plus sign of zero/inf not specified", FUNC(casinh) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("casinh (NaN - inf i) == inf + NaN i plus sign of zero/inf not specified", FUNC(casinh) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("casinh (10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(casinh) (BUILD_COMPLEX (10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casinh (-10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(casinh) (BUILD_COMPLEX (-10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casinh (NaN + 0.75 i) == NaN + NaN i plus invalid exception allowed", FUNC(casinh) (BUILD_COMPLEX (nan_value, 0.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casinh (-0.75 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(casinh) (BUILD_COMPLEX (-0.75, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("casinh (NaN + NaN i) == NaN + NaN i", FUNC(casinh) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("casinh (0.7 + 1.2 i) == 0.97865459559367387689317593222160964 + 0.91135418953156011567903546856170941 i", FUNC(casinh) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.97865459559367387689317593222160964L, 0.91135418953156011567903546856170941L), DELTA262, 0, 0); check_complex ("casinh (-2 - 3 i) == -1.9686379257930962917886650952454982 - 0.96465850440760279204541105949953237 i", FUNC(casinh) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-1.9686379257930962917886650952454982L, -0.96465850440760279204541105949953237L), DELTA263, 0, 0); print_complex_max_error ("casinh", DELTAcasinh, 0); } static void catan_test (void) { errno = 0; FUNC(catan) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("catan (0 + 0 i) == 0 + 0 i", FUNC(catan) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0, 0), 0, 0, 0); check_complex ("catan (-0 + 0 i) == -0 + 0 i", FUNC(catan) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_zero, 0), 0, 0, 0); check_complex ("catan (0 - 0 i) == 0 - 0 i", FUNC(catan) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0, minus_zero), 0, 0, 0); check_complex ("catan (-0 - 0 i) == -0 - 0 i", FUNC(catan) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("catan (inf + inf i) == pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (M_PI_2l, 0), 0, 0, 0); check_complex ("catan (inf - inf i) == pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (-inf + inf i) == -pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (-M_PI_2l, 0), 0, 0, 0); check_complex ("catan (-inf - inf i) == -pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (-M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (inf - 10.0 i) == pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (plus_infty, -10.0)), BUILD_COMPLEX (M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (-inf - 10.0 i) == -pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (minus_infty, -10.0)), BUILD_COMPLEX (-M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (inf - 0 i) == pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (-inf - 0 i) == -pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (-M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (inf + 0.0 i) == pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (plus_infty, 0.0)), BUILD_COMPLEX (M_PI_2l, 0), 0, 0, 0); check_complex ("catan (-inf + 0.0 i) == -pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (minus_infty, 0.0)), BUILD_COMPLEX (-M_PI_2l, 0), 0, 0, 0); check_complex ("catan (inf + 0.1 i) == pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (plus_infty, 0.1L)), BUILD_COMPLEX (M_PI_2l, 0), 0, 0, 0); check_complex ("catan (-inf + 0.1 i) == -pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (minus_infty, 0.1L)), BUILD_COMPLEX (-M_PI_2l, 0), 0, 0, 0); check_complex ("catan (0.0 - inf i) == pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (0.0, minus_infty)), BUILD_COMPLEX (M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (-0 - inf i) == -pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (-M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (100.0 - inf i) == pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (100.0, minus_infty)), BUILD_COMPLEX (M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (-100.0 - inf i) == -pi/2 - 0 i", FUNC(catan) (BUILD_COMPLEX (-100.0, minus_infty)), BUILD_COMPLEX (-M_PI_2l, minus_zero), 0, 0, 0); check_complex ("catan (0.0 + inf i) == pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (0.0, plus_infty)), BUILD_COMPLEX (M_PI_2l, 0), 0, 0, 0); check_complex ("catan (-0 + inf i) == -pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (-M_PI_2l, 0), 0, 0, 0); check_complex ("catan (0.5 + inf i) == pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (0.5, plus_infty)), BUILD_COMPLEX (M_PI_2l, 0), 0, 0, 0); check_complex ("catan (-0.5 + inf i) == -pi/2 + 0 i", FUNC(catan) (BUILD_COMPLEX (-0.5, plus_infty)), BUILD_COMPLEX (-M_PI_2l, 0), 0, 0, 0); check_complex ("catan (NaN + 0.0 i) == NaN + 0 i", FUNC(catan) (BUILD_COMPLEX (nan_value, 0.0)), BUILD_COMPLEX (nan_value, 0), 0, 0, 0); check_complex ("catan (NaN - 0 i) == NaN - 0 i", FUNC(catan) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, minus_zero), 0, 0, 0); check_complex ("catan (NaN + inf i) == NaN + 0 i", FUNC(catan) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (nan_value, 0), 0, 0, 0); check_complex ("catan (NaN - inf i) == NaN - 0 i", FUNC(catan) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (nan_value, minus_zero), 0, 0, 0); check_complex ("catan (0.0 + NaN i) == NaN + NaN i", FUNC(catan) (BUILD_COMPLEX (0.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("catan (-0 + NaN i) == NaN + NaN i", FUNC(catan) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("catan (inf + NaN i) == pi/2 + 0 i plus sign of zero/inf not specified", FUNC(catan) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (M_PI_2l, 0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("catan (-inf + NaN i) == -pi/2 + 0 i plus sign of zero/inf not specified", FUNC(catan) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (-M_PI_2l, 0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("catan (NaN + 10.5 i) == NaN + NaN i plus invalid exception allowed", FUNC(catan) (BUILD_COMPLEX (nan_value, 10.5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catan (NaN - 10.5 i) == NaN + NaN i plus invalid exception allowed", FUNC(catan) (BUILD_COMPLEX (nan_value, -10.5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catan (0.75 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(catan) (BUILD_COMPLEX (0.75, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catan (-0.75 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(catan) (BUILD_COMPLEX (-0.75, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catan (NaN + NaN i) == NaN + NaN i", FUNC(catan) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("catan (0.7 + 1.2 i) == 1.0785743834118921877443707996386368 + 0.57705737765343067644394541889341712 i", FUNC(catan) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (1.0785743834118921877443707996386368L, 0.57705737765343067644394541889341712L), DELTA301, 0, 0); check_complex ("catan (-2 - 3 i) == -1.4099210495965755225306193844604208 - 0.22907268296853876629588180294200276 i", FUNC(catan) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-1.4099210495965755225306193844604208L, -0.22907268296853876629588180294200276L), DELTA302, 0, 0); print_complex_max_error ("catan", DELTAcatan, 0); } static void catanh_test (void) { errno = 0; FUNC(catanh) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("catanh (0 + 0 i) == 0.0 + 0.0 i", FUNC(catanh) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("catanh (-0 + 0 i) == -0 + 0.0 i", FUNC(catanh) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("catanh (0 - 0 i) == 0.0 - 0 i", FUNC(catanh) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("catanh (-0 - 0 i) == -0 - 0 i", FUNC(catanh) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("catanh (inf + inf i) == 0.0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, 0); check_complex ("catanh (inf - inf i) == 0.0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, 0); check_complex ("catanh (-inf + inf i) == -0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (minus_zero, M_PI_2l), 0, 0, 0); check_complex ("catanh (-inf - inf i) == -0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (minus_zero, -M_PI_2l), 0, 0, 0); check_complex ("catanh (-10.0 + inf i) == -0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (-10.0, plus_infty)), BUILD_COMPLEX (minus_zero, M_PI_2l), 0, 0, 0); check_complex ("catanh (-10.0 - inf i) == -0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (-10.0, minus_infty)), BUILD_COMPLEX (minus_zero, -M_PI_2l), 0, 0, 0); check_complex ("catanh (-0 + inf i) == -0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (minus_zero, M_PI_2l), 0, 0, 0); check_complex ("catanh (-0 - inf i) == -0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (minus_zero, -M_PI_2l), 0, 0, 0); check_complex ("catanh (0 + inf i) == 0.0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, 0); check_complex ("catanh (0 - inf i) == 0.0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, 0); check_complex ("catanh (0.1 + inf i) == 0.0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (0.1L, plus_infty)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, 0); check_complex ("catanh (0.1 - inf i) == 0.0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (0.1L, minus_infty)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, 0); check_complex ("catanh (-inf + 0 i) == -0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (minus_zero, M_PI_2l), 0, 0, 0); check_complex ("catanh (-inf - 0 i) == -0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (minus_zero, -M_PI_2l), 0, 0, 0); check_complex ("catanh (-inf + 100 i) == -0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_infty, 100)), BUILD_COMPLEX (minus_zero, M_PI_2l), 0, 0, 0); check_complex ("catanh (-inf - 100 i) == -0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (minus_infty, -100)), BUILD_COMPLEX (minus_zero, -M_PI_2l), 0, 0, 0); check_complex ("catanh (inf + 0 i) == 0.0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, 0); check_complex ("catanh (inf - 0 i) == 0.0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, 0); check_complex ("catanh (inf + 0.5 i) == 0.0 + pi/2 i", FUNC(catanh) (BUILD_COMPLEX (plus_infty, 0.5)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, 0); check_complex ("catanh (inf - 0.5 i) == 0.0 - pi/2 i", FUNC(catanh) (BUILD_COMPLEX (plus_infty, -0.5)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, 0); check_complex ("catanh (0 + NaN i) == 0.0 + NaN i", FUNC(catanh) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (0.0, nan_value), 0, 0, 0); check_complex ("catanh (-0 + NaN i) == -0 + NaN i", FUNC(catanh) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (minus_zero, nan_value), 0, 0, 0); check_complex ("catanh (inf + NaN i) == 0.0 + NaN i", FUNC(catanh) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (0.0, nan_value), 0, 0, 0); check_complex ("catanh (-inf + NaN i) == -0 + NaN i", FUNC(catanh) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (minus_zero, nan_value), 0, 0, 0); check_complex ("catanh (NaN + 0 i) == NaN + NaN i", FUNC(catanh) (BUILD_COMPLEX (nan_value, 0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("catanh (NaN - 0 i) == NaN + NaN i", FUNC(catanh) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("catanh (NaN + inf i) == 0.0 + pi/2 i plus sign of zero/inf not specified", FUNC(catanh) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (0.0, M_PI_2l), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("catanh (NaN - inf i) == 0.0 - pi/2 i plus sign of zero/inf not specified", FUNC(catanh) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (0.0, -M_PI_2l), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("catanh (10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(catanh) (BUILD_COMPLEX (10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catanh (-10.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(catanh) (BUILD_COMPLEX (-10.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catanh (NaN + 0.75 i) == NaN + NaN i plus invalid exception allowed", FUNC(catanh) (BUILD_COMPLEX (nan_value, 0.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catanh (NaN - 0.75 i) == NaN + NaN i plus invalid exception allowed", FUNC(catanh) (BUILD_COMPLEX (nan_value, -0.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("catanh (NaN + NaN i) == NaN + NaN i", FUNC(catanh) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("catanh (0.7 + 1.2 i) == 0.2600749516525135959200648705635915 + 0.97024030779509898497385130162655963 i", FUNC(catanh) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.2600749516525135959200648705635915L, 0.97024030779509898497385130162655963L), DELTA340, 0, 0); check_complex ("catanh (-2 - 3 i) == -0.14694666622552975204743278515471595 - 1.3389725222944935611241935759091443 i", FUNC(catanh) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-0.14694666622552975204743278515471595L, -1.3389725222944935611241935759091443L), DELTA341, 0, 0); print_complex_max_error ("catanh", DELTAcatanh, 0); } #endif static void cbrt_test (void) { errno = 0; FUNC(cbrt) (8); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("cbrt (0.0) == 0.0", FUNC(cbrt) (0.0), 0.0, 0, 0, 0); check_float ("cbrt (-0) == -0", FUNC(cbrt) (minus_zero), minus_zero, 0, 0, 0); check_float ("cbrt (inf) == inf", FUNC(cbrt) (plus_infty), plus_infty, 0, 0, 0); check_float ("cbrt (-inf) == -inf", FUNC(cbrt) (minus_infty), minus_infty, 0, 0, 0); check_float ("cbrt (NaN) == NaN", FUNC(cbrt) (nan_value), nan_value, 0, 0, 0); check_float ("cbrt (-0.001) == -0.1", FUNC(cbrt) (-0.001L), -0.1L, DELTA347, 0, 0); check_float ("cbrt (8) == 2", FUNC(cbrt) (8), 2, 0, 0, 0); check_float ("cbrt (-27.0) == -3.0", FUNC(cbrt) (-27.0), -3.0, DELTA349, 0, 0); check_float ("cbrt (0.970299) == 0.99", FUNC(cbrt) (0.970299L), 0.99L, DELTA350, 0, 0); check_float ("cbrt (0.7) == 0.8879040017426007084", FUNC(cbrt) (0.7L), 0.8879040017426007084L, DELTA351, 0, 0); print_max_error ("cbrt", DELTAcbrt, 0); } #if 0 /* XXX scp XXX */ static void ccos_test (void) { errno = 0; FUNC(ccos) (BUILD_COMPLEX (0, 0)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("ccos (0.0 + 0.0 i) == 1.0 - 0 i", FUNC(ccos) (BUILD_COMPLEX (0.0, 0.0)), BUILD_COMPLEX (1.0, minus_zero), 0, 0, 0); check_complex ("ccos (-0 + 0.0 i) == 1.0 + 0.0 i", FUNC(ccos) (BUILD_COMPLEX (minus_zero, 0.0)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("ccos (0.0 - 0 i) == 1.0 + 0.0 i", FUNC(ccos) (BUILD_COMPLEX (0.0, minus_zero)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("ccos (-0 - 0 i) == 1.0 - 0 i", FUNC(ccos) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (1.0, minus_zero), 0, 0, 0); check_complex ("ccos (inf + 0.0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (plus_infty, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccos (inf - 0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccos (-inf + 0.0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (minus_infty, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccos (-inf - 0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccos (0.0 + inf i) == inf - 0 i", FUNC(ccos) (BUILD_COMPLEX (0.0, plus_infty)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("ccos (0.0 - inf i) == inf + 0.0 i", FUNC(ccos) (BUILD_COMPLEX (0.0, minus_infty)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("ccos (-0 + inf i) == inf + 0.0 i", FUNC(ccos) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("ccos (-0 - inf i) == inf - 0 i", FUNC(ccos) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("ccos (inf + inf i) == inf + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (-inf + inf i) == inf + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (inf - inf i) == inf + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (-inf - inf i) == inf + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (4.625 + inf i) == -inf + inf i", FUNC(ccos) (BUILD_COMPLEX (4.625, plus_infty)), BUILD_COMPLEX (minus_infty, plus_infty), 0, 0, 0); check_complex ("ccos (4.625 - inf i) == -inf - inf i", FUNC(ccos) (BUILD_COMPLEX (4.625, minus_infty)), BUILD_COMPLEX (minus_infty, minus_infty), 0, 0, 0); check_complex ("ccos (-4.625 + inf i) == -inf - inf i", FUNC(ccos) (BUILD_COMPLEX (-4.625, plus_infty)), BUILD_COMPLEX (minus_infty, minus_infty), 0, 0, 0); check_complex ("ccos (-4.625 - inf i) == -inf + inf i", FUNC(ccos) (BUILD_COMPLEX (-4.625, minus_infty)), BUILD_COMPLEX (minus_infty, plus_infty), 0, 0, 0); check_complex ("ccos (inf + 6.75 i) == NaN + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (plus_infty, 6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (inf - 6.75 i) == NaN + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (plus_infty, -6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (-inf + 6.75 i) == NaN + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (minus_infty, 6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (-inf - 6.75 i) == NaN + NaN i plus invalid exception", FUNC(ccos) (BUILD_COMPLEX (minus_infty, -6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccos (NaN + 0.0 i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (nan_value, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccos (NaN - 0 i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccos (NaN + inf i) == inf + NaN i", FUNC(ccos) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("ccos (NaN - inf i) == inf + NaN i", FUNC(ccos) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("ccos (NaN + 9.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(ccos) (BUILD_COMPLEX (nan_value, 9.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccos (NaN - 9.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(ccos) (BUILD_COMPLEX (nan_value, -9.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccos (0.0 + NaN i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (0.0, nan_value)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccos (-0 + NaN i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccos) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccos (10.0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ccos) (BUILD_COMPLEX (10.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccos (-10.0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ccos) (BUILD_COMPLEX (-10.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccos (inf + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ccos) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccos (-inf + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ccos) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccos (NaN + NaN i) == NaN + NaN i", FUNC(ccos) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("ccos (0.7 + 1.2 i) == 1.3848657645312111080 - 0.97242170335830028619 i", FUNC(ccos) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (1.3848657645312111080L, -0.97242170335830028619L), DELTA389, 0, 0); check_complex ("ccos (-2 - 3 i) == -4.1896256909688072301 - 9.1092278937553365979 i", FUNC(ccos) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-4.1896256909688072301L, -9.1092278937553365979L), DELTA390, 0, 0); print_complex_max_error ("ccos", DELTAccos, 0); } static void ccosh_test (void) { errno = 0; FUNC(ccosh) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("ccosh (0.0 + 0.0 i) == 1.0 + 0.0 i", FUNC(ccosh) (BUILD_COMPLEX (0.0, 0.0)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("ccosh (-0 + 0.0 i) == 1.0 - 0 i", FUNC(ccosh) (BUILD_COMPLEX (minus_zero, 0.0)), BUILD_COMPLEX (1.0, minus_zero), 0, 0, 0); check_complex ("ccosh (0.0 - 0 i) == 1.0 - 0 i", FUNC(ccosh) (BUILD_COMPLEX (0.0, minus_zero)), BUILD_COMPLEX (1.0, minus_zero), 0, 0, 0); check_complex ("ccosh (-0 - 0 i) == 1.0 + 0.0 i", FUNC(ccosh) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("ccosh (0.0 + inf i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (0.0, plus_infty)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (-0 + inf i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (0.0 - inf i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (0.0, minus_infty)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (-0 - inf i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (inf + 0.0 i) == inf + 0.0 i", FUNC(ccosh) (BUILD_COMPLEX (plus_infty, 0.0)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("ccosh (-inf + 0.0 i) == inf - 0 i", FUNC(ccosh) (BUILD_COMPLEX (minus_infty, 0.0)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("ccosh (inf - 0 i) == inf - 0 i", FUNC(ccosh) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("ccosh (-inf - 0 i) == inf + 0.0 i", FUNC(ccosh) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("ccosh (inf + inf i) == inf + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (-inf + inf i) == inf + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (inf - inf i) == inf + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (-inf - inf i) == inf + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (inf + 4.625 i) == -inf - inf i", FUNC(ccosh) (BUILD_COMPLEX (plus_infty, 4.625)), BUILD_COMPLEX (minus_infty, minus_infty), 0, 0, 0); check_complex ("ccosh (-inf + 4.625 i) == -inf + inf i", FUNC(ccosh) (BUILD_COMPLEX (minus_infty, 4.625)), BUILD_COMPLEX (minus_infty, plus_infty), 0, 0, 0); check_complex ("ccosh (inf - 4.625 i) == -inf + inf i", FUNC(ccosh) (BUILD_COMPLEX (plus_infty, -4.625)), BUILD_COMPLEX (minus_infty, plus_infty), 0, 0, 0); check_complex ("ccosh (-inf - 4.625 i) == -inf - inf i", FUNC(ccosh) (BUILD_COMPLEX (minus_infty, -4.625)), BUILD_COMPLEX (minus_infty, minus_infty), 0, 0, 0); check_complex ("ccosh (6.75 + inf i) == NaN + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (6.75, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (-6.75 + inf i) == NaN + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (-6.75, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (6.75 - inf i) == NaN + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (6.75, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (-6.75 - inf i) == NaN + NaN i plus invalid exception", FUNC(ccosh) (BUILD_COMPLEX (-6.75, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ccosh (0.0 + NaN i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (0.0, nan_value)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (-0 + NaN i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (inf + NaN i) == inf + NaN i", FUNC(ccosh) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("ccosh (-inf + NaN i) == inf + NaN i", FUNC(ccosh) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("ccosh (9.0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ccosh) (BUILD_COMPLEX (9.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccosh (-9.0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ccosh) (BUILD_COMPLEX (-9.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccosh (NaN + 0.0 i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (nan_value, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (NaN - 0 i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(ccosh) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ccosh (NaN + 10.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(ccosh) (BUILD_COMPLEX (nan_value, 10.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccosh (NaN - 10.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(ccosh) (BUILD_COMPLEX (nan_value, -10.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccosh (NaN + inf i) == NaN + NaN i plus invalid exception allowed", FUNC(ccosh) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccosh (NaN - inf i) == NaN + NaN i plus invalid exception allowed", FUNC(ccosh) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ccosh (NaN + NaN i) == NaN + NaN i", FUNC(ccosh) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("ccosh (0.7 + 1.2 i) == 0.4548202223691477654 + 0.7070296600921537682 i", FUNC(ccosh) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.4548202223691477654L, 0.7070296600921537682L), DELTA428, 0, 0); check_complex ("ccosh (-2 - 3 i) == -3.7245455049153225654 + 0.5118225699873846088 i", FUNC(ccosh) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-3.7245455049153225654L, 0.5118225699873846088L), DELTA429, 0, 0); print_complex_max_error ("ccosh", DELTAccosh, 0); } #endif static void ceil_test (void) { init_max_error (); check_float ("ceil (0.0) == 0.0", FUNC(ceil) (0.0), 0.0, 0, 0, 0); check_float ("ceil (-0) == -0", FUNC(ceil) (minus_zero), minus_zero, 0, 0, 0); check_float ("ceil (inf) == inf", FUNC(ceil) (plus_infty), plus_infty, 0, 0, 0); check_float ("ceil (-inf) == -inf", FUNC(ceil) (minus_infty), minus_infty, 0, 0, 0); check_float ("ceil (NaN) == NaN", FUNC(ceil) (nan_value), nan_value, 0, 0, 0); check_float ("ceil (pi) == 4.0", FUNC(ceil) (M_PIl), 4.0, 0, 0, 0); check_float ("ceil (-pi) == -3.0", FUNC(ceil) (-M_PIl), -3.0, 0, 0, 0); print_max_error ("ceil", 0, 0); } #if 0 /* XXX scp XXX */ static void cexp_test (void) { errno = 0; FUNC(cexp) (BUILD_COMPLEX (0, 0)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("cexp (+0 + +0 i) == 1 + 0.0 i", FUNC(cexp) (BUILD_COMPLEX (plus_zero, plus_zero)), BUILD_COMPLEX (1, 0.0), 0, 0, 0); check_complex ("cexp (-0 + +0 i) == 1 + 0.0 i", FUNC(cexp) (BUILD_COMPLEX (minus_zero, plus_zero)), BUILD_COMPLEX (1, 0.0), 0, 0, 0); check_complex ("cexp (+0 - 0 i) == 1 - 0 i", FUNC(cexp) (BUILD_COMPLEX (plus_zero, minus_zero)), BUILD_COMPLEX (1, minus_zero), 0, 0, 0); check_complex ("cexp (-0 - 0 i) == 1 - 0 i", FUNC(cexp) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (1, minus_zero), 0, 0, 0); check_complex ("cexp (inf + +0 i) == inf + 0.0 i", FUNC(cexp) (BUILD_COMPLEX (plus_infty, plus_zero)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("cexp (inf - 0 i) == inf - 0 i", FUNC(cexp) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("cexp (-inf + +0 i) == 0.0 + 0.0 i", FUNC(cexp) (BUILD_COMPLEX (minus_infty, plus_zero)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("cexp (-inf - 0 i) == 0.0 - 0 i", FUNC(cexp) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("cexp (0.0 + inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (0.0, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (-0 + inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (0.0 - inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (0.0, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (-0 - inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (100.0 + inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (100.0, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (-100.0 + inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (-100.0, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (100.0 - inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (100.0, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (-100.0 - inf i) == NaN + NaN i plus invalid exception", FUNC(cexp) (BUILD_COMPLEX (-100.0, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("cexp (-inf + 2.0 i) == -0 + 0.0 i", FUNC(cexp) (BUILD_COMPLEX (minus_infty, 2.0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("cexp (-inf + 4.0 i) == -0 - 0 i", FUNC(cexp) (BUILD_COMPLEX (minus_infty, 4.0)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("cexp (inf + 2.0 i) == -inf + inf i", FUNC(cexp) (BUILD_COMPLEX (plus_infty, 2.0)), BUILD_COMPLEX (minus_infty, plus_infty), 0, 0, 0); check_complex ("cexp (inf + 4.0 i) == -inf - inf i", FUNC(cexp) (BUILD_COMPLEX (plus_infty, 4.0)), BUILD_COMPLEX (minus_infty, minus_infty), 0, 0, 0); check_complex ("cexp (inf + inf i) == inf + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(cexp) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("cexp (inf - inf i) == inf + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(cexp) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("cexp (-inf + inf i) == 0.0 + 0.0 i plus sign of zero/inf not specified", FUNC(cexp) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (0.0, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("cexp (-inf - inf i) == 0.0 - 0 i plus sign of zero/inf not specified", FUNC(cexp) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("cexp (-inf + NaN i) == 0 + 0 i plus sign of zero/inf not specified", FUNC(cexp) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (0, 0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("cexp (inf + NaN i) == inf + NaN i", FUNC(cexp) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("cexp (NaN + 0.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(cexp) (BUILD_COMPLEX (nan_value, 0.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cexp (NaN + 1.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(cexp) (BUILD_COMPLEX (nan_value, 1.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cexp (NaN + inf i) == NaN + NaN i plus invalid exception allowed", FUNC(cexp) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cexp (0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(cexp) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cexp (1 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(cexp) (BUILD_COMPLEX (1, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("cexp (NaN + NaN i) == NaN + NaN i", FUNC(cexp) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("cexp (0.7 + 1.2 i) == 0.72969890915032360123451688642930727 + 1.8768962328348102821139467908203072 i", FUNC(cexp) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.72969890915032360123451688642930727L, 1.8768962328348102821139467908203072L), DELTA469, 0, 0); check_complex ("cexp (-2.0 - 3.0 i) == -0.13398091492954261346140525546115575 - 0.019098516261135196432576240858800925 i", FUNC(cexp) (BUILD_COMPLEX (-2.0, -3.0)), BUILD_COMPLEX (-0.13398091492954261346140525546115575L, -0.019098516261135196432576240858800925L), DELTA470, 0, 0); print_complex_max_error ("cexp", DELTAcexp, 0); } static void cimag_test (void) { init_max_error (); check_float ("cimag (1.0 + 0.0 i) == 0.0", FUNC(cimag) (BUILD_COMPLEX (1.0, 0.0)), 0.0, 0, 0, 0); check_float ("cimag (1.0 - 0 i) == -0", FUNC(cimag) (BUILD_COMPLEX (1.0, minus_zero)), minus_zero, 0, 0, 0); check_float ("cimag (1.0 + NaN i) == NaN", FUNC(cimag) (BUILD_COMPLEX (1.0, nan_value)), nan_value, 0, 0, 0); check_float ("cimag (NaN + NaN i) == NaN", FUNC(cimag) (BUILD_COMPLEX (nan_value, nan_value)), nan_value, 0, 0, 0); check_float ("cimag (1.0 + inf i) == inf", FUNC(cimag) (BUILD_COMPLEX (1.0, plus_infty)), plus_infty, 0, 0, 0); check_float ("cimag (1.0 - inf i) == -inf", FUNC(cimag) (BUILD_COMPLEX (1.0, minus_infty)), minus_infty, 0, 0, 0); check_float ("cimag (2.0 + 3.0 i) == 3.0", FUNC(cimag) (BUILD_COMPLEX (2.0, 3.0)), 3.0, 0, 0, 0); print_max_error ("cimag", 0, 0); } static void clog_test (void) { errno = 0; FUNC(clog) (BUILD_COMPLEX (-2, -3)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("clog (-0 + 0 i) == -inf + pi i plus division by zero exception", FUNC(clog) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_infty, M_PIl), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog (-0 - 0 i) == -inf - pi i plus division by zero exception", FUNC(clog) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_infty, -M_PIl), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog (0 + 0 i) == -inf + 0.0 i plus division by zero exception", FUNC(clog) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (minus_infty, 0.0), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog (0 - 0 i) == -inf - 0 i plus division by zero exception", FUNC(clog) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (minus_infty, minus_zero), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog (-inf + inf i) == inf + 3/4 pi i", FUNC(clog) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_34l), 0, 0, 0); check_complex ("clog (-inf - inf i) == inf - 3/4 pi i", FUNC(clog) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_34l), 0, 0, 0); check_complex ("clog (inf + inf i) == inf + pi/4 i", FUNC(clog) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_4l), 0, 0, 0); check_complex ("clog (inf - inf i) == inf - pi/4 i", FUNC(clog) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_4l), 0, 0, 0); check_complex ("clog (0 + inf i) == inf + pi/2 i", FUNC(clog) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("clog (3 + inf i) == inf + pi/2 i", FUNC(clog) (BUILD_COMPLEX (3, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("clog (-0 + inf i) == inf + pi/2 i", FUNC(clog) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("clog (-3 + inf i) == inf + pi/2 i", FUNC(clog) (BUILD_COMPLEX (-3, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_2l), 0, 0, 0); check_complex ("clog (0 - inf i) == inf - pi/2 i", FUNC(clog) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("clog (3 - inf i) == inf - pi/2 i", FUNC(clog) (BUILD_COMPLEX (3, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("clog (-0 - inf i) == inf - pi/2 i", FUNC(clog) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("clog (-3 - inf i) == inf - pi/2 i", FUNC(clog) (BUILD_COMPLEX (-3, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI_2l), 0, 0, 0); check_complex ("clog (-inf + 0 i) == inf + pi i", FUNC(clog) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (plus_infty, M_PIl), 0, 0, 0); check_complex ("clog (-inf + 1 i) == inf + pi i", FUNC(clog) (BUILD_COMPLEX (minus_infty, 1)), BUILD_COMPLEX (plus_infty, M_PIl), 0, 0, 0); check_complex ("clog (-inf - 0 i) == inf - pi i", FUNC(clog) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, -M_PIl), 0, 0, 0); check_complex ("clog (-inf - 1 i) == inf - pi i", FUNC(clog) (BUILD_COMPLEX (minus_infty, -1)), BUILD_COMPLEX (plus_infty, -M_PIl), 0, 0, 0); check_complex ("clog (inf + 0 i) == inf + 0.0 i", FUNC(clog) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("clog (inf + 1 i) == inf + 0.0 i", FUNC(clog) (BUILD_COMPLEX (plus_infty, 1)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("clog (inf - 0 i) == inf - 0 i", FUNC(clog) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("clog (inf - 1 i) == inf - 0 i", FUNC(clog) (BUILD_COMPLEX (plus_infty, -1)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("clog (inf + NaN i) == inf + NaN i", FUNC(clog) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog (-inf + NaN i) == inf + NaN i", FUNC(clog) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog (NaN + inf i) == inf + NaN i", FUNC(clog) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog (NaN - inf i) == inf + NaN i", FUNC(clog) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog (0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (3 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (3, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (-0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (-3 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (-3, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (NaN + 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (nan_value, 0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (NaN + 5 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (nan_value, 5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (NaN - 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (NaN - 5 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog) (BUILD_COMPLEX (nan_value, -5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog (NaN + NaN i) == NaN + NaN i", FUNC(clog) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("clog (-2 - 3 i) == 1.2824746787307683680267437207826593 - 2.1587989303424641704769327722648368 i", FUNC(clog) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (1.2824746787307683680267437207826593L, -2.1587989303424641704769327722648368L), DELTA515, 0, 0); print_complex_max_error ("clog", DELTAclog, 0); } static void clog10_test (void) { errno = 0; FUNC(clog10) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("clog10 (-0 + 0 i) == -inf + pi i plus division by zero exception", FUNC(clog10) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_infty, M_PIl), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog10 (-0 - 0 i) == -inf - pi i plus division by zero exception", FUNC(clog10) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_infty, -M_PIl), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog10 (0 + 0 i) == -inf + 0.0 i plus division by zero exception", FUNC(clog10) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (minus_infty, 0.0), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog10 (0 - 0 i) == -inf - 0 i plus division by zero exception", FUNC(clog10) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (minus_infty, minus_zero), 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_complex ("clog10 (-inf + inf i) == inf + 3/4 pi*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI_34_LOG10El), DELTA520, 0, 0); check_complex ("clog10 (inf + inf i) == inf + pi/4*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI4_LOG10El), DELTA521, 0, 0); check_complex ("clog10 (inf - inf i) == inf - pi/4*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI4_LOG10El), DELTA522, 0, 0); check_complex ("clog10 (0 + inf i) == inf + pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI2_LOG10El), DELTA523, 0, 0); check_complex ("clog10 (3 + inf i) == inf + pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (3, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI2_LOG10El), DELTA524, 0, 0); check_complex ("clog10 (-0 + inf i) == inf + pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI2_LOG10El), DELTA525, 0, 0); check_complex ("clog10 (-3 + inf i) == inf + pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (-3, plus_infty)), BUILD_COMPLEX (plus_infty, M_PI2_LOG10El), DELTA526, 0, 0); check_complex ("clog10 (0 - inf i) == inf - pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI2_LOG10El), DELTA527, 0, 0); check_complex ("clog10 (3 - inf i) == inf - pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (3, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI2_LOG10El), DELTA528, 0, 0); check_complex ("clog10 (-0 - inf i) == inf - pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI2_LOG10El), DELTA529, 0, 0); check_complex ("clog10 (-3 - inf i) == inf - pi/2*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (-3, minus_infty)), BUILD_COMPLEX (plus_infty, -M_PI2_LOG10El), DELTA530, 0, 0); check_complex ("clog10 (-inf + 0 i) == inf + pi*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (plus_infty, M_PI_LOG10El), DELTA531, 0, 0); check_complex ("clog10 (-inf + 1 i) == inf + pi*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (minus_infty, 1)), BUILD_COMPLEX (plus_infty, M_PI_LOG10El), DELTA532, 0, 0); check_complex ("clog10 (-inf - 0 i) == inf - pi*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, -M_PI_LOG10El), DELTA533, 0, 0); check_complex ("clog10 (-inf - 1 i) == inf - pi*log10(e) i", FUNC(clog10) (BUILD_COMPLEX (minus_infty, -1)), BUILD_COMPLEX (plus_infty, -M_PI_LOG10El), DELTA534, 0, 0); check_complex ("clog10 (inf + 0 i) == inf + 0.0 i", FUNC(clog10) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("clog10 (inf + 1 i) == inf + 0.0 i", FUNC(clog10) (BUILD_COMPLEX (plus_infty, 1)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("clog10 (inf - 0 i) == inf - 0 i", FUNC(clog10) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("clog10 (inf - 1 i) == inf - 0 i", FUNC(clog10) (BUILD_COMPLEX (plus_infty, -1)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("clog10 (inf + NaN i) == inf + NaN i", FUNC(clog10) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog10 (-inf + NaN i) == inf + NaN i", FUNC(clog10) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog10 (NaN + inf i) == inf + NaN i", FUNC(clog10) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog10 (NaN - inf i) == inf + NaN i", FUNC(clog10) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("clog10 (0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (3 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (3, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (-0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (-3 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (-3, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (NaN + 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (nan_value, 0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (NaN + 5 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (nan_value, 5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (NaN - 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (NaN - 5 i) == NaN + NaN i plus invalid exception allowed", FUNC(clog10) (BUILD_COMPLEX (nan_value, -5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("clog10 (NaN + NaN i) == NaN + NaN i", FUNC(clog10) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("clog10 (0.7 + 1.2 i) == 0.1427786545038868803 + 0.4528483579352493248 i", FUNC(clog10) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.1427786545038868803L, 0.4528483579352493248L), DELTA552, 0, 0); check_complex ("clog10 (-2 - 3 i) == 0.5569716761534183846 - 0.9375544629863747085 i", FUNC(clog10) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (0.5569716761534183846L, -0.9375544629863747085L), DELTA553, 0, 0); print_complex_max_error ("clog10", DELTAclog10, 0); } static void conj_test (void) { init_max_error (); check_complex ("conj (0.0 + 0.0 i) == 0.0 - 0 i", FUNC(conj) (BUILD_COMPLEX (0.0, 0.0)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("conj (0.0 - 0 i) == 0.0 + 0.0 i", FUNC(conj) (BUILD_COMPLEX (0.0, minus_zero)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("conj (NaN + NaN i) == NaN + NaN i", FUNC(conj) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("conj (inf - inf i) == inf + inf i", FUNC(conj) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("conj (inf + inf i) == inf - inf i", FUNC(conj) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("conj (1.0 + 2.0 i) == 1.0 - 2.0 i", FUNC(conj) (BUILD_COMPLEX (1.0, 2.0)), BUILD_COMPLEX (1.0, -2.0), 0, 0, 0); check_complex ("conj (3.0 - 4.0 i) == 3.0 + 4.0 i", FUNC(conj) (BUILD_COMPLEX (3.0, -4.0)), BUILD_COMPLEX (3.0, 4.0), 0, 0, 0); print_complex_max_error ("conj", 0, 0); } #endif static void copysign_test (void) { init_max_error (); check_float ("copysign (0, 4) == 0", FUNC(copysign) (0, 4), 0, 0, 0, 0); check_float ("copysign (0, -4) == -0", FUNC(copysign) (0, -4), minus_zero, 0, 0, 0); check_float ("copysign (-0, 4) == 0", FUNC(copysign) (minus_zero, 4), 0, 0, 0, 0); check_float ("copysign (-0, -4) == -0", FUNC(copysign) (minus_zero, -4), minus_zero, 0, 0, 0); check_float ("copysign (inf, 0) == inf", FUNC(copysign) (plus_infty, 0), plus_infty, 0, 0, 0); check_float ("copysign (inf, -0) == -inf", FUNC(copysign) (plus_infty, minus_zero), minus_infty, 0, 0, 0); check_float ("copysign (-inf, 0) == inf", FUNC(copysign) (minus_infty, 0), plus_infty, 0, 0, 0); check_float ("copysign (-inf, -0) == -inf", FUNC(copysign) (minus_infty, minus_zero), minus_infty, 0, 0, 0); check_float ("copysign (0, inf) == 0", FUNC(copysign) (0, plus_infty), 0, 0, 0, 0); check_float ("copysign (0, -0) == -0", FUNC(copysign) (0, minus_zero), minus_zero, 0, 0, 0); check_float ("copysign (-0, inf) == 0", FUNC(copysign) (minus_zero, plus_infty), 0, 0, 0, 0); check_float ("copysign (-0, -0) == -0", FUNC(copysign) (minus_zero, minus_zero), minus_zero, 0, 0, 0); /* XXX More correctly we would have to check the sign of the NaN. */ check_float ("copysign (NaN, 0) == NaN", FUNC(copysign) (nan_value, 0), nan_value, 0, 0, 0); check_float ("copysign (NaN, -0) == NaN", FUNC(copysign) (nan_value, minus_zero), nan_value, 0, 0, 0); check_float ("copysign (-NaN, 0) == NaN", FUNC(copysign) (-nan_value, 0), nan_value, 0, 0, 0); check_float ("copysign (-NaN, -0) == NaN", FUNC(copysign) (-nan_value, minus_zero), nan_value, 0, 0, 0); print_max_error ("copysign", 0, 0); } static void cos_test (void) { errno = 0; FUNC(cos) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("cos (0) == 1", FUNC(cos) (0), 1, 0, 0, 0); check_float ("cos (-0) == 1", FUNC(cos) (minus_zero), 1, 0, 0, 0); check_float ("cos (inf) == NaN plus invalid exception", FUNC(cos) (plus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("cos (-inf) == NaN plus invalid exception", FUNC(cos) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("cos (NaN) == NaN", FUNC(cos) (nan_value), nan_value, 0, 0, 0); check_float ("cos (M_PI_6l * 2.0) == 0.5", FUNC(cos) (M_PI_6l * 2.0), 0.5, DELTA582, 0, 0); check_float ("cos (M_PI_6l * 4.0) == -0.5", FUNC(cos) (M_PI_6l * 4.0), -0.5, DELTA583, 0, 0); check_float ("cos (pi/2) == 0", FUNC(cos) (M_PI_2l), 0, DELTA584, 0, 0); check_float ("cos (0.7) == 0.76484218728448842625585999019186495", FUNC(cos) (0.7L), 0.76484218728448842625585999019186495L, DELTA585, 0, 0); print_max_error ("cos", DELTAcos, 0); } static void cosh_test (void) { errno = 0; FUNC(cosh) (0.7L); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("cosh (0) == 1", FUNC(cosh) (0), 1, 0, 0, 0); check_float ("cosh (-0) == 1", FUNC(cosh) (minus_zero), 1, 0, 0, 0); #ifndef TEST_INLINE check_float ("cosh (inf) == inf", FUNC(cosh) (plus_infty), plus_infty, 0, 0, 0); check_float ("cosh (-inf) == inf", FUNC(cosh) (minus_infty), plus_infty, 0, 0, 0); #endif check_float ("cosh (NaN) == NaN", FUNC(cosh) (nan_value), nan_value, 0, 0, 0); check_float ("cosh (0.7) == 1.255169005630943018", FUNC(cosh) (0.7L), 1.255169005630943018L, DELTA591, 0, 0); print_max_error ("cosh", DELTAcosh, 0); } #if 0 /* XXX scp XXX */ static void cpow_test (void) { errno = 0; FUNC(cpow) (BUILD_COMPLEX (1, 0), BUILD_COMPLEX (0, 0)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("cpow (1 + 0 i, 0 + 0 i) == 1.0 + 0.0 i", FUNC(cpow) (BUILD_COMPLEX (1, 0), BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("cpow (2 + 0 i, 10 + 0 i) == 1024.0 + 0.0 i", FUNC(cpow) (BUILD_COMPLEX (2, 0), BUILD_COMPLEX (10, 0)), BUILD_COMPLEX (1024.0, 0.0), 0, 0, 0); check_complex ("cpow (e + 0 i, 0 + 2 * M_PIl i) == 1.0 + 0.0 i", FUNC(cpow) (BUILD_COMPLEX (M_El, 0), BUILD_COMPLEX (0, 2 * M_PIl)), BUILD_COMPLEX (1.0, 0.0), DELTA594, 0, 0); check_complex ("cpow (2 + 3 i, 4 + 0 i) == -119.0 - 120.0 i", FUNC(cpow) (BUILD_COMPLEX (2, 3), BUILD_COMPLEX (4, 0)), BUILD_COMPLEX (-119.0, -120.0), DELTA595, 0, 0); check_complex ("cpow (NaN + NaN i, NaN + NaN i) == NaN + NaN i", FUNC(cpow) (BUILD_COMPLEX (nan_value, nan_value), BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); print_complex_max_error ("cpow", DELTAcpow, 0); } static void cproj_test (void) { init_max_error (); check_complex ("cproj (0.0 + 0.0 i) == 0.0 + 0.0 i", FUNC(cproj) (BUILD_COMPLEX (0.0, 0.0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("cproj (-0 - 0 i) == -0 - 0 i", FUNC(cproj) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("cproj (0.0 - 0 i) == 0.0 - 0 i", FUNC(cproj) (BUILD_COMPLEX (0.0, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("cproj (-0 + 0.0 i) == -0 + 0.0 i", FUNC(cproj) (BUILD_COMPLEX (minus_zero, 0.0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("cproj (NaN + NaN i) == NaN + NaN i", FUNC(cproj) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("cproj (inf + inf i) == inf + 0.0 i", FUNC(cproj) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("cproj (inf - inf i) == inf - 0 i", FUNC(cproj) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("cproj (-inf + inf i) == inf + 0.0 i", FUNC(cproj) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("cproj (-inf - inf i) == inf - 0 i", FUNC(cproj) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("cproj (1.0 + 0.0 i) == 1.0 + 0.0 i", FUNC(cproj) (BUILD_COMPLEX (1.0, 0.0)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("cproj (2.0 + 3.0 i) == 0.2857142857142857142857142857142857 + 0.42857142857142857142857142857142855 i", FUNC(cproj) (BUILD_COMPLEX (2.0, 3.0)), BUILD_COMPLEX (0.2857142857142857142857142857142857L, 0.42857142857142857142857142857142855L), 0, 0, 0); print_complex_max_error ("cproj", 0, 0); } static void creal_test (void) { init_max_error (); check_float ("creal (0.0 + 1.0 i) == 0.0", FUNC(creal) (BUILD_COMPLEX (0.0, 1.0)), 0.0, 0, 0, 0); check_float ("creal (-0 + 1.0 i) == -0", FUNC(creal) (BUILD_COMPLEX (minus_zero, 1.0)), minus_zero, 0, 0, 0); check_float ("creal (NaN + 1.0 i) == NaN", FUNC(creal) (BUILD_COMPLEX (nan_value, 1.0)), nan_value, 0, 0, 0); check_float ("creal (NaN + NaN i) == NaN", FUNC(creal) (BUILD_COMPLEX (nan_value, nan_value)), nan_value, 0, 0, 0); check_float ("creal (inf + 1.0 i) == inf", FUNC(creal) (BUILD_COMPLEX (plus_infty, 1.0)), plus_infty, 0, 0, 0); check_float ("creal (-inf + 1.0 i) == -inf", FUNC(creal) (BUILD_COMPLEX (minus_infty, 1.0)), minus_infty, 0, 0, 0); check_float ("creal (2.0 + 3.0 i) == 2.0", FUNC(creal) (BUILD_COMPLEX (2.0, 3.0)), 2.0, 0, 0, 0); print_max_error ("creal", 0, 0); } static void csin_test (void) { errno = 0; FUNC(csin) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("csin (0.0 + 0.0 i) == 0.0 + 0.0 i", FUNC(csin) (BUILD_COMPLEX (0.0, 0.0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("csin (-0 + 0.0 i) == -0 + 0.0 i", FUNC(csin) (BUILD_COMPLEX (minus_zero, 0.0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("csin (0.0 - 0 i) == 0 - 0 i", FUNC(csin) (BUILD_COMPLEX (0.0, minus_zero)), BUILD_COMPLEX (0, minus_zero), 0, 0, 0); check_complex ("csin (-0 - 0 i) == -0 - 0 i", FUNC(csin) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("csin (0.0 + inf i) == 0.0 + inf i", FUNC(csin) (BUILD_COMPLEX (0.0, plus_infty)), BUILD_COMPLEX (0.0, plus_infty), 0, 0, 0); check_complex ("csin (-0 + inf i) == -0 + inf i", FUNC(csin) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (minus_zero, plus_infty), 0, 0, 0); check_complex ("csin (0.0 - inf i) == 0.0 - inf i", FUNC(csin) (BUILD_COMPLEX (0.0, minus_infty)), BUILD_COMPLEX (0.0, minus_infty), 0, 0, 0); check_complex ("csin (-0 - inf i) == -0 - inf i", FUNC(csin) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (minus_zero, minus_infty), 0, 0, 0); check_complex ("csin (inf + 0.0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (plus_infty, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (-inf + 0.0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (minus_infty, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (inf - 0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (-inf - 0 i) == NaN + 0.0 i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (inf + inf i) == NaN + inf i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (-inf + inf i) == NaN + inf i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (inf - inf i) == NaN + inf i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (-inf - inf i) == NaN + inf i plus invalid exception and sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csin (inf + 6.75 i) == NaN + NaN i plus invalid exception", FUNC(csin) (BUILD_COMPLEX (plus_infty, 6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csin (inf - 6.75 i) == NaN + NaN i plus invalid exception", FUNC(csin) (BUILD_COMPLEX (plus_infty, -6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csin (-inf + 6.75 i) == NaN + NaN i plus invalid exception", FUNC(csin) (BUILD_COMPLEX (minus_infty, 6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csin (-inf - 6.75 i) == NaN + NaN i plus invalid exception", FUNC(csin) (BUILD_COMPLEX (minus_infty, -6.75)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csin (4.625 + inf i) == -inf - inf i", FUNC(csin) (BUILD_COMPLEX (4.625, plus_infty)), BUILD_COMPLEX (minus_infty, minus_infty), 0, 0, 0); check_complex ("csin (4.625 - inf i) == -inf + inf i", FUNC(csin) (BUILD_COMPLEX (4.625, minus_infty)), BUILD_COMPLEX (minus_infty, plus_infty), 0, 0, 0); check_complex ("csin (-4.625 + inf i) == inf - inf i", FUNC(csin) (BUILD_COMPLEX (-4.625, plus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csin (-4.625 - inf i) == inf + inf i", FUNC(csin) (BUILD_COMPLEX (-4.625, minus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csin (NaN + 0.0 i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (nan_value, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csin (NaN - 0 i) == NaN + 0.0 i plus sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csin (NaN + inf i) == NaN + inf i plus sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csin (NaN - inf i) == NaN + inf i plus sign of zero/inf not specified", FUNC(csin) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csin (NaN + 9.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(csin) (BUILD_COMPLEX (nan_value, 9.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csin (NaN - 9.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(csin) (BUILD_COMPLEX (nan_value, -9.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csin (0.0 + NaN i) == 0.0 + NaN i", FUNC(csin) (BUILD_COMPLEX (0.0, nan_value)), BUILD_COMPLEX (0.0, nan_value), 0, 0, 0); check_complex ("csin (-0 + NaN i) == -0 + NaN i", FUNC(csin) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (minus_zero, nan_value), 0, 0, 0); check_complex ("csin (10.0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csin) (BUILD_COMPLEX (10.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csin (NaN - 10.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(csin) (BUILD_COMPLEX (nan_value, -10.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csin (inf + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csin) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csin (-inf + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csin) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csin (NaN + NaN i) == NaN + NaN i", FUNC(csin) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("csin (0.7 + 1.2 i) == 1.1664563419657581376 + 1.1544997246948547371 i", FUNC(csin) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (1.1664563419657581376L, 1.1544997246948547371L), DELTA652, 0, 0); check_complex ("csin (-2 - 3 i) == -9.1544991469114295734 + 4.1689069599665643507 i", FUNC(csin) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-9.1544991469114295734L, 4.1689069599665643507L), 0, 0, 0); print_complex_max_error ("csin", DELTAcsin, 0); } static void csinh_test (void) { errno = 0; FUNC(csinh) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("csinh (0.0 + 0.0 i) == 0.0 + 0.0 i", FUNC(csinh) (BUILD_COMPLEX (0.0, 0.0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("csinh (-0 + 0.0 i) == -0 + 0.0 i", FUNC(csinh) (BUILD_COMPLEX (minus_zero, 0.0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("csinh (0.0 - 0 i) == 0.0 - 0 i", FUNC(csinh) (BUILD_COMPLEX (0.0, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("csinh (-0 - 0 i) == -0 - 0 i", FUNC(csinh) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("csinh (0.0 + inf i) == 0.0 + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (0.0, plus_infty)), BUILD_COMPLEX (0.0, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (-0 + inf i) == 0.0 + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (0.0, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (0.0 - inf i) == 0.0 + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (0.0, minus_infty)), BUILD_COMPLEX (0.0, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (-0 - inf i) == 0.0 + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (0.0, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (inf + 0.0 i) == inf + 0.0 i", FUNC(csinh) (BUILD_COMPLEX (plus_infty, 0.0)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("csinh (-inf + 0.0 i) == -inf + 0.0 i", FUNC(csinh) (BUILD_COMPLEX (minus_infty, 0.0)), BUILD_COMPLEX (minus_infty, 0.0), 0, 0, 0); check_complex ("csinh (inf - 0 i) == inf - 0 i", FUNC(csinh) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("csinh (-inf - 0 i) == -inf - 0 i", FUNC(csinh) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (minus_infty, minus_zero), 0, 0, 0); check_complex ("csinh (inf + inf i) == inf + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (-inf + inf i) == inf + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (inf - inf i) == inf + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (-inf - inf i) == inf + NaN i plus invalid exception and sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN); check_complex ("csinh (inf + 4.625 i) == -inf - inf i", FUNC(csinh) (BUILD_COMPLEX (plus_infty, 4.625)), BUILD_COMPLEX (minus_infty, minus_infty), 0, 0, 0); check_complex ("csinh (-inf + 4.625 i) == inf - inf i", FUNC(csinh) (BUILD_COMPLEX (minus_infty, 4.625)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csinh (inf - 4.625 i) == -inf + inf i", FUNC(csinh) (BUILD_COMPLEX (plus_infty, -4.625)), BUILD_COMPLEX (minus_infty, plus_infty), 0, 0, 0); check_complex ("csinh (-inf - 4.625 i) == inf + inf i", FUNC(csinh) (BUILD_COMPLEX (minus_infty, -4.625)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csinh (6.75 + inf i) == NaN + NaN i plus invalid exception", FUNC(csinh) (BUILD_COMPLEX (6.75, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csinh (-6.75 + inf i) == NaN + NaN i plus invalid exception", FUNC(csinh) (BUILD_COMPLEX (-6.75, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csinh (6.75 - inf i) == NaN + NaN i plus invalid exception", FUNC(csinh) (BUILD_COMPLEX (6.75, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csinh (-6.75 - inf i) == NaN + NaN i plus invalid exception", FUNC(csinh) (BUILD_COMPLEX (-6.75, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("csinh (0.0 + NaN i) == 0.0 + NaN i plus sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (0.0, nan_value)), BUILD_COMPLEX (0.0, nan_value), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csinh (-0 + NaN i) == 0.0 + NaN i plus sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (0.0, nan_value), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csinh (inf + NaN i) == inf + NaN i plus sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csinh (-inf + NaN i) == inf + NaN i plus sign of zero/inf not specified", FUNC(csinh) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csinh (9.0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csinh) (BUILD_COMPLEX (9.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csinh (-9.0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csinh) (BUILD_COMPLEX (-9.0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csinh (NaN + 0.0 i) == NaN + 0.0 i", FUNC(csinh) (BUILD_COMPLEX (nan_value, 0.0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, 0); check_complex ("csinh (NaN - 0 i) == NaN - 0 i", FUNC(csinh) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, minus_zero), 0, 0, 0); check_complex ("csinh (NaN + 10.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(csinh) (BUILD_COMPLEX (nan_value, 10.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csinh (NaN - 10.0 i) == NaN + NaN i plus invalid exception allowed", FUNC(csinh) (BUILD_COMPLEX (nan_value, -10.0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csinh (NaN + inf i) == NaN + NaN i plus invalid exception allowed", FUNC(csinh) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csinh (NaN - inf i) == NaN + NaN i plus invalid exception allowed", FUNC(csinh) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csinh (NaN + NaN i) == NaN + NaN i", FUNC(csinh) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("csinh (0.7 + 1.2 i) == 0.27487868678117583582 + 1.1698665727426565139 i", FUNC(csinh) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.27487868678117583582L, 1.1698665727426565139L), DELTA691, 0, 0); check_complex ("csinh (-2 - 3 i) == 3.5905645899857799520 - 0.5309210862485198052 i", FUNC(csinh) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (3.5905645899857799520L, -0.5309210862485198052L), DELTA692, 0, 0); print_complex_max_error ("csinh", DELTAcsinh, 0); } static void csqrt_test (void) { errno = 0; FUNC(csqrt) (BUILD_COMPLEX (-1, 0)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("csqrt (0 + 0 i) == 0.0 + 0.0 i", FUNC(csqrt) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("csqrt (0 - 0 i) == 0 - 0 i", FUNC(csqrt) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0, minus_zero), 0, 0, 0); check_complex ("csqrt (-0 + 0 i) == 0.0 + 0.0 i", FUNC(csqrt) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("csqrt (-0 - 0 i) == 0.0 - 0 i", FUNC(csqrt) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("csqrt (-inf + 0 i) == 0.0 + inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (0.0, plus_infty), 0, 0, 0); check_complex ("csqrt (-inf + 6 i) == 0.0 + inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_infty, 6)), BUILD_COMPLEX (0.0, plus_infty), 0, 0, 0); check_complex ("csqrt (-inf - 0 i) == 0.0 - inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (0.0, minus_infty), 0, 0, 0); check_complex ("csqrt (-inf - 6 i) == 0.0 - inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_infty, -6)), BUILD_COMPLEX (0.0, minus_infty), 0, 0, 0); check_complex ("csqrt (inf + 0 i) == inf + 0.0 i", FUNC(csqrt) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("csqrt (inf + 6 i) == inf + 0.0 i", FUNC(csqrt) (BUILD_COMPLEX (plus_infty, 6)), BUILD_COMPLEX (plus_infty, 0.0), 0, 0, 0); check_complex ("csqrt (inf - 0 i) == inf - 0 i", FUNC(csqrt) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("csqrt (inf - 6 i) == inf - 0 i", FUNC(csqrt) (BUILD_COMPLEX (plus_infty, -6)), BUILD_COMPLEX (plus_infty, minus_zero), 0, 0, 0); check_complex ("csqrt (0 + inf i) == inf + inf i", FUNC(csqrt) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csqrt (4 + inf i) == inf + inf i", FUNC(csqrt) (BUILD_COMPLEX (4, plus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csqrt (inf + inf i) == inf + inf i", FUNC(csqrt) (BUILD_COMPLEX (plus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csqrt (-0 + inf i) == inf + inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csqrt (-4 + inf i) == inf + inf i", FUNC(csqrt) (BUILD_COMPLEX (-4, plus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csqrt (-inf + inf i) == inf + inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_infty, plus_infty)), BUILD_COMPLEX (plus_infty, plus_infty), 0, 0, 0); check_complex ("csqrt (0 - inf i) == inf - inf i", FUNC(csqrt) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csqrt (4 - inf i) == inf - inf i", FUNC(csqrt) (BUILD_COMPLEX (4, minus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csqrt (inf - inf i) == inf - inf i", FUNC(csqrt) (BUILD_COMPLEX (plus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csqrt (-0 - inf i) == inf - inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csqrt (-4 - inf i) == inf - inf i", FUNC(csqrt) (BUILD_COMPLEX (-4, minus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csqrt (-inf - inf i) == inf - inf i", FUNC(csqrt) (BUILD_COMPLEX (minus_infty, minus_infty)), BUILD_COMPLEX (plus_infty, minus_infty), 0, 0, 0); check_complex ("csqrt (-inf + NaN i) == NaN + inf i plus sign of zero/inf not specified", FUNC(csqrt) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (nan_value, plus_infty), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("csqrt (inf + NaN i) == inf + NaN i", FUNC(csqrt) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (plus_infty, nan_value), 0, 0, 0); check_complex ("csqrt (0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (1 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (1, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (-0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (-1 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (-1, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (NaN + 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (nan_value, 0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (NaN + 8 i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (nan_value, 8)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (NaN - 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (NaN - 8 i) == NaN + NaN i plus invalid exception allowed", FUNC(csqrt) (BUILD_COMPLEX (nan_value, -8)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("csqrt (NaN + NaN i) == NaN + NaN i", FUNC(csqrt) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("csqrt (16.0 - 30.0 i) == 5.0 - 3.0 i", FUNC(csqrt) (BUILD_COMPLEX (16.0, -30.0)), BUILD_COMPLEX (5.0, -3.0), 0, 0, 0); check_complex ("csqrt (-1 + 0 i) == 0.0 + 1.0 i", FUNC(csqrt) (BUILD_COMPLEX (-1, 0)), BUILD_COMPLEX (0.0, 1.0), 0, 0, 0); check_complex ("csqrt (0 + 2 i) == 1.0 + 1.0 i", FUNC(csqrt) (BUILD_COMPLEX (0, 2)), BUILD_COMPLEX (1.0, 1.0), 0, 0, 0); check_complex ("csqrt (119 + 120 i) == 12.0 + 5.0 i", FUNC(csqrt) (BUILD_COMPLEX (119, 120)), BUILD_COMPLEX (12.0, 5.0), 0, 0, 0); check_complex ("csqrt (0.7 + 1.2 i) == 1.022067610030026450706487883081139 + 0.58704531296356521154977678719838035 i", FUNC(csqrt) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (1.022067610030026450706487883081139L, 0.58704531296356521154977678719838035L), DELTA732, 0, 0); check_complex ("csqrt (-2 - 3 i) == 0.89597747612983812471573375529004348 - 1.6741492280355400404480393008490519 i", FUNC(csqrt) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (0.89597747612983812471573375529004348L, -1.6741492280355400404480393008490519L), DELTA733, 0, 0); check_complex ("csqrt (-2 + 3 i) == 0.89597747612983812471573375529004348 + 1.6741492280355400404480393008490519 i", FUNC(csqrt) (BUILD_COMPLEX (-2, 3)), BUILD_COMPLEX (0.89597747612983812471573375529004348L, 1.6741492280355400404480393008490519L), DELTA734, 0, 0); print_complex_max_error ("csqrt", DELTAcsqrt, 0); } static void ctan_test (void) { errno = 0; FUNC(ctan) (BUILD_COMPLEX (0.7L, 1.2L)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("ctan (0 + 0 i) == 0.0 + 0.0 i", FUNC(ctan) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("ctan (0 - 0 i) == 0.0 - 0 i", FUNC(ctan) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("ctan (-0 + 0 i) == -0 + 0.0 i", FUNC(ctan) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("ctan (-0 - 0 i) == -0 - 0 i", FUNC(ctan) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("ctan (0 + inf i) == 0.0 + 1.0 i", FUNC(ctan) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (0.0, 1.0), 0, 0, 0); check_complex ("ctan (1 + inf i) == 0.0 + 1.0 i", FUNC(ctan) (BUILD_COMPLEX (1, plus_infty)), BUILD_COMPLEX (0.0, 1.0), 0, 0, 0); check_complex ("ctan (-0 + inf i) == -0 + 1.0 i", FUNC(ctan) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (minus_zero, 1.0), 0, 0, 0); check_complex ("ctan (-1 + inf i) == -0 + 1.0 i", FUNC(ctan) (BUILD_COMPLEX (-1, plus_infty)), BUILD_COMPLEX (minus_zero, 1.0), 0, 0, 0); check_complex ("ctan (0 - inf i) == 0.0 - 1.0 i", FUNC(ctan) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (0.0, -1.0), 0, 0, 0); check_complex ("ctan (1 - inf i) == 0.0 - 1.0 i", FUNC(ctan) (BUILD_COMPLEX (1, minus_infty)), BUILD_COMPLEX (0.0, -1.0), 0, 0, 0); check_complex ("ctan (-0 - inf i) == -0 - 1.0 i", FUNC(ctan) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (minus_zero, -1.0), 0, 0, 0); check_complex ("ctan (-1 - inf i) == -0 - 1.0 i", FUNC(ctan) (BUILD_COMPLEX (-1, minus_infty)), BUILD_COMPLEX (minus_zero, -1.0), 0, 0, 0); check_complex ("ctan (inf + 0 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (inf + 2 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (plus_infty, 2)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (-inf + 0 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (-inf + 2 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (minus_infty, 2)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (inf - 0 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (inf - 2 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (plus_infty, -2)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (-inf - 0 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (-inf - 2 i) == NaN + NaN i plus invalid exception", FUNC(ctan) (BUILD_COMPLEX (minus_infty, -2)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctan (NaN + inf i) == 0.0 + 1.0 i plus sign of zero/inf not specified", FUNC(ctan) (BUILD_COMPLEX (nan_value, plus_infty)), BUILD_COMPLEX (0.0, 1.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ctan (NaN - inf i) == 0.0 - 1.0 i plus sign of zero/inf not specified", FUNC(ctan) (BUILD_COMPLEX (nan_value, minus_infty)), BUILD_COMPLEX (0.0, -1.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ctan (0 + NaN i) == 0.0 + NaN i", FUNC(ctan) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (0.0, nan_value), 0, 0, 0); check_complex ("ctan (-0 + NaN i) == -0 + NaN i", FUNC(ctan) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (minus_zero, nan_value), 0, 0, 0); check_complex ("ctan (0.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ctan) (BUILD_COMPLEX (0.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctan (-4.5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ctan) (BUILD_COMPLEX (-4.5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctan (NaN + 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(ctan) (BUILD_COMPLEX (nan_value, 0)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctan (NaN + 5 i) == NaN + NaN i plus invalid exception allowed", FUNC(ctan) (BUILD_COMPLEX (nan_value, 5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctan (NaN - 0 i) == NaN + NaN i plus invalid exception allowed", FUNC(ctan) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctan (NaN - 0.25 i) == NaN + NaN i plus invalid exception allowed", FUNC(ctan) (BUILD_COMPLEX (nan_value, -0.25)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctan (NaN + NaN i) == NaN + NaN i", FUNC(ctan) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("ctan (0.7 + 1.2 i) == 0.1720734197630349001 + 0.9544807059989405538 i", FUNC(ctan) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (0.1720734197630349001L, 0.9544807059989405538L), DELTA766, 0, 0); check_complex ("ctan (-2 - 3 i) == 0.0037640256415042482 - 1.0032386273536098014 i", FUNC(ctan) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (0.0037640256415042482L, -1.0032386273536098014L), DELTA767, 0, 0); print_complex_max_error ("ctan", DELTActan, 0); } static void ctanh_test (void) { errno = 0; FUNC(ctanh) (BUILD_COMPLEX (0, 0)); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_complex ("ctanh (0 + 0 i) == 0.0 + 0.0 i", FUNC(ctanh) (BUILD_COMPLEX (0, 0)), BUILD_COMPLEX (0.0, 0.0), 0, 0, 0); check_complex ("ctanh (0 - 0 i) == 0.0 - 0 i", FUNC(ctanh) (BUILD_COMPLEX (0, minus_zero)), BUILD_COMPLEX (0.0, minus_zero), 0, 0, 0); check_complex ("ctanh (-0 + 0 i) == -0 + 0.0 i", FUNC(ctanh) (BUILD_COMPLEX (minus_zero, 0)), BUILD_COMPLEX (minus_zero, 0.0), 0, 0, 0); check_complex ("ctanh (-0 - 0 i) == -0 - 0 i", FUNC(ctanh) (BUILD_COMPLEX (minus_zero, minus_zero)), BUILD_COMPLEX (minus_zero, minus_zero), 0, 0, 0); check_complex ("ctanh (inf + 0 i) == 1.0 + 0.0 i", FUNC(ctanh) (BUILD_COMPLEX (plus_infty, 0)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("ctanh (inf + 1 i) == 1.0 + 0.0 i", FUNC(ctanh) (BUILD_COMPLEX (plus_infty, 1)), BUILD_COMPLEX (1.0, 0.0), 0, 0, 0); check_complex ("ctanh (inf - 0 i) == 1.0 - 0 i", FUNC(ctanh) (BUILD_COMPLEX (plus_infty, minus_zero)), BUILD_COMPLEX (1.0, minus_zero), 0, 0, 0); check_complex ("ctanh (inf - 1 i) == 1.0 - 0 i", FUNC(ctanh) (BUILD_COMPLEX (plus_infty, -1)), BUILD_COMPLEX (1.0, minus_zero), 0, 0, 0); check_complex ("ctanh (-inf + 0 i) == -1.0 + 0.0 i", FUNC(ctanh) (BUILD_COMPLEX (minus_infty, 0)), BUILD_COMPLEX (-1.0, 0.0), 0, 0, 0); check_complex ("ctanh (-inf + 1 i) == -1.0 + 0.0 i", FUNC(ctanh) (BUILD_COMPLEX (minus_infty, 1)), BUILD_COMPLEX (-1.0, 0.0), 0, 0, 0); check_complex ("ctanh (-inf - 0 i) == -1.0 - 0 i", FUNC(ctanh) (BUILD_COMPLEX (minus_infty, minus_zero)), BUILD_COMPLEX (-1.0, minus_zero), 0, 0, 0); check_complex ("ctanh (-inf - 1 i) == -1.0 - 0 i", FUNC(ctanh) (BUILD_COMPLEX (minus_infty, -1)), BUILD_COMPLEX (-1.0, minus_zero), 0, 0, 0); check_complex ("ctanh (0 + inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (0, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (2 + inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (2, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (0 - inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (0, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (2 - inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (2, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (-0 + inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (minus_zero, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (-2 + inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (-2, plus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (-0 - inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (minus_zero, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (-2 - inf i) == NaN + NaN i plus invalid exception", FUNC(ctanh) (BUILD_COMPLEX (-2, minus_infty)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION); check_complex ("ctanh (inf + NaN i) == 1.0 + 0.0 i plus sign of zero/inf not specified", FUNC(ctanh) (BUILD_COMPLEX (plus_infty, nan_value)), BUILD_COMPLEX (1.0, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ctanh (-inf + NaN i) == -1.0 + 0.0 i plus sign of zero/inf not specified", FUNC(ctanh) (BUILD_COMPLEX (minus_infty, nan_value)), BUILD_COMPLEX (-1.0, 0.0), 0, 0, IGNORE_ZERO_INF_SIGN); check_complex ("ctanh (NaN + 0 i) == NaN + 0.0 i", FUNC(ctanh) (BUILD_COMPLEX (nan_value, 0)), BUILD_COMPLEX (nan_value, 0.0), 0, 0, 0); check_complex ("ctanh (NaN - 0 i) == NaN - 0 i", FUNC(ctanh) (BUILD_COMPLEX (nan_value, minus_zero)), BUILD_COMPLEX (nan_value, minus_zero), 0, 0, 0); check_complex ("ctanh (NaN + 0.5 i) == NaN + NaN i plus invalid exception allowed", FUNC(ctanh) (BUILD_COMPLEX (nan_value, 0.5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctanh (NaN - 4.5 i) == NaN + NaN i plus invalid exception allowed", FUNC(ctanh) (BUILD_COMPLEX (nan_value, -4.5)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctanh (0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ctanh) (BUILD_COMPLEX (0, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctanh (5 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ctanh) (BUILD_COMPLEX (5, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctanh (-0 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ctanh) (BUILD_COMPLEX (minus_zero, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctanh (-0.25 + NaN i) == NaN + NaN i plus invalid exception allowed", FUNC(ctanh) (BUILD_COMPLEX (-0.25, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, INVALID_EXCEPTION_OK); check_complex ("ctanh (NaN + NaN i) == NaN + NaN i", FUNC(ctanh) (BUILD_COMPLEX (nan_value, nan_value)), BUILD_COMPLEX (nan_value, nan_value), 0, 0, 0); check_complex ("ctanh (0 + pi/4 i) == 0.0 + 1.0 i", FUNC(ctanh) (BUILD_COMPLEX (0, M_PI_4l)), BUILD_COMPLEX (0.0, 1.0), DELTA799, 0, 0); check_complex ("ctanh (0.7 + 1.2 i) == 1.3472197399061191630 + 0.4778641038326365540 i", FUNC(ctanh) (BUILD_COMPLEX (0.7L, 1.2L)), BUILD_COMPLEX (1.3472197399061191630L, 0.4778641038326365540L), DELTA800, 0, 0); check_complex ("ctanh (-2 - 3 i) == -0.9653858790221331242 + 0.0098843750383224937 i", FUNC(ctanh) (BUILD_COMPLEX (-2, -3)), BUILD_COMPLEX (-0.9653858790221331242L, 0.0098843750383224937L), DELTA801, 0, 0); print_complex_max_error ("ctanh", DELTActanh, 0); } #endif static void erf_test (void) { errno = 0; FUNC(erf) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("erf (0) == 0", FUNC(erf) (0), 0, 0, 0, 0); check_float ("erf (-0) == -0", FUNC(erf) (minus_zero), minus_zero, 0, 0, 0); check_float ("erf (inf) == 1", FUNC(erf) (plus_infty), 1, 0, 0, 0); check_float ("erf (-inf) == -1", FUNC(erf) (minus_infty), -1, 0, 0, 0); check_float ("erf (NaN) == NaN", FUNC(erf) (nan_value), nan_value, 0, 0, 0); check_float ("erf (0.7) == 0.67780119383741847297", FUNC(erf) (0.7L), 0.67780119383741847297L, 0, 0, 0); check_float ("erf (1.2) == 0.91031397822963538024", FUNC(erf) (1.2L), 0.91031397822963538024L, 0, 0, 0); check_float ("erf (2.0) == 0.99532226501895273416", FUNC(erf) (2.0), 0.99532226501895273416L, 0, 0, 0); check_float ("erf (4.1) == 0.99999999329997234592", FUNC(erf) (4.1L), 0.99999999329997234592L, 0, 0, 0); check_float ("erf (27) == 1.0", FUNC(erf) (27), 1.0L, 0, 0, 0); print_max_error ("erf", 0, 0); } static void erfc_test (void) { errno = 0; FUNC(erfc) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("erfc (inf) == 0.0", FUNC(erfc) (plus_infty), 0.0, 0, 0, 0); check_float ("erfc (-inf) == 2.0", FUNC(erfc) (minus_infty), 2.0, 0, 0, 0); check_float ("erfc (0.0) == 1.0", FUNC(erfc) (0.0), 1.0, 0, 0, 0); check_float ("erfc (-0) == 1.0", FUNC(erfc) (minus_zero), 1.0, 0, 0, 0); check_float ("erfc (NaN) == NaN", FUNC(erfc) (nan_value), nan_value, 0, 0, 0); check_float ("erfc (0.7) == 0.32219880616258152702", FUNC(erfc) (0.7L), 0.32219880616258152702L, DELTA817, 0, 0); check_float ("erfc (1.2) == 0.089686021770364619762", FUNC(erfc) (1.2L), 0.089686021770364619762L, DELTA818, 0, 0); check_float ("erfc (2.0) == 0.0046777349810472658379", FUNC(erfc) (2.0), 0.0046777349810472658379L, DELTA819, 0, 0); check_float ("erfc (4.1) == 0.67000276540848983727e-8", FUNC(erfc) (4.1L), 0.67000276540848983727e-8L, DELTA820, 0, 0); check_float ("erfc (9) == 0.41370317465138102381e-36", FUNC(erfc) (9), 0.41370317465138102381e-36L, DELTA821, 0, 0); print_max_error ("erfc", DELTAerfc, 0); } static void exp_test (void) { errno = 0; FUNC(exp) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("exp (0) == 1", FUNC(exp) (0), 1, 0, 0, 0); check_float ("exp (-0) == 1", FUNC(exp) (minus_zero), 1, 0, 0, 0); #ifndef TEST_INLINE check_float ("exp (inf) == inf", FUNC(exp) (plus_infty), plus_infty, 0, 0, 0); check_float ("exp (-inf) == 0", FUNC(exp) (minus_infty), 0, 0, 0, 0); #endif check_float ("exp (NaN) == NaN", FUNC(exp) (nan_value), nan_value, 0, 0, 0); check_float ("exp (1) == e", FUNC(exp) (1), M_El, 0, 0, 0); check_float ("exp (2) == e^2", FUNC(exp) (2), M_E2l, 0, 0, 0); check_float ("exp (3) == e^3", FUNC(exp) (3), M_E3l, 0, 0, 0); check_float ("exp (0.7) == 2.0137527074704765216", FUNC(exp) (0.7L), 2.0137527074704765216L, DELTA830, 0, 0); check_float ("exp (50.0) == 5184705528587072464087.45332293348538", FUNC(exp) (50.0L), 5184705528587072464087.45332293348538L, DELTA831, 0, 0); #ifdef TEST_LDOUBLE /* The result can only be represented in long double. */ check_float ("exp (1000.0) == 0.197007111401704699388887935224332313e435", FUNC(exp) (1000.0L), 0.197007111401704699388887935224332313e435L, DELTA832, 0, 0); #endif print_max_error ("exp", DELTAexp, 0); } #if 0 /* XXX scp XXX */ static void exp10_test (void) { errno = 0; FUNC(exp10) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("exp10 (0) == 1", FUNC(exp10) (0), 1, 0, 0, 0); check_float ("exp10 (-0) == 1", FUNC(exp10) (minus_zero), 1, 0, 0, 0); check_float ("exp10 (inf) == inf", FUNC(exp10) (plus_infty), plus_infty, 0, 0, 0); check_float ("exp10 (-inf) == 0", FUNC(exp10) (minus_infty), 0, 0, 0, 0); check_float ("exp10 (NaN) == NaN", FUNC(exp10) (nan_value), nan_value, 0, 0, 0); check_float ("exp10 (3) == 1000", FUNC(exp10) (3), 1000, DELTA838, 0, 0); check_float ("exp10 (-1) == 0.1", FUNC(exp10) (-1), 0.1L, DELTA839, 0, 0); check_float ("exp10 (1e6) == inf", FUNC(exp10) (1e6), plus_infty, 0, 0, 0); check_float ("exp10 (-1e6) == 0", FUNC(exp10) (-1e6), 0, 0, 0, 0); check_float ("exp10 (0.7) == 5.0118723362727228500155418688494574", FUNC(exp10) (0.7L), 5.0118723362727228500155418688494574L, DELTA842, 0, 0); print_max_error ("exp10", DELTAexp10, 0); } #endif static void exp2_test (void) { errno = 0; FUNC(exp2) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("exp2 (0) == 1", FUNC(exp2) (0), 1, 0, 0, 0); check_float ("exp2 (-0) == 1", FUNC(exp2) (minus_zero), 1, 0, 0, 0); check_float ("exp2 (inf) == inf", FUNC(exp2) (plus_infty), plus_infty, 0, 0, 0); check_float ("exp2 (-inf) == 0", FUNC(exp2) (minus_infty), 0, 0, 0, 0); check_float ("exp2 (NaN) == NaN", FUNC(exp2) (nan_value), nan_value, 0, 0, 0); check_float ("exp2 (10) == 1024", FUNC(exp2) (10), 1024, 0, 0, 0); check_float ("exp2 (-1) == 0.5", FUNC(exp2) (-1), 0.5, 0, 0, 0); check_float ("exp2 (1e6) == inf", FUNC(exp2) (1e6), plus_infty, 0, 0, 0); check_float ("exp2 (-1e6) == 0", FUNC(exp2) (-1e6), 0, 0, 0, 0); check_float ("exp2 (0.7) == 1.6245047927124710452", FUNC(exp2) (0.7L), 1.6245047927124710452L, DELTA852, 0, 0); print_max_error ("exp2", DELTAexp2, 0); } static void expm1_test (void) { errno = 0; FUNC(expm1) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("expm1 (0) == 0", FUNC(expm1) (0), 0, 0, 0, 0); check_float ("expm1 (-0) == -0", FUNC(expm1) (minus_zero), minus_zero, 0, 0, 0); #ifndef TEST_INLINE check_float ("expm1 (inf) == inf", FUNC(expm1) (plus_infty), plus_infty, 0, 0, 0); check_float ("expm1 (-inf) == -1", FUNC(expm1) (minus_infty), -1, 0, 0, 0); #endif check_float ("expm1 (NaN) == NaN", FUNC(expm1) (nan_value), nan_value, 0, 0, 0); check_float ("expm1 (1) == M_El - 1.0", FUNC(expm1) (1), M_El - 1.0, 0, 0, 0); check_float ("expm1 (0.7) == 1.0137527074704765216", FUNC(expm1) (0.7L), 1.0137527074704765216L, DELTA859, 0, 0); print_max_error ("expm1", DELTAexpm1, 0); } static void fabs_test (void) { init_max_error (); check_float ("fabs (0) == 0", FUNC(fabs) ((FLOAT)0.0), 0, 0, 0, 0); check_float ("fabs (-0) == 0", FUNC(fabs) (minus_zero), 0, 0, 0, 0); check_float ("fabs (inf) == inf", FUNC(fabs) (plus_infty), plus_infty, 0, 0, 0); check_float ("fabs (-inf) == inf", FUNC(fabs) (minus_infty), plus_infty, 0, 0, 0); check_float ("fabs (NaN) == NaN", FUNC(fabs) (nan_value), nan_value, 0, 0, 0); check_float ("fabs (38.0) == 38.0", FUNC(fabs) ((FLOAT)38.0), 38.0, 0, 0, 0); check_float ("fabs (-e) == e", FUNC(fabs) ((FLOAT)-M_El), M_El, 0, 0, 0); print_max_error ("fabs", 0, 0); } static void fdim_test (void) { init_max_error (); check_float ("fdim (0, 0) == 0", FUNC(fdim) (0, 0), 0, 0, 0, 0); check_float ("fdim (9, 0) == 9", FUNC(fdim) (9, 0), 9, 0, 0, 0); check_float ("fdim (0, 9) == 0", FUNC(fdim) (0, 9), 0, 0, 0, 0); check_float ("fdim (-9, 0) == 0", FUNC(fdim) (-9, 0), 0, 0, 0, 0); check_float ("fdim (0, -9) == 9", FUNC(fdim) (0, -9), 9, 0, 0, 0); check_float ("fdim (inf, 9) == inf", FUNC(fdim) (plus_infty, 9), plus_infty, 0, 0, 0); check_float ("fdim (inf, -9) == inf", FUNC(fdim) (plus_infty, -9), plus_infty, 0, 0, 0); check_float ("fdim (-inf, 9) == 0", FUNC(fdim) (minus_infty, 9), 0, 0, 0, 0); check_float ("fdim (-inf, -9) == 0", FUNC(fdim) (minus_infty, -9), 0, 0, 0, 0); check_float ("fdim (9, -inf) == inf", FUNC(fdim) (9, minus_infty), plus_infty, 0, 0, 0); check_float ("fdim (-9, -inf) == inf", FUNC(fdim) (-9, minus_infty), plus_infty, 0, 0, 0); check_float ("fdim (9, inf) == 0", FUNC(fdim) (9, plus_infty), 0, 0, 0, 0); check_float ("fdim (-9, inf) == 0", FUNC(fdim) (-9, plus_infty), 0, 0, 0, 0); check_float ("fdim (0, NaN) == NaN", FUNC(fdim) (0, nan_value), nan_value, 0, 0, 0); check_float ("fdim (9, NaN) == NaN", FUNC(fdim) (9, nan_value), nan_value, 0, 0, 0); check_float ("fdim (-9, NaN) == NaN", FUNC(fdim) (-9, nan_value), nan_value, 0, 0, 0); check_float ("fdim (NaN, 9) == NaN", FUNC(fdim) (nan_value, 9), nan_value, 0, 0, 0); check_float ("fdim (NaN, -9) == NaN", FUNC(fdim) (nan_value, -9), nan_value, 0, 0, 0); check_float ("fdim (inf, NaN) == NaN", FUNC(fdim) (plus_infty, nan_value), nan_value, 0, 0, 0); check_float ("fdim (-inf, NaN) == NaN", FUNC(fdim) (minus_infty, nan_value), nan_value, 0, 0, 0); check_float ("fdim (NaN, inf) == NaN", FUNC(fdim) (nan_value, plus_infty), nan_value, 0, 0, 0); check_float ("fdim (NaN, -inf) == NaN", FUNC(fdim) (nan_value, minus_infty), nan_value, 0, 0, 0); check_float ("fdim (NaN, NaN) == NaN", FUNC(fdim) (nan_value, nan_value), nan_value, 0, 0, 0); print_max_error ("fdim", 0, 0); } static void floor_test (void) { init_max_error (); check_float ("floor (0.0) == 0.0", FUNC(floor) (0.0), 0.0, 0, 0, 0); check_float ("floor (-0) == -0", FUNC(floor) (minus_zero), minus_zero, 0, 0, 0); check_float ("floor (inf) == inf", FUNC(floor) (plus_infty), plus_infty, 0, 0, 0); check_float ("floor (-inf) == -inf", FUNC(floor) (minus_infty), minus_infty, 0, 0, 0); check_float ("floor (NaN) == NaN", FUNC(floor) (nan_value), nan_value, 0, 0, 0); check_float ("floor (pi) == 3.0", FUNC(floor) (M_PIl), 3.0, 0, 0, 0); check_float ("floor (-pi) == -4.0", FUNC(floor) (-M_PIl), -4.0, 0, 0, 0); print_max_error ("floor", 0, 0); } static void fma_test (void) { init_max_error (); check_float ("fma (1.0, 2.0, 3.0) == 5.0", FUNC(fma) (1.0, 2.0, 3.0), 5.0, 0, 0, 0); check_float ("fma (NaN, 2.0, 3.0) == NaN", FUNC(fma) (nan_value, 2.0, 3.0), nan_value, 0, 0, 0); check_float ("fma (1.0, NaN, 3.0) == NaN", FUNC(fma) (1.0, nan_value, 3.0), nan_value, 0, 0, 0); check_float ("fma (1.0, 2.0, NaN) == NaN plus invalid exception allowed", FUNC(fma) (1.0, 2.0, nan_value), nan_value, 0, 0, INVALID_EXCEPTION_OK); check_float ("fma (inf, 0.0, NaN) == NaN plus invalid exception allowed", FUNC(fma) (plus_infty, 0.0, nan_value), nan_value, 0, 0, INVALID_EXCEPTION_OK); check_float ("fma (-inf, 0.0, NaN) == NaN plus invalid exception allowed", FUNC(fma) (minus_infty, 0.0, nan_value), nan_value, 0, 0, INVALID_EXCEPTION_OK); check_float ("fma (0.0, inf, NaN) == NaN plus invalid exception allowed", FUNC(fma) (0.0, plus_infty, nan_value), nan_value, 0, 0, INVALID_EXCEPTION_OK); check_float ("fma (0.0, -inf, NaN) == NaN plus invalid exception allowed", FUNC(fma) (0.0, minus_infty, nan_value), nan_value, 0, 0, INVALID_EXCEPTION_OK); check_float ("fma (inf, 0.0, 1.0) == NaN plus invalid exception", FUNC(fma) (plus_infty, 0.0, 1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("fma (-inf, 0.0, 1.0) == NaN plus invalid exception", FUNC(fma) (minus_infty, 0.0, 1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("fma (0.0, inf, 1.0) == NaN plus invalid exception", FUNC(fma) (0.0, plus_infty, 1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("fma (0.0, -inf, 1.0) == NaN plus invalid exception", FUNC(fma) (0.0, minus_infty, 1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("fma (inf, inf, -inf) == NaN plus invalid exception", FUNC(fma) (plus_infty, plus_infty, minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("fma (-inf, inf, inf) == NaN plus invalid exception", FUNC(fma) (minus_infty, plus_infty, plus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("fma (inf, -inf, inf) == NaN plus invalid exception", FUNC(fma) (plus_infty, minus_infty, plus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("fma (-inf, -inf, -inf) == NaN plus invalid exception", FUNC(fma) (minus_infty, minus_infty, minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); print_max_error ("fma", 0, 0); } static void fmax_test (void) { init_max_error (); check_float ("fmax (0, 0) == 0", FUNC(fmax) (0, 0), 0, 0, 0, 0); check_float ("fmax (-0, -0) == -0", FUNC(fmax) (minus_zero, minus_zero), minus_zero, 0, 0, 0); check_float ("fmax (9, 0) == 9", FUNC(fmax) (9, 0), 9, 0, 0, 0); check_float ("fmax (0, 9) == 9", FUNC(fmax) (0, 9), 9, 0, 0, 0); check_float ("fmax (-9, 0) == 0", FUNC(fmax) (-9, 0), 0, 0, 0, 0); check_float ("fmax (0, -9) == 0", FUNC(fmax) (0, -9), 0, 0, 0, 0); check_float ("fmax (inf, 9) == inf", FUNC(fmax) (plus_infty, 9), plus_infty, 0, 0, 0); check_float ("fmax (0, inf) == inf", FUNC(fmax) (0, plus_infty), plus_infty, 0, 0, 0); check_float ("fmax (-9, inf) == inf", FUNC(fmax) (-9, plus_infty), plus_infty, 0, 0, 0); check_float ("fmax (inf, -9) == inf", FUNC(fmax) (plus_infty, -9), plus_infty, 0, 0, 0); check_float ("fmax (-inf, 9) == 9", FUNC(fmax) (minus_infty, 9), 9, 0, 0, 0); check_float ("fmax (-inf, -9) == -9", FUNC(fmax) (minus_infty, -9), -9, 0, 0, 0); check_float ("fmax (9, -inf) == 9", FUNC(fmax) (9, minus_infty), 9, 0, 0, 0); check_float ("fmax (-9, -inf) == -9", FUNC(fmax) (-9, minus_infty), -9, 0, 0, 0); check_float ("fmax (0, NaN) == 0", FUNC(fmax) (0, nan_value), 0, 0, 0, 0); check_float ("fmax (9, NaN) == 9", FUNC(fmax) (9, nan_value), 9, 0, 0, 0); check_float ("fmax (-9, NaN) == -9", FUNC(fmax) (-9, nan_value), -9, 0, 0, 0); check_float ("fmax (NaN, 0) == 0", FUNC(fmax) (nan_value, 0), 0, 0, 0, 0); check_float ("fmax (NaN, 9) == 9", FUNC(fmax) (nan_value, 9), 9, 0, 0, 0); check_float ("fmax (NaN, -9) == -9", FUNC(fmax) (nan_value, -9), -9, 0, 0, 0); check_float ("fmax (inf, NaN) == inf", FUNC(fmax) (plus_infty, nan_value), plus_infty, 0, 0, 0); check_float ("fmax (-inf, NaN) == -inf", FUNC(fmax) (minus_infty, nan_value), minus_infty, 0, 0, 0); check_float ("fmax (NaN, inf) == inf", FUNC(fmax) (nan_value, plus_infty), plus_infty, 0, 0, 0); check_float ("fmax (NaN, -inf) == -inf", FUNC(fmax) (nan_value, minus_infty), minus_infty, 0, 0, 0); check_float ("fmax (NaN, NaN) == NaN", FUNC(fmax) (nan_value, nan_value), nan_value, 0, 0, 0); print_max_error ("fmax", 0, 0); } static void fmin_test (void) { init_max_error (); check_float ("fmin (0, 0) == 0", FUNC(fmin) (0, 0), 0, 0, 0, 0); check_float ("fmin (-0, -0) == -0", FUNC(fmin) (minus_zero, minus_zero), minus_zero, 0, 0, 0); check_float ("fmin (9, 0) == 0", FUNC(fmin) (9, 0), 0, 0, 0, 0); check_float ("fmin (0, 9) == 0", FUNC(fmin) (0, 9), 0, 0, 0, 0); check_float ("fmin (-9, 0) == -9", FUNC(fmin) (-9, 0), -9, 0, 0, 0); check_float ("fmin (0, -9) == -9", FUNC(fmin) (0, -9), -9, 0, 0, 0); check_float ("fmin (inf, 9) == 9", FUNC(fmin) (plus_infty, 9), 9, 0, 0, 0); check_float ("fmin (9, inf) == 9", FUNC(fmin) (9, plus_infty), 9, 0, 0, 0); check_float ("fmin (inf, -9) == -9", FUNC(fmin) (plus_infty, -9), -9, 0, 0, 0); check_float ("fmin (-9, inf) == -9", FUNC(fmin) (-9, plus_infty), -9, 0, 0, 0); check_float ("fmin (-inf, 9) == -inf", FUNC(fmin) (minus_infty, 9), minus_infty, 0, 0, 0); check_float ("fmin (-inf, -9) == -inf", FUNC(fmin) (minus_infty, -9), minus_infty, 0, 0, 0); check_float ("fmin (9, -inf) == -inf", FUNC(fmin) (9, minus_infty), minus_infty, 0, 0, 0); check_float ("fmin (-9, -inf) == -inf", FUNC(fmin) (-9, minus_infty), minus_infty, 0, 0, 0); check_float ("fmin (0, NaN) == 0", FUNC(fmin) (0, nan_value), 0, 0, 0, 0); check_float ("fmin (9, NaN) == 9", FUNC(fmin) (9, nan_value), 9, 0, 0, 0); check_float ("fmin (-9, NaN) == -9", FUNC(fmin) (-9, nan_value), -9, 0, 0, 0); check_float ("fmin (NaN, 0) == 0", FUNC(fmin) (nan_value, 0), 0, 0, 0, 0); check_float ("fmin (NaN, 9) == 9", FUNC(fmin) (nan_value, 9), 9, 0, 0, 0); check_float ("fmin (NaN, -9) == -9", FUNC(fmin) (nan_value, -9), -9, 0, 0, 0); check_float ("fmin (inf, NaN) == inf", FUNC(fmin) (plus_infty, nan_value), plus_infty, 0, 0, 0); check_float ("fmin (-inf, NaN) == -inf", FUNC(fmin) (minus_infty, nan_value), minus_infty, 0, 0, 0); check_float ("fmin (NaN, inf) == inf", FUNC(fmin) (nan_value, plus_infty), plus_infty, 0, 0, 0); check_float ("fmin (NaN, -inf) == -inf", FUNC(fmin) (nan_value, minus_infty), minus_infty, 0, 0, 0); check_float ("fmin (NaN, NaN) == NaN", FUNC(fmin) (nan_value, nan_value), nan_value, 0, 0, 0); print_max_error ("fmin", 0, 0); } static void fmod_test (void) { errno = 0; FUNC(fmod) (6.5, 2.3L); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); /* fmod (+0, y) == +0 for y != 0. */ check_float ("fmod (0, 3) == 0", FUNC(fmod) (0, 3), 0, 0, 0, 0); /* fmod (-0, y) == -0 for y != 0. */ check_float ("fmod (-0, 3) == -0", FUNC(fmod) (minus_zero, 3), minus_zero, 0, 0, 0); /* fmod (+inf, y) == NaN plus invalid exception. */ check_float ("fmod (inf, 3) == NaN plus invalid exception", FUNC(fmod) (plus_infty, 3), nan_value, 0, 0, INVALID_EXCEPTION); /* fmod (-inf, y) == NaN plus invalid exception. */ check_float ("fmod (-inf, 3) == NaN plus invalid exception", FUNC(fmod) (minus_infty, 3), nan_value, 0, 0, INVALID_EXCEPTION); /* fmod (x, +0) == NaN plus invalid exception. */ check_float ("fmod (3, 0) == NaN plus invalid exception", FUNC(fmod) (3, 0), nan_value, 0, 0, INVALID_EXCEPTION); /* fmod (x, -0) == NaN plus invalid exception. */ check_float ("fmod (3, -0) == NaN plus invalid exception", FUNC(fmod) (3, minus_zero), nan_value, 0, 0, INVALID_EXCEPTION); /* fmod (x, +inf) == x for x not infinite. */ check_float ("fmod (3.0, inf) == 3.0", FUNC(fmod) (3.0, plus_infty), 3.0, 0, 0, 0); /* fmod (x, -inf) == x for x not infinite. */ check_float ("fmod (3.0, -inf) == 3.0", FUNC(fmod) (3.0, minus_infty), 3.0, 0, 0, 0); check_float ("fmod (NaN, NaN) == NaN", FUNC(fmod) (nan_value, nan_value), nan_value, 0, 0, 0); check_float ("fmod (6.5, 2.3) == 1.9", FUNC(fmod) (6.5, 2.3L), 1.9L, DELTA972, 0, 0); check_float ("fmod (-6.5, 2.3) == -1.9", FUNC(fmod) (-6.5, 2.3L), -1.9L, DELTA973, 0, 0); check_float ("fmod (6.5, -2.3) == 1.9", FUNC(fmod) (6.5, -2.3L), 1.9L, DELTA974, 0, 0); check_float ("fmod (-6.5, -2.3) == -1.9", FUNC(fmod) (-6.5, -2.3L), -1.9L, DELTA975, 0, 0); print_max_error ("fmod", DELTAfmod, 0); } static void fpclassify_test (void) { init_max_error (); check_int ("fpclassify (NaN) == FP_NAN", fpclassify (nan_value), FP_NAN, 0, 0, 0); check_int ("fpclassify (inf) == FP_INFINITE", fpclassify (plus_infty), FP_INFINITE, 0, 0, 0); check_int ("fpclassify (-inf) == FP_INFINITE", fpclassify (minus_infty), FP_INFINITE, 0, 0, 0); check_int ("fpclassify (+0) == FP_ZERO", fpclassify (plus_zero), FP_ZERO, 0, 0, 0); check_int ("fpclassify (-0) == FP_ZERO", fpclassify (minus_zero), FP_ZERO, 0, 0, 0); check_int ("fpclassify (1000) == FP_NORMAL", fpclassify (1000.0), FP_NORMAL, 0, 0, 0); print_max_error ("fpclassify", 0, 0); } static void frexp_test (void) { int x; init_max_error (); check_float ("frexp (inf, &x) == inf", FUNC(frexp) (plus_infty, &x), plus_infty, 0, 0, 0); check_float ("frexp (-inf, &x) == -inf", FUNC(frexp) (minus_infty, &x), minus_infty, 0, 0, 0); check_float ("frexp (NaN, &x) == NaN", FUNC(frexp) (nan_value, &x), nan_value, 0, 0, 0); check_float ("frexp (0.0, &x) == 0.0", FUNC(frexp) (0.0, &x), 0.0, 0, 0, 0); check_int ("frexp (0.0, &x) sets x to 0.0", x, 0.0, 0, 0, 0); check_float ("frexp (-0, &x) == -0", FUNC(frexp) (minus_zero, &x), minus_zero, 0, 0, 0); check_int ("frexp (-0, &x) sets x to 0.0", x, 0.0, 0, 0, 0); check_float ("frexp (12.8, &x) == 0.8", FUNC(frexp) (12.8L, &x), 0.8L, 0, 0, 0); check_int ("frexp (12.8, &x) sets x to 4", x, 4, 0, 0, 0); check_float ("frexp (-27.34, &x) == -0.854375", FUNC(frexp) (-27.34L, &x), -0.854375L, 0, 0, 0); check_int ("frexp (-27.34, &x) sets x to 5", x, 5, 0, 0, 0); print_max_error ("frexp", 0, 0); } #define gamma lgamma /* XXX scp XXX */ #define gammaf lgammaf /* XXX scp XXX */ static void gamma_test (void) { errno = 0; FUNC(gamma) (1); if (errno == ENOSYS) /* Function not implemented. */ return; feclearexcept (FE_ALL_EXCEPT); init_max_error (); signgam = 0; check_float ("gamma (inf) == inf", FUNC(gamma) (plus_infty), plus_infty, 0, 0, 0); signgam = 0; check_float ("gamma (0) == inf plus division by zero exception", FUNC(gamma) (0), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); signgam = 0; check_float ("gamma (-3) == inf plus division by zero exception", FUNC(gamma) (-3), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); signgam = 0; check_float ("gamma (-inf) == inf", FUNC(gamma) (minus_infty), plus_infty, 0, 0, 0); signgam = 0; check_float ("gamma (NaN) == NaN", FUNC(gamma) (nan_value), nan_value, 0, 0, 0); signgam = 0; check_float ("gamma (1) == 0", FUNC(gamma) (1), 0, 0, 0, 0); check_int ("gamma (1) sets signgam to 1", signgam, 1, 0, 0, 0); signgam = 0; check_float ("gamma (3) == M_LN2l", FUNC(gamma) (3), M_LN2l, 0, 0, 0); check_int ("gamma (3) sets signgam to 1", signgam, 1, 0, 0, 0); signgam = 0; check_float ("gamma (0.5) == log(sqrt(pi))", FUNC(gamma) (0.5), M_LOG_SQRT_PIl, 0, 0, 0); check_int ("gamma (0.5) sets signgam to 1", signgam, 1, 0, 0, 0); signgam = 0; check_float ("gamma (-0.5) == log(2*sqrt(pi))", FUNC(gamma) (-0.5), M_LOG_2_SQRT_PIl, DELTA1004, 0, 0); check_int ("gamma (-0.5) sets signgam to -1", signgam, -1, 0, 0, 0); print_max_error ("gamma", DELTAgamma, 0); } #undef gamma /* XXX scp XXX */ #undef gammaf /* XXX scp XXX */ static void hypot_test (void) { errno = 0; FUNC(hypot) (0.7L, 12.4L); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("hypot (inf, 1) == inf plus sign of zero/inf not specified", FUNC(hypot) (plus_infty, 1), plus_infty, 0, 0, IGNORE_ZERO_INF_SIGN); check_float ("hypot (-inf, 1) == inf plus sign of zero/inf not specified", FUNC(hypot) (minus_infty, 1), plus_infty, 0, 0, IGNORE_ZERO_INF_SIGN); #ifndef TEST_INLINE check_float ("hypot (inf, NaN) == inf", FUNC(hypot) (plus_infty, nan_value), plus_infty, 0, 0, 0); check_float ("hypot (-inf, NaN) == inf", FUNC(hypot) (minus_infty, nan_value), plus_infty, 0, 0, 0); check_float ("hypot (NaN, inf) == inf", FUNC(hypot) (nan_value, plus_infty), plus_infty, 0, 0, 0); check_float ("hypot (NaN, -inf) == inf", FUNC(hypot) (nan_value, minus_infty), plus_infty, 0, 0, 0); #endif check_float ("hypot (NaN, NaN) == NaN", FUNC(hypot) (nan_value, nan_value), nan_value, 0, 0, 0); /* hypot (x,y) == hypot (+-x, +-y) */ check_float ("hypot (0.7, 12.4) == 12.419742348374220601176836866763271", FUNC(hypot) (0.7L, 12.4L), 12.419742348374220601176836866763271L, DELTA1013, 0, 0); check_float ("hypot (-0.7, 12.4) == 12.419742348374220601176836866763271", FUNC(hypot) (-0.7L, 12.4L), 12.419742348374220601176836866763271L, DELTA1014, 0, 0); check_float ("hypot (0.7, -12.4) == 12.419742348374220601176836866763271", FUNC(hypot) (0.7L, -12.4L), 12.419742348374220601176836866763271L, DELTA1015, 0, 0); check_float ("hypot (-0.7, -12.4) == 12.419742348374220601176836866763271", FUNC(hypot) (-0.7L, -12.4L), 12.419742348374220601176836866763271L, DELTA1016, 0, 0); check_float ("hypot (12.4, 0.7) == 12.419742348374220601176836866763271", FUNC(hypot) (12.4L, 0.7L), 12.419742348374220601176836866763271L, DELTA1017, 0, 0); check_float ("hypot (-12.4, 0.7) == 12.419742348374220601176836866763271", FUNC(hypot) (-12.4L, 0.7L), 12.419742348374220601176836866763271L, DELTA1018, 0, 0); check_float ("hypot (12.4, -0.7) == 12.419742348374220601176836866763271", FUNC(hypot) (12.4L, -0.7L), 12.419742348374220601176836866763271L, DELTA1019, 0, 0); check_float ("hypot (-12.4, -0.7) == 12.419742348374220601176836866763271", FUNC(hypot) (-12.4L, -0.7L), 12.419742348374220601176836866763271L, DELTA1020, 0, 0); /* hypot (x,0) == fabs (x) */ check_float ("hypot (0.7, 0) == 0.7", FUNC(hypot) (0.7L, 0), 0.7L, 0, 0, 0); check_float ("hypot (-0.7, 0) == 0.7", FUNC(hypot) (-0.7L, 0), 0.7L, 0, 0, 0); check_float ("hypot (-5.7e7, 0) == 5.7e7", FUNC(hypot) (-5.7e7, 0), 5.7e7L, 0, 0, 0); check_float ("hypot (0.7, 1.2) == 1.3892443989449804508432547041028554", FUNC(hypot) (0.7L, 1.2L), 1.3892443989449804508432547041028554L, DELTA1024, 0, 0); print_max_error ("hypot", DELTAhypot, 0); } static void ilogb_test (void) { init_max_error (); check_int ("ilogb (1) == 0", FUNC(ilogb) (1), 0, 0, 0, 0); check_int ("ilogb (e) == 1", FUNC(ilogb) (M_El), 1, 0, 0, 0); check_int ("ilogb (1024) == 10", FUNC(ilogb) (1024), 10, 0, 0, 0); check_int ("ilogb (-2000) == 10", FUNC(ilogb) (-2000), 10, 0, 0, 0); /* XXX We have a problem here: the standard does not tell us whether exceptions are allowed/required. ignore them for now. */ check_int ("ilogb (0.0) == FP_ILOGB0 plus exceptions allowed", FUNC(ilogb) (0.0), FP_ILOGB0, 0, 0, EXCEPTIONS_OK); check_int ("ilogb (NaN) == FP_ILOGBNAN plus exceptions allowed", FUNC(ilogb) (nan_value), FP_ILOGBNAN, 0, 0, EXCEPTIONS_OK); check_int ("ilogb (inf) == INT_MAX plus exceptions allowed", FUNC(ilogb) (plus_infty), INT_MAX, 0, 0, EXCEPTIONS_OK); check_int ("ilogb (-inf) == INT_MAX plus exceptions allowed", FUNC(ilogb) (minus_infty), INT_MAX, 0, 0, EXCEPTIONS_OK); print_max_error ("ilogb", 0, 0); } static void isfinite_test (void) { init_max_error (); check_bool ("isfinite (0) == true", isfinite (0.0), 1, 0, 0, 0); check_bool ("isfinite (-0) == true", isfinite (minus_zero), 1, 0, 0, 0); check_bool ("isfinite (10) == true", isfinite (10.0), 1, 0, 0, 0); check_bool ("isfinite (inf) == false", isfinite (plus_infty), 0, 0, 0, 0); check_bool ("isfinite (-inf) == false", isfinite (minus_infty), 0, 0, 0, 0); check_bool ("isfinite (NaN) == false", isfinite (nan_value), 0, 0, 0, 0); print_max_error ("isfinite", 0, 0); } static void isnormal_test (void) { init_max_error (); check_bool ("isnormal (0) == false", isnormal (0.0), 0, 0, 0, 0); check_bool ("isnormal (-0) == false", isnormal (minus_zero), 0, 0, 0, 0); check_bool ("isnormal (10) == true", isnormal (10.0), 1, 0, 0, 0); check_bool ("isnormal (inf) == false", isnormal (plus_infty), 0, 0, 0, 0); check_bool ("isnormal (-inf) == false", isnormal (minus_infty), 0, 0, 0, 0); check_bool ("isnormal (NaN) == false", isnormal (nan_value), 0, 0, 0, 0); print_max_error ("isnormal", 0, 0); } static void j0_test (void) { FLOAT s, c; errno = 0; FUNC (sincos) (0, &s, &c); if (errno == ENOSYS) /* Required function not implemented. */ return; FUNC(j0) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); /* j0 is the Bessel function of the first kind of order 0 */ check_float ("j0 (NaN) == NaN", FUNC(j0) (nan_value), nan_value, 0, 0, 0); check_float ("j0 (inf) == 0", FUNC(j0) (plus_infty), 0, 0, 0, 0); check_float ("j0 (-1.0) == 0.76519768655796655145", FUNC(j0) (-1.0), 0.76519768655796655145L, 0, 0, 0); check_float ("j0 (0.0) == 1.0", FUNC(j0) (0.0), 1.0, 0, 0, 0); check_float ("j0 (0.1) == 0.99750156206604003228", FUNC(j0) (0.1L), 0.99750156206604003228L, 0, 0, 0); check_float ("j0 (0.7) == 0.88120088860740528084", FUNC(j0) (0.7L), 0.88120088860740528084L, 0, 0, 0); check_float ("j0 (1.0) == 0.76519768655796655145", FUNC(j0) (1.0), 0.76519768655796655145L, 0, 0, 0); check_float ("j0 (1.5) == 0.51182767173591812875", FUNC(j0) (1.5), 0.51182767173591812875L, 0, 0, 0); check_float ("j0 (2.0) == 0.22389077914123566805", FUNC(j0) (2.0), 0.22389077914123566805L, DELTA1053, 0, 0); check_float ("j0 (8.0) == 0.17165080713755390609", FUNC(j0) (8.0), 0.17165080713755390609L, DELTA1054, 0, 0); check_float ("j0 (10.0) == -0.24593576445134833520", FUNC(j0) (10.0), -0.24593576445134833520L, DELTA1055, 0, 0); print_max_error ("j0", DELTAj0, 0); } static void j1_test (void) { FLOAT s, c; errno = 0; FUNC (sincos) (0, &s, &c); if (errno == ENOSYS) /* Required function not implemented. */ return; FUNC(j1) (0); if (errno == ENOSYS) /* Function not implemented. */ return; /* j1 is the Bessel function of the first kind of order 1 */ init_max_error (); check_float ("j1 (NaN) == NaN", FUNC(j1) (nan_value), nan_value, 0, 0, 0); check_float ("j1 (inf) == 0", FUNC(j1) (plus_infty), 0, 0, 0, 0); check_float ("j1 (-1.0) == -0.44005058574493351596", FUNC(j1) (-1.0), -0.44005058574493351596L, 0, 0, 0); check_float ("j1 (0.0) == 0.0", FUNC(j1) (0.0), 0.0, 0, 0, 0); check_float ("j1 (0.1) == 0.049937526036241997556", FUNC(j1) (0.1L), 0.049937526036241997556L, 0, 0, 0); check_float ("j1 (0.7) == 0.32899574154005894785", FUNC(j1) (0.7L), 0.32899574154005894785L, 0, 0, 0); check_float ("j1 (1.0) == 0.44005058574493351596", FUNC(j1) (1.0), 0.44005058574493351596L, 0, 0, 0); check_float ("j1 (1.5) == 0.55793650791009964199", FUNC(j1) (1.5), 0.55793650791009964199L, 0, 0, 0); check_float ("j1 (2.0) == 0.57672480775687338720", FUNC(j1) (2.0), 0.57672480775687338720L, DELTA1064, 0, 0); check_float ("j1 (8.0) == 0.23463634685391462438", FUNC(j1) (8.0), 0.23463634685391462438L, DELTA1065, 0, 0); check_float ("j1 (10.0) == 0.043472746168861436670", FUNC(j1) (10.0), 0.043472746168861436670L, DELTA1066, 0, 0); print_max_error ("j1", DELTAj1, 0); } static void jn_test (void) { FLOAT s, c; errno = 0; FUNC (sincos) (0, &s, &c); if (errno == ENOSYS) /* Required function not implemented. */ return; FUNC(jn) (1, 1); if (errno == ENOSYS) /* Function not implemented. */ return; /* jn is the Bessel function of the first kind of order n. */ init_max_error (); /* jn (0, x) == j0 (x) */ check_float ("jn (0, NaN) == NaN", FUNC(jn) (0, nan_value), nan_value, 0, 0, 0); check_float ("jn (0, inf) == 0", FUNC(jn) (0, plus_infty), 0, 0, 0, 0); check_float ("jn (0, -1.0) == 0.76519768655796655145", FUNC(jn) (0, -1.0), 0.76519768655796655145L, 0, 0, 0); check_float ("jn (0, 0.0) == 1.0", FUNC(jn) (0, 0.0), 1.0, 0, 0, 0); check_float ("jn (0, 0.1) == 0.99750156206604003228", FUNC(jn) (0, 0.1L), 0.99750156206604003228L, 0, 0, 0); check_float ("jn (0, 0.7) == 0.88120088860740528084", FUNC(jn) (0, 0.7L), 0.88120088860740528084L, 0, 0, 0); check_float ("jn (0, 1.0) == 0.76519768655796655145", FUNC(jn) (0, 1.0), 0.76519768655796655145L, 0, 0, 0); check_float ("jn (0, 1.5) == 0.51182767173591812875", FUNC(jn) (0, 1.5), 0.51182767173591812875L, 0, 0, 0); check_float ("jn (0, 2.0) == 0.22389077914123566805", FUNC(jn) (0, 2.0), 0.22389077914123566805L, DELTA1075, 0, 0); check_float ("jn (0, 8.0) == 0.17165080713755390609", FUNC(jn) (0, 8.0), 0.17165080713755390609L, DELTA1076, 0, 0); check_float ("jn (0, 10.0) == -0.24593576445134833520", FUNC(jn) (0, 10.0), -0.24593576445134833520L, DELTA1077, 0, 0); /* jn (1, x) == j1 (x) */ check_float ("jn (1, NaN) == NaN", FUNC(jn) (1, nan_value), nan_value, 0, 0, 0); check_float ("jn (1, inf) == 0", FUNC(jn) (1, plus_infty), 0, 0, 0, 0); check_float ("jn (1, -1.0) == -0.44005058574493351596", FUNC(jn) (1, -1.0), -0.44005058574493351596L, 0, 0, 0); check_float ("jn (1, 0.0) == 0.0", FUNC(jn) (1, 0.0), 0.0, 0, 0, 0); check_float ("jn (1, 0.1) == 0.049937526036241997556", FUNC(jn) (1, 0.1L), 0.049937526036241997556L, 0, 0, 0); check_float ("jn (1, 0.7) == 0.32899574154005894785", FUNC(jn) (1, 0.7L), 0.32899574154005894785L, 0, 0, 0); check_float ("jn (1, 1.0) == 0.44005058574493351596", FUNC(jn) (1, 1.0), 0.44005058574493351596L, 0, 0, 0); check_float ("jn (1, 1.5) == 0.55793650791009964199", FUNC(jn) (1, 1.5), 0.55793650791009964199L, 0, 0, 0); check_float ("jn (1, 2.0) == 0.57672480775687338720", FUNC(jn) (1, 2.0), 0.57672480775687338720L, DELTA1086, 0, 0); check_float ("jn (1, 8.0) == 0.23463634685391462438", FUNC(jn) (1, 8.0), 0.23463634685391462438L, DELTA1087, 0, 0); check_float ("jn (1, 10.0) == 0.043472746168861436670", FUNC(jn) (1, 10.0), 0.043472746168861436670L, DELTA1088, 0, 0); /* jn (3, x) */ check_float ("jn (3, NaN) == NaN", FUNC(jn) (3, nan_value), nan_value, 0, 0, 0); check_float ("jn (3, inf) == 0", FUNC(jn) (3, plus_infty), 0, 0, 0, 0); check_float ("jn (3, -1.0) == -0.019563353982668405919", FUNC(jn) (3, -1.0), -0.019563353982668405919L, DELTA1091, 0, 0); check_float ("jn (3, 0.0) == 0.0", FUNC(jn) (3, 0.0), 0.0, 0, 0, 0); check_float ("jn (3, 0.1) == 0.000020820315754756261429", FUNC(jn) (3, 0.1L), 0.000020820315754756261429L, DELTA1093, 0, 0); check_float ("jn (3, 0.7) == 0.0069296548267508408077", FUNC(jn) (3, 0.7L), 0.0069296548267508408077L, DELTA1094, 0, 0); check_float ("jn (3, 1.0) == 0.019563353982668405919", FUNC(jn) (3, 1.0), 0.019563353982668405919L, DELTA1095, 0, 0); check_float ("jn (3, 2.0) == 0.12894324947440205110", FUNC(jn) (3, 2.0), 0.12894324947440205110L, DELTA1096, 0, 0); check_float ("jn (3, 10.0) == 0.058379379305186812343", FUNC(jn) (3, 10.0), 0.058379379305186812343L, DELTA1097, 0, 0); /* jn (10, x) */ check_float ("jn (10, NaN) == NaN", FUNC(jn) (10, nan_value), nan_value, 0, 0, 0); check_float ("jn (10, inf) == 0", FUNC(jn) (10, plus_infty), 0, 0, 0, 0); check_float ("jn (10, -1.0) == 0.26306151236874532070e-9", FUNC(jn) (10, -1.0), 0.26306151236874532070e-9L, DELTA1100, 0, 0); check_float ("jn (10, 0.0) == 0.0", FUNC(jn) (10, 0.0), 0.0, 0, 0, 0); check_float ("jn (10, 0.1) == 0.26905328954342155795e-19", FUNC(jn) (10, 0.1L), 0.26905328954342155795e-19L, DELTA1102, 0, 0); check_float ("jn (10, 0.7) == 0.75175911502153953928e-11", FUNC(jn) (10, 0.7L), 0.75175911502153953928e-11L, DELTA1103, 0, 0); check_float ("jn (10, 1.0) == 0.26306151236874532070e-9", FUNC(jn) (10, 1.0), 0.26306151236874532070e-9L, DELTA1104, 0, 0); check_float ("jn (10, 2.0) == 0.25153862827167367096e-6", FUNC(jn) (10, 2.0), 0.25153862827167367096e-6L, DELTA1105, 0, 0); check_float ("jn (10, 10.0) == 0.20748610663335885770", FUNC(jn) (10, 10.0), 0.20748610663335885770L, DELTA1106, 0, 0); print_max_error ("jn", DELTAjn, 0); } static void ldexp_test (void) { check_float ("ldexp (0, 0) == 0", FUNC(ldexp) (0, 0), 0, 0, 0, 0); check_float ("ldexp (-0, 0) == -0", FUNC(ldexp) (minus_zero, 0), minus_zero, 0, 0, 0); check_float ("ldexp (inf, 1) == inf", FUNC(ldexp) (plus_infty, 1), plus_infty, 0, 0, 0); check_float ("ldexp (-inf, 1) == -inf", FUNC(ldexp) (minus_infty, 1), minus_infty, 0, 0, 0); check_float ("ldexp (NaN, 1) == NaN", FUNC(ldexp) (nan_value, 1), nan_value, 0, 0, 0); check_float ("ldexp (0.8, 4) == 12.8", FUNC(ldexp) (0.8L, 4), 12.8L, 0, 0, 0); check_float ("ldexp (-0.854375, 5) == -27.34", FUNC(ldexp) (-0.854375L, 5), -27.34L, 0, 0, 0); /* ldexp (x, 0) == x. */ check_float ("ldexp (1.0, 0) == 1.0", FUNC(ldexp) (1.0L, 0L), 1.0L, 0, 0, 0); } static void lgamma_test (void) { errno = 0; FUNC(lgamma) (0); if (errno == ENOSYS) /* Function not implemented. */ return; feclearexcept (FE_ALL_EXCEPT); init_max_error (); signgam = 0; check_float ("lgamma (inf) == inf", FUNC(lgamma) (plus_infty), plus_infty, 0, 0, 0); signgam = 0; check_float ("lgamma (0) == inf plus division by zero exception", FUNC(lgamma) (0), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); signgam = 0; check_float ("lgamma (NaN) == NaN", FUNC(lgamma) (nan_value), nan_value, 0, 0, 0); /* lgamma (x) == +inf plus divide by zero exception for integer x <= 0. */ signgam = 0; check_float ("lgamma (-3) == inf plus division by zero exception", FUNC(lgamma) (-3), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); signgam = 0; check_float ("lgamma (-inf) == inf", FUNC(lgamma) (minus_infty), plus_infty, 0, 0, 0); signgam = 0; check_float ("lgamma (1) == 0", FUNC(lgamma) (1), 0, 0, 0, 0); check_int ("lgamma (1) sets signgam to 1", signgam, 1, 0, 0, 0); signgam = 0; check_float ("lgamma (3) == M_LN2l", FUNC(lgamma) (3), M_LN2l, 0, 0, 0); check_int ("lgamma (3) sets signgam to 1", signgam, 1, 0, 0, 0); signgam = 0; check_float ("lgamma (0.5) == log(sqrt(pi))", FUNC(lgamma) (0.5), M_LOG_SQRT_PIl, 0, 0, 0); check_int ("lgamma (0.5) sets signgam to 1", signgam, 1, 0, 0, 0); signgam = 0; check_float ("lgamma (-0.5) == log(2*sqrt(pi))", FUNC(lgamma) (-0.5), M_LOG_2_SQRT_PIl, DELTA1126, 0, 0); check_int ("lgamma (-0.5) sets signgam to -1", signgam, -1, 0, 0, 0); signgam = 0; check_float ("lgamma (0.7) == 0.26086724653166651439", FUNC(lgamma) (0.7L), 0.26086724653166651439L, DELTA1128, 0, 0); check_int ("lgamma (0.7) sets signgam to 1", signgam, 1, 0, 0, 0); signgam = 0; check_float ("lgamma (1.2) == -0.853740900033158497197e-1", FUNC(lgamma) (1.2L), -0.853740900033158497197e-1L, DELTA1130, 0, 0); check_int ("lgamma (1.2) sets signgam to 1", signgam, 1, 0, 0, 0); print_max_error ("lgamma", DELTAlgamma, 0); } static void lrint_test (void) { /* XXX this test is incomplete. We need to have a way to specifiy the rounding method and test the critical cases. So far, only unproblematic numbers are tested. */ init_max_error (); check_long ("lrint (0.0) == 0", FUNC(lrint) (0.0), 0, 0, 0, 0); check_long ("lrint (-0) == 0", FUNC(lrint) (minus_zero), 0, 0, 0, 0); check_long ("lrint (0.2) == 0", FUNC(lrint) (0.2L), 0, 0, 0, 0); check_long ("lrint (-0.2) == 0", FUNC(lrint) (-0.2L), 0, 0, 0, 0); check_long ("lrint (1.4) == 1", FUNC(lrint) (1.4L), 1, 0, 0, 0); check_long ("lrint (-1.4) == -1", FUNC(lrint) (-1.4L), -1, 0, 0, 0); check_long ("lrint (8388600.3) == 8388600", FUNC(lrint) (8388600.3L), 8388600, 0, 0, 0); check_long ("lrint (-8388600.3) == -8388600", FUNC(lrint) (-8388600.3L), -8388600, 0, 0, 0); print_max_error ("lrint", 0, 0); } static void llrint_test (void) { /* XXX this test is incomplete. We need to have a way to specifiy the rounding method and test the critical cases. So far, only unproblematic numbers are tested. */ init_max_error (); check_longlong ("llrint (0.0) == 0", FUNC(llrint) (0.0), 0, 0, 0, 0); check_longlong ("llrint (-0) == 0", FUNC(llrint) (minus_zero), 0, 0, 0, 0); check_longlong ("llrint (0.2) == 0", FUNC(llrint) (0.2L), 0, 0, 0, 0); check_longlong ("llrint (-0.2) == 0", FUNC(llrint) (-0.2L), 0, 0, 0, 0); check_longlong ("llrint (1.4) == 1", FUNC(llrint) (1.4L), 1, 0, 0, 0); check_longlong ("llrint (-1.4) == -1", FUNC(llrint) (-1.4L), -1, 0, 0, 0); check_longlong ("llrint (8388600.3) == 8388600", FUNC(llrint) (8388600.3L), 8388600, 0, 0, 0); check_longlong ("llrint (-8388600.3) == -8388600", FUNC(llrint) (-8388600.3L), -8388600, 0, 0, 0); /* Test boundary conditions. */ /* 0x1FFFFF */ check_longlong ("llrint (2097151.0) == 2097151LL", FUNC(llrint) (2097151.0), 2097151LL, 0, 0, 0); /* 0x800000 */ check_longlong ("llrint (8388608.0) == 8388608LL", FUNC(llrint) (8388608.0), 8388608LL, 0, 0, 0); /* 0x1000000 */ check_longlong ("llrint (16777216.0) == 16777216LL", FUNC(llrint) (16777216.0), 16777216LL, 0, 0, 0); /* 0x20000000000 */ check_longlong ("llrint (2199023255552.0) == 2199023255552LL", FUNC(llrint) (2199023255552.0), 2199023255552LL, 0, 0, 0); /* 0x40000000000 */ check_longlong ("llrint (4398046511104.0) == 4398046511104LL", FUNC(llrint) (4398046511104.0), 4398046511104LL, 0, 0, 0); /* 0x10000000000000 */ check_longlong ("llrint (4503599627370496.0) == 4503599627370496LL", FUNC(llrint) (4503599627370496.0), 4503599627370496LL, 0, 0, 0); /* 0x10000080000000 */ check_longlong ("llrint (4503601774854144.0) == 4503601774854144LL", FUNC(llrint) (4503601774854144.0), 4503601774854144LL, 0, 0, 0); /* 0x20000000000000 */ check_longlong ("llrint (9007199254740992.0) == 9007199254740992LL", FUNC(llrint) (9007199254740992.0), 9007199254740992LL, 0, 0, 0); /* 0x80000000000000 */ check_longlong ("llrint (36028797018963968.0) == 36028797018963968LL", FUNC(llrint) (36028797018963968.0), 36028797018963968LL, 0, 0, 0); /* 0x100000000000000 */ check_longlong ("llrint (72057594037927936.0) == 72057594037927936LL", FUNC(llrint) (72057594037927936.0), 72057594037927936LL, 0, 0, 0); print_max_error ("llrint", 0, 0); } static void log_test (void) { errno = 0; FUNC(log) (1); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("log (0) == -inf plus division by zero exception", FUNC(log) (0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("log (-0) == -inf plus division by zero exception", FUNC(log) (minus_zero), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("log (1) == 0", FUNC(log) (1), 0, 0, 0, 0); check_float ("log (-1) == NaN plus invalid exception", FUNC(log) (-1), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("log (inf) == inf", FUNC(log) (plus_infty), plus_infty, 0, 0, 0); check_float ("log (e) == 1", FUNC(log) (M_El), 1, DELTA1163, 0, 0); check_float ("log (1.0 / M_El) == -1", FUNC(log) (1.0 / M_El), -1, DELTA1164, 0, 0); check_float ("log (2) == M_LN2l", FUNC(log) (2), M_LN2l, 0, 0, 0); check_float ("log (10) == M_LN10l", FUNC(log) (10), M_LN10l, 0, 0, 0); check_float ("log (0.7) == -0.35667494393873237891263871124118447", FUNC(log) (0.7L), -0.35667494393873237891263871124118447L, DELTA1167, 0, 0); print_max_error ("log", DELTAlog, 0); } static void log10_test (void) { errno = 0; FUNC(log10) (1); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("log10 (0) == -inf plus division by zero exception", FUNC(log10) (0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("log10 (-0) == -inf plus division by zero exception", FUNC(log10) (minus_zero), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("log10 (1) == 0", FUNC(log10) (1), 0, 0, 0, 0); /* log10 (x) == NaN plus invalid exception if x < 0. */ check_float ("log10 (-1) == NaN plus invalid exception", FUNC(log10) (-1), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("log10 (inf) == inf", FUNC(log10) (plus_infty), plus_infty, 0, 0, 0); check_float ("log10 (NaN) == NaN", FUNC(log10) (nan_value), nan_value, 0, 0, 0); check_float ("log10 (0.1) == -1", FUNC(log10) (0.1L), -1, 0, 0, 0); check_float ("log10 (10.0) == 1", FUNC(log10) (10.0), 1, 0, 0, 0); check_float ("log10 (100.0) == 2", FUNC(log10) (100.0), 2, 0, 0, 0); check_float ("log10 (10000.0) == 4", FUNC(log10) (10000.0), 4, 0, 0, 0); check_float ("log10 (e) == log10(e)", FUNC(log10) (M_El), M_LOG10El, DELTA1178, 0, 0); check_float ("log10 (0.7) == -0.15490195998574316929", FUNC(log10) (0.7L), -0.15490195998574316929L, DELTA1179, 0, 0); print_max_error ("log10", DELTAlog10, 0); } static void log1p_test (void) { errno = 0; FUNC(log1p) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("log1p (0) == 0", FUNC(log1p) (0), 0, 0, 0, 0); check_float ("log1p (-0) == -0", FUNC(log1p) (minus_zero), minus_zero, 0, 0, 0); check_float ("log1p (-1) == -inf plus division by zero exception", FUNC(log1p) (-1), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("log1p (-2) == NaN plus invalid exception", FUNC(log1p) (-2), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("log1p (inf) == inf", FUNC(log1p) (plus_infty), plus_infty, 0, 0, 0); check_float ("log1p (NaN) == NaN", FUNC(log1p) (nan_value), nan_value, 0, 0, 0); check_float ("log1p (M_El - 1.0) == 1", FUNC(log1p) (M_El - 1.0), 1, DELTA1186, 0, 0); check_float ("log1p (-0.3) == -0.35667494393873237891263871124118447", FUNC(log1p) (-0.3L), -0.35667494393873237891263871124118447L, DELTA1187, 0, 0); print_max_error ("log1p", DELTAlog1p, 0); } static void log2_test (void) { errno = 0; FUNC(log2) (1); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("log2 (0) == -inf plus division by zero exception", FUNC(log2) (0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("log2 (-0) == -inf plus division by zero exception", FUNC(log2) (minus_zero), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("log2 (1) == 0", FUNC(log2) (1), 0, 0, 0, 0); check_float ("log2 (-1) == NaN plus invalid exception", FUNC(log2) (-1), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("log2 (inf) == inf", FUNC(log2) (plus_infty), plus_infty, 0, 0, 0); check_float ("log2 (NaN) == NaN", FUNC(log2) (nan_value), nan_value, 0, 0, 0); check_float ("log2 (e) == M_LOG2El", FUNC(log2) (M_El), M_LOG2El, 0, 0, 0); check_float ("log2 (2.0) == 1", FUNC(log2) (2.0), 1, 0, 0, 0); check_float ("log2 (16.0) == 4", FUNC(log2) (16.0), 4, 0, 0, 0); check_float ("log2 (256.0) == 8", FUNC(log2) (256.0), 8, 0, 0, 0); check_float ("log2 (0.7) == -0.51457317282975824043", FUNC(log2) (0.7L), -0.51457317282975824043L, DELTA1198, 0, 0); print_max_error ("log2", DELTAlog2, 0); } static void logb_test (void) { init_max_error (); check_float ("logb (inf) == inf", FUNC(logb) (plus_infty), plus_infty, 0, 0, 0); check_float ("logb (-inf) == inf", FUNC(logb) (minus_infty), plus_infty, 0, 0, 0); check_float ("logb (0) == -inf plus division by zero exception", FUNC(logb) (0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("logb (-0) == -inf plus division by zero exception", FUNC(logb) (minus_zero), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("logb (NaN) == NaN", FUNC(logb) (nan_value), nan_value, 0, 0, 0); check_float ("logb (1) == 0", FUNC(logb) (1), 0, 0, 0, 0); check_float ("logb (e) == 1", FUNC(logb) (M_El), 1, 0, 0, 0); check_float ("logb (1024) == 10", FUNC(logb) (1024), 10, 0, 0, 0); check_float ("logb (-2000) == 10", FUNC(logb) (-2000), 10, 0, 0, 0); print_max_error ("logb", 0, 0); } static void lround_test (void) { init_max_error (); check_long ("lround (0) == 0", FUNC(lround) (0), 0, 0, 0, 0); check_long ("lround (-0) == 0", FUNC(lround) (minus_zero), 0, 0, 0, 0); check_long ("lround (0.2) == 0.0", FUNC(lround) (0.2L), 0.0, 0, 0, 0); check_long ("lround (-0.2) == 0", FUNC(lround) (-0.2L), 0, 0, 0, 0); check_long ("lround (0.5) == 1", FUNC(lround) (0.5), 1, 0, 0, 0); check_long ("lround (-0.5) == -1", FUNC(lround) (-0.5), -1, 0, 0, 0); check_long ("lround (0.8) == 1", FUNC(lround) (0.8L), 1, 0, 0, 0); check_long ("lround (-0.8) == -1", FUNC(lround) (-0.8L), -1, 0, 0, 0); check_long ("lround (1.5) == 2", FUNC(lround) (1.5), 2, 0, 0, 0); check_long ("lround (-1.5) == -2", FUNC(lround) (-1.5), -2, 0, 0, 0); check_long ("lround (22514.5) == 22515", FUNC(lround) (22514.5), 22515, 0, 0, 0); check_long ("lround (-22514.5) == -22515", FUNC(lround) (-22514.5), -22515, 0, 0, 0); #ifndef TEST_FLOAT check_long ("lround (2097152.5) == 2097153", FUNC(lround) (2097152.5), 2097153, 0, 0, 0); check_long ("lround (-2097152.5) == -2097153", FUNC(lround) (-2097152.5), -2097153, 0, 0, 0); #endif print_max_error ("lround", 0, 0); } static void llround_test (void) { init_max_error (); check_longlong ("llround (0) == 0", FUNC(llround) (0), 0, 0, 0, 0); check_longlong ("llround (-0) == 0", FUNC(llround) (minus_zero), 0, 0, 0, 0); check_longlong ("llround (0.2) == 0.0", FUNC(llround) (0.2L), 0.0, 0, 0, 0); check_longlong ("llround (-0.2) == 0", FUNC(llround) (-0.2L), 0, 0, 0, 0); check_longlong ("llround (0.5) == 1", FUNC(llround) (0.5), 1, 0, 0, 0); check_longlong ("llround (-0.5) == -1", FUNC(llround) (-0.5), -1, 0, 0, 0); check_longlong ("llround (0.8) == 1", FUNC(llround) (0.8L), 1, 0, 0, 0); check_longlong ("llround (-0.8) == -1", FUNC(llround) (-0.8L), -1, 0, 0, 0); check_longlong ("llround (1.5) == 2", FUNC(llround) (1.5), 2, 0, 0, 0); check_longlong ("llround (-1.5) == -2", FUNC(llround) (-1.5), -2, 0, 0, 0); check_longlong ("llround (22514.5) == 22515", FUNC(llround) (22514.5), 22515, 0, 0, 0); check_longlong ("llround (-22514.5) == -22515", FUNC(llround) (-22514.5), -22515, 0, 0, 0); #ifndef TEST_FLOAT check_longlong ("llround (2097152.5) == 2097153", FUNC(llround) (2097152.5), 2097153, 0, 0, 0); check_longlong ("llround (-2097152.5) == -2097153", FUNC(llround) (-2097152.5), -2097153, 0, 0, 0); check_longlong ("llround (34359738368.5) == 34359738369ll", FUNC(llround) (34359738368.5), 34359738369ll, 0, 0, 0); check_longlong ("llround (-34359738368.5) == -34359738369ll", FUNC(llround) (-34359738368.5), -34359738369ll, 0, 0, 0); #endif /* Test boundary conditions. */ /* 0x1FFFFF */ check_longlong ("llround (2097151.0) == 2097151LL", FUNC(llround) (2097151.0), 2097151LL, 0, 0, 0); /* 0x800000 */ check_longlong ("llround (8388608.0) == 8388608LL", FUNC(llround) (8388608.0), 8388608LL, 0, 0, 0); /* 0x1000000 */ check_longlong ("llround (16777216.0) == 16777216LL", FUNC(llround) (16777216.0), 16777216LL, 0, 0, 0); /* 0x20000000000 */ check_longlong ("llround (2199023255552.0) == 2199023255552LL", FUNC(llround) (2199023255552.0), 2199023255552LL, 0, 0, 0); /* 0x40000000000 */ check_longlong ("llround (4398046511104.0) == 4398046511104LL", FUNC(llround) (4398046511104.0), 4398046511104LL, 0, 0, 0); /* 0x10000000000000 */ check_longlong ("llround (4503599627370496.0) == 4503599627370496LL", FUNC(llround) (4503599627370496.0), 4503599627370496LL, 0, 0, 0); /* 0x10000080000000 */ check_longlong ("llrint (4503601774854144.0) == 4503601774854144LL", FUNC(llrint) (4503601774854144.0), 4503601774854144LL, 0, 0, 0); /* 0x20000000000000 */ check_longlong ("llround (9007199254740992.0) == 9007199254740992LL", FUNC(llround) (9007199254740992.0), 9007199254740992LL, 0, 0, 0); /* 0x80000000000000 */ check_longlong ("llround (36028797018963968.0) == 36028797018963968LL", FUNC(llround) (36028797018963968.0), 36028797018963968LL, 0, 0, 0); /* 0x100000000000000 */ check_longlong ("llround (72057594037927936.0) == 72057594037927936LL", FUNC(llround) (72057594037927936.0), 72057594037927936LL, 0, 0, 0); #ifndef TEST_FLOAT /* 0x100000000 */ check_longlong ("llround (4294967295.5) == 4294967296LL", FUNC(llround) (4294967295.5), 4294967296LL, 0, 0, 0); /* 0x200000000 */ check_longlong ("llround (8589934591.5) == 8589934592LL", FUNC(llround) (8589934591.5), 8589934592LL, 0, 0, 0); #endif print_max_error ("llround", 0, 0); } static void modf_test (void) { FLOAT x; init_max_error (); check_float ("modf (inf, &x) == 0", FUNC(modf) (plus_infty, &x), 0, 0, 0, 0); check_float ("modf (inf, &x) sets x to plus_infty", x, plus_infty, 0, 0, 0); check_float ("modf (-inf, &x) == -0", FUNC(modf) (minus_infty, &x), minus_zero, 0, 0, 0); check_float ("modf (-inf, &x) sets x to minus_infty", x, minus_infty, 0, 0, 0); check_float ("modf (NaN, &x) == NaN", FUNC(modf) (nan_value, &x), nan_value, 0, 0, 0); check_float ("modf (NaN, &x) sets x to nan_value", x, nan_value, 0, 0, 0); check_float ("modf (0, &x) == 0", FUNC(modf) (0, &x), 0, 0, 0, 0); check_float ("modf (0, &x) sets x to 0", x, 0, 0, 0, 0); check_float ("modf (1.5, &x) == 0.5", FUNC(modf) (1.5, &x), 0.5, 0, 0, 0); check_float ("modf (1.5, &x) sets x to 1", x, 1, 0, 0, 0); check_float ("modf (2.5, &x) == 0.5", FUNC(modf) (2.5, &x), 0.5, 0, 0, 0); check_float ("modf (2.5, &x) sets x to 2", x, 2, 0, 0, 0); check_float ("modf (-2.5, &x) == -0.5", FUNC(modf) (-2.5, &x), -0.5, 0, 0, 0); check_float ("modf (-2.5, &x) sets x to -2", x, -2, 0, 0, 0); check_float ("modf (20, &x) == 0", FUNC(modf) (20, &x), 0, 0, 0, 0); check_float ("modf (20, &x) sets x to 20", x, 20, 0, 0, 0); check_float ("modf (21, &x) == 0", FUNC(modf) (21, &x), 0, 0, 0, 0); check_float ("modf (21, &x) sets x to 21", x, 21, 0, 0, 0); check_float ("modf (89.5, &x) == 0.5", FUNC(modf) (89.5, &x), 0.5, 0, 0, 0); check_float ("modf (89.5, &x) sets x to 89", x, 89, 0, 0, 0); print_max_error ("modf", 0, 0); } static void nearbyint_test (void) { init_max_error (); check_float ("nearbyint (0.0) == 0.0", FUNC(nearbyint) (0.0), 0.0, 0, 0, 0); check_float ("nearbyint (-0) == -0", FUNC(nearbyint) (minus_zero), minus_zero, 0, 0, 0); check_float ("nearbyint (inf) == inf", FUNC(nearbyint) (plus_infty), plus_infty, 0, 0, 0); check_float ("nearbyint (-inf) == -inf", FUNC(nearbyint) (minus_infty), minus_infty, 0, 0, 0); check_float ("nearbyint (NaN) == NaN", FUNC(nearbyint) (nan_value), nan_value, 0, 0, 0); /* Default rounding mode is round to nearest. */ check_float ("nearbyint (0.5) == 0.0", FUNC(nearbyint) (0.5), 0.0, 0, 0, 0); check_float ("nearbyint (1.5) == 2.0", FUNC(nearbyint) (1.5), 2.0, 0, 0, 0); check_float ("nearbyint (-0.5) == -0", FUNC(nearbyint) (-0.5), minus_zero, 0, 0, 0); check_float ("nearbyint (-1.5) == -2.0", FUNC(nearbyint) (-1.5), -2.0, 0, 0, 0); print_max_error ("nearbyint", 0, 0); } static void nextafter_test (void) { init_max_error (); check_float ("nextafter (0, 0) == 0", FUNC(nextafter) (0, 0), 0, 0, 0, 0); check_float ("nextafter (-0, 0) == 0", FUNC(nextafter) (minus_zero, 0), 0, 0, 0, 0); check_float ("nextafter (0, -0) == -0", FUNC(nextafter) (0, minus_zero), minus_zero, 0, 0, 0); check_float ("nextafter (-0, -0) == -0", FUNC(nextafter) (minus_zero, minus_zero), minus_zero, 0, 0, 0); check_float ("nextafter (9, 9) == 9", FUNC(nextafter) (9, 9), 9, 0, 0, 0); check_float ("nextafter (-9, -9) == -9", FUNC(nextafter) (-9, -9), -9, 0, 0, 0); check_float ("nextafter (inf, inf) == inf", FUNC(nextafter) (plus_infty, plus_infty), plus_infty, 0, 0, 0); check_float ("nextafter (-inf, -inf) == -inf", FUNC(nextafter) (minus_infty, minus_infty), minus_infty, 0, 0, 0); check_float ("nextafter (NaN, 1.1) == NaN", FUNC(nextafter) (nan_value, 1.1L), nan_value, 0, 0, 0); check_float ("nextafter (1.1, NaN) == NaN", FUNC(nextafter) (1.1L, nan_value), nan_value, 0, 0, 0); check_float ("nextafter (NaN, NaN) == NaN", FUNC(nextafter) (nan_value, nan_value), nan_value, 0, 0, 0); /* XXX We need the hexadecimal FP number representation here for further tests. */ print_max_error ("nextafter", 0, 0); } #if 0 /* XXX scp XXX */ static void nexttoward_test (void) { init_max_error (); check_float ("nexttoward (0, 0) == 0", FUNC(nexttoward) (0, 0), 0, 0, 0, 0); check_float ("nexttoward (-0, 0) == 0", FUNC(nexttoward) (minus_zero, 0), 0, 0, 0, 0); check_float ("nexttoward (0, -0) == -0", FUNC(nexttoward) (0, minus_zero), minus_zero, 0, 0, 0); check_float ("nexttoward (-0, -0) == -0", FUNC(nexttoward) (minus_zero, minus_zero), minus_zero, 0, 0, 0); check_float ("nexttoward (9, 9) == 9", FUNC(nexttoward) (9, 9), 9, 0, 0, 0); check_float ("nexttoward (-9, -9) == -9", FUNC(nexttoward) (-9, -9), -9, 0, 0, 0); check_float ("nexttoward (inf, inf) == inf", FUNC(nexttoward) (plus_infty, plus_infty), plus_infty, 0, 0, 0); check_float ("nexttoward (-inf, -inf) == -inf", FUNC(nexttoward) (minus_infty, minus_infty), minus_infty, 0, 0, 0); check_float ("nexttoward (NaN, 1.1) == NaN", FUNC(nexttoward) (nan_value, 1.1L), nan_value, 0, 0, 0); check_float ("nexttoward (1.1, NaN) == NaN", FUNC(nexttoward) (1.1L, nan_value), nan_value, 0, 0, 0); check_float ("nexttoward (NaN, NaN) == NaN", FUNC(nexttoward) (nan_value, nan_value), nan_value, 0, 0, 0); /* XXX We need the hexadecimal FP number representation here for further tests. */ print_max_error ("nexttoward", 0, 0); } #endif static void pow_test (void) { errno = 0; FUNC(pow) (0, 0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("pow (0, 0) == 1", FUNC(pow) (0, 0), 1, 0, 0, 0); check_float ("pow (0, -0) == 1", FUNC(pow) (0, minus_zero), 1, 0, 0, 0); check_float ("pow (-0, 0) == 1", FUNC(pow) (minus_zero, 0), 1, 0, 0, 0); check_float ("pow (-0, -0) == 1", FUNC(pow) (minus_zero, minus_zero), 1, 0, 0, 0); check_float ("pow (10, 0) == 1", FUNC(pow) (10, 0), 1, 0, 0, 0); check_float ("pow (10, -0) == 1", FUNC(pow) (10, minus_zero), 1, 0, 0, 0); check_float ("pow (-10, 0) == 1", FUNC(pow) (-10, 0), 1, 0, 0, 0); check_float ("pow (-10, -0) == 1", FUNC(pow) (-10, minus_zero), 1, 0, 0, 0); check_float ("pow (NaN, 0) == 1", FUNC(pow) (nan_value, 0), 1, 0, 0, 0); check_float ("pow (NaN, -0) == 1", FUNC(pow) (nan_value, minus_zero), 1, 0, 0, 0); #ifndef TEST_INLINE check_float ("pow (1.1, inf) == inf", FUNC(pow) (1.1L, plus_infty), plus_infty, 0, 0, 0); check_float ("pow (inf, inf) == inf", FUNC(pow) (plus_infty, plus_infty), plus_infty, 0, 0, 0); check_float ("pow (-1.1, inf) == inf", FUNC(pow) (-1.1L, plus_infty), plus_infty, 0, 0, 0); check_float ("pow (-inf, inf) == inf", FUNC(pow) (minus_infty, plus_infty), plus_infty, 0, 0, 0); check_float ("pow (0.9, inf) == 0", FUNC(pow) (0.9L, plus_infty), 0, 0, 0, 0); check_float ("pow (1e-7, inf) == 0", FUNC(pow) (1e-7L, plus_infty), 0, 0, 0, 0); check_float ("pow (-0.9, inf) == 0", FUNC(pow) (-0.9L, plus_infty), 0, 0, 0, 0); check_float ("pow (-1e-7, inf) == 0", FUNC(pow) (-1e-7L, plus_infty), 0, 0, 0, 0); check_float ("pow (1.1, -inf) == 0", FUNC(pow) (1.1L, minus_infty), 0, 0, 0, 0); check_float ("pow (inf, -inf) == 0", FUNC(pow) (plus_infty, minus_infty), 0, 0, 0, 0); check_float ("pow (-1.1, -inf) == 0", FUNC(pow) (-1.1L, minus_infty), 0, 0, 0, 0); check_float ("pow (-inf, -inf) == 0", FUNC(pow) (minus_infty, minus_infty), 0, 0, 0, 0); check_float ("pow (0.9, -inf) == inf", FUNC(pow) (0.9L, minus_infty), plus_infty, 0, 0, 0); check_float ("pow (1e-7, -inf) == inf", FUNC(pow) (1e-7L, minus_infty), plus_infty, 0, 0, 0); check_float ("pow (-0.9, -inf) == inf", FUNC(pow) (-0.9L, minus_infty), plus_infty, 0, 0, 0); check_float ("pow (-1e-7, -inf) == inf", FUNC(pow) (-1e-7L, minus_infty), plus_infty, 0, 0, 0); check_float ("pow (inf, 1e-7) == inf", FUNC(pow) (plus_infty, 1e-7L), plus_infty, 0, 0, 0); check_float ("pow (inf, 1) == inf", FUNC(pow) (plus_infty, 1), plus_infty, 0, 0, 0); check_float ("pow (inf, 1e7) == inf", FUNC(pow) (plus_infty, 1e7L), plus_infty, 0, 0, 0); check_float ("pow (inf, -1e-7) == 0", FUNC(pow) (plus_infty, -1e-7L), 0, 0, 0, 0); check_float ("pow (inf, -1) == 0", FUNC(pow) (plus_infty, -1), 0, 0, 0, 0); check_float ("pow (inf, -1e7) == 0", FUNC(pow) (plus_infty, -1e7L), 0, 0, 0, 0); check_float ("pow (-inf, 1) == -inf", FUNC(pow) (minus_infty, 1), minus_infty, 0, 0, 0); check_float ("pow (-inf, 11) == -inf", FUNC(pow) (minus_infty, 11), minus_infty, 0, 0, 0); check_float ("pow (-inf, 1001) == -inf", FUNC(pow) (minus_infty, 1001), minus_infty, 0, 0, 0); check_float ("pow (-inf, 2) == inf", FUNC(pow) (minus_infty, 2), plus_infty, 0, 0, 0); check_float ("pow (-inf, 12) == inf", FUNC(pow) (minus_infty, 12), plus_infty, 0, 0, 0); check_float ("pow (-inf, 1002) == inf", FUNC(pow) (minus_infty, 1002), plus_infty, 0, 0, 0); check_float ("pow (-inf, 0.1) == inf", FUNC(pow) (minus_infty, 0.1L), plus_infty, 0, 0, 0); check_float ("pow (-inf, 1.1) == inf", FUNC(pow) (minus_infty, 1.1L), plus_infty, 0, 0, 0); check_float ("pow (-inf, 11.1) == inf", FUNC(pow) (minus_infty, 11.1L), plus_infty, 0, 0, 0); check_float ("pow (-inf, 1001.1) == inf", FUNC(pow) (minus_infty, 1001.1L), plus_infty, 0, 0, 0); check_float ("pow (-inf, -1) == -0", FUNC(pow) (minus_infty, -1), minus_zero, 0, 0, 0); check_float ("pow (-inf, -11) == -0", FUNC(pow) (minus_infty, -11), minus_zero, 0, 0, 0); check_float ("pow (-inf, -1001) == -0", FUNC(pow) (minus_infty, -1001), minus_zero, 0, 0, 0); check_float ("pow (-inf, -2) == 0", FUNC(pow) (minus_infty, -2), 0, 0, 0, 0); check_float ("pow (-inf, -12) == 0", FUNC(pow) (minus_infty, -12), 0, 0, 0, 0); check_float ("pow (-inf, -1002) == 0", FUNC(pow) (minus_infty, -1002), 0, 0, 0, 0); check_float ("pow (-inf, -0.1) == 0", FUNC(pow) (minus_infty, -0.1L), 0, 0, 0, 0); check_float ("pow (-inf, -1.1) == 0", FUNC(pow) (minus_infty, -1.1L), 0, 0, 0, 0); check_float ("pow (-inf, -11.1) == 0", FUNC(pow) (minus_infty, -11.1L), 0, 0, 0, 0); check_float ("pow (-inf, -1001.1) == 0", FUNC(pow) (minus_infty, -1001.1L), 0, 0, 0, 0); #endif check_float ("pow (NaN, NaN) == NaN", FUNC(pow) (nan_value, nan_value), nan_value, 0, 0, 0); check_float ("pow (0, NaN) == NaN", FUNC(pow) (0, nan_value), nan_value, 0, 0, 0); check_float ("pow (1, NaN) == 1", FUNC(pow) (1, nan_value), 1, 0, 0, 0); check_float ("pow (-1, NaN) == NaN", FUNC(pow) (-1, nan_value), nan_value, 0, 0, 0); check_float ("pow (NaN, 1) == NaN", FUNC(pow) (nan_value, 1), nan_value, 0, 0, 0); check_float ("pow (NaN, -1) == NaN", FUNC(pow) (nan_value, -1), nan_value, 0, 0, 0); /* pow (x, NaN) == NaN. */ check_float ("pow (3.0, NaN) == NaN", FUNC(pow) (3.0, nan_value), nan_value, 0, 0, 0); check_float ("pow (1, inf) == 1", FUNC(pow) (1, plus_infty), 1, 0, 0, 0); check_float ("pow (-1, inf) == 1", FUNC(pow) (-1, plus_infty), 1, 0, 0, 0); check_float ("pow (1, -inf) == 1", FUNC(pow) (1, minus_infty), 1, 0, 0, 0); check_float ("pow (-1, -inf) == 1", FUNC(pow) (-1, minus_infty), 1, 0, 0, 0); check_float ("pow (-0.1, 1.1) == NaN plus invalid exception", FUNC(pow) (-0.1L, 1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("pow (-0.1, -1.1) == NaN plus invalid exception", FUNC(pow) (-0.1L, -1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("pow (-10.1, 1.1) == NaN plus invalid exception", FUNC(pow) (-10.1L, 1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("pow (-10.1, -1.1) == NaN plus invalid exception", FUNC(pow) (-10.1L, -1.1L), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("pow (0, -1) == inf plus division by zero exception", FUNC(pow) (0, -1), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (0, -11) == inf plus division by zero exception", FUNC(pow) (0, -11), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (-0, -1) == -inf plus division by zero exception", FUNC(pow) (minus_zero, -1), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (-0, -11) == -inf plus division by zero exception", FUNC(pow) (minus_zero, -11), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (0, -2) == inf plus division by zero exception", FUNC(pow) (0, -2), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (0, -11.1) == inf plus division by zero exception", FUNC(pow) (0, -11.1L), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (-0, -2) == inf plus division by zero exception", FUNC(pow) (minus_zero, -2), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (-0, -11.1) == inf plus division by zero exception", FUNC(pow) (minus_zero, -11.1L), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("pow (0, 1) == 0", FUNC(pow) (0, 1), 0, 0, 0, 0); check_float ("pow (0, 11) == 0", FUNC(pow) (0, 11), 0, 0, 0, 0); check_float ("pow (-0, 1) == -0", FUNC(pow) (minus_zero, 1), minus_zero, 0, 0, 0); check_float ("pow (-0, 11) == -0", FUNC(pow) (minus_zero, 11), minus_zero, 0, 0, 0); check_float ("pow (0, 2) == 0", FUNC(pow) (0, 2), 0, 0, 0, 0); check_float ("pow (0, 11.1) == 0", FUNC(pow) (0, 11.1L), 0, 0, 0, 0); check_float ("pow (-0, 2) == 0", FUNC(pow) (minus_zero, 2), 0, 0, 0, 0); check_float ("pow (-0, 11.1) == 0", FUNC(pow) (minus_zero, 11.1L), 0, 0, 0, 0); #ifndef TEST_INLINE /* pow (x, +inf) == +inf for |x| > 1. */ check_float ("pow (1.5, inf) == inf", FUNC(pow) (1.5, plus_infty), plus_infty, 0, 0, 0); /* pow (x, +inf) == +0 for |x| < 1. */ check_float ("pow (0.5, inf) == 0.0", FUNC(pow) (0.5, plus_infty), 0.0, 0, 0, 0); /* pow (x, -inf) == +0 for |x| > 1. */ check_float ("pow (1.5, -inf) == 0.0", FUNC(pow) (1.5, minus_infty), 0.0, 0, 0, 0); /* pow (x, -inf) == +inf for |x| < 1. */ check_float ("pow (0.5, -inf) == inf", FUNC(pow) (0.5, minus_infty), plus_infty, 0, 0, 0); #endif /* pow (+inf, y) == +inf for y > 0. */ check_float ("pow (inf, 2) == inf", FUNC(pow) (plus_infty, 2), plus_infty, 0, 0, 0); /* pow (+inf, y) == +0 for y < 0. */ check_float ("pow (inf, -1) == 0.0", FUNC(pow) (plus_infty, -1), 0.0, 0, 0, 0); /* pow (-inf, y) == -inf for y an odd integer > 0. */ check_float ("pow (-inf, 27) == -inf", FUNC(pow) (minus_infty, 27), minus_infty, 0, 0, 0); /* pow (-inf, y) == +inf for y > 0 and not an odd integer. */ check_float ("pow (-inf, 28) == inf", FUNC(pow) (minus_infty, 28), plus_infty, 0, 0, 0); /* pow (-inf, y) == -0 for y an odd integer < 0. */ check_float ("pow (-inf, -3) == -0", FUNC(pow) (minus_infty, -3), minus_zero, 0, 0, 0); /* pow (-inf, y) == +0 for y < 0 and not an odd integer. */ check_float ("pow (-inf, -2.0) == 0.0", FUNC(pow) (minus_infty, -2.0), 0.0, 0, 0, 0); /* pow (+0, y) == +0 for y an odd integer > 0. */ check_float ("pow (0.0, 27) == 0.0", FUNC(pow) (0.0, 27), 0.0, 0, 0, 0); /* pow (-0, y) == -0 for y an odd integer > 0. */ check_float ("pow (-0, 27) == -0", FUNC(pow) (minus_zero, 27), minus_zero, 0, 0, 0); /* pow (+0, y) == +0 for y > 0 and not an odd integer. */ check_float ("pow (0.0, 4) == 0.0", FUNC(pow) (0.0, 4), 0.0, 0, 0, 0); /* pow (-0, y) == +0 for y > 0 and not an odd integer. */ check_float ("pow (-0, 4) == 0.0", FUNC(pow) (minus_zero, 4), 0.0, 0, 0, 0); check_float ("pow (0.7, 1.2) == 0.65180494056638638188", FUNC(pow) (0.7L, 1.2L), 0.65180494056638638188L, DELTA1398, 0, 0); #if defined TEST_DOUBLE || defined TEST_LDOUBLE check_float ("pow (-7.49321e+133, -9.80818e+16) == 0", FUNC(pow) (-7.49321e+133, -9.80818e+16), 0, 0, 0, 0); #endif print_max_error ("pow", DELTApow, 0); } static void remainder_test (void) { errno = 0; FUNC(remainder) (1.625, 1.0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("remainder (1, 0) == NaN plus invalid exception", FUNC(remainder) (1, 0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remainder (1, -0) == NaN plus invalid exception", FUNC(remainder) (1, minus_zero), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remainder (inf, 1) == NaN plus invalid exception", FUNC(remainder) (plus_infty, 1), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remainder (-inf, 1) == NaN plus invalid exception", FUNC(remainder) (minus_infty, 1), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remainder (NaN, NaN) == NaN", FUNC(remainder) (nan_value, nan_value), nan_value, 0, 0, 0); check_float ("remainder (1.625, 1.0) == -0.375", FUNC(remainder) (1.625, 1.0), -0.375, 0, 0, 0); check_float ("remainder (-1.625, 1.0) == 0.375", FUNC(remainder) (-1.625, 1.0), 0.375, 0, 0, 0); check_float ("remainder (1.625, -1.0) == -0.375", FUNC(remainder) (1.625, -1.0), -0.375, 0, 0, 0); check_float ("remainder (-1.625, -1.0) == 0.375", FUNC(remainder) (-1.625, -1.0), 0.375, 0, 0, 0); check_float ("remainder (5.0, 2.0) == 1.0", FUNC(remainder) (5.0, 2.0), 1.0, 0, 0, 0); check_float ("remainder (3.0, 2.0) == -1.0", FUNC(remainder) (3.0, 2.0), -1.0, 0, 0, 0); print_max_error ("remainder", 0, 0); } static void remquo_test (void) { /* x is needed. */ int x; errno = 0; FUNC(remquo) (1.625, 1.0, &x); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("remquo (1, 0, &x) == NaN plus invalid exception", FUNC(remquo) (1, 0, &x), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remquo (1, -0, &x) == NaN plus invalid exception", FUNC(remquo) (1, minus_zero, &x), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remquo (inf, 1, &x) == NaN plus invalid exception", FUNC(remquo) (plus_infty, 1, &x), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remquo (-inf, 1, &x) == NaN plus invalid exception", FUNC(remquo) (minus_infty, 1, &x), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("remquo (NaN, NaN, &x) == NaN", FUNC(remquo) (nan_value, nan_value, &x), nan_value, 0, 0, 0); check_float ("remquo (1.625, 1.0, &x) == -0.375", FUNC(remquo) (1.625, 1.0, &x), -0.375, 0, 0, 0); check_int ("remquo (1.625, 1.0, &x) sets x to 2", x, 2, 0, 0, 0); check_float ("remquo (-1.625, 1.0, &x) == 0.375", FUNC(remquo) (-1.625, 1.0, &x), 0.375, 0, 0, 0); check_int ("remquo (-1.625, 1.0, &x) sets x to -2", x, -2, 0, 0, 0); check_float ("remquo (1.625, -1.0, &x) == -0.375", FUNC(remquo) (1.625, -1.0, &x), -0.375, 0, 0, 0); check_int ("remquo (1.625, -1.0, &x) sets x to -2", x, -2, 0, 0, 0); check_float ("remquo (-1.625, -1.0, &x) == 0.375", FUNC(remquo) (-1.625, -1.0, &x), 0.375, 0, 0, 0); check_int ("remquo (-1.625, -1.0, &x) sets x to 2", x, 2, 0, 0, 0); check_float ("remquo (5, 2, &x) == 1", FUNC(remquo) (5, 2, &x), 1, 0, 0, 0); check_int ("remquo (5, 2, &x) sets x to 2", x, 2, 0, 0, 0); check_float ("remquo (3, 2, &x) == -1", FUNC(remquo) (3, 2, &x), -1, 0, 0, 0); check_int ("remquo (3, 2, &x) sets x to 2", x, 2, 0, 0, 0); print_max_error ("remquo", 0, 0); } static void rint_test (void) { init_max_error (); check_float ("rint (0.0) == 0.0", FUNC(rint) (0.0), 0.0, 0, 0, 0); check_float ("rint (-0) == -0", FUNC(rint) (minus_zero), minus_zero, 0, 0, 0); check_float ("rint (inf) == inf", FUNC(rint) (plus_infty), plus_infty, 0, 0, 0); check_float ("rint (-inf) == -inf", FUNC(rint) (minus_infty), minus_infty, 0, 0, 0); /* Default rounding mode is round to even. */ check_float ("rint (0.5) == 0.0", FUNC(rint) (0.5), 0.0, 0, 0, 0); check_float ("rint (1.5) == 2.0", FUNC(rint) (1.5), 2.0, 0, 0, 0); check_float ("rint (2.5) == 2.0", FUNC(rint) (2.5), 2.0, 0, 0, 0); check_float ("rint (3.5) == 4.0", FUNC(rint) (3.5), 4.0, 0, 0, 0); check_float ("rint (4.5) == 4.0", FUNC(rint) (4.5), 4.0, 0, 0, 0); check_float ("rint (-0.5) == -0.0", FUNC(rint) (-0.5), -0.0, 0, 0, 0); check_float ("rint (-1.5) == -2.0", FUNC(rint) (-1.5), -2.0, 0, 0, 0); check_float ("rint (-2.5) == -2.0", FUNC(rint) (-2.5), -2.0, 0, 0, 0); check_float ("rint (-3.5) == -4.0", FUNC(rint) (-3.5), -4.0, 0, 0, 0); check_float ("rint (-4.5) == -4.0", FUNC(rint) (-4.5), -4.0, 0, 0, 0); print_max_error ("rint", 0, 0); } static void round_test (void) { init_max_error (); check_float ("round (0) == 0", FUNC(round) (0), 0, 0, 0, 0); check_float ("round (-0) == -0", FUNC(round) (minus_zero), minus_zero, 0, 0, 0); check_float ("round (0.2) == 0.0", FUNC(round) (0.2L), 0.0, 0, 0, 0); check_float ("round (-0.2) == -0", FUNC(round) (-0.2L), minus_zero, 0, 0, 0); check_float ("round (0.5) == 1.0", FUNC(round) (0.5), 1.0, 0, 0, 0); check_float ("round (-0.5) == -1.0", FUNC(round) (-0.5), -1.0, 0, 0, 0); check_float ("round (0.8) == 1.0", FUNC(round) (0.8L), 1.0, 0, 0, 0); check_float ("round (-0.8) == -1.0", FUNC(round) (-0.8L), -1.0, 0, 0, 0); check_float ("round (1.5) == 2.0", FUNC(round) (1.5), 2.0, 0, 0, 0); check_float ("round (-1.5) == -2.0", FUNC(round) (-1.5), -2.0, 0, 0, 0); check_float ("round (2097152.5) == 2097153", FUNC(round) (2097152.5), 2097153, 0, 0, 0); check_float ("round (-2097152.5) == -2097153", FUNC(round) (-2097152.5), -2097153, 0, 0, 0); print_max_error ("round", 0, 0); } static void scalbn_test (void) { init_max_error (); check_float ("scalbn (0, 0) == 0", FUNC(scalbn) (0, 0), 0, 0, 0, 0); check_float ("scalbn (-0, 0) == -0", FUNC(scalbn) (minus_zero, 0), minus_zero, 0, 0, 0); check_float ("scalbn (inf, 1) == inf", FUNC(scalbn) (plus_infty, 1), plus_infty, 0, 0, 0); check_float ("scalbn (-inf, 1) == -inf", FUNC(scalbn) (minus_infty, 1), minus_infty, 0, 0, 0); check_float ("scalbn (NaN, 1) == NaN", FUNC(scalbn) (nan_value, 1), nan_value, 0, 0, 0); check_float ("scalbn (0.8, 4) == 12.8", FUNC(scalbn) (0.8L, 4), 12.8L, 0, 0, 0); check_float ("scalbn (-0.854375, 5) == -27.34", FUNC(scalbn) (-0.854375L, 5), -27.34L, 0, 0, 0); check_float ("scalbn (1, 0) == 1", FUNC(scalbn) (1, 0L), 1, 0, 0, 0); print_max_error ("scalbn", 0, 0); } static void scalbln_test (void) { init_max_error (); check_float ("scalbln (0, 0) == 0", FUNC(scalbln) (0, 0), 0, 0, 0, 0); check_float ("scalbln (-0, 0) == -0", FUNC(scalbln) (minus_zero, 0), minus_zero, 0, 0, 0); check_float ("scalbln (inf, 1) == inf", FUNC(scalbln) (plus_infty, 1), plus_infty, 0, 0, 0); check_float ("scalbln (-inf, 1) == -inf", FUNC(scalbln) (minus_infty, 1), minus_infty, 0, 0, 0); check_float ("scalbln (NaN, 1) == NaN", FUNC(scalbln) (nan_value, 1), nan_value, 0, 0, 0); check_float ("scalbln (0.8, 4) == 12.8", FUNC(scalbln) (0.8L, 4), 12.8L, 0, 0, 0); check_float ("scalbln (-0.854375, 5) == -27.34", FUNC(scalbln) (-0.854375L, 5), -27.34L, 0, 0, 0); check_float ("scalbln (1, 0) == 1", FUNC(scalbln) (1, 0L), 1, 0, 0, 0); print_max_error ("scalbn", 0, 0); } static void signbit_test (void) { init_max_error (); check_bool ("signbit (0) == false", signbit (0.0), 0, 0, 0, 0); check_bool ("signbit (-0) == true", signbit (minus_zero), 1, 0, 0, 0); check_bool ("signbit (inf) == false", signbit (plus_infty), 0, 0, 0, 0); check_bool ("signbit (-inf) == true", signbit (minus_infty), 1, 0, 0, 0); /* signbit (x) != 0 for x < 0. */ check_bool ("signbit (-1) == true", signbit (-1.0), 1, 0, 0, 0); /* signbit (x) == 0 for x >= 0. */ check_bool ("signbit (1) == false", signbit (1.0), 0, 0, 0, 0); print_max_error ("signbit", 0, 0); } static void sin_test (void) { errno = 0; FUNC(sin) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("sin (0) == 0", FUNC(sin) (0), 0, 0, 0, 0); check_float ("sin (-0) == -0", FUNC(sin) (minus_zero), minus_zero, 0, 0, 0); check_float ("sin (inf) == NaN plus invalid exception", FUNC(sin) (plus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("sin (-inf) == NaN plus invalid exception", FUNC(sin) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("sin (NaN) == NaN", FUNC(sin) (nan_value), nan_value, 0, 0, 0); check_float ("sin (pi/6) == 0.5", FUNC(sin) (M_PI_6l), 0.5, 0, 0, 0); check_float ("sin (-pi/6) == -0.5", FUNC(sin) (-M_PI_6l), -0.5, 0, 0, 0); check_float ("sin (pi/2) == 1", FUNC(sin) (M_PI_2l), 1, 0, 0, 0); check_float ("sin (-pi/2) == -1", FUNC(sin) (-M_PI_2l), -1, 0, 0, 0); check_float ("sin (0.7) == 0.64421768723769105367261435139872014", FUNC(sin) (0.7L), 0.64421768723769105367261435139872014L, DELTA1524, 0, 0); print_max_error ("sin", DELTAsin, 0); } static void sincos_test (void) { FLOAT sin_res, cos_res; errno = 0; FUNC(sincos) (0, &sin_res, &cos_res); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); /* sincos is treated differently because it returns void. */ FUNC (sincos) (0, &sin_res, &cos_res); check_float ("sincos (0, &sin_res, &cos_res) puts 0 in sin_res", sin_res, 0, 0, 0, 0); check_float ("sincos (0, &sin_res, &cos_res) puts 1 in cos_res", cos_res, 1, 0, 0, 0); FUNC (sincos) (minus_zero, &sin_res, &cos_res); check_float ("sincos (-0, &sin_res, &cos_res) puts -0 in sin_res", sin_res, minus_zero, 0, 0, 0); check_float ("sincos (-0, &sin_res, &cos_res) puts 1 in cos_res", cos_res, 1, 0, 0, 0); FUNC (sincos) (plus_infty, &sin_res, &cos_res); check_float ("sincos (inf, &sin_res, &cos_res) puts NaN in sin_res plus invalid exception", sin_res, nan_value, 0, 0, INVALID_EXCEPTION); check_float ("sincos (inf, &sin_res, &cos_res) puts NaN in cos_res", cos_res, nan_value, 0, 0, 0); FUNC (sincos) (minus_infty, &sin_res, &cos_res); check_float ("sincos (-inf, &sin_res, &cos_res) puts NaN in sin_res plus invalid exception", sin_res, nan_value, 0, 0, INVALID_EXCEPTION); check_float ("sincos (-inf, &sin_res, &cos_res) puts NaN in cos_res", cos_res, nan_value, 0, 0, 0); FUNC (sincos) (nan_value, &sin_res, &cos_res); check_float ("sincos (NaN, &sin_res, &cos_res) puts NaN in sin_res", sin_res, nan_value, 0, 0, 0); check_float ("sincos (NaN, &sin_res, &cos_res) puts NaN in cos_res", cos_res, nan_value, 0, 0, 0); FUNC (sincos) (M_PI_2l, &sin_res, &cos_res); check_float ("sincos (pi/2, &sin_res, &cos_res) puts 1 in sin_res", sin_res, 1, 0, 0, 0); check_float ("sincos (pi/2, &sin_res, &cos_res) puts 0 in cos_res", cos_res, 0, DELTA1536, 0, 0); FUNC (sincos) (M_PI_6l, &sin_res, &cos_res); check_float ("sincos (pi/6, &sin_res, &cos_res) puts 0.5 in sin_res", sin_res, 0.5, 0, 0, 0); check_float ("sincos (pi/6, &sin_res, &cos_res) puts 0.86602540378443864676372317075293616 in cos_res", cos_res, 0.86602540378443864676372317075293616L, 0, 0, 0); FUNC (sincos) (M_PI_6l*2.0, &sin_res, &cos_res); check_float ("sincos (M_PI_6l*2.0, &sin_res, &cos_res) puts 0.86602540378443864676372317075293616 in sin_res", sin_res, 0.86602540378443864676372317075293616L, DELTA1539, 0, 0); check_float ("sincos (M_PI_6l*2.0, &sin_res, &cos_res) puts 0.5 in cos_res", cos_res, 0.5, DELTA1540, 0, 0); FUNC (sincos) (0.7L, &sin_res, &cos_res); check_float ("sincos (0.7, &sin_res, &cos_res) puts 0.64421768723769105367261435139872014 in sin_res", sin_res, 0.64421768723769105367261435139872014L, DELTA1541, 0, 0); check_float ("sincos (0.7, &sin_res, &cos_res) puts 0.76484218728448842625585999019186495 in cos_res", cos_res, 0.76484218728448842625585999019186495L, DELTA1542, 0, 0); print_max_error ("sincos", DELTAsincos, 0); } static void sinh_test (void) { errno = 0; FUNC(sinh) (0.7L); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("sinh (0) == 0", FUNC(sinh) (0), 0, 0, 0, 0); check_float ("sinh (-0) == -0", FUNC(sinh) (minus_zero), minus_zero, 0, 0, 0); #ifndef TEST_INLINE check_float ("sinh (inf) == inf", FUNC(sinh) (plus_infty), plus_infty, 0, 0, 0); check_float ("sinh (-inf) == -inf", FUNC(sinh) (minus_infty), minus_infty, 0, 0, 0); #endif check_float ("sinh (NaN) == NaN", FUNC(sinh) (nan_value), nan_value, 0, 0, 0); check_float ("sinh (0.7) == 0.75858370183953350346", FUNC(sinh) (0.7L), 0.75858370183953350346L, DELTA1548, 0, 0); #if 0 /* XXX scp XXX */ check_float ("sinh (0x8p-32) == 1.86264514923095703232705808926175479e-9", FUNC(sinh) (0x8p-32L), 1.86264514923095703232705808926175479e-9L, 0, 0, 0); #endif print_max_error ("sinh", DELTAsinh, 0); } static void sqrt_test (void) { errno = 0; FUNC(sqrt) (1); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("sqrt (0) == 0", FUNC(sqrt) (0), 0, 0, 0, 0); check_float ("sqrt (NaN) == NaN", FUNC(sqrt) (nan_value), nan_value, 0, 0, 0); check_float ("sqrt (inf) == inf", FUNC(sqrt) (plus_infty), plus_infty, 0, 0, 0); check_float ("sqrt (-0) == -0", FUNC(sqrt) (minus_zero), minus_zero, 0, 0, 0); /* sqrt (x) == NaN plus invalid exception for x < 0. */ check_float ("sqrt (-1) == NaN plus invalid exception", FUNC(sqrt) (-1), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("sqrt (-inf) == NaN plus invalid exception", FUNC(sqrt) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("sqrt (NaN) == NaN", FUNC(sqrt) (nan_value), nan_value, 0, 0, 0); check_float ("sqrt (2209) == 47", FUNC(sqrt) (2209), 47, 0, 0, 0); check_float ("sqrt (4) == 2", FUNC(sqrt) (4), 2, 0, 0, 0); check_float ("sqrt (2) == M_SQRT2l", FUNC(sqrt) (2), M_SQRT2l, 0, 0, 0); check_float ("sqrt (0.25) == 0.5", FUNC(sqrt) (0.25), 0.5, 0, 0, 0); check_float ("sqrt (6642.25) == 81.5", FUNC(sqrt) (6642.25), 81.5, 0, 0, 0); check_float ("sqrt (15239.9025) == 123.45", FUNC(sqrt) (15239.9025L), 123.45L, DELTA1562, 0, 0); check_float ("sqrt (0.7) == 0.83666002653407554797817202578518747", FUNC(sqrt) (0.7L), 0.83666002653407554797817202578518747L, 0, 0, 0); print_max_error ("sqrt", DELTAsqrt, 0); } static void tan_test (void) { errno = 0; FUNC(tan) (0); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("tan (0) == 0", FUNC(tan) (0), 0, 0, 0, 0); check_float ("tan (-0) == -0", FUNC(tan) (minus_zero), minus_zero, 0, 0, 0); check_float ("tan (inf) == NaN plus invalid exception", FUNC(tan) (plus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("tan (-inf) == NaN plus invalid exception", FUNC(tan) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("tan (NaN) == NaN", FUNC(tan) (nan_value), nan_value, 0, 0, 0); check_float ("tan (pi/4) == 1", FUNC(tan) (M_PI_4l), 1, DELTA1569, 0, 0); check_float ("tan (0.7) == 0.84228838046307944812813500221293775", FUNC(tan) (0.7L), 0.84228838046307944812813500221293775L, DELTA1570, 0, 0); print_max_error ("tan", DELTAtan, 0); } static void tanh_test (void) { errno = 0; FUNC(tanh) (0.7L); if (errno == ENOSYS) /* Function not implemented. */ return; init_max_error (); check_float ("tanh (0) == 0", FUNC(tanh) (0), 0, 0, 0, 0); check_float ("tanh (-0) == -0", FUNC(tanh) (minus_zero), minus_zero, 0, 0, 0); #ifndef TEST_INLINE check_float ("tanh (inf) == 1", FUNC(tanh) (plus_infty), 1, 0, 0, 0); check_float ("tanh (-inf) == -1", FUNC(tanh) (minus_infty), -1, 0, 0, 0); #endif check_float ("tanh (NaN) == NaN", FUNC(tanh) (nan_value), nan_value, 0, 0, 0); check_float ("tanh (0.7) == 0.60436777711716349631", FUNC(tanh) (0.7L), 0.60436777711716349631L, DELTA1576, 0, 0); check_float ("tanh (-0.7) == -0.60436777711716349631", FUNC(tanh) (-0.7L), -0.60436777711716349631L, DELTA1577, 0, 0); check_float ("tanh (1.0) == 0.7615941559557648881194582826047935904", FUNC(tanh) (1.0L), 0.7615941559557648881194582826047935904L, 0, 0, 0); check_float ("tanh (-1.0) == -0.7615941559557648881194582826047935904", FUNC(tanh) (-1.0L), -0.7615941559557648881194582826047935904L, 0, 0, 0); /* 2^-57 */ check_float ("tanh (6.938893903907228377647697925567626953125e-18) == 6.938893903907228377647697925567626953125e-18", FUNC(tanh) (6.938893903907228377647697925567626953125e-18L), 6.938893903907228377647697925567626953125e-18L, 0, 0, 0); print_max_error ("tanh", DELTAtanh, 0); } static void tgamma_test (void) { errno = 0; FUNC(tgamma) (1); if (errno == ENOSYS) /* Function not implemented. */ return; feclearexcept (FE_ALL_EXCEPT); init_max_error (); check_float ("tgamma (inf) == inf", FUNC(tgamma) (plus_infty), plus_infty, 0, 0, 0); check_float ("tgamma (0) == inf plus divide-by-zero", FUNC(tgamma) (0), plus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("tgamma (-0) == inf plus divide-by-zero", FUNC(tgamma) (minus_zero), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); /* tgamma (x) == NaN plus invalid exception for integer x <= 0. */ check_float ("tgamma (-2) == NaN plus invalid exception", FUNC(tgamma) (-2), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("tgamma (-inf) == NaN plus invalid exception", FUNC(tgamma) (minus_infty), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("tgamma (NaN) == NaN", FUNC(tgamma) (nan_value), nan_value, 0, 0, 0); check_float ("tgamma (0.5) == sqrt (pi)", FUNC(tgamma) (0.5), M_SQRT_PIl, DELTA1587, 0, 0); check_float ("tgamma (-0.5) == -2 sqrt (pi)", FUNC(tgamma) (-0.5), -M_2_SQRT_PIl, DELTA1588, 0, 0); check_float ("tgamma (1) == 1", FUNC(tgamma) (1), 1, 0, 0, 0); check_float ("tgamma (4) == 6", FUNC(tgamma) (4), 6, DELTA1590, 0, 0); check_float ("tgamma (0.7) == 1.29805533264755778568", FUNC(tgamma) (0.7L), 1.29805533264755778568L, DELTA1591, 0, 0); check_float ("tgamma (1.2) == 0.91816874239976061064", FUNC(tgamma) (1.2L), 0.91816874239976061064L, 0, 0, 0); print_max_error ("tgamma", DELTAtgamma, 0); } static void trunc_test (void) { init_max_error (); check_float ("trunc (inf) == inf", FUNC(trunc) (plus_infty), plus_infty, 0, 0, 0); check_float ("trunc (-inf) == -inf", FUNC(trunc) (minus_infty), minus_infty, 0, 0, 0); check_float ("trunc (NaN) == NaN", FUNC(trunc) (nan_value), nan_value, 0, 0, 0); check_float ("trunc (0) == 0", FUNC(trunc) (0), 0, 0, 0, 0); check_float ("trunc (-0) == -0", FUNC(trunc) (minus_zero), minus_zero, 0, 0, 0); check_float ("trunc (0.625) == 0", FUNC(trunc) (0.625), 0, 0, 0, 0); check_float ("trunc (-0.625) == -0", FUNC(trunc) (-0.625), minus_zero, 0, 0, 0); check_float ("trunc (1) == 1", FUNC(trunc) (1), 1, 0, 0, 0); check_float ("trunc (-1) == -1", FUNC(trunc) (-1), -1, 0, 0, 0); check_float ("trunc (1.625) == 1", FUNC(trunc) (1.625), 1, 0, 0, 0); check_float ("trunc (-1.625) == -1", FUNC(trunc) (-1.625), -1, 0, 0, 0); check_float ("trunc (1048580.625) == 1048580", FUNC(trunc) (1048580.625L), 1048580L, 0, 0, 0); check_float ("trunc (-1048580.625) == -1048580", FUNC(trunc) (-1048580.625L), -1048580L, 0, 0, 0); check_float ("trunc (8388610.125) == 8388610.0", FUNC(trunc) (8388610.125L), 8388610.0L, 0, 0, 0); check_float ("trunc (-8388610.125) == -8388610.0", FUNC(trunc) (-8388610.125L), -8388610.0L, 0, 0, 0); check_float ("trunc (4294967296.625) == 4294967296.0", FUNC(trunc) (4294967296.625L), 4294967296.0L, 0, 0, 0); check_float ("trunc (-4294967296.625) == -4294967296.0", FUNC(trunc) (-4294967296.625L), -4294967296.0L, 0, 0, 0); print_max_error ("trunc", 0, 0); } static void y0_test (void) { FLOAT s, c; errno = 0; FUNC (sincos) (0, &s, &c); if (errno == ENOSYS) /* Required function not implemented. */ return; FUNC(y0) (1); if (errno == ENOSYS) /* Function not implemented. */ return; /* y0 is the Bessel function of the second kind of order 0 */ init_max_error (); check_float ("y0 (-1.0) == NaN", FUNC(y0) (-1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("y0 (0.0) == -inf", FUNC(y0) (0.0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("y0 (NaN) == NaN", FUNC(y0) (nan_value), nan_value, 0, 0, 0); check_float ("y0 (inf) == 0", FUNC(y0) (plus_infty), 0, 0, 0, 0); check_float ("y0 (0.1) == -1.5342386513503668441", FUNC(y0) (0.1L), -1.5342386513503668441L, DELTA1614, 0, 0); check_float ("y0 (0.7) == -0.19066492933739506743", FUNC(y0) (0.7L), -0.19066492933739506743L, DELTA1615, 0, 0); check_float ("y0 (1.0) == 0.088256964215676957983", FUNC(y0) (1.0), 0.088256964215676957983L, DELTA1616, 0, 0); check_float ("y0 (1.5) == 0.38244892379775884396", FUNC(y0) (1.5), 0.38244892379775884396L, DELTA1617, 0, 0); check_float ("y0 (2.0) == 0.51037567264974511960", FUNC(y0) (2.0), 0.51037567264974511960L, DELTA1618, 0, 0); check_float ("y0 (8.0) == 0.22352148938756622053", FUNC(y0) (8.0), 0.22352148938756622053L, DELTA1619, 0, 0); check_float ("y0 (10.0) == 0.055671167283599391424", FUNC(y0) (10.0), 0.055671167283599391424L, DELTA1620, 0, 0); print_max_error ("y0", DELTAy0, 0); } static void y1_test (void) { FLOAT s, c; errno = 0; FUNC (sincos) (0, &s, &c); if (errno == ENOSYS) /* Required function not implemented. */ return; FUNC(y1) (1); if (errno == ENOSYS) /* Function not implemented. */ return; /* y1 is the Bessel function of the second kind of order 1 */ init_max_error (); check_float ("y1 (-1.0) == NaN", FUNC(y1) (-1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("y1 (0.0) == -inf", FUNC(y1) (0.0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("y1 (inf) == 0", FUNC(y1) (plus_infty), 0, 0, 0, 0); check_float ("y1 (NaN) == NaN", FUNC(y1) (nan_value), nan_value, 0, 0, 0); check_float ("y1 (0.1) == -6.4589510947020269877", FUNC(y1) (0.1L), -6.4589510947020269877L, DELTA1625, 0, 0); check_float ("y1 (0.7) == -1.1032498719076333697", FUNC(y1) (0.7L), -1.1032498719076333697L, DELTA1626, 0, 0); check_float ("y1 (1.0) == -0.78121282130028871655", FUNC(y1) (1.0), -0.78121282130028871655L, DELTA1627, 0, 0); check_float ("y1 (1.5) == -0.41230862697391129595", FUNC(y1) (1.5), -0.41230862697391129595L, DELTA1628, 0, 0); check_float ("y1 (2.0) == -0.10703243154093754689", FUNC(y1) (2.0), -0.10703243154093754689L, DELTA1629, 0, 0); check_float ("y1 (8.0) == -0.15806046173124749426", FUNC(y1) (8.0), -0.15806046173124749426L, DELTA1630, 0, 0); check_float ("y1 (10.0) == 0.24901542420695388392", FUNC(y1) (10.0), 0.24901542420695388392L, DELTA1631, 0, 0); print_max_error ("y1", DELTAy1, 0); } static void yn_test (void) { FLOAT s, c; errno = 0; FUNC (sincos) (0, &s, &c); if (errno == ENOSYS) /* Required function not implemented. */ return; FUNC(yn) (1, 1); if (errno == ENOSYS) /* Function not implemented. */ return; /* yn is the Bessel function of the second kind of order n */ init_max_error (); /* yn (0, x) == y0 (x) */ check_float ("yn (0, -1.0) == NaN", FUNC(yn) (0, -1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("yn (0, 0.0) == -inf", FUNC(yn) (0, 0.0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("yn (0, NaN) == NaN", FUNC(yn) (0, nan_value), nan_value, 0, 0, 0); check_float ("yn (0, inf) == 0", FUNC(yn) (0, plus_infty), 0, 0, 0, 0); check_float ("yn (0, 0.1) == -1.5342386513503668441", FUNC(yn) (0, 0.1L), -1.5342386513503668441L, DELTA1636, 0, 0); check_float ("yn (0, 0.7) == -0.19066492933739506743", FUNC(yn) (0, 0.7L), -0.19066492933739506743L, DELTA1637, 0, 0); check_float ("yn (0, 1.0) == 0.088256964215676957983", FUNC(yn) (0, 1.0), 0.088256964215676957983L, DELTA1638, 0, 0); check_float ("yn (0, 1.5) == 0.38244892379775884396", FUNC(yn) (0, 1.5), 0.38244892379775884396L, DELTA1639, 0, 0); check_float ("yn (0, 2.0) == 0.51037567264974511960", FUNC(yn) (0, 2.0), 0.51037567264974511960L, DELTA1640, 0, 0); check_float ("yn (0, 8.0) == 0.22352148938756622053", FUNC(yn) (0, 8.0), 0.22352148938756622053L, DELTA1641, 0, 0); check_float ("yn (0, 10.0) == 0.055671167283599391424", FUNC(yn) (0, 10.0), 0.055671167283599391424L, DELTA1642, 0, 0); /* yn (1, x) == y1 (x) */ check_float ("yn (1, -1.0) == NaN", FUNC(yn) (1, -1.0), nan_value, 0, 0, INVALID_EXCEPTION); check_float ("yn (1, 0.0) == -inf", FUNC(yn) (1, 0.0), minus_infty, 0, 0, DIVIDE_BY_ZERO_EXCEPTION); check_float ("yn (1, inf) == 0", FUNC(yn) (1, plus_infty), 0, 0, 0, 0); check_float ("yn (1, NaN) == NaN", FUNC(yn) (1, nan_value), nan_value, 0, 0, 0); check_float ("yn (1, 0.1) == -6.4589510947020269877", FUNC(yn) (1, 0.1L), -6.4589510947020269877L, DELTA1647, 0, 0); check_float ("yn (1, 0.7) == -1.1032498719076333697", FUNC(yn) (1, 0.7L), -1.1032498719076333697L, DELTA1648, 0, 0); check_float ("yn (1, 1.0) == -0.78121282130028871655", FUNC(yn) (1, 1.0), -0.78121282130028871655L, DELTA1649, 0, 0); check_float ("yn (1, 1.5) == -0.41230862697391129595", FUNC(yn) (1, 1.5), -0.41230862697391129595L, DELTA1650, 0, 0); check_float ("yn (1, 2.0) == -0.10703243154093754689", FUNC(yn) (1, 2.0), -0.10703243154093754689L, DELTA1651, 0, 0); check_float ("yn (1, 8.0) == -0.15806046173124749426", FUNC(yn) (1, 8.0), -0.15806046173124749426L, DELTA1652, 0, 0); check_float ("yn (1, 10.0) == 0.24901542420695388392", FUNC(yn) (1, 10.0), 0.24901542420695388392L, DELTA1653, 0, 0); /* yn (3, x) */ check_float ("yn (3, inf) == 0", FUNC(yn) (3, plus_infty), 0, 0, 0, 0); check_float ("yn (3, NaN) == NaN", FUNC(yn) (3, nan_value), nan_value, 0, 0, 0); check_float ("yn (3, 0.1) == -5099.3323786129048894", FUNC(yn) (3, 0.1L), -5099.3323786129048894L, DELTA1656, 0, 0); check_float ("yn (3, 0.7) == -15.819479052819633505", FUNC(yn) (3, 0.7L), -15.819479052819633505L, DELTA1657, 0, 0); check_float ("yn (3, 1.0) == -5.8215176059647288478", FUNC(yn) (3, 1.0), -5.8215176059647288478L, 0, 0, 0); check_float ("yn (3, 2.0) == -1.1277837768404277861", FUNC(yn) (3, 2.0), -1.1277837768404277861L, DELTA1659, 0, 0); check_float ("yn (3, 10.0) == -0.25136265718383732978", FUNC(yn) (3, 10.0), -0.25136265718383732978L, DELTA1660, 0, 0); /* yn (10, x) */ check_float ("yn (10, inf) == 0", FUNC(yn) (10, plus_infty), 0, 0, 0, 0); check_float ("yn (10, NaN) == NaN", FUNC(yn) (10, nan_value), nan_value, 0, 0, 0); check_float ("yn (10, 0.1) == -0.11831335132045197885e19", FUNC(yn) (10, 0.1L), -0.11831335132045197885e19L, DELTA1663, 0, 0); check_float ("yn (10, 0.7) == -0.42447194260703866924e10", FUNC(yn) (10, 0.7L), -0.42447194260703866924e10L, DELTA1664, 0, 0); check_float ("yn (10, 1.0) == -0.12161801427868918929e9", FUNC(yn) (10, 1.0), -0.12161801427868918929e9L, DELTA1665, 0, 0); check_float ("yn (10, 2.0) == -129184.54220803928264", FUNC(yn) (10, 2.0), -129184.54220803928264L, DELTA1666, 0, 0); check_float ("yn (10, 10.0) == -0.35981415218340272205", FUNC(yn) (10, 10.0), -0.35981415218340272205L, DELTA1667, 0, 0); print_max_error ("yn", DELTAyn, 0); } static void initialize (void) { plus_zero = 0.0; nan_value = plus_zero / plus_zero; /* Suppress GCC warning */ minus_zero = FUNC(copysign) (0.0, -1.0); plus_infty = CHOOSE (HUGE_VALL, HUGE_VAL, HUGE_VALF, HUGE_VALL, HUGE_VAL, HUGE_VALF); minus_infty = CHOOSE (-HUGE_VALL, -HUGE_VAL, -HUGE_VALF, -HUGE_VALL, -HUGE_VAL, -HUGE_VALF); (void) &plus_zero; (void) &nan_value; (void) &minus_zero; (void) &plus_infty; (void) &minus_infty; /* Clear all exceptions. From now on we must not get random exceptions. */ feclearexcept (FE_ALL_EXCEPT); } #if 0 /* XXX scp XXX */ /* Definitions of arguments for argp functions. */ static const struct argp_option options[] = { { "verbose", 'v', "NUMBER", 0, "Level of verbosity (0..3)"}, { "ulps-file", 'u', NULL, 0, "Output ulps to file ULPs"}, { "no-max-error", 'f', NULL, 0, "Don't output maximal errors of functions"}, { "no-points", 'p', NULL, 0, "Don't output results of functions invocations"}, { "ignore-max-ulp", 'i', "yes/no", 0, "Ignore given maximal errors"}, { NULL, 0, NULL, 0, NULL } }; /* Short description of program. */ static const char doc[] = "Math test suite: " TEST_MSG ; /* Prototype for option handler. */ static error_t parse_opt (int key, char *arg, struct argp_state *state); /* Data structure to communicate with argp functions. */ static struct argp argp = { options, parse_opt, NULL, doc, }; /* Handle program arguments. */ static error_t parse_opt (int key, char *arg, struct argp_state *state) { switch (key) { case 'f': output_max_error = 0; break; case 'i': if (strcmp (arg, "yes") == 0) ignore_max_ulp = 1; else if (strcmp (arg, "no") == 0) ignore_max_ulp = 0; break; case 'p': output_points = 0; break; case 'u': output_ulps = 1; break; case 'v': if (optarg) verbose = (unsigned int) strtoul (optarg, NULL, 0); else verbose = 3; break; default: return ARGP_ERR_UNKNOWN; } return 0; } #endif #if 0 /* function to check our ulp calculation. */ void check_ulp (void) { int i; FLOAT u, diff, ulp; /* This gives one ulp. */ u = FUNC(nextafter) (10, 20); check_equal (10.0, u, 1, &diff, &ulp); printf ("One ulp: % .4" PRINTF_NEXPR "\n", ulp); /* This gives one more ulp. */ u = FUNC(nextafter) (u, 20); check_equal (10.0, u, 2, &diff, &ulp); printf ("two ulp: % .4" PRINTF_NEXPR "\n", ulp); /* And now calculate 100 ulp. */ for (i = 2; i < 100; i++) u = FUNC(nextafter) (u, 20); check_equal (10.0, u, 100, &diff, &ulp); printf ("100 ulp: % .4" PRINTF_NEXPR "\n", ulp); } #endif int main (int argc, char **argv) { #if 0 /* XXX scp XXX */ int remaining; #endif verbose = 1; output_ulps = 0; output_max_error = 1; output_points = 1; /* XXX set to 0 for releases. */ ignore_max_ulp = 0; #if 0 /* XXX scp XXX */ /* Parse and process arguments. */ argp_parse (&argp, argc, argv, 0, &remaining, NULL); if (remaining != argc) { fprintf (stderr, "wrong number of arguments"); argp_help (&argp, stdout, ARGP_HELP_SEE, program_invocation_short_name); exit (EXIT_FAILURE); } #endif if (output_ulps) { ulps_file = fopen ("ULPs", "a"); if (ulps_file == NULL) { perror ("can't open file `ULPs' for writing: "); exit (1); } } initialize (); printf (TEST_MSG); #if 0 check_ulp (); #endif /* Keep the tests a wee bit ordered (according to ISO C99). */ /* Classification macros: */ fpclassify_test (); isfinite_test (); isnormal_test (); signbit_test (); /* Trigonometric functions: */ acos_test (); asin_test (); atan_test (); atan2_test (); cos_test (); sin_test (); sincos_test (); tan_test (); /* Hyperbolic functions: */ acosh_test (); asinh_test (); atanh_test (); cosh_test (); sinh_test (); tanh_test (); /* Exponential and logarithmic functions: */ exp_test (); #if 0 /* XXX scp XXX */ exp10_test (); #endif exp2_test (); expm1_test (); frexp_test (); ldexp_test (); log_test (); log10_test (); log1p_test (); log2_test (); logb_test (); modf_test (); ilogb_test (); scalbn_test (); scalbln_test (); /* Power and absolute value functions: */ cbrt_test (); fabs_test (); hypot_test (); pow_test (); sqrt_test (); /* Error and gamma functions: */ erf_test (); erfc_test (); gamma_test (); lgamma_test (); tgamma_test (); /* Nearest integer functions: */ ceil_test (); floor_test (); nearbyint_test (); rint_test (); lrint_test (); llrint_test (); round_test (); lround_test (); llround_test (); trunc_test (); /* Remainder functions: */ fmod_test (); remainder_test (); remquo_test (); /* Manipulation functions: */ copysign_test (); nextafter_test (); #if 0 /* XXX scp XXX */ nexttoward_test (); #endif /* maximum, minimum and positive difference functions */ fdim_test (); fmax_test (); fmin_test (); /* Multiply and add: */ fma_test (); #if 0 /* XXX scp XXX */ /* Complex functions: */ cabs_test (); cacos_test (); cacosh_test (); carg_test (); casin_test (); casinh_test (); catan_test (); catanh_test (); ccos_test (); ccosh_test (); cexp_test (); cimag_test (); clog10_test (); clog_test (); conj_test (); cpow_test (); cproj_test (); creal_test (); csin_test (); csinh_test (); csqrt_test (); ctan_test (); ctanh_test (); #endif /* Bessel functions: */ j0_test (); j1_test (); jn_test (); y0_test (); y1_test (); yn_test (); if (output_ulps) fclose (ulps_file); printf ("\nTest suite completed:\n"); printf (" %d test cases plus %d tests for exception flags executed.\n", noTests, noExcTests); if (noXFails) printf (" %d expected failures occurred.\n", noXFails); if (noXPasses) printf (" %d unexpected passes occurred.\n", noXPasses); if (noErrors) { printf (" %d errors occurred.\n", noErrors); return 1; } printf (" All tests passed successfully.\n"); return 0; } /* * Local Variables: * mode:c * End: */ wcc-0.0.2/src/wsh/openlibm/test/test-float.c0000644000175000017500000000245713122010155017337 0ustar philphil/* Copyright (C) 1997, 1999 Free Software Foundation, Inc. This file is part of the GNU C Library. Contributed by Andreas Jaeger , 1997. The GNU C Library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. The GNU C Library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with the GNU C Library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. */ #define FUNC(function) function ## f #define FLOAT float #define TEST_MSG "testing float (without inline functions)\n" #define MATHCONST(x) x #define CHOOSE(Clongdouble,Cdouble,Cfloat,Cinlinelongdouble,Cinlinedouble,Cinlinefloat) Cfloat #define PRINTF_EXPR "e" #define PRINTF_XEXPR "a" #define PRINTF_NEXPR "f" #define TEST_FLOAT 1 #ifndef __NO_MATH_INLINES # define __NO_MATH_INLINES #endif #include "libm-test.c" wcc-0.0.2/src/wsh/openlibm/test/libm-test-ulps.h0000644000175000017500000006733113122010155020145 0ustar philphil/* This file is automatically generated from libm-test-ulps with gen-libm-test.pl. Don't change it - change instead the master files. */ /* Maximal error of functions. */ #define DELTAacos CHOOSE(1150, 0, 0, 1150, 0, 0) /* acos */ #define DELTAacosh CHOOSE(1, 0, 0, 1, 0, 0) /* acosh */ #define DELTAasin CHOOSE(1, 1, 0, 1, 0, 0) /* asin */ #define DELTAasinh CHOOSE(656, 0, 0, 656, 0, 0) /* asinh */ #define DELTAatan CHOOSE(549, 0, 0, 549, 0, 0) /* atan */ #define DELTAatanh CHOOSE(1605, 1, 0, 1605, 1, 0) /* atanh */ #define DELTAatan2 CHOOSE(549, 0, 0, 549, 0, 0) /* atan2 */ #define DELTAcabs CHOOSE(560, 1, 1, 560, 1, 1) /* cabs */ #define DELTAcacos CHOOSE(BUILD_COMPLEX (151, 329), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 2), BUILD_COMPLEX (151, 329), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 2)) /* cacos */ #define DELTAcacosh CHOOSE(BUILD_COMPLEX (328, 151), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (4, 4), BUILD_COMPLEX (328, 151), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (4, 4)) /* cacosh */ #define DELTAcasin CHOOSE(BUILD_COMPLEX (603, 329), BUILD_COMPLEX (3, 0), BUILD_COMPLEX (2, 2), BUILD_COMPLEX (603, 329), BUILD_COMPLEX (3, 0), BUILD_COMPLEX (2, 2)) /* casin */ #define DELTAcasinh CHOOSE(BUILD_COMPLEX (892, 12), BUILD_COMPLEX (5, 3), BUILD_COMPLEX (1, 6), BUILD_COMPLEX (892, 12), BUILD_COMPLEX (5, 3), BUILD_COMPLEX (1, 6)) /* casinh */ #define DELTAcatan CHOOSE(BUILD_COMPLEX (251, 474), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (251, 474), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* catan */ #define DELTAcatanh CHOOSE(BUILD_COMPLEX (66, 447), BUILD_COMPLEX (2, 0), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (66, 447), BUILD_COMPLEX (2, 0), BUILD_COMPLEX (1, 0)) /* catanh */ #define DELTAcbrt CHOOSE(716, 1, 0, 716, 1, 0) /* cbrt */ #define DELTAccos CHOOSE(BUILD_COMPLEX (5, 1901), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (5, 1901), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1)) /* ccos */ #define DELTAccosh CHOOSE(BUILD_COMPLEX (1467, 1183), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1467, 1183), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1)) /* ccosh */ #define DELTAcexp CHOOSE(BUILD_COMPLEX (940, 1067), 0, BUILD_COMPLEX (1, 0), BUILD_COMPLEX (940, 1067), 0, BUILD_COMPLEX (1, 0)) /* cexp */ #define DELTAclog CHOOSE(BUILD_COMPLEX (0, 1), 0, 0, BUILD_COMPLEX (0, 1), 0, 0) /* clog */ #define DELTAclog10 CHOOSE(BUILD_COMPLEX (1403, 186), BUILD_COMPLEX (2, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1403, 186), BUILD_COMPLEX (2, 1), BUILD_COMPLEX (1, 1)) /* clog10 */ #define DELTAcos CHOOSE(529, 2, 1, 529, 2, 1) /* cos */ #define DELTAcosh CHOOSE(309, 0, 0, 309, 0, 0) /* cosh */ #define DELTAcpow CHOOSE(BUILD_COMPLEX (2, 9), BUILD_COMPLEX (1, 1.104), BUILD_COMPLEX (4, 2.5333), BUILD_COMPLEX (2, 9), BUILD_COMPLEX (1, 1.104), BUILD_COMPLEX (4, 2.5333)) /* cpow */ #define DELTAcsin CHOOSE(BUILD_COMPLEX (966, 168), 0, 0, BUILD_COMPLEX (966, 168), 0, 0) /* csin */ #define DELTAcsinh CHOOSE(BUILD_COMPLEX (413, 477), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (413, 477), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1)) /* csinh */ #define DELTAcsqrt CHOOSE(BUILD_COMPLEX (237, 128), BUILD_COMPLEX (1, 0), 0, BUILD_COMPLEX (237, 128), BUILD_COMPLEX (1, 0), 0) /* csqrt */ #define DELTActan CHOOSE(BUILD_COMPLEX (690, 367), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (690, 367), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 1)) /* ctan */ #define DELTActanh CHOOSE(BUILD_COMPLEX (286, 3074), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (286, 3074), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (1, 1)) /* ctanh */ #define DELTAerfc CHOOSE(36, 24, 12, 36, 24, 12) /* erfc */ #define DELTAexp CHOOSE(754, 0, 0, 754, 0, 0) /* exp */ #define DELTAexp10 CHOOSE(1182, 1, 0, 1182, 1, 0) /* exp10 */ #define DELTAexp2 CHOOSE(462, 0, 0, 462, 0, 0) /* exp2 */ #define DELTAexpm1 CHOOSE(825, 0, 0, 825, 0, 0) /* expm1 */ #define DELTAfmod CHOOSE(4096, 2, 1, 4096, 2, 1) /* fmod */ #define DELTAgamma CHOOSE(1, 1, 0, 1, 1, 0) /* gamma */ #define DELTAhypot CHOOSE(560, 1, 1, 560, 0, 0) /* hypot */ #define DELTAj0 CHOOSE(0, 2, 1, 0, 2, 1) /* j0 */ #define DELTAj1 CHOOSE(2, 2, 1, 2, 2, 1) /* j1 */ #define DELTAjn CHOOSE(2, 5, 2, 2, 5, 2) /* jn */ #define DELTAlgamma CHOOSE(1, 1, 2, 1, 1, 2) /* lgamma */ #define DELTAlog CHOOSE(2341, 1, 1, 2341, 1, 1) /* log */ #define DELTAlog10 CHOOSE(2033, 1, 1, 2033, 1, 1) /* log10 */ #define DELTAlog1p CHOOSE(585, 1, 1, 585, 1, 1) /* log1p */ #define DELTAlog2 CHOOSE(1688, 1, 1, 1688, 1, 1) /* log2 */ #define DELTApow CHOOSE(725, 0, 0, 725, 0, 0) /* pow */ #define DELTAsin CHOOSE(627, 0, 0, 627, 0, 0) /* sin */ #define DELTAsincos CHOOSE(627, 1, 1, 627, 1, 1) /* sincos */ #define DELTAsinh CHOOSE(1029, 0, 1, 1028, 0, 1) /* sinh */ #define DELTAsqrt CHOOSE(489, 0, 0, 489, 0, 0) /* sqrt */ #define DELTAtan CHOOSE(1401, 0.5, 0, 1401, 0.5, 0) /* tan */ #define DELTAtanh CHOOSE(521, 0, 0, 521, 0, 0) /* tanh */ #define DELTAtgamma CHOOSE(2, 2, 1, 2, 2, 1) /* tgamma */ #define DELTAy0 CHOOSE(2, 3, 1, 2, 3, 1) /* y0 */ #define DELTAy1 CHOOSE(2, 3, 2, 2, 3, 2) /* y1 */ #define DELTAyn CHOOSE(7, 6, 3, 7, 6, 3) /* yn */ /* Error of single function calls. */ #define DELTA16 CHOOSE(1, 0, 0, 1, 0, 0) /* acosh (7) == 2.633915793849633417250092694615937 */ #define DELTA24 CHOOSE(1, 0, 0, 1, 0, 0) /* asin (0.5) == pi/6 */ #define DELTA25 CHOOSE(1, 0, 0, 1, 0, 0) /* asin (-0.5) == -pi/6 */ #define DELTA26 CHOOSE(1, 0, 0, 1, 0, 0) /* asin (1.0) == pi/2 */ #define DELTA27 CHOOSE(1, 0, 0, 1, 0, 0) /* asin (-1.0) == -pi/2 */ #define DELTA28 CHOOSE(1, 1, 0, 1, 0, 0) /* asin (0.7) == 0.77539749661075306374035335271498708 */ #define DELTA34 CHOOSE(656, 0, 0, 656, 0, 0) /* asinh (0.7) == 0.652666566082355786 */ #define DELTA42 CHOOSE(549, 0, 0, 549, 0, 0) /* atan (0.7) == 0.61072596438920861654375887649023613 */ #define DELTA50 CHOOSE(1605, 1, 0, 1605, 1, 0) /* atanh (0.7) == 0.8673005276940531944 */ #define DELTA74 CHOOSE(549, 0, 0, 549, 0, 0) /* atan2 (0.7, 1) == 0.61072596438920861654375887649023613 */ #define DELTA78 CHOOSE(1, 0, 0, 1, 0, 0) /* atan2 (0.4, 0.0003) == 1.5700463269355215717704032607580829 */ #define DELTA85 CHOOSE(0, 0, 1, 0, 0, 1) /* cabs (0.7 + 12.4 i) == 12.419742348374220601176836866763271 */ #define DELTA86 CHOOSE(0, 0, 1, 0, 0, 1) /* cabs (-12.4 + 0.7 i) == 12.419742348374220601176836866763271 */ #define DELTA87 CHOOSE(0, 0, 1, 0, 0, 1) /* cabs (-0.7 + 12.4 i) == 12.419742348374220601176836866763271 */ #define DELTA88 CHOOSE(0, 0, 1, 0, 0, 1) /* cabs (-12.4 - 0.7 i) == 12.419742348374220601176836866763271 */ #define DELTA89 CHOOSE(0, 0, 1, 0, 0, 1) /* cabs (-0.7 - 12.4 i) == 12.419742348374220601176836866763271 */ #define DELTA96 CHOOSE(560, 1, 0, 560, 1, 0) /* cabs (0.7 + 1.2 i) == 1.3892443989449804508432547041028554 */ #define DELTA130 CHOOSE(BUILD_COMPLEX (151, 329), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 2), BUILD_COMPLEX (151, 329), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 2)) /* cacos (0.7 + 1.2 i) == 1.1351827477151551088992008271819053 - 1.0927647857577371459105272080819308 i */ #define DELTA131 CHOOSE(BUILD_COMPLEX (0, 1), 0, 0, BUILD_COMPLEX (0, 1), 0, 0) /* cacos (-2 - 3 i) == 2.1414491111159960199416055713254211 + 1.9833870299165354323470769028940395 i */ #define DELTA165 CHOOSE(BUILD_COMPLEX (328, 151), BUILD_COMPLEX (1, 0), 0, BUILD_COMPLEX (328, 151), BUILD_COMPLEX (1, 0), 0) /* cacosh (0.7 + 1.2 i) == 1.0927647857577371459105272080819308 + 1.1351827477151551088992008271819053 i */ #define DELTA166 CHOOSE(BUILD_COMPLEX (6, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (4, 4), BUILD_COMPLEX (6, 1), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (4, 4)) /* cacosh (-2 - 3 i) == -1.9833870299165354323470769028940395 + 2.1414491111159960199416055713254211 i */ #define DELTA225 CHOOSE(BUILD_COMPLEX (603, 329), BUILD_COMPLEX (3, 0), BUILD_COMPLEX (2, 2), BUILD_COMPLEX (603, 329), BUILD_COMPLEX (3, 0), BUILD_COMPLEX (2, 2)) /* casin (0.7 + 1.2 i) == 0.4356135790797415103321208644578462 + 1.0927647857577371459105272080819308 i */ #define DELTA226 CHOOSE(BUILD_COMPLEX (0, 1), 0, 0, BUILD_COMPLEX (0, 1), 0, 0) /* casin (-2 - 3 i) == -0.57065278432109940071028387968566963 - 1.9833870299165354323470769028940395 i */ #define DELTA262 CHOOSE(BUILD_COMPLEX (892, 12), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (892, 12), 0, BUILD_COMPLEX (0, 1)) /* casinh (0.7 + 1.2 i) == 0.97865459559367387689317593222160964 + 0.91135418953156011567903546856170941 i */ #define DELTA263 CHOOSE(BUILD_COMPLEX (6, 6), BUILD_COMPLEX (5, 3), BUILD_COMPLEX (1, 6), BUILD_COMPLEX (6, 6), BUILD_COMPLEX (5, 3), BUILD_COMPLEX (1, 6)) /* casinh (-2 - 3 i) == -1.9686379257930962917886650952454982 - 0.96465850440760279204541105949953237 i */ #define DELTA301 CHOOSE(BUILD_COMPLEX (251, 474), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (251, 474), 0, BUILD_COMPLEX (0, 1)) /* catan (0.7 + 1.2 i) == 1.0785743834118921877443707996386368 + 0.57705737765343067644394541889341712 i */ #define DELTA302 CHOOSE(BUILD_COMPLEX (0, 7), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 7), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* catan (-2 - 3 i) == -1.4099210495965755225306193844604208 - 0.22907268296853876629588180294200276 i */ #define DELTA340 CHOOSE(BUILD_COMPLEX (66, 447), BUILD_COMPLEX (1, 0), 0, BUILD_COMPLEX (66, 447), BUILD_COMPLEX (1, 0), 0) /* catanh (0.7 + 1.2 i) == 0.2600749516525135959200648705635915 + 0.97024030779509898497385130162655963 i */ #define DELTA341 CHOOSE(BUILD_COMPLEX (6, 0), BUILD_COMPLEX (2, 0), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (6, 0), BUILD_COMPLEX (2, 0), BUILD_COMPLEX (1, 0)) /* catanh (-2 - 3 i) == -0.14694666622552975204743278515471595 - 1.3389725222944935611241935759091443 i */ #define DELTA347 CHOOSE(716, 0, 0, 716, 0, 0) /* cbrt (-0.001) == -0.1 */ #define DELTA349 CHOOSE(1, 0, 0, 1, 0, 0) /* cbrt (-27.0) == -3.0 */ #define DELTA350 CHOOSE(306, 0, 0, 306, 0, 0) /* cbrt (0.970299) == 0.99 */ #define DELTA351 CHOOSE(346, 1, 0, 346, 1, 0) /* cbrt (0.7) == 0.8879040017426007084 */ #define DELTA389 CHOOSE(BUILD_COMPLEX (5, 1901), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (5, 1901), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 0)) /* ccos (0.7 + 1.2 i) == 1.3848657645312111080 - 0.97242170335830028619 i */ #define DELTA390 CHOOSE(BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1)) /* ccos (-2 - 3 i) == -4.1896256909688072301 - 9.1092278937553365979 i */ #define DELTA428 CHOOSE(BUILD_COMPLEX (1467, 1183), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1467, 1183), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 0)) /* ccosh (0.7 + 1.2 i) == 0.4548202223691477654 + 0.7070296600921537682 i */ #define DELTA429 CHOOSE(BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* ccosh (-2 - 3 i) == -3.7245455049153225654 + 0.5118225699873846088 i */ #define DELTA469 CHOOSE(BUILD_COMPLEX (940, 0), 0, BUILD_COMPLEX (1, 0), BUILD_COMPLEX (940, 0), 0, BUILD_COMPLEX (1, 0)) /* cexp (0.7 + 1.2 i) == 0.72969890915032360123451688642930727 + 1.8768962328348102821139467908203072 i */ #define DELTA470 CHOOSE(BUILD_COMPLEX (4, 18), 0, 0, BUILD_COMPLEX (4, 18), 0, 0) /* cexp (-2.0 - 3.0 i) == -0.13398091492954261346140525546115575 - 0.019098516261135196432576240858800925 i */ #define DELTA515 CHOOSE(BUILD_COMPLEX (0, 1), 0, 0, BUILD_COMPLEX (0, 1), 0, 0) /* clog (-2 - 3 i) == 1.2824746787307683680267437207826593 - 2.1587989303424641704769327722648368 i */ #define DELTA520 CHOOSE(0, BUILD_COMPLEX (0, 1), 0, 0, BUILD_COMPLEX (0, 1), 0) /* clog10 (-inf + inf i) == inf + 3/4 pi*log10(e) i */ #define DELTA521 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (inf + inf i) == inf + pi/4*log10(e) i */ #define DELTA522 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (inf - inf i) == inf - pi/4*log10(e) i */ #define DELTA523 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (0 + inf i) == inf + pi/2*log10(e) i */ #define DELTA524 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (3 + inf i) == inf + pi/2*log10(e) i */ #define DELTA525 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-0 + inf i) == inf + pi/2*log10(e) i */ #define DELTA526 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-3 + inf i) == inf + pi/2*log10(e) i */ #define DELTA527 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (0 - inf i) == inf - pi/2*log10(e) i */ #define DELTA528 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (3 - inf i) == inf - pi/2*log10(e) i */ #define DELTA529 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-0 - inf i) == inf - pi/2*log10(e) i */ #define DELTA530 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-3 - inf i) == inf - pi/2*log10(e) i */ #define DELTA531 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-inf + 0 i) == inf + pi*log10(e) i */ #define DELTA532 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-inf + 1 i) == inf + pi*log10(e) i */ #define DELTA533 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-inf - 0 i) == inf - pi*log10(e) i */ #define DELTA534 CHOOSE(0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1)) /* clog10 (-inf - 1 i) == inf - pi*log10(e) i */ #define DELTA552 CHOOSE(BUILD_COMPLEX (1403, 186), BUILD_COMPLEX (2, 1), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1403, 186), BUILD_COMPLEX (2, 1), BUILD_COMPLEX (1, 0)) /* clog10 (0.7 + 1.2 i) == 0.1427786545038868803 + 0.4528483579352493248 i */ #define DELTA553 CHOOSE(BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 1), 0) /* clog10 (-2 - 3 i) == 0.5569716761534183846 - 0.9375544629863747085 i */ #define DELTA582 CHOOSE(0, 1, 0.5, 0, 1, 0.5) /* cos (M_PI_6l * 2.0) == 0.5 */ #define DELTA583 CHOOSE(0.5, 2, 1, 0.5, 2, 1) /* cos (M_PI_6l * 4.0) == -0.5 */ #define DELTA584 CHOOSE(0.25, 0.2758, 0.3667, 0.25, 0.2758, 0.3667) /* cos (pi/2) == 0 */ #define DELTA585 CHOOSE(529, 1, 0, 529, 1, 0) /* cos (0.7) == 0.76484218728448842625585999019186495 */ #define DELTA591 CHOOSE(309, 0, 0, 309, 0, 0) /* cosh (0.7) == 1.255169005630943018 */ #define DELTA594 CHOOSE(BUILD_COMPLEX (0, 9), BUILD_COMPLEX (0, 1.104), BUILD_COMPLEX (0, 2.5333), BUILD_COMPLEX (0, 9), BUILD_COMPLEX (0, 1.104), BUILD_COMPLEX (0, 2.5333)) /* cpow (e + 0 i, 0 + 2 * M_PIl i) == 1.0 + 0.0 i */ #define DELTA595 CHOOSE(BUILD_COMPLEX (2, 5), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (4, 1), BUILD_COMPLEX (2, 5), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (4, 1)) /* cpow (2 + 3 i, 4 + 0 i) == -119.0 - 120.0 i */ #define DELTA652 CHOOSE(BUILD_COMPLEX (966, 168), 0, 0, BUILD_COMPLEX (966, 168), 0, 0) /* csin (0.7 + 1.2 i) == 1.1664563419657581376 + 1.1544997246948547371 i */ #define DELTA691 CHOOSE(BUILD_COMPLEX (413, 477), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (413, 477), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (1, 0)) /* csinh (0.7 + 1.2 i) == 0.27487868678117583582 + 1.1698665727426565139 i */ #define DELTA692 CHOOSE(BUILD_COMPLEX (0, 2), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (0, 2), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (0, 1)) /* csinh (-2 - 3 i) == 3.5905645899857799520 - 0.5309210862485198052 i */ #define DELTA732 CHOOSE(BUILD_COMPLEX (237, 128), BUILD_COMPLEX (1, 0), 0, BUILD_COMPLEX (237, 128), BUILD_COMPLEX (1, 0), 0) /* csqrt (0.7 + 1.2 i) == 1.022067610030026450706487883081139 + 0.58704531296356521154977678719838035 i */ #define DELTA733 CHOOSE(BUILD_COMPLEX (1, 0), 0, 0, BUILD_COMPLEX (1, 0), 0, 0) /* csqrt (-2 - 3 i) == 0.89597747612983812471573375529004348 - 1.6741492280355400404480393008490519 i */ #define DELTA734 CHOOSE(BUILD_COMPLEX (1, 0), 0, 0, BUILD_COMPLEX (1, 0), 0, 0) /* csqrt (-2 + 3 i) == 0.89597747612983812471573375529004348 + 1.6741492280355400404480393008490519 i */ #define DELTA766 CHOOSE(BUILD_COMPLEX (690, 367), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (690, 367), BUILD_COMPLEX (1, 1), BUILD_COMPLEX (1, 0)) /* ctan (0.7 + 1.2 i) == 0.1720734197630349001 + 0.9544807059989405538 i */ #define DELTA767 CHOOSE(BUILD_COMPLEX (439, 2), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (439, 2), 0, BUILD_COMPLEX (0, 1)) /* ctan (-2 - 3 i) == 0.0037640256415042482 - 1.0032386273536098014 i */ #define DELTA799 CHOOSE(0, BUILD_COMPLEX (0, 0.5), BUILD_COMPLEX (0, 1), 0, BUILD_COMPLEX (0, 0.5), BUILD_COMPLEX (0, 1)) /* ctanh (0 + pi/4 i) == 0.0 + 1.0 i */ #define DELTA800 CHOOSE(BUILD_COMPLEX (286, 3074), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (1, 0), BUILD_COMPLEX (286, 3074), BUILD_COMPLEX (0, 1), BUILD_COMPLEX (1, 0)) /* ctanh (0.7 + 1.2 i) == 1.3472197399061191630 + 0.4778641038326365540 i */ #define DELTA801 CHOOSE(BUILD_COMPLEX (5, 25), 0, BUILD_COMPLEX (0, 1), BUILD_COMPLEX (5, 25), 0, BUILD_COMPLEX (0, 1)) /* ctanh (-2 - 3 i) == -0.9653858790221331242 + 0.0098843750383224937 i */ #define DELTA817 CHOOSE(1, 1, 0, 1, 1, 0) /* erfc (0.7) == 0.32219880616258152702 */ #define DELTA818 CHOOSE(3, 1, 2, 3, 1, 2) /* erfc (1.2) == 0.089686021770364619762 */ #define DELTA819 CHOOSE(0, 1, 0, 0, 1, 0) /* erfc (2.0) == 0.0046777349810472658379 */ #define DELTA820 CHOOSE(12, 24, 12, 12, 24, 12) /* erfc (4.1) == 0.67000276540848983727e-8 */ #define DELTA821 CHOOSE(36, 0, 0, 36, 0, 0) /* erfc (9) == 0.41370317465138102381e-36 */ #define DELTA830 CHOOSE(412, 0, 0, 412, 0, 0) /* exp (0.7) == 2.0137527074704765216 */ #define DELTA831 CHOOSE(16, 0, 0, 16, 0, 0) /* exp (50.0) == 5184705528587072464087.45332293348538 */ #define DELTA832 CHOOSE(754, 0, 0, 754, 0, 0) /* exp (1000.0) == 0.197007111401704699388887935224332313e435 */ #define DELTA838 CHOOSE(8, 0, 0, 8, 0, 0) /* exp10 (3) == 1000 */ #define DELTA839 CHOOSE(818, 0, 0, 818, 0, 0) /* exp10 (-1) == 0.1 */ #define DELTA842 CHOOSE(1182, 1, 0, 1182, 1, 0) /* exp10 (0.7) == 5.0118723362727228500155418688494574 */ #define DELTA852 CHOOSE(462, 0, 0, 462, 0, 0) /* exp2 (0.7) == 1.6245047927124710452 */ #define DELTA859 CHOOSE(825, 0, 0, 825, 0, 0) /* expm1 (0.7) == 1.0137527074704765216 */ #define DELTA972 CHOOSE(4096, 2, 1, 4096, 2, 1) /* fmod (6.5, 2.3) == 1.9 */ #define DELTA973 CHOOSE(4096, 2, 1, 4096, 2, 1) /* fmod (-6.5, 2.3) == -1.9 */ #define DELTA974 CHOOSE(4096, 2, 1, 4096, 2, 1) /* fmod (6.5, -2.3) == 1.9 */ #define DELTA975 CHOOSE(4096, 2, 1, 4096, 2, 1) /* fmod (-6.5, -2.3) == -1.9 */ #define DELTA1004 CHOOSE(1, 1, 0, 1, 1, 0) /* gamma (-0.5) == log(2*sqrt(pi)) */ #define DELTA1013 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (0.7, 12.4) == 12.419742348374220601176836866763271 */ #define DELTA1014 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (-0.7, 12.4) == 12.419742348374220601176836866763271 */ #define DELTA1015 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (0.7, -12.4) == 12.419742348374220601176836866763271 */ #define DELTA1016 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (-0.7, -12.4) == 12.419742348374220601176836866763271 */ #define DELTA1017 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (12.4, 0.7) == 12.419742348374220601176836866763271 */ #define DELTA1018 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (-12.4, 0.7) == 12.419742348374220601176836866763271 */ #define DELTA1019 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (12.4, -0.7) == 12.419742348374220601176836866763271 */ #define DELTA1020 CHOOSE(406, 0, 1, 406, 0, 0) /* hypot (-12.4, -0.7) == 12.419742348374220601176836866763271 */ #define DELTA1024 CHOOSE(560, 1, 0, 560, 0, 0) /* hypot (0.7, 1.2) == 1.3892443989449804508432547041028554 */ #define DELTA1053 CHOOSE(0, 1, 1, 0, 1, 1) /* j0 (2.0) == 0.22389077914123566805 */ #define DELTA1054 CHOOSE(0, 0, 1, 0, 0, 1) /* j0 (8.0) == 0.17165080713755390609 */ #define DELTA1055 CHOOSE(0, 2, 1, 0, 2, 1) /* j0 (10.0) == -0.24593576445134833520 */ #define DELTA1064 CHOOSE(0, 1, 0, 0, 1, 0) /* j1 (2.0) == 0.57672480775687338720 */ #define DELTA1065 CHOOSE(1, 0, 1, 1, 0, 1) /* j1 (8.0) == 0.23463634685391462438 */ #define DELTA1066 CHOOSE(2, 2, 1, 2, 2, 1) /* j1 (10.0) == 0.043472746168861436670 */ #define DELTA1075 CHOOSE(0, 1, 1, 0, 1, 1) /* jn (0, 2.0) == 0.22389077914123566805 */ #define DELTA1076 CHOOSE(1, 0, 1, 1, 0, 1) /* jn (0, 8.0) == 0.17165080713755390609 */ #define DELTA1077 CHOOSE(2, 2, 1, 2, 2, 1) /* jn (0, 10.0) == -0.24593576445134833520 */ #define DELTA1086 CHOOSE(0, 1, 0, 0, 1, 0) /* jn (1, 2.0) == 0.57672480775687338720 */ #define DELTA1087 CHOOSE(1, 0, 1, 1, 0, 1) /* jn (1, 8.0) == 0.23463634685391462438 */ #define DELTA1088 CHOOSE(2, 2, 1, 2, 2, 1) /* jn (1, 10.0) == 0.043472746168861436670 */ #define DELTA1091 CHOOSE(1, 0, 0, 1, 0, 0) /* jn (3, -1.0) == -0.019563353982668405919 */ #define DELTA1093 CHOOSE(1, 1, 0, 1, 1, 0) /* jn (3, 0.1) == 0.000020820315754756261429 */ #define DELTA1094 CHOOSE(0, 2, 0, 0, 2, 0) /* jn (3, 0.7) == 0.0069296548267508408077 */ #define DELTA1095 CHOOSE(1, 0, 0, 1, 0, 0) /* jn (3, 1.0) == 0.019563353982668405919 */ #define DELTA1096 CHOOSE(0, 1, 1, 0, 1, 1) /* jn (3, 2.0) == 0.12894324947440205110 */ #define DELTA1097 CHOOSE(1, 3, 1, 1, 3, 1) /* jn (3, 10.0) == 0.058379379305186812343 */ #define DELTA1100 CHOOSE(1, 1, 1, 1, 1, 1) /* jn (10, -1.0) == 0.26306151236874532070e-9 */ #define DELTA1102 CHOOSE(1, 5, 2, 1, 5, 2) /* jn (10, 0.1) == 0.26905328954342155795e-19 */ #define DELTA1103 CHOOSE(2, 4, 1, 2, 4, 1) /* jn (10, 0.7) == 0.75175911502153953928e-11 */ #define DELTA1104 CHOOSE(1, 1, 1, 1, 1, 1) /* jn (10, 1.0) == 0.26306151236874532070e-9 */ #define DELTA1105 CHOOSE(1, 2, 1, 1, 2, 1) /* jn (10, 2.0) == 0.25153862827167367096e-6 */ #define DELTA1106 CHOOSE(2, 4, 2, 2, 4, 2) /* jn (10, 10.0) == 0.20748610663335885770 */ #define DELTA1126 CHOOSE(1, 1, 0, 1, 1, 0) /* lgamma (-0.5) == log(2*sqrt(pi)) */ #define DELTA1128 CHOOSE(0, 1, 1, 0, 1, 1) /* lgamma (0.7) == 0.26086724653166651439 */ #define DELTA1130 CHOOSE(1, 1, 2, 1, 1, 2) /* lgamma (1.2) == -0.853740900033158497197e-1 */ #define DELTA1163 CHOOSE(1, 0, 0.5, 1, 0, 0.5) /* log (e) == 1 */ #define DELTA1164 CHOOSE(1, 0, 0, 1, 0, 0) /* log (1.0 / M_El) == -1 */ #define DELTA1167 CHOOSE(2341, 1, 1, 2341, 1, 1) /* log (0.7) == -0.35667494393873237891263871124118447 */ #define DELTA1178 CHOOSE(1, 0, 1, 1, 0, 1) /* log10 (e) == log10(e) */ #define DELTA1179 CHOOSE(2033, 1, 0, 2033, 1, 0) /* log10 (0.7) == -0.15490195998574316929 */ #define DELTA1186 CHOOSE(1, 0, 0, 1, 0, 0) /* log1p (M_El - 1.0) == 1 */ #define DELTA1187 CHOOSE(585, 1, 1, 585, 1, 1) /* log1p (-0.3) == -0.35667494393873237891263871124118447 */ #define DELTA1198 CHOOSE(1688, 1, 1, 1688, 1, 1) /* log2 (0.7) == -0.51457317282975824043 */ #define DELTA1398 CHOOSE(725, 0, 0, 725, 0, 0) /* pow (0.7, 1.2) == 0.65180494056638638188 */ #define DELTA1524 CHOOSE(627, 0, 0, 627, 0, 0) /* sin (0.7) == 0.64421768723769105367261435139872014 */ #define DELTA1536 CHOOSE(0.25, 0.2758, 0.3667, 0.25, 0.2758, 0.3667) /* sincos (pi/2, &sin_res, &cos_res) puts 0 in cos_res */ #define DELTA1539 CHOOSE(1, 1, 1, 1, 1, 1) /* sincos (M_PI_6l*2.0, &sin_res, &cos_res) puts 0.86602540378443864676372317075293616 in sin_res */ #define DELTA1540 CHOOSE(0, 1, 0.5, 0, 1, 0.5) /* sincos (M_PI_6l*2.0, &sin_res, &cos_res) puts 0.5 in cos_res */ #define DELTA1541 CHOOSE(627, 0, 0, 627, 0, 0) /* sincos (0.7, &sin_res, &cos_res) puts 0.64421768723769105367261435139872014 in sin_res */ #define DELTA1542 CHOOSE(528, 1, 0, 528, 1, 0) /* sincos (0.7, &sin_res, &cos_res) puts 0.76484218728448842625585999019186495 in cos_res */ #define DELTA1548 CHOOSE(1029, 0, 1, 1028, 0, 1) /* sinh (0.7) == 0.75858370183953350346 */ #define DELTA1562 CHOOSE(325, 0, 0, 325, 0, 0) /* sqrt (15239.9025) == 123.45 */ #define DELTA1569 CHOOSE(0, 0.5, 0, 0, 0.5, 0) /* tan (pi/4) == 1 */ #define DELTA1570 CHOOSE(1401, 0, 0, 1401, 0, 0) /* tan (0.7) == 0.84228838046307944812813500221293775 */ #define DELTA1576 CHOOSE(521, 0, 0, 521, 0, 0) /* tanh (0.7) == 0.60436777711716349631 */ #define DELTA1577 CHOOSE(1, 0, 0, 1, 0, 0) /* tanh (-0.7) == -0.60436777711716349631 */ #define DELTA1587 CHOOSE(0, 0, 1, 0, 0, 1) /* tgamma (0.5) == sqrt (pi) */ #define DELTA1588 CHOOSE(2, 2, 1, 2, 2, 1) /* tgamma (-0.5) == -2 sqrt (pi) */ #define DELTA1590 CHOOSE(2, 0, 0, 2, 0, 0) /* tgamma (4) == 6 */ #define DELTA1591 CHOOSE(0, 1, 1, 0, 1, 1) /* tgamma (0.7) == 1.29805533264755778568 */ #define DELTA1614 CHOOSE(0, 1, 1, 0, 1, 1) /* y0 (0.1) == -1.5342386513503668441 */ #define DELTA1615 CHOOSE(2, 3, 1, 2, 3, 1) /* y0 (0.7) == -0.19066492933739506743 */ #define DELTA1616 CHOOSE(0, 2, 1, 0, 2, 1) /* y0 (1.0) == 0.088256964215676957983 */ #define DELTA1617 CHOOSE(0, 1, 1, 0, 1, 1) /* y0 (1.5) == 0.38244892379775884396 */ #define DELTA1618 CHOOSE(0, 1, 0, 0, 1, 0) /* y0 (2.0) == 0.51037567264974511960 */ #define DELTA1619 CHOOSE(1, 1, 1, 1, 1, 1) /* y0 (8.0) == 0.22352148938756622053 */ #define DELTA1620 CHOOSE(1, 2, 1, 2, 2, 1) /* y0 (10.0) == 0.055671167283599391424 */ #define DELTA1625 CHOOSE(1, 1, 1, 1, 1, 1) /* y1 (0.1) == -6.4589510947020269877 */ #define DELTA1626 CHOOSE(0, 1, 0, 0, 1, 0) /* y1 (0.7) == -1.1032498719076333697 */ #define DELTA1627 CHOOSE(0, 1, 0, 0, 1, 0) /* y1 (1.0) == -0.78121282130028871655 */ #define DELTA1628 CHOOSE(0, 0, 1, 0, 0, 1) /* y1 (1.5) == -0.41230862697391129595 */ #define DELTA1629 CHOOSE(1, 1, 2, 1, 1, 2) /* y1 (2.0) == -0.10703243154093754689 */ #define DELTA1630 CHOOSE(2, 0, 2, 2, 0, 2) /* y1 (8.0) == -0.15806046173124749426 */ #define DELTA1631 CHOOSE(0, 3, 2, 0, 3, 2) /* y1 (10.0) == 0.24901542420695388392 */ #define DELTA1636 CHOOSE(0, 1, 1, 0, 1, 1) /* yn (0, 0.1) == -1.5342386513503668441 */ #define DELTA1637 CHOOSE(2, 3, 1, 2, 3, 1) /* yn (0, 0.7) == -0.19066492933739506743 */ #define DELTA1638 CHOOSE(0, 2, 1, 0, 2, 1) /* yn (0, 1.0) == 0.088256964215676957983 */ #define DELTA1639 CHOOSE(0, 1, 1, 0, 1, 1) /* yn (0, 1.5) == 0.38244892379775884396 */ #define DELTA1640 CHOOSE(0, 1, 0, 0, 1, 0) /* yn (0, 2.0) == 0.51037567264974511960 */ #define DELTA1641 CHOOSE(1, 1, 1, 1, 1, 1) /* yn (0, 8.0) == 0.22352148938756622053 */ #define DELTA1642 CHOOSE(1, 2, 1, 1, 2, 1) /* yn (0, 10.0) == 0.055671167283599391424 */ #define DELTA1647 CHOOSE(1, 1, 1, 1, 1, 1) /* yn (1, 0.1) == -6.4589510947020269877 */ #define DELTA1648 CHOOSE(0, 1, 0, 0, 1, 0) /* yn (1, 0.7) == -1.1032498719076333697 */ #define DELTA1649 CHOOSE(0, 1, 0, 0, 1, 0) /* yn (1, 1.0) == -0.78121282130028871655 */ #define DELTA1650 CHOOSE(0, 0, 1, 0, 0, 1) /* yn (1, 1.5) == -0.41230862697391129595 */ #define DELTA1651 CHOOSE(1, 1, 2, 1, 1, 2) /* yn (1, 2.0) == -0.10703243154093754689 */ #define DELTA1652 CHOOSE(2, 0, 2, 2, 0, 2) /* yn (1, 8.0) == -0.15806046173124749426 */ #define DELTA1653 CHOOSE(0, 3, 2, 0, 3, 2) /* yn (1, 10.0) == 0.24901542420695388392 */ #define DELTA1656 CHOOSE(2, 1, 1, 2, 1, 1) /* yn (3, 0.1) == -5099.3323786129048894 */ #define DELTA1657 CHOOSE(2, 3, 1, 2, 3, 1) /* yn (3, 0.7) == -15.819479052819633505 */ #define DELTA1659 CHOOSE(0, 1, 1, 0, 1, 1) /* yn (3, 2.0) == -1.1277837768404277861 */ #define DELTA1660 CHOOSE(0, 1, 1, 0, 1, 1) /* yn (3, 10.0) == -0.25136265718383732978 */ #define DELTA1663 CHOOSE(2, 2, 1, 2, 2, 1) /* yn (10, 0.1) == -0.11831335132045197885e19 */ #define DELTA1664 CHOOSE(7, 6, 3, 7, 6, 3) /* yn (10, 0.7) == -0.42447194260703866924e10 */ #define DELTA1665 CHOOSE(0, 1, 1, 0, 1, 1) /* yn (10, 1.0) == -0.12161801427868918929e9 */ #define DELTA1666 CHOOSE(1, 2, 1, 1, 2, 1) /* yn (10, 2.0) == -129184.54220803928264 */ #define DELTA1667 CHOOSE(0, 2, 1, 0, 2, 1) /* yn (10, 10.0) == -0.35981415218340272205 */ wcc-0.0.2/src/wsh/openlibm/powerpc/0000755000175000017500000000000013122010155015601 5ustar philphilwcc-0.0.2/src/wsh/openlibm/powerpc/Make.files0000644000175000017500000000002513122010155017477 0ustar philphil$(CUR_SRCS) = fenv.c wcc-0.0.2/src/wsh/openlibm/powerpc/fenv.c0000644000175000017500000000413713122010155016710 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD$ */ #define __fenv_static #include #ifdef __GNUC_GNU_INLINE__ #error "This file must be compiled with C99 'inline' semantics" #endif const fenv_t __fe_dfl_env = 0x00000000; extern inline int feclearexcept(int __excepts); extern inline int fegetexceptflag(fexcept_t *__flagp, int __excepts); extern inline int fesetexceptflag(const fexcept_t *__flagp, int __excepts); extern inline int feraiseexcept(int __excepts); extern inline int fetestexcept(int __excepts); extern inline int fegetround(void); extern inline int fesetround(int __round); extern inline int fegetenv(fenv_t *__envp); extern inline int feholdexcept(fenv_t *__envp); extern inline int fesetenv(const fenv_t *__envp); extern inline int feupdateenv(const fenv_t *__envp); wcc-0.0.2/src/wsh/openlibm/include/0000755000175000017500000000000013122010155015545 5ustar philphilwcc-0.0.2/src/wsh/openlibm/include/openlibm_fenv_amd64.h0000644000175000017500000001406113122010155021536 0ustar philphil/*- * Copyright (c) 2004-2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/amd64/fenv.h,v 1.8 2011/10/10 15:43:09 das Exp $ */ #ifndef _FENV_H_ #define _FENV_H_ #include "cdefs-compat.h" #include "types-compat.h" #include "math_private.h" #ifndef __fenv_static #define __fenv_static static #endif typedef struct { struct { uint32_t __control; uint32_t __status; uint32_t __tag; char __other[16]; } __x87; uint32_t __mxcsr; } fenv_t; typedef uint16_t fexcept_t; /* Exception flags */ #define FE_INVALID 0x01 #define FE_DENORMAL 0x02 #define FE_DIVBYZERO 0x04 #define FE_OVERFLOW 0x08 #define FE_UNDERFLOW 0x10 #define FE_INEXACT 0x20 #define FE_ALL_EXCEPT (FE_DIVBYZERO | FE_DENORMAL | FE_INEXACT | \ FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) /* Rounding modes */ #define FE_TONEAREST 0x0000 #define FE_DOWNWARD 0x0400 #define FE_UPWARD 0x0800 #define FE_TOWARDZERO 0x0c00 #define _ROUND_MASK (FE_TONEAREST | FE_DOWNWARD | \ FE_UPWARD | FE_TOWARDZERO) /* * As compared to the x87 control word, the SSE unit's control word * has the rounding control bits offset by 3 and the exception mask * bits offset by 7. */ #define _SSE_ROUND_SHIFT 3 #define _SSE_EMASK_SHIFT 7 __BEGIN_DECLS /* Default floating-point environment */ extern const fenv_t __fe_dfl_env; #define FE_DFL_ENV (&__fe_dfl_env) #define __fldcw(__cw) __asm __volatile("fldcw %0" : : "m" (__cw)) #define __fldenv(__env) __asm __volatile("fldenv %0" : : "m" (__env)) #define __fldenvx(__env) __asm __volatile("fldenv %0" : : "m" (__env) \ : "st", "st(1)", "st(2)", "st(3)", "st(4)", \ "st(5)", "st(6)", "st(7)") #define __fnclex() __asm __volatile("fnclex") #define __fnstenv(__env) __asm __volatile("fnstenv %0" : "=m" (*(__env))) #define __fnstcw(__cw) __asm __volatile("fnstcw %0" : "=m" (*(__cw))) #define __fnstsw(__sw) __asm __volatile("fnstsw %0" : "=am" (*(__sw))) #define __fwait() __asm __volatile("fwait") #define __ldmxcsr(__csr) __asm __volatile("ldmxcsr %0" : : "m" (__csr)) #define __stmxcsr(__csr) __asm __volatile("stmxcsr %0" : "=m" (*(__csr))) __fenv_static __attribute__((always_inline)) inline int feclearexcept(int __excepts) { fenv_t __env; if (__excepts == FE_ALL_EXCEPT) { __fnclex(); } else { __fnstenv(&__env.__x87); __env.__x87.__status &= ~__excepts; __fldenv(__env.__x87); } __stmxcsr(&__env.__mxcsr); __env.__mxcsr &= ~__excepts; __ldmxcsr(__env.__mxcsr); return (0); } __fenv_static inline int fegetexceptflag(fexcept_t *__flagp, int __excepts) { uint32_t __mxcsr; uint16_t __status; __stmxcsr(&__mxcsr); __fnstsw(&__status); *__flagp = (__mxcsr | __status) & __excepts; return (0); } OLM_DLLEXPORT int fesetexceptflag(const fexcept_t *__flagp, int __excepts); OLM_DLLEXPORT int feraiseexcept(int __excepts); __fenv_static __attribute__((always_inline)) inline int fetestexcept(int __excepts) { uint32_t __mxcsr; uint16_t __status; __stmxcsr(&__mxcsr); __fnstsw(&__status); return ((__status | __mxcsr) & __excepts); } __fenv_static inline int fegetround(void) { uint16_t __control; /* * We assume that the x87 and the SSE unit agree on the * rounding mode. Reading the control word on the x87 turns * out to be about 5 times faster than reading it on the SSE * unit on an Opteron 244. */ __fnstcw(&__control); return (__control & _ROUND_MASK); } __fenv_static inline int fesetround(int __round) { uint32_t __mxcsr; uint16_t __control; if (__round & ~_ROUND_MASK) return (-1); __fnstcw(&__control); __control &= ~_ROUND_MASK; __control |= __round; __fldcw(__control); __stmxcsr(&__mxcsr); __mxcsr &= ~(_ROUND_MASK << _SSE_ROUND_SHIFT); __mxcsr |= __round << _SSE_ROUND_SHIFT; __ldmxcsr(__mxcsr); return (0); } OLM_DLLEXPORT int fegetenv(fenv_t *__envp); OLM_DLLEXPORT int feholdexcept(fenv_t *__envp); __fenv_static inline int fesetenv(const fenv_t *__envp) { /* * XXX Using fldenvx() instead of fldenv() tells the compiler that this * instruction clobbers the i387 register stack. This happens because * we restore the tag word from the saved environment. Normally, this * would happen anyway and we wouldn't care, because the ABI allows * function calls to clobber the i387 regs. However, fesetenv() is * inlined, so we need to be more careful. */ __fldenvx(__envp->__x87); __ldmxcsr(__envp->__mxcsr); return (0); } OLM_DLLEXPORT int feupdateenv(const fenv_t *__envp); #if __BSD_VISIBLE OLM_DLLEXPORT int feenableexcept(int __mask); OLM_DLLEXPORT int fedisableexcept(int __mask); /* We currently provide no external definition of fegetexcept(). */ static inline int fegetexcept(void) { uint16_t __control; /* * We assume that the masks for the x87 and the SSE unit are * the same. */ __fnstcw(&__control); return (~__control & FE_ALL_EXCEPT); } #endif /* __BSD_VISIBLE */ __END_DECLS #endif /* !_FENV_H_ */ wcc-0.0.2/src/wsh/openlibm/include/openlibm_complex.h0000644000175000017500000001356013122010155021257 0ustar philphil/* $OpenBSD: complex.h,v 1.5 2014/03/16 18:38:30 guenther Exp $ */ /* * Copyright (c) 2008 Martynas Venckus * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #ifdef OPENLIBM_USE_HOST_COMPLEX_H #include #else /* !OPENLIBM_USE_HOST_COMPLEX_H */ #ifndef OPENLIBM_COMPLEX_H #define OPENLIBM_COMPLEX_H #define complex _Complex #define _Complex_I 1.0fi #define I _Complex_I /* * Macros that can be used to construct complex values. * * The C99 standard intends x+I*y to be used for this, but x+I*y is * currently unusable in general since gcc introduces many overflow, * underflow, sign and efficiency bugs by rewriting I*y as * (0.0+I)*(y+0.0*I) and laboriously computing the full complex product. * In particular, I*Inf is corrupted to NaN+I*Inf, and I*-0 is corrupted * to -0.0+I*0.0. * * In C11, a CMPLX(x,y) macro was added to circumvent this limitation, * and gcc 4.7 added a __builtin_complex feature to simplify implementation * of CMPLX in libc, so we can take advantage of these features if they * are available. Clang simply allows complex values to be constructed * using a compound literal. * * If __builtin_complex is not available, resort to using inline * functions instead. These can unfortunately not be used to construct * compile-time constants. * * C99 specifies that complex numbers have the same representation as * an array of two elements, where the first element is the real part * and the second element is the imaginary part. */ #ifdef __clang__ # define CMPLXF(x, y) ((float complex){x, y}) # define CMPLX(x, y) ((double complex){x, y}) # define CMPLXL(x, y) ((long double complex){x, y}) #elif (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7)) && !defined(__INTEL_COMPILER) # define CMPLXF(x,y) __builtin_complex ((float) (x), (float) (y)) # define CMPLX(x,y) __builtin_complex ((double) (x), (double) (y)) # define CMPLXL(x,y) __builtin_complex ((long double) (x), (long double) (y)) #else static inline float complex CMPLXF(float x, float y) { union { float a[2]; float complex f; } z = {{ x, y }}; return (z.f); } static inline double complex CMPLX(double x, double y) { union { double a[2]; double complex f; } z = {{ x, y }}; return (z.f); } static inline long double complex CMPLXL(long double x, long double y) { union { long double a[2]; long double complex f; } z = {{ x, y }}; return (z.f); } #endif /* * Double versions of C99 functions */ double complex cacos(double complex); double complex casin(double complex); double complex catan(double complex); double complex ccos(double complex); double complex csin(double complex); double complex ctan(double complex); double complex cacosh(double complex); double complex casinh(double complex); double complex catanh(double complex); double complex ccosh(double complex); double complex csinh(double complex); double complex ctanh(double complex); double complex cexp(double complex); double complex clog(double complex); double cabs(double complex); double complex cpow(double complex, double complex); double complex csqrt(double complex); double carg(double complex); double cimag(double complex); double complex conj(double complex); double complex cproj(double complex); double creal(double complex); /* * Float versions of C99 functions */ float complex cacosf(float complex); float complex casinf(float complex); float complex catanf(float complex); float complex ccosf(float complex); float complex csinf(float complex); float complex ctanf(float complex); float complex cacoshf(float complex); float complex casinhf(float complex); float complex catanhf(float complex); float complex ccoshf(float complex); float complex csinhf(float complex); float complex ctanhf(float complex); float complex cexpf(float complex); float complex clogf(float complex); float cabsf(float complex); float complex cpowf(float complex, float complex); float complex csqrtf(float complex); float cargf(float complex); float cimagf(float complex); float complex conjf(float complex); float complex cprojf(float complex); float crealf(float complex); /* * Long double versions of C99 functions */ long double complex cacosl(long double complex); long double complex casinl(long double complex); long double complex catanl(long double complex); long double complex ccosl(long double complex); long double complex csinl(long double complex); long double complex ctanl(long double complex); long double complex cacoshl(long double complex); long double complex casinhl(long double complex); long double complex catanhl(long double complex); long double complex ccoshl(long double complex); long double complex csinhl(long double complex); long double complex ctanhl(long double complex); long double complex cexpl(long double complex); long double complex clogl(long double complex); long double cabsl(long double complex); long double complex cpowl(long double complex, long double complex); long double complex csqrtl(long double complex); long double cargl(long double complex); long double cimagl(long double complex); long double complex conjl(long double complex); long double complex cprojl(long double complex); long double creall(long double complex); #endif /* !OPENLIBM_COMPLEX_H */ #endif /* OPENLIBM_USE_HOST_COMPLEX_H */ wcc-0.0.2/src/wsh/openlibm/include/openlibm_fenv_arm.h0000644000175000017500000001213313122010155021400 0ustar philphil/*- * Copyright (c) 2004-2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/arm/fenv.h,v 1.6 2011/10/10 15:43:09 das Exp $ */ #ifndef _FENV_H_ #define _FENV_H_ #include #include "cdefs-compat.h" #ifndef __fenv_static #define __fenv_static static #endif typedef uint32_t fenv_t; typedef uint32_t fexcept_t; /* Exception flags */ #define FE_INVALID 0x0001 #define FE_DIVBYZERO 0x0002 #define FE_OVERFLOW 0x0004 #define FE_UNDERFLOW 0x0008 #define FE_INEXACT 0x0010 #define FE_ALL_EXCEPT (FE_DIVBYZERO | FE_INEXACT | \ FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) /* Rounding modes */ #define FE_TONEAREST 0x0000 #define FE_TOWARDZERO 0x0001 #define FE_UPWARD 0x0002 #define FE_DOWNWARD 0x0003 #define _ROUND_MASK (FE_TONEAREST | FE_DOWNWARD | \ FE_UPWARD | FE_TOWARDZERO) __BEGIN_DECLS /* Default floating-point environment */ extern const fenv_t __fe_dfl_env; #define FE_DFL_ENV (&__fe_dfl_env) /* We need to be able to map status flag positions to mask flag positions */ #define _FPUSW_SHIFT 16 #define _ENABLE_MASK (FE_ALL_EXCEPT << _FPUSW_SHIFT) #if defined(__aarch64__) #define __rfs(__fpsr) __asm __volatile("mrs %0,fpsr" : "=r" (*(__fpsr))) #define __wfs(__fpsr) __asm __volatile("msr fpsr,%0" : : "r" (__fpsr)) #elif defined(ARM_HARD_FLOAT) #define __rfs(__fpsr) __asm __volatile("rfs %0" : "=r" (*(__fpsr))) #define __wfs(__fpsr) __asm __volatile("wfs %0" : : "r" (__fpsr)) #else #define __rfs(__fpsr) #define __wfs(__fpsr) #endif __fenv_static inline int feclearexcept(int __excepts) { fexcept_t __fpsr; __rfs(&__fpsr); __fpsr &= ~__excepts; __wfs(__fpsr); return (0); } __fenv_static inline int fegetexceptflag(fexcept_t *__flagp, int __excepts) { fexcept_t __fpsr; __rfs(&__fpsr); *__flagp = __fpsr & __excepts; return (0); } __fenv_static inline int fesetexceptflag(const fexcept_t *__flagp, int __excepts) { fexcept_t __fpsr; __rfs(&__fpsr); __fpsr &= ~__excepts; __fpsr |= *__flagp & __excepts; __wfs(__fpsr); return (0); } __fenv_static inline int feraiseexcept(int __excepts) { fexcept_t __ex = __excepts; fesetexceptflag(&__ex, __excepts); /* XXX */ return (0); } __fenv_static inline int fetestexcept(int __excepts) { fexcept_t __fpsr; __rfs(&__fpsr); return (__fpsr & __excepts); } __fenv_static inline int fegetround(void) { /* * Apparently, the rounding mode is specified as part of the * instruction format on ARM, so the dynamic rounding mode is * indeterminate. Some FPUs may differ. */ return (-1); } __fenv_static inline int fesetround(int __round) { return (-1); } __fenv_static inline int fegetenv(fenv_t *__envp) { __rfs(__envp); return (0); } __fenv_static inline int feholdexcept(fenv_t *__envp) { fenv_t __env; __rfs(&__env); *__envp = __env; __env &= ~(FE_ALL_EXCEPT | _ENABLE_MASK); __wfs(__env); return (0); } __fenv_static inline int fesetenv(const fenv_t *__envp) { __wfs(*__envp); return (0); } __fenv_static inline int feupdateenv(const fenv_t *__envp) { fexcept_t __fpsr; __rfs(&__fpsr); __wfs(*__envp); feraiseexcept(__fpsr & FE_ALL_EXCEPT); return (0); } #if __BSD_VISIBLE /* We currently provide no external definitions of the functions below. */ static inline int feenableexcept(int __mask) { fenv_t __old_fpsr, __new_fpsr; __rfs(&__old_fpsr); __new_fpsr = __old_fpsr | (__mask & FE_ALL_EXCEPT) << _FPUSW_SHIFT; __wfs(__new_fpsr); return ((__old_fpsr >> _FPUSW_SHIFT) & FE_ALL_EXCEPT); } static inline int fedisableexcept(int __mask) { fenv_t __old_fpsr, __new_fpsr; __rfs(&__old_fpsr); __new_fpsr = __old_fpsr & ~((__mask & FE_ALL_EXCEPT) << _FPUSW_SHIFT); __wfs(__new_fpsr); return ((__old_fpsr >> _FPUSW_SHIFT) & FE_ALL_EXCEPT); } static inline int fegetexcept(void) { fenv_t __fpsr; __rfs(&__fpsr); return ((__fpsr & _ENABLE_MASK) >> _FPUSW_SHIFT); } #endif /* __BSD_VISIBLE */ __END_DECLS #endif /* !_FENV_H_ */ wcc-0.0.2/src/wsh/openlibm/include/openlibm_fenv_powerpc.h0000644000175000017500000001517713122010155022313 0ustar philphil/*- * Copyright (c) 2004-2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD$ */ #ifndef _FENV_H_ #define _FENV_H_ #include #ifndef __fenv_static #define __fenv_static static #endif typedef __uint32_t fenv_t; typedef __uint32_t fexcept_t; /* Exception flags */ #define FE_INEXACT 0x02000000 #define FE_DIVBYZERO 0x04000000 #define FE_UNDERFLOW 0x08000000 #define FE_OVERFLOW 0x10000000 #define FE_INVALID 0x20000000 /* all types of invalid FP ops */ /* * The PowerPC architecture has extra invalid flags that indicate the * specific type of invalid operation occurred. These flags may be * tested, set, and cleared---but not masked---separately. All of * these bits are cleared when FE_INVALID is cleared, but only * FE_VXSOFT is set when FE_INVALID is explicitly set in software. */ #define FE_VXCVI 0x00000100 /* invalid integer convert */ #define FE_VXSQRT 0x00000200 /* square root of a negative */ #define FE_VXSOFT 0x00000400 /* software-requested exception */ #define FE_VXVC 0x00080000 /* ordered comparison involving NaN */ #define FE_VXIMZ 0x00100000 /* inf * 0 */ #define FE_VXZDZ 0x00200000 /* 0 / 0 */ #define FE_VXIDI 0x00400000 /* inf / inf */ #define FE_VXISI 0x00800000 /* inf - inf */ #define FE_VXSNAN 0x01000000 /* operation on a signalling NaN */ #define FE_ALL_INVALID (FE_VXCVI | FE_VXSQRT | FE_VXSOFT | FE_VXVC | \ FE_VXIMZ | FE_VXZDZ | FE_VXIDI | FE_VXISI | \ FE_VXSNAN | FE_INVALID) #define FE_ALL_EXCEPT (FE_DIVBYZERO | FE_INEXACT | \ FE_ALL_INVALID | FE_OVERFLOW | FE_UNDERFLOW) /* Rounding modes */ #define FE_TONEAREST 0x0000 #define FE_TOWARDZERO 0x0001 #define FE_UPWARD 0x0002 #define FE_DOWNWARD 0x0003 #define _ROUND_MASK (FE_TONEAREST | FE_DOWNWARD | \ FE_UPWARD | FE_TOWARDZERO) __BEGIN_DECLS /* Default floating-point environment */ extern const fenv_t __fe_dfl_env; #define FE_DFL_ENV (&__fe_dfl_env) /* We need to be able to map status flag positions to mask flag positions */ #define _FPUSW_SHIFT 22 #define _ENABLE_MASK ((FE_DIVBYZERO | FE_INEXACT | FE_INVALID | \ FE_OVERFLOW | FE_UNDERFLOW) >> _FPUSW_SHIFT) #ifndef _SOFT_FLOAT #define __mffs(__env) __asm __volatile("mffs %0" : "=f" (*(__env))) #define __mtfsf(__env) __asm __volatile("mtfsf 255,%0" : : "f" (__env)) #else #define __mffs(__env) #define __mtfsf(__env) #endif union __fpscr { double __d; struct { #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ fenv_t __reg; __uint32_t __junk; #else __uint32_t __junk; fenv_t __reg; #endif } __bits; }; __fenv_static inline int feclearexcept(int __excepts) { union __fpscr __r; if (__excepts & FE_INVALID) __excepts |= FE_ALL_INVALID; __mffs(&__r.__d); __r.__bits.__reg &= ~__excepts; __mtfsf(__r.__d); return (0); } __fenv_static inline int fegetexceptflag(fexcept_t *__flagp, int __excepts) { union __fpscr __r; __mffs(&__r.__d); *__flagp = __r.__bits.__reg & __excepts; return (0); } __fenv_static inline int fesetexceptflag(const fexcept_t *__flagp, int __excepts) { union __fpscr __r; if (__excepts & FE_INVALID) __excepts |= FE_ALL_EXCEPT; __mffs(&__r.__d); __r.__bits.__reg &= ~__excepts; __r.__bits.__reg |= *__flagp & __excepts; __mtfsf(__r.__d); return (0); } __fenv_static inline int feraiseexcept(int __excepts) { union __fpscr __r; if (__excepts & FE_INVALID) __excepts |= FE_VXSOFT; __mffs(&__r.__d); __r.__bits.__reg |= __excepts; __mtfsf(__r.__d); return (0); } __fenv_static inline int fetestexcept(int __excepts) { union __fpscr __r; __mffs(&__r.__d); return (__r.__bits.__reg & __excepts); } __fenv_static inline int fegetround(void) { union __fpscr __r; __mffs(&__r.__d); return (__r.__bits.__reg & _ROUND_MASK); } __fenv_static inline int fesetround(int __round) { union __fpscr __r; if (__round & ~_ROUND_MASK) return (-1); __mffs(&__r.__d); __r.__bits.__reg &= ~_ROUND_MASK; __r.__bits.__reg |= __round; __mtfsf(__r.__d); return (0); } __fenv_static inline int fegetenv(fenv_t *__envp) { union __fpscr __r; __mffs(&__r.__d); *__envp = __r.__bits.__reg; return (0); } __fenv_static inline int feholdexcept(fenv_t *__envp) { union __fpscr __r; __mffs(&__r.__d); *__envp = __r.__d; __r.__bits.__reg &= ~(FE_ALL_EXCEPT | _ENABLE_MASK); __mtfsf(__r.__d); return (0); } __fenv_static inline int fesetenv(const fenv_t *__envp) { union __fpscr __r; __r.__bits.__reg = *__envp; __mtfsf(__r.__d); return (0); } __fenv_static inline int feupdateenv(const fenv_t *__envp) { union __fpscr __r; __mffs(&__r.__d); __r.__bits.__reg &= FE_ALL_EXCEPT; __r.__bits.__reg |= *__envp; __mtfsf(__r.__d); return (0); } #if __BSD_VISIBLE /* We currently provide no external definitions of the functions below. */ static inline int feenableexcept(int __mask) { union __fpscr __r; fenv_t __oldmask; __mffs(&__r.__d); __oldmask = __r.__bits.__reg; __r.__bits.__reg |= (__mask & FE_ALL_EXCEPT) >> _FPUSW_SHIFT; __mtfsf(__r.__d); return ((__oldmask & _ENABLE_MASK) << _FPUSW_SHIFT); } static inline int fedisableexcept(int __mask) { union __fpscr __r; fenv_t __oldmask; __mffs(&__r.__d); __oldmask = __r.__bits.__reg; __r.__bits.__reg &= ~((__mask & FE_ALL_EXCEPT) >> _FPUSW_SHIFT); __mtfsf(__r.__d); return ((__oldmask & _ENABLE_MASK) << _FPUSW_SHIFT); } static inline int fegetexcept(void) { union __fpscr __r; __mffs(&__r.__d); return ((__r.__bits.__reg & _ENABLE_MASK) << _FPUSW_SHIFT); } #endif /* __BSD_VISIBLE */ __END_DECLS #endif /* !_FENV_H_ */ wcc-0.0.2/src/wsh/openlibm/include/openlibm_math.h0000644000175000017500000003772213122010155020547 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * from: @(#)fdlibm.h 5.1 93/09/24 * $FreeBSD: src/lib/msun/src/openlibm.h,v 1.82 2011/11/12 19:55:48 theraven Exp $ */ #ifdef OPENLIBM_USE_HOST_MATH_H #include #else /* !OPENLIBM_USE_HOST_MATH_H */ #ifndef OPENLIBM_MATH_H #define OPENLIBM_MATH_H #if (defined(_WIN32) || defined (_MSC_VER)) && !defined(__WIN32__) #define __WIN32__ #endif #ifndef __arm__ #define LONG_DOUBLE #endif #ifndef __pure2 #define __pure2 #endif #ifdef _WIN32 # ifdef IMPORT_EXPORTS # define OLM_DLLEXPORT __declspec(dllimport) # else # define OLM_DLLEXPORT __declspec(dllexport) # endif #else #define OLM_DLLEXPORT __attribute__ ((visibility("default"))) #endif /* * ANSI/POSIX */ extern const union __infinity_un { unsigned char __uc[8]; double __ud; } __infinity; extern const union __nan_un { unsigned char __uc[sizeof(float)]; float __uf; } __nan; /* VBS #if __GNUC_PREREQ__(3, 3) || (defined(__INTEL_COMPILER) && __INTEL_COMPILER >= 800) #define __MATH_BUILTIN_CONSTANTS #endif #if __GNUC_PREREQ__(3, 0) && !defined(__INTEL_COMPILER) #define __MATH_BUILTIN_RELOPS #endif */ //VBS begin #define __MATH_BUILTIN_CONSTANTS #define __MATH_BUILTIN_RELOPS #ifndef __ISO_C_VISIBLE #define __ISO_C_VISIBLE 1999 #endif //VBS end #ifdef __MATH_BUILTIN_CONSTANTS #define HUGE_VAL __builtin_huge_val() #else #define HUGE_VAL (__infinity.__ud) #endif #if __ISO_C_VISIBLE >= 1999 #define FP_ILOGB0 (-INT_MAX) #define FP_ILOGBNAN INT_MAX #ifdef __MATH_BUILTIN_CONSTANTS #define HUGE_VALF __builtin_huge_valf() #define HUGE_VALL __builtin_huge_vall() #define INFINITY __builtin_inff() #define NAN __builtin_nanf("") #else #define HUGE_VALF (float)HUGE_VAL #define HUGE_VALL (long double)HUGE_VAL #define INFINITY HUGE_VALF #define NAN (__nan.__uf) #endif /* __MATH_BUILTIN_CONSTANTS */ #define MATH_ERRNO 1 #define MATH_ERREXCEPT 2 #define math_errhandling MATH_ERREXCEPT #define FP_FAST_FMAF 1 #ifdef __ia64__ #define FP_FAST_FMA 1 #define FP_FAST_FMAL 1 #endif /* Symbolic constants to classify floating point numbers. */ #define FP_INFINITE 0x01 #define FP_NAN 0x02 #define FP_NORMAL 0x04 #define FP_SUBNORMAL 0x08 #define FP_ZERO 0x10 #define fpclassify(x) \ ((sizeof (x) == sizeof (float)) ? __fpclassifyf(x) \ : (sizeof (x) == sizeof (double)) ? __fpclassifyd(x) \ : __fpclassifyl(x)) #define isfinite(x) \ ((sizeof (x) == sizeof (float)) ? __isfinitef(x) \ : (sizeof (x) == sizeof (double)) ? __isfinite(x) \ : __isfinitel(x)) #define isinf(x) \ ((sizeof (x) == sizeof (float)) ? __isinff(x) \ : (sizeof (x) == sizeof (double)) ? isinf(x) \ : __isinfl(x)) #define isnan(x) \ ((sizeof (x) == sizeof (float)) ? __isnanf(x) \ : (sizeof (x) == sizeof (double)) ? isnan(x) \ : __isnanl(x)) #define isnormal(x) \ ((sizeof (x) == sizeof (float)) ? __isnormalf(x) \ : (sizeof (x) == sizeof (double)) ? __isnormal(x) \ : __isnormall(x)) #ifdef __MATH_BUILTIN_RELOPS #define isgreater(x, y) __builtin_isgreater((x), (y)) #define isgreaterequal(x, y) __builtin_isgreaterequal((x), (y)) #define isless(x, y) __builtin_isless((x), (y)) #define islessequal(x, y) __builtin_islessequal((x), (y)) #define islessgreater(x, y) __builtin_islessgreater((x), (y)) #define isunordered(x, y) __builtin_isunordered((x), (y)) #else #define isgreater(x, y) (!isunordered((x), (y)) && (x) > (y)) #define isgreaterequal(x, y) (!isunordered((x), (y)) && (x) >= (y)) #define isless(x, y) (!isunordered((x), (y)) && (x) < (y)) #define islessequal(x, y) (!isunordered((x), (y)) && (x) <= (y)) #define islessgreater(x, y) (!isunordered((x), (y)) && \ ((x) > (y) || (y) > (x))) #define isunordered(x, y) (isnan(x) || isnan(y)) #endif /* __MATH_BUILTIN_RELOPS */ #define signbit(x) \ ((sizeof (x) == sizeof (float)) ? __signbitf(x) \ : (sizeof (x) == sizeof (double)) ? __signbit(x) \ : __signbitl(x)) //VBS //typedef __double_t double_t; //typedef __float_t float_t; #endif /* __ISO_C_VISIBLE >= 1999 */ /* * XOPEN/SVID */ #if __BSD_VISIBLE || __XSI_VISIBLE #define M_E 2.7182818284590452354 /* e */ #define M_LOG2E 1.4426950408889634074 /* log 2e */ #define M_LOG10E 0.43429448190325182765 /* log 10e */ #define M_LN2 0.69314718055994530942 /* log e2 */ #define M_LN10 2.30258509299404568402 /* log e10 */ #define M_PI 3.14159265358979323846 /* pi */ #define M_PI_2 1.57079632679489661923 /* pi/2 */ #define M_PI_4 0.78539816339744830962 /* pi/4 */ #define M_1_PI 0.31830988618379067154 /* 1/pi */ #define M_2_PI 0.63661977236758134308 /* 2/pi */ #define M_2_SQRTPI 1.12837916709551257390 /* 2/sqrt(pi) */ #define M_SQRT2 1.41421356237309504880 /* sqrt(2) */ #define M_SQRT1_2 0.70710678118654752440 /* 1/sqrt(2) */ #define MAXFLOAT ((float)3.40282346638528860e+38) #ifndef OPENLIBM_ONLY_THREAD_SAFE extern int signgam; #endif #endif /* __BSD_VISIBLE || __XSI_VISIBLE */ #if __BSD_VISIBLE #if 0 /* Old value from 4.4BSD-Lite openlibm.h; this is probably better. */ #define HUGE HUGE_VAL #else #define HUGE MAXFLOAT #endif #endif /* __BSD_VISIBLE */ /* * Most of these functions depend on the rounding mode and have the side * effect of raising floating-point exceptions, so they are not declared * as __pure2. In C99, FENV_ACCESS affects the purity of these functions. */ #if defined(__cplusplus) extern "C" { #endif /* Symbol present when OpenLibm is used. */ int isopenlibm(void); /* * ANSI/POSIX */ OLM_DLLEXPORT int __fpclassifyd(double) __pure2; OLM_DLLEXPORT int __fpclassifyf(float) __pure2; OLM_DLLEXPORT int __fpclassifyl(long double) __pure2; OLM_DLLEXPORT int __isfinitef(float) __pure2; OLM_DLLEXPORT int __isfinite(double) __pure2; OLM_DLLEXPORT int __isfinitel(long double) __pure2; OLM_DLLEXPORT int __isinff(float) __pure2; OLM_DLLEXPORT int __isinfl(long double) __pure2; OLM_DLLEXPORT int __isnanf(float) __pure2; OLM_DLLEXPORT int __isnanl(long double) __pure2; OLM_DLLEXPORT int __isnormalf(float) __pure2; OLM_DLLEXPORT int __isnormal(double) __pure2; OLM_DLLEXPORT int __isnormall(long double) __pure2; OLM_DLLEXPORT int __signbit(double) __pure2; OLM_DLLEXPORT int __signbitf(float) __pure2; OLM_DLLEXPORT int __signbitl(long double) __pure2; OLM_DLLEXPORT double acos(double); OLM_DLLEXPORT double asin(double); OLM_DLLEXPORT double atan(double); OLM_DLLEXPORT double atan2(double, double); OLM_DLLEXPORT double cos(double); OLM_DLLEXPORT double sin(double); OLM_DLLEXPORT double tan(double); OLM_DLLEXPORT double cosh(double); OLM_DLLEXPORT double sinh(double); OLM_DLLEXPORT double tanh(double); OLM_DLLEXPORT double exp(double); OLM_DLLEXPORT double frexp(double, int *); /* fundamentally !__pure2 */ OLM_DLLEXPORT double ldexp(double, int); OLM_DLLEXPORT double log(double); OLM_DLLEXPORT double log10(double); OLM_DLLEXPORT double modf(double, double *); /* fundamentally !__pure2 */ OLM_DLLEXPORT double pow(double, double); OLM_DLLEXPORT double sqrt(double); OLM_DLLEXPORT double ceil(double); OLM_DLLEXPORT double fabs(double) __pure2; OLM_DLLEXPORT double floor(double); OLM_DLLEXPORT double fmod(double, double); /* * These functions are not in C90. */ #if __BSD_VISIBLE || __ISO_C_VISIBLE >= 1999 || __XSI_VISIBLE OLM_DLLEXPORT double acosh(double); OLM_DLLEXPORT double asinh(double); OLM_DLLEXPORT double atanh(double); OLM_DLLEXPORT double cbrt(double); OLM_DLLEXPORT double erf(double); OLM_DLLEXPORT double erfc(double); OLM_DLLEXPORT double exp2(double); OLM_DLLEXPORT double expm1(double); OLM_DLLEXPORT double fma(double, double, double); OLM_DLLEXPORT double hypot(double, double); OLM_DLLEXPORT int ilogb(double) __pure2; OLM_DLLEXPORT int (isinf)(double) __pure2; OLM_DLLEXPORT int (isnan)(double) __pure2; OLM_DLLEXPORT double lgamma(double); OLM_DLLEXPORT long long llrint(double); OLM_DLLEXPORT long long llround(double); OLM_DLLEXPORT double log1p(double); OLM_DLLEXPORT double log2(double); OLM_DLLEXPORT double logb(double); OLM_DLLEXPORT long lrint(double); OLM_DLLEXPORT long lround(double); OLM_DLLEXPORT double nan(const char *) __pure2; OLM_DLLEXPORT double nextafter(double, double); OLM_DLLEXPORT double remainder(double, double); OLM_DLLEXPORT double remquo(double, double, int *); OLM_DLLEXPORT double rint(double); #endif /* __BSD_VISIBLE || __ISO_C_VISIBLE >= 1999 || __XSI_VISIBLE */ #if __BSD_VISIBLE || __XSI_VISIBLE OLM_DLLEXPORT double j0(double); OLM_DLLEXPORT double j1(double); OLM_DLLEXPORT double jn(int, double); OLM_DLLEXPORT double y0(double); OLM_DLLEXPORT double y1(double); OLM_DLLEXPORT double yn(int, double); #endif /* __BSD_VISIBLE || __XSI_VISIBLE */ #if __BSD_VISIBLE || __ISO_C_VISIBLE >= 1999 OLM_DLLEXPORT double copysign(double, double) __pure2; OLM_DLLEXPORT double fdim(double, double); OLM_DLLEXPORT double fmax(double, double) __pure2; OLM_DLLEXPORT double fmin(double, double) __pure2; OLM_DLLEXPORT double nearbyint(double); OLM_DLLEXPORT double round(double); OLM_DLLEXPORT double scalbln(double, long); OLM_DLLEXPORT double scalbn(double, int); OLM_DLLEXPORT double tgamma(double); OLM_DLLEXPORT double trunc(double); #endif /* * BSD math library entry points */ #if __BSD_VISIBLE OLM_DLLEXPORT int isnanf(float) __pure2; /* * Reentrant version of lgamma; passes signgam back by reference as the * second argument; user must allocate space for signgam. */ OLM_DLLEXPORT double lgamma_r(double, int *); /* * Single sine/cosine function. */ OLM_DLLEXPORT void sincos(double, double *, double *); #endif /* __BSD_VISIBLE */ /* float versions of ANSI/POSIX functions */ #if __ISO_C_VISIBLE >= 1999 OLM_DLLEXPORT float acosf(float); OLM_DLLEXPORT float asinf(float); OLM_DLLEXPORT float atanf(float); OLM_DLLEXPORT float atan2f(float, float); OLM_DLLEXPORT float cosf(float); OLM_DLLEXPORT float sinf(float); OLM_DLLEXPORT float tanf(float); OLM_DLLEXPORT float coshf(float); OLM_DLLEXPORT float sinhf(float); OLM_DLLEXPORT float tanhf(float); OLM_DLLEXPORT float exp2f(float); OLM_DLLEXPORT float expf(float); OLM_DLLEXPORT float expm1f(float); OLM_DLLEXPORT float frexpf(float, int *); /* fundamentally !__pure2 */ OLM_DLLEXPORT int ilogbf(float) __pure2; OLM_DLLEXPORT float ldexpf(float, int); OLM_DLLEXPORT float log10f(float); OLM_DLLEXPORT float log1pf(float); OLM_DLLEXPORT float log2f(float); OLM_DLLEXPORT float logf(float); OLM_DLLEXPORT float modff(float, float *); /* fundamentally !__pure2 */ OLM_DLLEXPORT float powf(float, float); OLM_DLLEXPORT float sqrtf(float); OLM_DLLEXPORT float ceilf(float); OLM_DLLEXPORT float fabsf(float) __pure2; OLM_DLLEXPORT float floorf(float); OLM_DLLEXPORT float fmodf(float, float); OLM_DLLEXPORT float roundf(float); OLM_DLLEXPORT float erff(float); OLM_DLLEXPORT float erfcf(float); OLM_DLLEXPORT float hypotf(float, float); OLM_DLLEXPORT float lgammaf(float); OLM_DLLEXPORT float tgammaf(float); OLM_DLLEXPORT float acoshf(float); OLM_DLLEXPORT float asinhf(float); OLM_DLLEXPORT float atanhf(float); OLM_DLLEXPORT float cbrtf(float); OLM_DLLEXPORT float logbf(float); OLM_DLLEXPORT float copysignf(float, float) __pure2; OLM_DLLEXPORT long long llrintf(float); OLM_DLLEXPORT long long llroundf(float); OLM_DLLEXPORT long lrintf(float); OLM_DLLEXPORT long lroundf(float); OLM_DLLEXPORT float nanf(const char *) __pure2; OLM_DLLEXPORT float nearbyintf(float); OLM_DLLEXPORT float nextafterf(float, float); OLM_DLLEXPORT float remainderf(float, float); OLM_DLLEXPORT float remquof(float, float, int *); OLM_DLLEXPORT float rintf(float); OLM_DLLEXPORT float scalblnf(float, long); OLM_DLLEXPORT float scalbnf(float, int); OLM_DLLEXPORT float truncf(float); OLM_DLLEXPORT float fdimf(float, float); OLM_DLLEXPORT float fmaf(float, float, float); OLM_DLLEXPORT float fmaxf(float, float) __pure2; OLM_DLLEXPORT float fminf(float, float) __pure2; #endif /* * float versions of BSD math library entry points */ #if __BSD_VISIBLE OLM_DLLEXPORT float dremf(float, float); OLM_DLLEXPORT float j0f(float); OLM_DLLEXPORT float j1f(float); OLM_DLLEXPORT float jnf(int, float); OLM_DLLEXPORT float y0f(float); OLM_DLLEXPORT float y1f(float); OLM_DLLEXPORT float ynf(int, float); /* * Float versions of reentrant version of lgamma; passes signgam back by * reference as the second argument; user must allocate space for signgam. */ OLM_DLLEXPORT float lgammaf_r(float, int *); /* * Single sine/cosine function. */ OLM_DLLEXPORT void sincosf(float, float *, float *); #endif /* __BSD_VISIBLE */ /* * long double versions of ISO/POSIX math functions */ #if __ISO_C_VISIBLE >= 1999 OLM_DLLEXPORT long double acoshl(long double); OLM_DLLEXPORT long double acosl(long double); OLM_DLLEXPORT long double asinhl(long double); OLM_DLLEXPORT long double asinl(long double); OLM_DLLEXPORT long double atan2l(long double, long double); OLM_DLLEXPORT long double atanhl(long double); OLM_DLLEXPORT long double atanl(long double); OLM_DLLEXPORT long double cbrtl(long double); OLM_DLLEXPORT long double ceill(long double); OLM_DLLEXPORT long double copysignl(long double, long double) __pure2; OLM_DLLEXPORT long double coshl(long double); OLM_DLLEXPORT long double cosl(long double); OLM_DLLEXPORT long double erfcl(long double); OLM_DLLEXPORT long double erfl(long double); OLM_DLLEXPORT long double exp2l(long double); OLM_DLLEXPORT long double expl(long double); OLM_DLLEXPORT long double expm1l(long double); OLM_DLLEXPORT long double fabsl(long double) __pure2; OLM_DLLEXPORT long double fdiml(long double, long double); OLM_DLLEXPORT long double floorl(long double); OLM_DLLEXPORT long double fmal(long double, long double, long double); OLM_DLLEXPORT long double fmaxl(long double, long double) __pure2; OLM_DLLEXPORT long double fminl(long double, long double) __pure2; OLM_DLLEXPORT long double fmodl(long double, long double); OLM_DLLEXPORT long double frexpl(long double value, int *); /* fundamentally !__pure2 */ OLM_DLLEXPORT long double hypotl(long double, long double); OLM_DLLEXPORT int ilogbl(long double) __pure2; OLM_DLLEXPORT long double ldexpl(long double, int); OLM_DLLEXPORT long double lgammal(long double); OLM_DLLEXPORT long long llrintl(long double); OLM_DLLEXPORT long long llroundl(long double); OLM_DLLEXPORT long double log10l(long double); OLM_DLLEXPORT long double log1pl(long double); OLM_DLLEXPORT long double log2l(long double); OLM_DLLEXPORT long double logbl(long double); OLM_DLLEXPORT long double logl(long double); OLM_DLLEXPORT long lrintl(long double); OLM_DLLEXPORT long lroundl(long double); OLM_DLLEXPORT long double modfl(long double, long double *); /* fundamentally !__pure2 */ OLM_DLLEXPORT long double nanl(const char *) __pure2; OLM_DLLEXPORT long double nearbyintl(long double); OLM_DLLEXPORT long double nextafterl(long double, long double); OLM_DLLEXPORT double nexttoward(double, long double); OLM_DLLEXPORT float nexttowardf(float, long double); OLM_DLLEXPORT long double nexttowardl(long double, long double); OLM_DLLEXPORT long double powl(long double, long double); OLM_DLLEXPORT long double remainderl(long double, long double); OLM_DLLEXPORT long double remquol(long double, long double, int *); OLM_DLLEXPORT long double rintl(long double); OLM_DLLEXPORT long double roundl(long double); OLM_DLLEXPORT long double scalblnl(long double, long); OLM_DLLEXPORT long double scalbnl(long double, int); OLM_DLLEXPORT long double sinhl(long double); OLM_DLLEXPORT long double sinl(long double); OLM_DLLEXPORT long double sqrtl(long double); OLM_DLLEXPORT long double tanhl(long double); OLM_DLLEXPORT long double tanl(long double); OLM_DLLEXPORT long double tgammal(long double); OLM_DLLEXPORT long double truncl(long double); #endif /* __ISO_C_VISIBLE >= 1999 */ /* Reentrant version of lgammal. */ #if __BSD_VISIBLE OLM_DLLEXPORT long double lgammal_r(long double, int *); /* * Single sine/cosine function. */ OLM_DLLEXPORT void sincosl(long double, long double *, long double *); #endif /* __BSD_VISIBLE */ #if defined(__cplusplus) } #endif #endif /* !OPENLIBM_MATH_H */ #endif /* OPENLIBM_USE_HOST_MATH_H */ wcc-0.0.2/src/wsh/openlibm/include/openlibm.h0000644000175000017500000000022513122010155017522 0ustar philphil#ifndef OPENLIBM_H #define OPENLIBM_H #include #include #include #endif /* !OPENLIBM_H */ wcc-0.0.2/src/wsh/openlibm/include/openlibm_fenv_i387.h0000644000175000017500000001545713122010155021327 0ustar philphil/*- * Copyright (c) 2004-2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/i387/fenv.h,v 1.8 2011/10/10 15:43:09 das Exp $ */ #ifndef _FENV_H_ #define _FENV_H_ #include "cdefs-compat.h" #include "types-compat.h" #ifndef __fenv_static #define __fenv_static static #endif /* * To preserve binary compatibility with FreeBSD 5.3, we pack the * mxcsr into some reserved fields, rather than changing sizeof(fenv_t). */ typedef struct { uint16_t __control; uint16_t __mxcsr_hi; uint16_t __status; uint16_t __mxcsr_lo; uint32_t __tag; char __other[16]; } fenv_t; #define __get_mxcsr(env) (((env).__mxcsr_hi << 16) | \ ((env).__mxcsr_lo)) #define __set_mxcsr(env, x) do { \ (env).__mxcsr_hi = (uint32_t)(x) >> 16; \ (env).__mxcsr_lo = (uint16_t)(x); \ } while (0) typedef uint16_t fexcept_t; /* Exception flags */ #define FE_INVALID 0x01 #define FE_DENORMAL 0x02 #define FE_DIVBYZERO 0x04 #define FE_OVERFLOW 0x08 #define FE_UNDERFLOW 0x10 #define FE_INEXACT 0x20 #define FE_ALL_EXCEPT (FE_DIVBYZERO | FE_DENORMAL | FE_INEXACT | \ FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) /* Rounding modes */ #define FE_TONEAREST 0x0000 #define FE_DOWNWARD 0x0400 #define FE_UPWARD 0x0800 #define FE_TOWARDZERO 0x0c00 #define _ROUND_MASK (FE_TONEAREST | FE_DOWNWARD | \ FE_UPWARD | FE_TOWARDZERO) /* * As compared to the x87 control word, the SSE unit's control word * has the rounding control bits offset by 3 and the exception mask * bits offset by 7. */ #define _SSE_ROUND_SHIFT 3 #define _SSE_EMASK_SHIFT 7 __BEGIN_DECLS /* After testing for SSE support once, we cache the result in __has_sse. */ enum __sse_support { __SSE_YES, __SSE_NO, __SSE_UNK }; extern enum __sse_support __has_sse; int __test_sse(void); #ifdef __SSE__ #define __HAS_SSE() 1 #else #define __HAS_SSE() (__has_sse == __SSE_YES || \ (__has_sse == __SSE_UNK && __test_sse())) #endif /* Default floating-point environment */ extern const fenv_t __fe_dfl_env; #define FE_DFL_ENV (&__fe_dfl_env) #define __fldcw(__cw) __asm __volatile("fldcw %0" : : "m" (__cw)) #define __fldenv(__env) __asm __volatile("fldenv %0" : : "m" (__env)) #define __fldenvx(__env) __asm __volatile("fldenv %0" : : "m" (__env) \ : "st", "st(1)", "st(2)", "st(3)", "st(4)", \ "st(5)", "st(6)", "st(7)") #define __fnclex() __asm __volatile("fnclex") #define __fnstenv(__env) __asm __volatile("fnstenv %0" : "=m" (*(__env))) #define __fnstcw(__cw) __asm __volatile("fnstcw %0" : "=m" (*(__cw))) #define __fnstsw(__sw) __asm __volatile("fnstsw %0" : "=am" (*(__sw))) #define __fwait() __asm __volatile("fwait") #define __ldmxcsr(__csr) __asm __volatile("ldmxcsr %0" : : "m" (__csr)) #define __stmxcsr(__csr) __asm __volatile("stmxcsr %0" : "=m" (*(__csr))) __fenv_static inline int feclearexcept(int __excepts) { fenv_t __env; uint32_t __mxcsr; if (__excepts == FE_ALL_EXCEPT) { __fnclex(); } else { __fnstenv(&__env); __env.__status &= ~__excepts; __fldenv(__env); } if (__HAS_SSE()) { __stmxcsr(&__mxcsr); __mxcsr &= ~__excepts; __ldmxcsr(__mxcsr); } return (0); } __fenv_static inline int fegetexceptflag(fexcept_t *__flagp, int __excepts) { uint32_t __mxcsr; uint16_t __status; __fnstsw(&__status); if (__HAS_SSE()) __stmxcsr(&__mxcsr); else __mxcsr = 0; *__flagp = (__mxcsr | __status) & __excepts; return (0); } int fesetexceptflag(const fexcept_t *__flagp, int __excepts); int feraiseexcept(int __excepts); __fenv_static inline int fetestexcept(int __excepts) { uint32_t __mxcsr; uint16_t __status; __fnstsw(&__status); if (__HAS_SSE()) __stmxcsr(&__mxcsr); else __mxcsr = 0; return ((__status | __mxcsr) & __excepts); } __fenv_static inline int fegetround(void) { uint16_t __control; /* * We assume that the x87 and the SSE unit agree on the * rounding mode. Reading the control word on the x87 turns * out to be about 5 times faster than reading it on the SSE * unit on an Opteron 244. */ __fnstcw(&__control); return (__control & _ROUND_MASK); } __fenv_static inline int fesetround(int __round) { uint32_t __mxcsr; uint16_t __control; if (__round & ~_ROUND_MASK) return (-1); __fnstcw(&__control); __control &= ~_ROUND_MASK; __control |= __round; __fldcw(__control); if (__HAS_SSE()) { __stmxcsr(&__mxcsr); __mxcsr &= ~(_ROUND_MASK << _SSE_ROUND_SHIFT); __mxcsr |= __round << _SSE_ROUND_SHIFT; __ldmxcsr(__mxcsr); } return (0); } int fegetenv(fenv_t *__envp); int feholdexcept(fenv_t *__envp); __fenv_static inline int fesetenv(const fenv_t *__envp) { fenv_t __env = *__envp; uint32_t __mxcsr; __mxcsr = __get_mxcsr(__env); __set_mxcsr(__env, 0xffffffff); /* * XXX Using fldenvx() instead of fldenv() tells the compiler that this * instruction clobbers the i387 register stack. This happens because * we restore the tag word from the saved environment. Normally, this * would happen anyway and we wouldn't care, because the ABI allows * function calls to clobber the i387 regs. However, fesetenv() is * inlined, so we need to be more careful. */ __fldenvx(__env); if (__HAS_SSE()) __ldmxcsr(__mxcsr); return (0); } int feupdateenv(const fenv_t *__envp); #if __BSD_VISIBLE int feenableexcept(int __mask); int fedisableexcept(int __mask); /* We currently provide no external definition of fegetexcept(). */ static inline int fegetexcept(void) { uint16_t __control; /* * We assume that the masks for the x87 and the SSE unit are * the same. */ __fnstcw(&__control); return (~__control & FE_ALL_EXCEPT); } #endif /* __BSD_VISIBLE */ __END_DECLS #endif /* !_FENV_H_ */ wcc-0.0.2/src/wsh/openlibm/include/openlibm_fenv.h0000644000175000017500000000065013122010155020542 0ustar philphil#ifdef OPENLIBM_USE_HOST_FENV_H #include #else /* !OPENLIBM_USE_HOST_FENV_H */ #if defined(__aarch64__) || defined(__arm__) #include #elif defined(__x86_64__) #include #elif defined(__i386__) #include #elif defined(__powerpc__) #include #else #error "Unsupported platform" #endif #endif /* OPENLIBM_USE_HOST_FENV_H */ wcc-0.0.2/src/wsh/openlibm/README.md0000644000175000017500000000322713122010155015405 0ustar philphil# OpenLibm [![Build Status](https://travis-ci.org/JuliaLang/openlibm.svg?branch=master)](https://travis-ci.org/JuliaLang/openlibm) [OpenLibm](http://www.openlibm.org) is an effort to have a high quality, portable, standalone C mathematical library ([`libm`](http://en.wikipedia.org/wiki/libm)). It can be used standalone in applications and programming language implementations. The project was born out of a need to have a good `libm` for the [Julia programming langage](http://www.julialang.org) that worked consistently across compilers and operating systems, and in 32-bit and 64-bit environments. ## Platform support OpenLibm builds on Linux, Mac OS X, Windows, FreeBSD, and OpenBSD. It builds with both GCC and clang. Although largely tested and widely used on x86 architectures, openlibm also supports ARM and powerPC. ## Build instructions 1. Use `make` to build OpenLibm. 2. Use `make USEGCC=1` to build with GCC. This is the default on Linux and Windows. 3. Use `make USECLANG=1` to build with clang. This is the default on OS X and FreeBSD. 4. Architectures are auto-detected. Use `make ARCH=i386` to force a build for i386. Other supported architectures are i486, i586, and i686. GCC 4.8 is the minimum requirement for correct codegen on older 32-bit architectures. 5. On OpenBSD, you need to install GNU Make (port name: `gmake`) and a recent version of `gcc` (tested: 4.9.2), as the default version provided by OpenBSD is too old (4.2.1). If you use OpenBSD's port system for this (port name: `gcc`), run `make CC=egcc` to force Make to use the newer `gcc`. ## Acknowledgements PowerPC support for openlibm was graciously sponsored by IBM. wcc-0.0.2/src/wsh/openlibm/.travis.yml0000644000175000017500000000202413122010155016231 0ustar philphil# We require a full (virtual) machine to load the kernel module for # binfmt support, which is needed to test other architectures besides # x86 using qemu user emulation. (This will not work in a container.) sudo: required dist: trusty language: c script: - make $FLAGS - make check $FLAGS $TEST_FLAGS - make clean && git status --ignored --porcelain && test -z "$(git status --ignored --porcelain)" matrix: include: - os: linux env: FLAGS="CC=gcc" - os: linux env: FLAGS="CC=gcc ARCH=i686" # implies -m32 -march=i686 addons: apt: packages: - gcc-multilib - os: linux env: FLAGS="CC=aarch64-linux-gnu-gcc" TEST_FLAGS="LDFLAGS=-static" addons: apt: packages: - gcc-aarch64-linux-gnu - libc6-dev-arm64-cross - qemu-user-static - binfmt-support notifications: email: false wcc-0.0.2/src/wsh/openlibm/i387/0000755000175000017500000000000013122010155014614 5ustar philphilwcc-0.0.2/src/wsh/openlibm/i387/e_remainderl.S0000644000175000017500000000061113122010155017364 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_remainderl.S,v 1.2 2011/01/07 16:13:12 kib Exp $") ENTRY(remainderl) fldt 16(%esp) fldt 4(%esp) 1: fprem1 fstsw %ax sahf jp 1b fstp %st(1) ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_floorf.S0000644000175000017500000000132613122010155016553 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_floorf.S,v 1.4 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: s_floorf.S,v 1.3 1995/05/09 00:04:32 jtc Exp $") */ ENTRY(floorf) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0400,%dx /* round towards -oo */ andw $0xf7ff,%dx movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ flds 8(%ebp); /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(floorf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_logbf.S0000644000175000017500000000064313122010155016356 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_logbf.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: s_logbf.S,v 1.3 1995/05/09 00:15:12 jtc Exp $") */ ENTRY(logbf) flds 4(%esp) fxtract fstp %st ret END(logbf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_truncf.S0000644000175000017500000000121113122010155016556 0ustar philphil/* * Based on code written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_truncf.S,v 1.4 2011/01/07 16:13:12 kib Exp $") ENTRY(truncf) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0c00,%dx /* round towards -oo */ movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ flds 8(%ebp) /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(truncf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_scalbn.S0000644000175000017500000000065013122010155016525 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_scalbn.S,v 1.10 2011/01/07 16:13:12 kib Exp $") ENTRY(scalbn) fildl 12(%esp) fldl 4(%esp) fscale fstp %st(1) ret END(scalbn) .globl CNAME(ldexp) .set CNAME(ldexp),CNAME(scalbn) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_copysignl.S0000644000175000017500000000072313122010155017273 0ustar philphil/* * Based on code written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_copysignl.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(copysignl) movl 24(%esp),%edx andl $0x8000,%edx movl 12(%esp),%eax andl $0x7fff,%eax orl %edx,%eax movl %eax,12(%esp) fldt 4(%esp) ret END(copysignl) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_lrintf.S0000644000175000017500000000321313122010155016557 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_lrintf.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(lrintf) flds 4(%esp) subl $4,%esp fistpl (%esp) popl %eax ret END(lrintf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_sqrtl.S0000644000175000017500000000050713122010155016413 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_sqrtl.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(sqrtl) fldt 4(%esp) fsqrt ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/bsd_ieeefp.h0000644000175000017500000001534113122010155017056 0ustar philphil/*- * Copyright (c) 2003 Peter Wemm. * Copyright (c) 1990 Andrew Moore, Talke Studio * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#) ieeefp.h 1.0 (Berkeley) 9/23/93 * $FreeBSD$ */ #ifndef _MACHINE_IEEEFP_H_ #define _MACHINE_IEEEFP_H_ /* * Deprecated historical FPU control interface * * IEEE floating point type, constant and function definitions. * XXX: FP*FLD and FP*OFF are undocumented pollution. */ /* VBS #ifndef _SYS_CDEFS_H_ #error this file needs sys/cdefs.h as a prerequisite #endif */ /* * Rounding modes. */ typedef enum { FP_RN=0, /* round to nearest */ FP_RM, /* round down towards minus infinity */ FP_RP, /* round up towards plus infinity */ FP_RZ /* truncate */ } fp_rnd_t; /* * Precision (i.e., rounding precision) modes. */ typedef enum { FP_PS=0, /* 24 bit (single-precision) */ FP_PRS, /* reserved */ FP_PD, /* 53 bit (double-precision) */ FP_PE /* 64 bit (extended-precision) */ } fp_prec_t; #define fp_except_t int /* * Exception bit masks. */ #define FP_X_INV 0x01 /* invalid operation */ #define FP_X_DNML 0x02 /* denormal */ #define FP_X_DZ 0x04 /* zero divide */ #define FP_X_OFL 0x08 /* overflow */ #define FP_X_UFL 0x10 /* underflow */ #define FP_X_IMP 0x20 /* (im)precision */ #define FP_X_STK 0x40 /* stack fault */ /* * FPU control word bit-field masks. */ #define FP_MSKS_FLD 0x3f /* exception masks field */ #define FP_PRC_FLD 0x300 /* precision control field */ #define FP_RND_FLD 0xc00 /* rounding control field */ /* * FPU status word bit-field masks. */ #define FP_STKY_FLD 0x3f /* sticky flags field */ /* * FPU control word bit-field offsets (shift counts). */ #define FP_MSKS_OFF 0 /* exception masks offset */ #define FP_PRC_OFF 8 /* precision control offset */ #define FP_RND_OFF 10 /* rounding control offset */ /* * FPU status word bit-field offsets (shift counts). */ #define FP_STKY_OFF 0 /* sticky flags offset */ //VBS //#ifdef __GNUCLIKE_ASM #define __fldcw(addr) __asm __volatile("fldcw %0" : : "m" (*(addr))) #define __fldenv(addr) __asm __volatile("fldenv %0" : : "m" (*(addr))) #define __fnclex() __asm __volatile("fnclex") #define __fnstcw(addr) __asm __volatile("fnstcw %0" : "=m" (*(addr))) #define __fnstenv(addr) __asm __volatile("fnstenv %0" : "=m" (*(addr))) #define __fnstsw(addr) __asm __volatile("fnstsw %0" : "=m" (*(addr))) /* * Load the control word. Be careful not to trap if there is a currently * unmasked exception (ones that will become freshly unmasked are not a * problem). This case must be handled by a save/restore of the * environment or even of the full x87 state. Accessing the environment * is very inefficient, so only do it when necessary. */ static __inline void __fnldcw(unsigned short _cw, unsigned short _newcw) { struct { unsigned _cw; unsigned _other[6]; } _env; unsigned short _sw; if ((_cw & FP_MSKS_FLD) != FP_MSKS_FLD) { __fnstsw(&_sw); if (((_sw & ~_cw) & FP_STKY_FLD) != 0) { __fnstenv(&_env); _env._cw = _newcw; __fldenv(&_env); return; } } __fldcw(&_newcw); } static __inline fp_rnd_t fpgetround(void) { unsigned short _cw; __fnstcw(&_cw); return ((fp_rnd_t)((_cw & FP_RND_FLD) >> FP_RND_OFF)); } static __inline fp_rnd_t fpsetround(fp_rnd_t _m) { fp_rnd_t _p; unsigned short _cw, _newcw; __fnstcw(&_cw); _p = (fp_rnd_t)((_cw & FP_RND_FLD) >> FP_RND_OFF); _newcw = _cw & ~FP_RND_FLD; _newcw |= (_m << FP_RND_OFF) & FP_RND_FLD; __fnldcw(_cw, _newcw); return (_p); } //static __inline fp_prec_t OLM_DLLEXPORT fp_prec_t fpgetprec(void) { unsigned short _cw; __fnstcw(&_cw); return ((fp_prec_t)((_cw & FP_PRC_FLD) >> FP_PRC_OFF)); } //static __inline fp_prec_t OLM_DLLEXPORT fp_prec_t fpsetprec(fp_prec_t _m) { fp_prec_t _p; unsigned short _cw, _newcw; __fnstcw(&_cw); _p = (fp_prec_t)((_cw & FP_PRC_FLD) >> FP_PRC_OFF); _newcw = _cw & ~FP_PRC_FLD; _newcw |= (_m << FP_PRC_OFF) & FP_PRC_FLD; __fnldcw(_cw, _newcw); return (_p); } /* * Get or set the exception mask. * Note that the x87 mask bits are inverted by the API -- a mask bit of 1 * means disable for x87 and SSE, but for fp*mask() it means enable. */ static __inline fp_except_t fpgetmask(void) { unsigned short _cw; __fnstcw(&_cw); return ((~_cw & FP_MSKS_FLD) >> FP_MSKS_OFF); } static __inline fp_except_t fpsetmask(fp_except_t _m) { fp_except_t _p; unsigned short _cw, _newcw; __fnstcw(&_cw); _p = (~_cw & FP_MSKS_FLD) >> FP_MSKS_OFF; _newcw = _cw & ~FP_MSKS_FLD; _newcw |= (~_m << FP_MSKS_OFF) & FP_MSKS_FLD; __fnldcw(_cw, _newcw); return (_p); } static __inline fp_except_t fpgetsticky(void) { unsigned _ex; unsigned short _sw; __fnstsw(&_sw); _ex = (_sw & FP_STKY_FLD) >> FP_STKY_OFF; return ((fp_except_t)_ex); } static __inline fp_except_t fpresetsticky(fp_except_t _m) { struct { unsigned _cw; unsigned _sw; unsigned _other[5]; } _env; fp_except_t _p; _m &= FP_STKY_FLD >> FP_STKY_OFF; _p = fpgetsticky(); if ((_p & ~_m) == _p) return (_p); if ((_p & ~_m) == 0) { __fnclex(); return (_p); } __fnstenv(&_env); _env._sw &= ~_m; __fldenv(&_env); return (_p); } //#endif /* __GNUCLIKE_ASM */ #endif /* !_MACHINE_IEEEFP_H_ */ wcc-0.0.2/src/wsh/openlibm/i387/s_logb.S0000644000175000017500000000053413122010155016207 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_logb.S,v 1.10 2011/01/07 16:13:12 kib Exp $") ENTRY(logb) fldl 4(%esp) fxtract fstp %st ret END(logb) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_remquol.S0000644000175000017500000000432013122010155016745 0ustar philphil/*- * Copyright (c) 2005-2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* * Based on public-domain remainder routine by J.T. Conklin . */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_remquol.S,v 1.2 2011/01/07 16:13:12 kib Exp $"); ENTRY(remquol) fldt 16(%esp) fldt 4(%esp) 1: fprem1 fstsw %ax sahf jp 1b fstp %st(1) /* Extract the three low-order bits of the quotient from C0,C3,C1. */ shrl $6,%eax movl %eax,%ecx andl $0x108,%eax rorl $7,%eax orl %eax,%ecx roll $4,%eax orl %ecx,%eax andl $7,%eax /* Negate the quotient bits if x*y<0. Avoid using an unpredictable branch. */ movl 24(%esp),%ecx xorl 12(%esp),%ecx movsx %cx,%ecx sarl $16,%ecx sarl $16,%ecx xorl %ecx,%eax andl $1,%ecx addl %ecx,%eax /* Store the quotient and return. */ movl 28(%esp),%ecx movl %eax,(%ecx) ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_sqrt.S0000644000175000017500000000052013122010155016232 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_sqrt.S,v 1.10 2011/01/07 16:13:12 kib Exp $") ENTRY(sqrt) fldl 4(%esp) fsqrt ret END(sqrt) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_logf.S0000644000175000017500000000062113122010155016172 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_logf.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: e_logf.S,v 1.2 1996/07/06 00:15:45 jtc Exp $") */ ENTRY(logf) fldln2 flds 4(%esp) fyl2x ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_scalbnf.S0000644000175000017500000000103613122010155016672 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_scalbnf.S,v 1.4 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: s_scalbnf.S,v 1.4 1999/01/02 05:15:40 kristerw Exp $") */ ENTRY(scalbnf) fildl 8(%esp) flds 4(%esp) fscale fstp %st(1) /* bug fix for fp stack overflow */ ret END(scalbnf) .globl CNAME(ldexpf) .set CNAME(ldexpf),CNAME(scalbnf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_lrint.S0000644000175000017500000000321213122010155016410 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_lrint.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); ENTRY(lrint) fldl 4(%esp) subl $4,%esp fistpl (%esp) popl %eax ret END(lrint) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_ceilf.S0000644000175000017500000000132213122010155016342 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_ceilf.S,v 1.4 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: s_ceilf.S,v 1.3 1995/05/08 23:52:44 jtc Exp $") */ ENTRY(ceilf) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0800,%dx /* round towards +oo */ andw $0xfbff,%dx movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ flds 8(%ebp); /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(ceilf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_exp.S0000644000175000017500000000273313122010155016045 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include /* e^x = 2^(x * log2(e)) */ ENTRY(exp) /* * If x is +-Inf, then the subtraction would give Inf-Inf = NaN. * Avoid this. Also avoid it if x is NaN for convenience. */ movl 8(%esp),%eax andl $0x7fffffff,%eax cmpl $0x7ff00000,%eax jae x_Inf_or_NaN fldl 4(%esp) /* * Extended precision is needed to reduce the maximum error from * hundreds of ulps to less than 1 ulp. Switch to it if necessary. * We may as well set the rounding mode to to-nearest and mask traps * if we switch. */ fstcw 4(%esp) movl 4(%esp),%eax andl $0x0300,%eax cmpl $0x0300,%eax /* RC == 0 && PC == 3? */ je 1f /* jump if mode is good */ movl $0x137f,8(%esp) fldcw 8(%esp) 1: fldl2e fmulp /* x * log2(e) */ fst %st(1) frndint /* int(x * log2(e)) */ fst %st(2) fsubrp /* fract(x * log2(e)) */ f2xm1 /* 2^(fract(x * log2(e))) - 1 */ fld1 faddp /* 2^(fract(x * log2(e))) */ fscale /* e^x */ fstp %st(1) je 1f fldcw 4(%esp) 1: ret x_Inf_or_NaN: /* * Return 0 if x is -Inf. Otherwise just return x; when x is Inf * this gives Inf, and when x is a NaN this gives the same result * as (x + x) (x quieted). */ cmpl $0xfff00000,8(%esp) jne x_not_minus_Inf cmpl $0,4(%esp) jne x_not_minus_Inf fldz ret x_not_minus_Inf: fldl 4(%esp) ret END(exp) // /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/Make.files0000644000175000017500000000125313122010155016516 0ustar philphil$(CUR_SRCS) = e_exp.S e_fmod.S e_log.S e_log10.S \ e_remainder.S e_sqrt.S s_ceil.S s_copysign.S \ s_floor.S s_llrint.S s_logb.S s_lrint.S \ s_remquo.S s_rint.S s_tan.S s_trunc.S ifneq ($(OS), WINNT) $(CUR_SRCS) += s_scalbn.S s_scalbnf.S s_scalbnl.S endif # float counterparts $(CUR_SRCS)+= e_log10f.S e_logf.S e_remainderf.S \ e_sqrtf.S s_ceilf.S s_copysignf.S s_floorf.S \ s_llrintf.S s_logbf.S s_lrintf.S \ s_remquof.S s_rintf.S s_truncf.S # long double counterparts $(CUR_SRCS)+= e_remainderl.S e_sqrtl.S s_ceill.S s_copysignl.S \ s_floorl.S s_llrintl.S \ s_logbl.S s_lrintl.S s_remquol.S s_rintl.S s_truncl.S $(CUR_SRCS)+= fenv.c wcc-0.0.2/src/wsh/openlibm/i387/s_llrintf.S0000644000175000017500000000323213122010155016734 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_llrintf.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(llrintf) flds 4(%esp) subl $8,%esp fistpll (%esp) popl %eax popl %edx ret END(llrintf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_llrintl.S0000644000175000017500000000321713122010155016745 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_llrintl.S,v 1.2 2011/01/07 16:13:12 kib Exp $"); ENTRY(llrintl) fldt 4(%esp) subl $8,%esp fistpll (%esp) popl %eax popl %edx ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/osx_asm.h0000644000175000017500000002632113122010155016442 0ustar philphil/* * Copyright (c) 2000 Apple Computer, Inc. All rights reserved. * * @APPLE_OSREFERENCE_LICENSE_HEADER_START@ * * This file contains Original Code and/or Modifications of Original Code * as defined in and that are subject to the Apple Public Source License * Version 2.0 (the 'License'). You may not use this file except in * compliance with the License. The rights granted to you under the License * may not be used to create, or enable the creation or redistribution of, * unlawful or unlicensed copies of an Apple operating system, or to * circumvent, violate, or enable the circumvention or violation of, any * terms of an Apple operating system software license agreement. * * Please obtain a copy of the License at * http://www.opensource.apple.com/apsl/ and read it before using this file. * * The Original Code and all software distributed under the License are * distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES, * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT. * Please see the License for the specific language governing rights and * limitations under the License. * * @APPLE_OSREFERENCE_LICENSE_HEADER_END@ */ /* * @OSF_COPYRIGHT@ */ /* * Mach Operating System * Copyright (c) 1991,1990,1989 Carnegie Mellon University * All Rights Reserved. * * Permission to use, copy, modify and distribute this software and its * documentation is hereby granted, provided that both the copyright * notice and this permission notice appear in all copies of the * software, derivative works or modified versions, and any portions * thereof, and that both notices appear in supporting documentation. * * CARNEGIE MELLON ALLOWS FREE USE OF THIS SOFTWARE IN ITS "AS IS" * CONDITION. CARNEGIE MELLON DISCLAIMS ANY LIABILITY OF ANY KIND FOR * ANY DAMAGES WHATSOEVER RESULTING FROM THE USE OF THIS SOFTWARE. * * Carnegie Mellon requests users of this software to return to * * Software Distribution Coordinator or Software.Distribution@CS.CMU.EDU * School of Computer Science * Carnegie Mellon University * Pittsburgh PA 15213-3890 * * any improvements or extensions that they make and grant Carnegie Mellon * the rights to redistribute these changes. */ #ifndef _I386_ASM_H_ #define _I386_ASM_H_ #ifdef _KERNEL #include #endif /* _KERNEL */ #ifdef MACH_KERNEL #include #else /* !MACH_KERNEL */ #define MACH_KDB 0 #endif /* !MACH_KERNEL */ #if defined(MACH_KERNEL) || defined(_KERNEL) #include #endif /* MACH_KERNEL || _KERNEL */ #if defined(__i386__) #define S_PC (%esp) #define S_ARG0 4(%esp) #define S_ARG1 8(%esp) #define S_ARG2 12(%esp) #define S_ARG3 16(%esp) #define S_ARG4 20(%esp) #define FRAME pushl %ebp; movl %esp, %ebp #define EMARF leave #define B_LINK (%ebp) #define B_PC 4(%ebp) #define B_ARG0 8(%ebp) #define B_ARG1 12(%ebp) #define B_ARG2 16(%ebp) #define B_ARG3 20(%ebp) #elif defined(__x86_64__) #define S_PC (%rsp) #define FRAME pushq %rbp; movq %rsp, %rbp #define EMARF leave #define B_LINK (%rbp) #define B_PC 8(%rbp) #else #error unsupported architecture #endif /* There is another definition of ALIGN for .c sources */ #ifdef ASSEMBLER #define ALIGN 4,0x90 #endif /* ASSEMBLER */ #ifndef FALIGN #define FALIGN ALIGN #endif #define LB(x,n) n #if __STDC__ #ifndef __NO_UNDERSCORES__ #define LCL(x) L ## x #define EXT(x) _ ## x #define LEXT(x) _ ## x ## : #else #define LCL(x) .L ## x #define EXT(x) x #define LEXT(x) x ## : #endif #define LBc(x,n) n ## : #define LBb(x,n) n ## b #define LBf(x,n) n ## f #else /* __STDC__ */ #ifndef __NO_UNDERSCORES__ #define LCL(x) L/**/x #define EXT(x) _/**/x #define LEXT(x) _/**/x/**/: #else /* __NO_UNDERSCORES__ */ #define LCL(x) .L/**/x #define EXT(x) x #define LEXT(x) x/**/: #endif /* __NO_UNDERSCORES__ */ #define LBc(x,n) n/**/: #define LBb(x,n) n/**/b #define LBf(x,n) n/**/f #endif /* __STDC__ */ #define SVC .byte 0x9a; .long 0; .word 0x7 #define RPC_SVC .byte 0x9a; .long 0; .word 0xf #define String .asciz #define Value .word #define Times(a,b) (a*b) #define Divide(a,b) (a/b) #define INB inb %dx, %al #define OUTB outb %al, %dx #define INL inl %dx, %eax #define OUTL outl %eax, %dx #define data16 .byte 0x66 #define addr16 .byte 0x67 #if !GPROF #define MCOUNT #elif defined(__SHARED__) #define MCOUNT ; .data;\ .align ALIGN;\ LBc(x, 8) .long 0;\ .text;\ Gpush;\ Gload;\ leal Gotoff(LBb(x,8)),%edx;\ Egaddr(%eax,_mcount_ptr);\ Gpop;\ call *(%eax); #else /* !GPROF, !__SHARED__ */ #define MCOUNT ; call mcount; #endif /* GPROF */ #ifdef __ELF__ #define ELF_FUNC(x) .type x,@function #define ELF_DATA(x) .type x,@object #define ELF_SIZE(x,s) .size x,s #else #define ELF_FUNC(x) #define ELF_DATA(x) #define ELF_SIZE(x,s) #endif #define Entry(x) .globl EXT(x); ELF_FUNC(EXT(x)); .align FALIGN; LEXT(x) #define ENTRY(x) Entry(x) MCOUNT #define ENTRY2(x,y) .globl EXT(x); .globl EXT(y); \ ELF_FUNC(EXT(x)); ELF_FUNC(EXT(y)); \ .align FALIGN; LEXT(x); LEXT(y) \ MCOUNT #if __STDC__ #define ASENTRY(x) .globl x; .align FALIGN; x ## : ELF_FUNC(x) MCOUNT #else #define ASENTRY(x) .globl x; .align FALIGN; x: ELF_FUNC(x) MCOUNT #endif /* __STDC__ */ #define DATA(x) .globl EXT(x); ELF_DATA(EXT(x)); .align ALIGN; LEXT(x) #define End(x) ELF_SIZE(x,.-x) #define END(x) End(EXT(x)) #define ENDDATA(x) END(x) #define Enddata(x) End(x) /* * ELF shared library accessor macros. * Gpush saves the %ebx register used for the GOT address * Gpop pops %ebx if we need a GOT * Gload loads %ebx with the GOT address if shared libraries are used * Gcall calls an external function. * Gotoff allows you to reference local labels. * Gotoff2 allows you to reference local labels with an index reg. * Gotoff3 allows you to reference local labels with an index reg & size. * Gaddr loads up a register with an address of an external item. * Gstack is the number of bytes that Gpush pushes on the stack. * * Varients of the above with E or L prefixes do EXT(name) or LCL(name) * respectively. */ #ifndef __SHARED__ #define Gpush #define Gpop #define Gload #define Gcall(func) call func #define Gotoff(lab) lab #define Gotoff2(l,r) l(r) #define Gotoff3(l,r,s) l(,r,s) #define Gaddr(to,lab) movl $lab,to #define Gcmp(lab,reg) cmpl $lab,reg #define Gmemload(lab,reg) movl lab,reg #define Gmemstore(reg,lab,tmp) movl reg,lab #define Gstack 0 #else #ifdef __ELF__ /* ELF shared libraries */ #define Gpush pushl %ebx #define Gpop popl %ebx #define Gload call 9f; 9: popl %ebx; addl $_GLOBAL_OFFSET_TABLE_+[.-9b],%ebx #define Gcall(func) call EXT(func)@PLT #define Gotoff(lab) lab@GOTOFF(%ebx) #define Gotoff2(l,r) l@GOTOFF(%ebx,r) #define Gotoff3(l,r,s) l@GOTOFF(%ebx,r,s) #define Gaddr(to,lab) movl lab@GOT(%ebx),to #define Gcmp(lab,reg) cmpl reg,lab@GOT(%ebx) #define Gmemload(lab,reg) movl lab@GOT(%ebx),reg; movl (reg),reg #define Gmemstore(reg,lab,tmp) movl lab@GOT(%ebx),tmp; movl reg,(tmp) #define Gstack 4 #else /* ROSE shared libraries */ #define Gpush #define Gpop #define Gload #define Gcall(func) call *9f; .data; .align ALIGN; 9: .long func; .text #define Gotoff(lab) lab #define Gotoff2(l,r) l(r) #define Gotoff3(l,r,s) l(,r,s) #define Gaddr(to,lab) movl 9f,to; .data; .align ALIGN; 9: .long lab; .text #define Gcmp(lab,reg) cmpl reg,9f; .data; .align ALIGN; 9: .long lab; .text #define Gmemload(lab,reg) movl 9f,reg; movl (reg),reg; .data; .align ALIGN; 9: .long lab; .text #define Gmemstore(reg,lab,tmp) movl 9f,tmp; movl reg,(tmp); .data; .align ALIGN; 9: .long lab; .text #define Gstack 0 #endif /* __ELF__ */ #endif /* __SHARED__ */ /* Egotoff is not provided, since external symbols should not use @GOTOFF relocations. */ #define Egcall(func) Gcall(EXT(func)) #define Egaddr(to,lab) Gaddr(to,EXT(lab)) #define Egcmp(lab,reg) Gcmp(EXT(lab),reg) #define Egmemload(lab,reg) Gmemload(EXT(lab),reg) #define Egmemstore(reg,lab,tmp) Gmemstore(reg,EXT(lab),tmp) #define Lgotoff(lab) Gotoff(LCL(lab)) #define Lgotoff2(l,r) Gotoff2(LCL(l),r) #define Lgotoff3(l,r,s) Gotoff3(LCL(l),r,s) #define Lgcmp(lab,reg) Gcmp(LCL(lab),reg) #define Lgmemload(lab,reg) movl Lgotoff(lab),reg #define Lgmemstore(reg,lab,tmp) movl reg,Lgotoff(lab) #ifdef ASSEMBLER #if MACH_KDB #include /* * This pseudo-assembler line is added so that there will be at least * one N_SO entry in the symbol stable to define the current file name. */ #endif /* MACH_KDB */ #else /* NOT ASSEMBLER */ /* These defines are here for .c files that wish to reference global symbols * within __asm__ statements. */ #ifndef __NO_UNDERSCORES__ #define CC_SYM_PREFIX "_" #else #define CC_SYM_PREFIX "" #endif /* __NO_UNDERSCORES__ */ #endif /* ASSEMBLER */ /* * The following macros make calls into C code. * They dynamically align the stack to 16 bytes. */ #if defined(__i386__) /* * Arguments are moved (not pushed) onto the correctly aligned stack. * NOTE: ESI is destroyed in the process, and hence cannot * be directly used as a parameter. Users of this macro must * independently preserve ESI (a non-volatile) if the routine is * intended to be called from C, for instance. */ #define CCALL(fn) \ movl %esp, %esi ;\ andl $0xFFFFFFF0, %esp ;\ call EXT(fn) ;\ movl %esi, %esp #define CCALL1(fn, arg1) \ movl %esp, %esi ;\ subl $4, %esp ;\ andl $0xFFFFFFF0, %esp ;\ movl arg1, (%esp) ;\ call EXT(fn) ;\ movl %esi, %esp #define CCALL2(fn, arg1, arg2) \ movl %esp, %esi ;\ subl $8, %esp ;\ andl $0xFFFFFFF0, %esp ;\ movl arg2, 4(%esp) ;\ movl arg1, (%esp) ;\ call EXT(fn) ;\ movl %esi, %esp /* This variant exists to permit adjustment of the stack by "dtrace" */ #define CCALL1WITHSP(fn, arg1) \ movl %esp, %esi ;\ subl $12, %esp ;\ andl $0xFFFFFFF0, %esp ;\ movl %esi, 8(%esp) ;\ leal 8(%esp), %esi ;\ movl %esi, 4(%esp) ;\ movl arg1, (%esp) ;\ call EXT(fn) ;\ movl 8(%esp), %esp /* * CCALL5 is used for callee functions with 3 arguments but * where arg2 (a3:a2) and arg3 (a5:a4) are 64-bit values. */ #define CCALL5(fn, a1, a2, a3, a4, a5) \ movl %esp, %esi ;\ subl $20, %esp ;\ andl $0xFFFFFFF0, %esp ;\ movl a5, 16(%esp) ;\ movl a4, 12(%esp) ;\ movl a3, 8(%esp) ;\ movl a2, 4(%esp) ;\ movl a1, (%esp) ;\ call EXT(fn) ;\ movl %esi, %esp #elif defined(__x86_64__) /* This variant exists to permit adjustment of the stack by "dtrace" */ #define CCALLWITHSP(fn) \ mov %rsp, %r12 ;\ sub $8, %rsp ;\ and $0xFFFFFFFFFFFFFFF0, %rsp ;\ mov %r12, (%rsp) ;\ leaq (%rsp), %rsi ;\ call EXT(fn) ;\ mov (%rsp), %rsp #define CCALL(fn) \ mov %rsp, %r12 ;\ and $0xFFFFFFFFFFFFFFF0, %rsp ;\ call EXT(fn) ;\ mov %r12, %rsp #define CCALL1(fn, arg1) \ mov arg1, %rdi ;\ CCALL(fn) #define CCALL2(fn, arg1, arg2) \ mov arg1, %rdi ;\ CCALL(fn) #define CCALL3(fn, arg1, arg2, arg3) \ mov arg1, %rdi ;\ mov arg2, %rsi ;\ mov arg3, %rdx ;\ CCALL(fn) #else #error unsupported architecture #endif #endif /* _I386_ASM_H_ */ wcc-0.0.2/src/wsh/openlibm/i387/s_rintf.S0000644000175000017500000000063113122010155016404 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_rintf.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: s_rintf.S,v 1.3 1995/05/09 00:17:22 jtc Exp $") */ ENTRY(rintf) flds 4(%esp) frndint ret END(rintf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_fmod.S0000644000175000017500000000060613122010155016173 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_fmod.S,v 1.11 2011/01/07 16:13:12 kib Exp $") ENTRY(fmod) fldl 12(%esp) fldl 4(%esp) 1: fprem fstsw %ax sahf jp 1b fstp %st(1) ret END(fmod) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_rintl.S0000644000175000017500000000051113122010155016407 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_rintl.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(rintl) fldt 4(%esp) frndint ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_floor.S0000644000175000017500000000121613122010155016403 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_floor.S,v 1.10 2011/01/07 16:13:12 kib Exp $") ENTRY(floor) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0400,%dx /* round towards -oo */ andw $0xf7ff,%dx movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ fldl 8(%ebp); /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(floor) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_log.S0000644000175000017500000000052513122010155016027 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_log.S,v 1.10 2011/01/07 16:13:12 kib Exp $") ENTRY(log) fldln2 fldl 4(%esp) fyl2x ret END(log) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/fenv.c0000644000175000017500000001227613122010155015726 0ustar philphil/*- * Copyright (c) 2004-2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/i387/fenv.c,v 1.8 2011/10/21 06:25:31 das Exp $ */ #include "cdefs-compat.h" #include "types-compat.h" #include "math_private.h" #include "i387/bsd_npx.h" #define __fenv_static #include #ifdef __GNUC_GNU_INLINE__ #error "This file must be compiled with C99 'inline' semantics" #endif const fenv_t __fe_dfl_env = { __INITIAL_NPXCW__, 0x0000, 0x0000, 0x1f80, 0xffffffff, { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff } }; enum __sse_support __has_sse = #ifdef __SSE__ __SSE_YES; #else __SSE_UNK; #endif #define getfl(x) __asm __volatile("pushfl\n\tpopl %0" : "=mr" (*(x))) #define setfl(x) __asm __volatile("pushl %0\n\tpopfl" : : "g" (x)) #define cpuid_dx(x) __asm __volatile("pushl %%ebx\n\tmovl $1, %%eax\n\t" \ "cpuid\n\tpopl %%ebx" \ : "=d" (*(x)) : : "eax", "ecx") /* * Test for SSE support on this processor. We need to do this because * we need to use ldmxcsr/stmxcsr to get correct results if any part * of the program was compiled to use SSE floating-point, but we can't * use SSE on older processors. */ int __test_sse(void) { int flag, nflag; int dx_features; /* Am I a 486? */ getfl(&flag); nflag = flag ^ 0x200000; setfl(nflag); getfl(&nflag); if (flag != nflag) { /* Not a 486, so CPUID should work. */ cpuid_dx(&dx_features); if (dx_features & 0x2000000) { __has_sse = __SSE_YES; return (1); } } __has_sse = __SSE_NO; return (0); } extern inline OLM_DLLEXPORT int feclearexcept(int __excepts); extern inline OLM_DLLEXPORT int fegetexceptflag(fexcept_t *__flagp, int __excepts); OLM_DLLEXPORT int fesetexceptflag(const fexcept_t *flagp, int excepts) { fenv_t env; uint32_t mxcsr; __fnstenv(&env); env.__status &= ~excepts; env.__status |= *flagp & excepts; __fldenv(env); if (__HAS_SSE()) { __stmxcsr(&mxcsr); mxcsr &= ~excepts; mxcsr |= *flagp & excepts; __ldmxcsr(mxcsr); } return (0); } OLM_DLLEXPORT int feraiseexcept(int excepts) { fexcept_t ex = excepts; fesetexceptflag(&ex, excepts); __fwait(); return (0); } extern inline OLM_DLLEXPORT int fetestexcept(int __excepts); extern inline OLM_DLLEXPORT int fegetround(void); extern inline OLM_DLLEXPORT int fesetround(int __round); int fegetenv(fenv_t *envp) { uint32_t mxcsr; __fnstenv(envp); /* * fnstenv masks all exceptions, so we need to restore * the old control word to avoid this side effect. */ __fldcw(envp->__control); if (__HAS_SSE()) { __stmxcsr(&mxcsr); __set_mxcsr(*envp, mxcsr); } return (0); } int feholdexcept(fenv_t *envp) { uint32_t mxcsr; __fnstenv(envp); __fnclex(); if (__HAS_SSE()) { __stmxcsr(&mxcsr); __set_mxcsr(*envp, mxcsr); mxcsr &= ~FE_ALL_EXCEPT; mxcsr |= FE_ALL_EXCEPT << _SSE_EMASK_SHIFT; __ldmxcsr(mxcsr); } return (0); } extern inline OLM_DLLEXPORT int fesetenv(const fenv_t *__envp); OLM_DLLEXPORT int feupdateenv(const fenv_t *envp) { uint32_t mxcsr; uint16_t status; __fnstsw(&status); if (__HAS_SSE()) __stmxcsr(&mxcsr); else mxcsr = 0; fesetenv(envp); feraiseexcept((mxcsr | status) & FE_ALL_EXCEPT); return (0); } int feenableexcept(int mask) { uint32_t mxcsr, omask; uint16_t control; mask &= FE_ALL_EXCEPT; __fnstcw(&control); if (__HAS_SSE()) __stmxcsr(&mxcsr); else mxcsr = 0; omask = ~(control | mxcsr >> _SSE_EMASK_SHIFT) & FE_ALL_EXCEPT; control &= ~mask; __fldcw(control); if (__HAS_SSE()) { mxcsr &= ~(mask << _SSE_EMASK_SHIFT); __ldmxcsr(mxcsr); } return (omask); } int fedisableexcept(int mask) { uint32_t mxcsr, omask; uint16_t control; mask &= FE_ALL_EXCEPT; __fnstcw(&control); if (__HAS_SSE()) __stmxcsr(&mxcsr); else mxcsr = 0; omask = ~(control | mxcsr >> _SSE_EMASK_SHIFT) & FE_ALL_EXCEPT; control |= mask; __fldcw(control); if (__HAS_SSE()) { mxcsr |= mask << _SSE_EMASK_SHIFT; __ldmxcsr(mxcsr); } return (omask); } wcc-0.0.2/src/wsh/openlibm/i387/s_copysignf.S0000644000175000017500000000102613122010155017262 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_copysignf.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: s_copysignf.S,v 1.3 1995/05/08 23:53:25 jtc Exp $") */ ENTRY(copysignf) movl 8(%esp),%edx andl $0x80000000,%edx movl 4(%esp),%eax andl $0x7fffffff,%eax orl %edx,%eax movl %eax,4(%esp) flds 4(%esp) ret END(copysignf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_llrint.S0000644000175000017500000000323113122010155016565 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_llrint.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); ENTRY(llrint) fldl 4(%esp) subl $8,%esp fistpll (%esp) popl %eax popl %edx ret END(llrint) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/invtrig.c0000644000175000017500000001022713122010155016444 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/invtrig.c,v 1.1 2008/08/02 03:56:22 das Exp $"); #include #define STRUCT_DECLS #include "invtrig.h" /* * asinl() and acosl() */ const LONGDOUBLE pS0 = { 0xaaaaaaaaaaaaaaa8ULL, 0x3ffcU }, /* 1.66666666666666666631e-01L */ pS1 = { 0xd5271b6699b48bfaULL, 0xbffdU }, /* -4.16313987993683104320e-01L */ pS2 = { 0xbcf67ca9e9f669cfULL, 0x3ffdU }, /* 3.69068046323246813704e-01L */ pS3 = { 0x8b7baa3d15f9830dULL, 0xbffcU }, /* -1.36213932016738603108e-01L */ pS4 = { 0x92154b093a3bff1cULL, 0x3ff9U }, /* 1.78324189708471965733e-02L */ pS5 = { 0xe5dd76401964508cULL, 0xbff2U }, /* -2.19216428382605211588e-04L */ pS6 = { 0xee69c5b0fdb76951ULL, 0xbfedU }, /* -7.10526623669075243183e-06L */ qS1 = { 0xbcaa2159c01436a0ULL, 0xc000U }, /* -2.94788392796209867269e+00L */ qS2 = { 0xd17a73d1e1564c29ULL, 0x4000U }, /* 3.27309890266528636716e+00L */ qS3 = { 0xd767e411c9cf4c2cULL, 0xbfffU }, /* -1.68285799854822427013e+00L */ qS4 = { 0xc809c0dfb9b0d0b7ULL, 0x3ffdU }, /* 3.90699412641738801874e-01L */ qS5 = { 0x80c3a2197c8ced57ULL, 0xbffaU }; /* -3.14365703596053263322e-02L */ /* * atanl() */ const LONGDOUBLE atanhi[] = { { 0xed63382b0dda7b45ULL, 0x3ffdU }, /* 4.63647609000806116202e-01L */ { 0xc90fdaa22168c235ULL, 0x3ffeU }, /* 7.85398163397448309628e-01L */ { 0xfb985e940fb4d900ULL, 0x3ffeU }, /* 9.82793723247329067960e-01L */ { 0xc90fdaa22168c235ULL, 0x3fffU }, /* 1.57079632679489661926e+00L */ }; const LONGDOUBLE atanlo[] = { { 0xdfc88bd978751a07ULL, 0x3fbcU }, /* 1.18469937025062860669e-20L */ { 0xece675d1fc8f8cbbULL, 0xbfbcU }, /* -1.25413940316708300586e-20L */ { 0xf10f5e197793c283ULL, 0x3fbdU }, /* 2.55232234165405176172e-20L */ { 0xece675d1fc8f8cbbULL, 0xbfbdU }, /* -2.50827880633416601173e-20L */ }; const LONGDOUBLE aT[] = { { 0xaaaaaaaaaaaaaa9fULL, 0x3ffdU }, /* 3.33333333333333333017e-01L */ { 0xcccccccccccc62bcULL, 0xbffcU }, /* -1.99999999999999632011e-01L */ { 0x9249249248b81e3fULL, 0x3ffcU }, /* 1.42857142857046531280e-01L */ { 0xe38e38e3316f3de5ULL, 0xbffbU }, /* -1.11111111100562372733e-01L */ { 0xba2e8b8dc280726aULL, 0x3ffbU }, /* 9.09090902935647302252e-02L */ { 0x9d89d5b4c6847ec4ULL, 0xbffbU }, /* -7.69230552476207730353e-02L */ { 0x8888461d3099c677ULL, 0x3ffbU }, /* 6.66661718042406260546e-02L */ { 0xf0e8ee0f5328dc29ULL, 0xbffaU }, /* -5.88158892835030888692e-02L */ { 0xd73ea84d24bae54aULL, 0x3ffaU }, /* 5.25499891539726639379e-02L */ { 0xc08fa381dcd9213aULL, 0xbffaU }, /* -4.70119845393155721494e-02L */ { 0xa54a26f4095f2a3aULL, 0x3ffaU }, /* 4.03539201366454414072e-02L */ { 0xeea2d8d059ef3ad6ULL, 0xbff9U }, /* -2.91303858419364158725e-02L */ { 0xcc82292ab894b051ULL, 0x3ff8U }, /* 1.24822046299269234080e-02L */ }; const LONGDOUBLE pi_lo = { 0xece675d1fc8f8cbbULL, 0xbfbeU }; /* -5.01655761266833202345e-20L */ wcc-0.0.2/src/wsh/openlibm/i387/s_tan.S0000644000175000017500000000076513122010155016054 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_tan.S,v 1.9 2011/01/07 16:13:12 kib Exp $") ENTRY(tan) fldl 4(%esp) fptan fnstsw %ax andw $0x400,%ax jnz 1f fstp %st(0) ret 1: fldpi fadd %st(0) fxch %st(1) 2: fprem1 fstsw %ax andw $0x400,%ax jnz 2b fstp %st(1) fptan fstp %st(0) ret END(tan) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_remquof.S0000644000175000017500000000430513122010155016742 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* * Based on public-domain remainder routine by J.T. Conklin . */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_remquof.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); ENTRY(remquof) flds 8(%esp) flds 4(%esp) 1: fprem1 fstsw %ax sahf jp 1b fstp %st(1) /* Extract the three low-order bits of the quotient from C0,C3,C1. */ shrl $6,%eax movl %eax,%ecx andl $0x108,%eax rorl $7,%eax orl %eax,%ecx roll $4,%eax orl %ecx,%eax andl $7,%eax /* Negate the quotient bits if x*y<0. Avoid using an unpredictable branch. */ movl 8(%esp),%ecx xorl 4(%esp),%ecx sarl $16,%ecx sarl $16,%ecx xorl %ecx,%eax andl $1,%ecx addl %ecx,%eax /* Store the quotient and return. */ movl 12(%esp),%ecx movl %eax,(%ecx) ret END(remquof) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_lrintl.S0000644000175000017500000000320113122010155016562 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_lrintl.S,v 1.2 2011/01/07 16:13:12 kib Exp $"); ENTRY(lrintl) fldt 4(%esp) subl $4,%esp fistpl (%esp) popl %eax ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_rint.S0000644000175000017500000000052113122010155016234 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_rint.S,v 1.9 2011/01/07 16:13:12 kib Exp $") ENTRY(rint) fldl 4(%esp) frndint ret END(rint) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_remquo.S0000644000175000017500000000430413122010155016573 0ustar philphil/*- * Copyright (c) 2005 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* * Based on public-domain remainder routine by J.T. Conklin . */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_remquo.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); ENTRY(remquo) fldl 12(%esp) fldl 4(%esp) 1: fprem1 fstsw %ax sahf jp 1b fstp %st(1) /* Extract the three low-order bits of the quotient from C0,C3,C1. */ shrl $6,%eax movl %eax,%ecx andl $0x108,%eax rorl $7,%eax orl %eax,%ecx roll $4,%eax orl %ecx,%eax andl $7,%eax /* Negate the quotient bits if x*y<0. Avoid using an unpredictable branch. */ movl 16(%esp),%ecx xorl 8(%esp),%ecx sarl $16,%ecx sarl $16,%ecx xorl %ecx,%eax andl $1,%ecx addl %ecx,%eax /* Store the quotient and return. */ movl 20(%esp),%ecx movl %eax,(%ecx) ret END(remquo) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_floorl.S0000644000175000017500000000123313122010155016556 0ustar philphil/* * Based on code written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_floorl.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(floorl) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0400,%dx /* round towards -oo */ andw $0xf7ff,%dx movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ fldt 8(%ebp) /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(floorl) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_cos.S0000644000175000017500000000073313122010155016051 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_cos.S,v 1.9 2011/01/07 16:13:12 kib Exp $") ENTRY(cos) fldl 4(%esp) fcos fnstsw %ax andw $0x400,%ax jnz 1f ret 1: fldpi fadd %st(0) fxch %st(1) 2: fprem1 fnstsw %ax andw $0x400,%ax jnz 2b fstp %st(1) fcos ret END(cos) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_log10f.S0000644000175000017500000000064313122010155016337 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_log10f.S,v 1.4 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: e_log10f.S,v 1.1 1996/07/03 16:50:22 jtc Exp $") */ ENTRY(log10f) fldlg2 flds 4(%esp) fyl2x ret END(log10f) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_sqrtf.S0000644000175000017500000000062713122010155016410 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_sqrtf.S,v 1.4 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: e_sqrtf.S,v 1.2 1995/05/08 23:50:14 jtc Exp $") */ ENTRY(sqrtf) flds 4(%esp) fsqrt ret END(sqrtf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_ceill.S0000644000175000017500000000123113122010155016347 0ustar philphil/* * Based on code written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_ceill.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(ceill) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0800,%dx /* round towards +oo */ andw $0xfbff,%dx movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ fldt 8(%ebp) /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(ceill) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_copysign.S0000644000175000017500000000071313122010155017116 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_copysign.S,v 1.9 2011/01/07 16:13:12 kib Exp $") ENTRY(copysign) movl 16(%esp),%edx andl $0x80000000,%edx movl 8(%esp),%eax andl $0x7fffffff,%eax orl %edx,%eax movl %eax,8(%esp) fldl 4(%esp) ret END(copysign) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/bsd_npx.h0000644000175000017500000001275713122010155016436 0ustar philphil/*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)npx.h 5.3 (Berkeley) 1/18/91 * $FreeBSD: src/sys/i386/include/npx.h,v 1.29.2.1 2006/07/01 00:57:55 davidxu Exp $ */ /* * 287/387 NPX Coprocessor Data Structures and Constants * W. Jolitz 1/90 */ #ifndef _MACHINE_NPX_H_ #define _MACHINE_NPX_H_ /* Environment information of floating point unit */ struct env87 { long en_cw; /* control word (16bits) */ long en_sw; /* status word (16bits) */ long en_tw; /* tag word (16bits) */ long en_fip; /* floating point instruction pointer */ unsigned short en_fcs; /* floating code segment selector */ unsigned short en_opcode; /* opcode last executed (11 bits ) */ long en_foo; /* floating operand offset */ long en_fos; /* floating operand segment selector */ }; /* Contents of each floating point accumulator */ struct fpacc87 { #ifdef dontdef /* too unportable */ unsigned long fp_mantlo; /* mantissa low (31:0) */ unsigned long fp_manthi; /* mantissa high (63:32) */ int fp_exp:15; /* exponent */ int fp_sgn:1; /* mantissa sign */ #else unsigned char fp_bytes[10]; #endif }; /* Floating point context */ struct save87 { struct env87 sv_env; /* floating point control/status */ struct fpacc87 sv_ac[8]; /* accumulator contents, 0-7 */ unsigned char sv_pad0[4]; /* padding for (now unused) saved status word */ /* * Bogus padding for emulators. Emulators should use their own * struct and arrange to store into this struct (ending here) * before it is inspected for ptracing or for core dumps. Some * emulators overwrite the whole struct. We have no good way of * knowing how much padding to leave. Leave just enough for the * GPL emulator's i387_union (176 bytes total). */ unsigned char sv_pad[64]; /* padding; used by emulators */ }; struct envxmm { uint16_t en_cw; /* control word (16bits) */ uint16_t en_sw; /* status word (16bits) */ uint16_t en_tw; /* tag word (16bits) */ uint16_t en_opcode; /* opcode last executed (11 bits ) */ uint32_t en_fip; /* floating point instruction pointer */ uint16_t en_fcs; /* floating code segment selector */ uint16_t en_pad0; /* padding */ uint32_t en_foo; /* floating operand offset */ uint16_t en_fos; /* floating operand segment selector */ uint16_t en_pad1; /* padding */ uint32_t en_mxcsr; /* SSE sontorol/status register */ uint32_t en_mxcsr_mask; /* valid bits in mxcsr */ }; /* Contents of each SSE extended accumulator */ struct xmmacc { unsigned char xmm_bytes[16]; }; struct savexmm { struct envxmm sv_env; struct { struct fpacc87 fp_acc; unsigned char fp_pad[6]; /* padding */ } sv_fp[8]; struct xmmacc sv_xmm[8]; unsigned char sv_pad[224]; } __attribute__((__aligned__(16))); union savefpu { struct save87 sv_87; struct savexmm sv_xmm; }; /* * The hardware default control word for i387's and later coprocessors is * 0x37F, giving: * * round to nearest * 64-bit precision * all exceptions masked. * * We modify the affine mode bit and precision bits in this to give: * * affine mode for 287's (if they work at all) (1 in bitfield 1<<12) * 53-bit precision (2 in bitfield 3<<8) * * 64-bit precision often gives bad results with high level languages * because it makes the results of calculations depend on whether * intermediate values are stored in memory or in FPU registers. */ #define __INITIAL_NPXCW__ 0x127F #define __INITIAL_MXCSR__ 0x1F80 #ifdef _KERNEL #define IO_NPX 0x0F0 /* Numeric Coprocessor */ #define IO_NPXSIZE 16 /* 80387/80487 NPX registers */ #define IRQ_NPX 13 /* full reset on some systems, NOP on others */ #define npx_full_reset() outb(IO_NPX + 1, 0) int npxdna(void); void npxdrop(void); void npxexit(struct thread *td); int npxformat(void); int npxgetregs(struct thread *td, union savefpu *addr); void npxinit(unsigned short control); void npxsave(union savefpu *addr); void npxsetregs(struct thread *td, union savefpu *addr); int npxtrap(void); #endif #endif /* !_MACHINE_NPX_H_ */wcc-0.0.2/src/wsh/openlibm/i387/s_truncl.S0000644000175000017500000000121113122010155016564 0ustar philphil/* * Based on code written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_truncl.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(truncl) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0c00,%dx /* round towards -oo */ movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ fldt 8(%ebp) /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(truncl) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/bsd_asm.h0000644000175000017500000000736413122010155016407 0ustar philphil/*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)DEFS.h 5.1 (Berkeley) 4/23/90 * $FreeBSD: src/sys/i386/include/asm.h,v 1.14 2007/08/22 04:26:07 jkoshy Exp $ */ #ifndef _MACHINE_ASM_H_ #define _MACHINE_ASM_H_ #if defined(__APPLE__) #include "osx_asm.h" #define CNAME(x) EXT(x) #else #include "cdefs-compat.h" #ifdef PIC #define PIC_PROLOGUE \ pushl %ebx; \ call 1f; \ 1: \ popl %ebx; \ addl $_GLOBAL_OFFSET_TABLE_+[.-1b],%ebx #define PIC_EPILOGUE \ popl %ebx #define PIC_PLT(x) x@PLT #define PIC_GOT(x) x@GOT(%ebx) #else #define PIC_PROLOGUE #define PIC_EPILOGUE #define PIC_PLT(x) x #define PIC_GOT(x) x #endif /* * CNAME and HIDENAME manage the relationship between symbol names in C * and the equivalent assembly language names. CNAME is given a name as * it would be used in a C program. It expands to the equivalent assembly * language name. HIDENAME is given an assembly-language name, and expands * to a possibly-modified form that will be invisible to C programs. */ /* XXX should use .p2align 4,0x90 for -m486. */ #define _START_ENTRY .p2align 2,0x90 #if defined(__ELF__) #define CNAME(csym) csym #define HIDENAME(asmsym) .asmsym #define _ENTRY(x) .text; _START_ENTRY; \ .globl CNAME(x); .type CNAME(x),@function; CNAME(x): #define END(x) .size x, . - x #elif defined(_WIN32) #ifndef _MSC_VER #define END(x) .end #define _START_ENTRY_WIN .text; _START_ENTRY #else #define END(x) end #define _START_ENTRY_WIN .code; _START_ENTRY #endif #define CNAME(csym) _##csym #define HIDENAME(asmsym) .asmsym #define _ENTRY(x) _START_ENTRY_WIN; \ .globl CNAME(x); .section .drectve; .ascii " -export:" #x; \ .section .text; .def CNAME(x); .scl 2; .type 32; .endef; CNAME(x): #endif #ifdef PROF #define ALTENTRY(x) _ENTRY(x); \ pushl %ebp; movl %esp,%ebp; \ call PIC_PLT(HIDENAME(mcount)); \ popl %ebp; \ jmp 9f #define ENTRY(x) _ENTRY(x); \ pushl %ebp; movl %esp,%ebp; \ call PIC_PLT(HIDENAME(mcount)); \ popl %ebp; \ 9: #else #define ALTENTRY(x) _ENTRY(x) #define ENTRY(x) _ENTRY(x) #endif #define RCSID(x) .text; .asciz x #undef __FBSDID #define __FBSDID(s) /* nothing */ #endif #endif /* !_MACHINE_ASM_H_ */ wcc-0.0.2/src/wsh/openlibm/i387/e_remainderf.S0000644000175000017500000000074113122010155017362 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_remainderf.S,v 1.4 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: e_remainderf.S,v 1.2 1995/05/08 23:49:47 jtc Exp $") */ ENTRY(remainderf) flds 8(%esp) flds 4(%esp) 1: fprem1 fstsw %ax sahf jp 1b fstp %st(1) ret END(remainderf) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_ceil.S0000644000175000017500000000107013122010155016174 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include ENTRY(ceil) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0800,%dx /* round towards +oo */ andw $0xfbff,%dx movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ fldl 8(%ebp); /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(ceil) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_logbl.S0000644000175000017500000000052313122010155016361 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_logbl.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(logbl) fldt 4(%esp) fxtract fstp %st ret /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_trunc.S0000644000175000017500000000120613122010155016414 0ustar philphil/* * Based on code written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_trunc.S,v 1.3 2011/01/07 16:13:12 kib Exp $") ENTRY(trunc) pushl %ebp movl %esp,%ebp subl $8,%esp fstcw -4(%ebp) /* store fpu control word */ movw -4(%ebp),%dx orw $0x0c00,%dx /* round towards -oo */ movw %dx,-8(%ebp) fldcw -8(%ebp) /* load modfied control word */ fldl 8(%ebp) /* round */ frndint fldcw -4(%ebp) /* restore original control word */ leave ret END(trunc) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_sin.S0000644000175000017500000000073213122010155016055 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_sin.S,v 1.9 2011/01/07 16:13:12 kib Exp $") ENTRY(sin) fldl 4(%esp) fsin fnstsw %ax andw $0x400,%ax jnz 1f ret 1: fldpi fadd %st(0) fxch %st(1) 2: fprem1 fnstsw %ax andw $0x400,%ax jnz 2b fstp %st(1) fsin ret END(sin) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_log10.S0000644000175000017500000000053313122010155016167 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_log10.S,v 1.10 2011/01/07 16:13:12 kib Exp $") ENTRY(log10) fldlg2 fldl 4(%esp) fyl2x ret END(log10) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/s_scalbnl.S0000644000175000017500000000077213122010155016706 0ustar philphil/* * Written by J.T. Conklin . * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/s_scalbnl.S,v 1.3 2011/01/07 16:13:12 kib Exp $"); /* RCSID("$NetBSD: s_scalbnf.S,v 1.4 1999/01/02 05:15:40 kristerw Exp $") */ ENTRY(scalbnl) fildl 16(%esp) fldt 4(%esp) fscale fstp %st(1) ret END(scalbnl) .globl CNAME(ldexpl) .set CNAME(ldexpl),CNAME(scalbnl) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/i387/e_remainder.S0000644000175000017500000000062613122010155017216 0ustar philphil/* * Written by: * J.T. Conklin (jtc@netbsd.org) * Public domain. */ #include //__FBSDID("$FreeBSD: src/lib/msun/i387/e_remainder.S,v 1.11 2011/01/07 16:13:12 kib Exp $") ENTRY(remainder) fldl 12(%esp) fldl 4(%esp) 1: fprem1 fstsw %ax sahf jp 1b fstp %st(1) ret END(remainder) /* Enable stack protection */ #if defined(__ELF__) .section .note.GNU-stack,"",%progbits #endif wcc-0.0.2/src/wsh/openlibm/.mailmap0000644000175000017500000000564513122010155015555 0ustar philphilJuliaLang JuliaLang Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Jeff Bezanson Stefan Karpinski Stefan Karpinski Stefan Karpinski Viral B. Shah Viral B. Shah Viral B. Shah Viral B. Shah George Xing George Xing Stephan Boyer Stephan Boyer Stephan Boyer Stephan Boyer Giuseppe Zingales Giuseppe Zingales Jameson Nash Jameson Nash Jameson Nash Alan Edelman PlayMyCode PlayMyCode Corey M. Hoffstein Corey M. Hoffstein Stefan Kroboth Tim Holy Tim Holy Patrick O'Leary Ivan Mantova Keno Fischer Keno Fischer Keno Fischer wcc-0.0.2/src/wsh/openlibm/LICENSE.md0000644000175000017500000001334113122010155015530 0ustar philphil## OpenLibm OpenLibm contains code that is covered by various licenses. The OpenLibm code derives from the FreeBSD msun and OpenBSD libm implementations, which in turn derives from FDLIBM 5.3. As a result, it has a number of fixes and updates that have accumulated over the years in msun, and also optimized assembly versions of many functions. These improvements are provided under the BSD and ISC licenses. The msun library also includes work placed under the public domain, which is noted in the individual files. Further work on making a standalone OpenLibm library from msun, as part of the Julia project is covered under the MIT license. The test files, test-double.c and test-float.c are under the LGPL. ## Parts copyrighted by the Julia project (MIT License) > Copyright (c) 2011-14 The Julia Project. > https://github.com/JuliaLang/openlibm/graphs/contributors > > Permission is hereby granted, free of charge, to any person obtaining > a copy of this software and associated documentation files (the > "Software"), to deal in the Software without restriction, including > without limitation the rights to use, copy, modify, merge, publish, > distribute, sublicense, and/or sell copies of the Software, and to > permit persons to whom the Software is furnished to do so, subject to > the following conditions: > > The above copyright notice and this permission notice shall be > included in all copies or substantial portions of the Software. > > THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, > EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF > MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND > NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE > LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION > OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION > WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ## Parts copyrighted by Stephen L. Moshier (ISC License) > Copyright (c) 2008 Stephen L. Moshier > > Permission to use, copy, modify, and distribute this software for any > purpose with or without fee is hereby granted, provided that the above > copyright notice and this permission notice appear in all copies. > > THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES > WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF > MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR > ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES > WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN > ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF > OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ## FREEBSD MSUN (FreeBSD/2-clause BSD/Simplified BSD License) > Copyright 1992-2011 The FreeBSD Project. All rights reserved. > > Redistribution and use in source and binary forms, with or without > modification, are permitted provided that the following conditions are > met: > > 1. Redistributions of source code must retain the above copyright > notice, this list of conditions and the following disclaimer. > > 2. Redistributions in binary form must reproduce the above copyright > notice, this list of conditions and the following disclaimer in the > documentation and/or other materials provided with the distribution. > THIS SOFTWARE IS PROVIDED BY THE FREEBSD PROJECT ``AS IS'' AND ANY > EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE > IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR > PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FREEBSD PROJECT OR > CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, > EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, > PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR > PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF > LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING > NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS > SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. > > The views and conclusions contained in the software and documentation > are those of the authors and should not be interpreted as representing > official policies, either expressed or implied, of the FreeBSD > Project. ## FDLIBM > Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. > > Developed at SunPro, a Sun Microsystems, Inc. business. > Permission to use, copy, modify, and distribute this > software is freely granted, provided that this notice > is preserved. ## Tests > Copyright (C) 1997, 1999 Free Software Foundation, Inc. > This file is part of the GNU C Library. > Contributed by Andreas Jaeger , 1997. > > The GNU C Library is free software; you can redistribute it and/or > modify it under the terms of the GNU Lesser General Public > License as published by the Free Software Foundation; either > version 2.1 of the License, or (at your option) any later version. > > The GNU C Library is distributed in the hope that it will be useful, > but WITHOUT ANY WARRANTY; without even the implied warranty of > MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU > Lesser General Public License for more details. > > You should have received a copy of the GNU Lesser General Public > License along with the GNU C Library; if not, write to the Free > Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA > 02111-1307 USA. wcc-0.0.2/src/wsh/openlibm/.gitignore0000644000175000017500000000004613122010155016112 0ustar philphil*.o *~ *.a *.dll* *.so* *.dylib* *.pc wcc-0.0.2/src/wsh/openlibm/.git0000644000175000017500000000005713122010155014710 0ustar philphilgitdir: ../../../.git/modules/src/wsh/openlibm wcc-0.0.2/src/wsh/openlibm/arm/0000755000175000017500000000000013122010155014701 5ustar philphilwcc-0.0.2/src/wsh/openlibm/arm/Make.files0000644000175000017500000000002513122010155016577 0ustar philphil$(CUR_SRCS) = fenv.c wcc-0.0.2/src/wsh/openlibm/arm/fenv.c0000644000175000017500000000437613122010155016015 0ustar philphil/*- * Copyright (c) 2004 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/arm/fenv.c,v 1.3 2011/10/16 05:37:56 das Exp $ */ #define __fenv_static #include #ifdef __GNUC_GNU_INLINE__ #error "This file must be compiled with C99 'inline' semantics" #endif /* * Hopefully the system ID byte is immutable, so it's valid to use * this as a default environment. */ const fenv_t __fe_dfl_env = 0; extern inline int feclearexcept(int __excepts); extern inline int fegetexceptflag(fexcept_t *__flagp, int __excepts); extern inline int fesetexceptflag(const fexcept_t *__flagp, int __excepts); extern inline int feraiseexcept(int __excepts); extern inline int fetestexcept(int __excepts); extern inline int fegetround(void); extern inline int fesetround(int __round); extern inline int fegetenv(fenv_t *__envp); extern inline int feholdexcept(fenv_t *__envp); extern inline int fesetenv(const fenv_t *__envp); extern inline int feupdateenv(const fenv_t *__envp); wcc-0.0.2/src/wsh/openlibm/ld128/0000755000175000017500000000000013122010155014754 5ustar philphilwcc-0.0.2/src/wsh/openlibm/ld128/e_fmodl.c0000644000175000017500000000647413122010155016540 0ustar philphil/* @(#)e_fmod.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * fmodl(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract */ #include #include "math_private.h" static const long double one = 1.0, Zero[] = {0.0, -0.0,}; long double fmodl(long double x, long double y) { int64_t n,hx,hy,hz,ix,iy,sx,i; u_int64_t lx,ly,lz; GET_LDOUBLE_WORDS64(hx,lx,x); GET_LDOUBLE_WORDS64(hy,ly,y); sx = hx&0x8000000000000000ULL; /* sign of x */ hx ^=sx; /* |x| */ hy &= 0x7fffffffffffffffLL; /* |y| */ /* purge off exception values */ if((hy|ly)==0||(hx>=0x7fff000000000000LL)|| /* y=0,or x not finite */ ((hy|((ly|-ly)>>63))>0x7fff000000000000LL)) /* or y is NaN */ return (x*y)/(x*y); if(hx<=hy) { if((hx>63]; /* |x|=|y| return x*0*/ } /* determine ix = ilogb(x) */ if(hx<0x0001000000000000LL) { /* subnormal x */ if(hx==0) { for (ix = -16431, i=lx; i>0; i<<=1) ix -=1; } else { for (ix = -16382, i=hx<<15; i>0; i<<=1) ix -=1; } } else ix = (hx>>48)-0x3fff; /* determine iy = ilogb(y) */ if(hy<0x0001000000000000LL) { /* subnormal y */ if(hy==0) { for (iy = -16431, i=ly; i>0; i<<=1) iy -=1; } else { for (iy = -16382, i=hy<<15; i>0; i<<=1) iy -=1; } } else iy = (hy>>48)-0x3fff; /* set up {hx,lx}, {hy,ly} and align y to x */ if(ix >= -16382) hx = 0x0001000000000000LL|(0x0000ffffffffffffLL&hx); else { /* subnormal x, shift x to normal */ n = -16382-ix; if(n<=63) { hx = (hx<>(64-n)); lx <<= n; } else { hx = lx<<(n-64); lx = 0; } } if(iy >= -16382) hy = 0x0001000000000000LL|(0x0000ffffffffffffLL&hy); else { /* subnormal y, shift y to normal */ n = -16382-iy; if(n<=63) { hy = (hy<>(64-n)); ly <<= n; } else { hy = ly<<(n-64); ly = 0; } } /* fix point fmod */ n = ix - iy; while(n--) { hz=hx-hy;lz=lx-ly; if(lx>63); lx = lx+lx;} else { if((hz|lz)==0) /* return sign(x)*0 */ return Zero[(u_int64_t)sx>>63]; hx = hz+hz+(lz>>63); lx = lz+lz; } } hz=hx-hy;lz=lx-ly; if(lx=0) {hx=hz;lx=lz;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) /* return sign(x)*0 */ return Zero[(u_int64_t)sx>>63]; while(hx<0x0001000000000000LL) { /* normalize x */ hx = hx+hx+(lx>>63); lx = lx+lx; iy -= 1; } if(iy>= -16382) { /* normalize output */ hx = ((hx-0x0001000000000000LL)|((iy+16383)<<48)); SET_LDOUBLE_WORDS64(x,hx|sx,lx); } else { /* subnormal output */ n = -16382 - iy; if(n<=48) { lx = (lx>>n)|((u_int64_t)hx<<(64-n)); hx >>= n; } else if (n<=63) { lx = (hx<<(64-n))|(lx>>n); hx = sx; } else { lx = hx>>(n-64); hx = sx; } SET_LDOUBLE_WORDS64(x,hx|sx,lx); x *= one; /* create necessary signal */ } return x; /* exact output */ } wcc-0.0.2/src/wsh/openlibm/ld128/e_logl.c0000644000175000017500000002310113122010155016356 0ustar philphil/* $OpenBSD: e_logl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* logl.c * * Natural logarithm for 128-bit long double precision. * * * * SYNOPSIS: * * long double x, y, logl(); * * y = logl( x ); * * * * DESCRIPTION: * * Returns the base e (2.718...) logarithm of x. * * The argument is separated into its exponent and fractional * parts. Use of a lookup table increases the speed of the routine. * The program uses logarithms tabulated at intervals of 1/128 to * cover the domain from approximately 0.7 to 1.4. * * On the interval [-1/128, +1/128] the logarithm of 1+x is approximated by * log(1+x) = x - 0.5 x^2 + x^3 P(x) . * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.875, 1.125 100000 1.2e-34 4.1e-35 * IEEE 0.125, 8 100000 1.2e-34 4.1e-35 * * * WARNING: * * This program uses integer operations on bit fields of floating-point * numbers. It does not work with data structures other than the * structure assumed. * */ #include #include "math_private.h" /* log(1+x) = x - .5 x^2 + x^3 l(x) -.0078125 <= x <= +.0078125 peak relative error 1.2e-37 */ static const long double l3 = 3.333333333333333333333333333333336096926E-1L, l4 = -2.499999999999999999999999999486853077002E-1L, l5 = 1.999999999999999999999999998515277861905E-1L, l6 = -1.666666666666666666666798448356171665678E-1L, l7 = 1.428571428571428571428808945895490721564E-1L, l8 = -1.249999999999999987884655626377588149000E-1L, l9 = 1.111111111111111093947834982832456459186E-1L, l10 = -1.000000000000532974938900317952530453248E-1L, l11 = 9.090909090915566247008015301349979892689E-2L, l12 = -8.333333211818065121250921925397567745734E-2L, l13 = 7.692307559897661630807048686258659316091E-2L, l14 = -7.144242754190814657241902218399056829264E-2L, l15 = 6.668057591071739754844678883223432347481E-2L; /* Lookup table of ln(t) - (t-1) t = 0.5 + (k+26)/128) k = 0, ..., 91 */ static const long double logtbl[92] = { -5.5345593589352099112142921677820359632418E-2L, -5.2108257402767124761784665198737642086148E-2L, -4.8991686870576856279407775480686721935120E-2L, -4.5993270766361228596215288742353061431071E-2L, -4.3110481649613269682442058976885699556950E-2L, -4.0340872319076331310838085093194799765520E-2L, -3.7682072451780927439219005993827431503510E-2L, -3.5131785416234343803903228503274262719586E-2L, -3.2687785249045246292687241862699949178831E-2L, -3.0347913785027239068190798397055267411813E-2L, -2.8110077931525797884641940838507561326298E-2L, -2.5972247078357715036426583294246819637618E-2L, -2.3932450635346084858612873953407168217307E-2L, -2.1988775689981395152022535153795155900240E-2L, -2.0139364778244501615441044267387667496733E-2L, -1.8382413762093794819267536615342902718324E-2L, -1.6716169807550022358923589720001638093023E-2L, -1.5138929457710992616226033183958974965355E-2L, -1.3649036795397472900424896523305726435029E-2L, -1.2244881690473465543308397998034325468152E-2L, -1.0924898127200937840689817557742469105693E-2L, -9.6875626072830301572839422532631079809328E-3L, -8.5313926245226231463436209313499745894157E-3L, -7.4549452072765973384933565912143044991706E-3L, -6.4568155251217050991200599386801665681310E-3L, -5.5356355563671005131126851708522185605193E-3L, -4.6900728132525199028885749289712348829878E-3L, -3.9188291218610470766469347968659624282519E-3L, -3.2206394539524058873423550293617843896540E-3L, -2.5942708080877805657374888909297113032132E-3L, -2.0385211375711716729239156839929281289086E-3L, -1.5522183228760777967376942769773768850872E-3L, -1.1342191863606077520036253234446621373191E-3L, -7.8340854719967065861624024730268350459991E-4L, -4.9869831458030115699628274852562992756174E-4L, -2.7902661731604211834685052867305795169688E-4L, -1.2335696813916860754951146082826952093496E-4L, -3.0677461025892873184042490943581654591817E-5L, #define ZERO logtbl[38] 0.0000000000000000000000000000000000000000E0L, -3.0359557945051052537099938863236321874198E-5L, -1.2081346403474584914595395755316412213151E-4L, -2.7044071846562177120083903771008342059094E-4L, -4.7834133324631162897179240322783590830326E-4L, -7.4363569786340080624467487620270965403695E-4L, -1.0654639687057968333207323853366578860679E-3L, -1.4429854811877171341298062134712230604279E-3L, -1.8753781835651574193938679595797367137975E-3L, -2.3618380914922506054347222273705859653658E-3L, -2.9015787624124743013946600163375853631299E-3L, -3.4938307889254087318399313316921940859043E-3L, -4.1378413103128673800485306215154712148146E-3L, -4.8328735414488877044289435125365629849599E-3L, -5.5782063183564351739381962360253116934243E-3L, -6.3731336597098858051938306767880719015261E-3L, -7.2169643436165454612058905294782949315193E-3L, -8.1090214990427641365934846191367315083867E-3L, -9.0486422112807274112838713105168375482480E-3L, -1.0035177140880864314674126398350812606841E-2L, -1.1067990155502102718064936259435676477423E-2L, -1.2146457974158024928196575103115488672416E-2L, -1.3269969823361415906628825374158424754308E-2L, -1.4437927104692837124388550722759686270765E-2L, -1.5649743073340777659901053944852735064621E-2L, -1.6904842527181702880599758489058031645317E-2L, -1.8202661505988007336096407340750378994209E-2L, -1.9542647000370545390701192438691126552961E-2L, -2.0924256670080119637427928803038530924742E-2L, -2.2346958571309108496179613803760727786257E-2L, -2.3810230892650362330447187267648486279460E-2L, -2.5313561699385640380910474255652501521033E-2L, -2.6856448685790244233704909690165496625399E-2L, -2.8438398935154170008519274953860128449036E-2L, -3.0058928687233090922411781058956589863039E-2L, -3.1717563112854831855692484086486099896614E-2L, -3.3413836095418743219397234253475252001090E-2L, -3.5147290019036555862676702093393332533702E-2L, -3.6917475563073933027920505457688955423688E-2L, -3.8723951502862058660874073462456610731178E-2L, -4.0566284516358241168330505467000838017425E-2L, -4.2444048996543693813649967076598766917965E-2L, -4.4356826869355401653098777649745233339196E-2L, -4.6304207416957323121106944474331029996141E-2L, -4.8285787106164123613318093945035804818364E-2L, -5.0301169421838218987124461766244507342648E-2L, -5.2349964705088137924875459464622098310997E-2L, -5.4431789996103111613753440311680967840214E-2L, -5.6546268881465384189752786409400404404794E-2L, -5.8693031345788023909329239565012647817664E-2L, -6.0871713627532018185577188079210189048340E-2L, -6.3081958078862169742820420185833800925568E-2L, -6.5323413029406789694910800219643791556918E-2L, -6.7595732653791419081537811574227049288168E-2L }; /* ln(2) = ln2a + ln2b with extended precision. */ static const long double ln2a = 6.93145751953125e-1L, ln2b = 1.4286068203094172321214581765680755001344E-6L; long double logl(long double x) { long double z, y, w; ieee_quad_shape_type u, t; unsigned int m; int k, e; u.value = x; m = u.parts32.mswhi; /* Check for IEEE special cases. */ k = m & 0x7fffffff; /* log(0) = -infinity. */ if ((k | u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) { return -0.5L / ZERO; } /* log ( x < 0 ) = NaN */ if (m & 0x80000000) { return (x - x) / ZERO; } /* log (infinity or NaN) */ if (k >= 0x7fff0000) { return x + x; } /* Extract exponent and reduce domain to 0.703125 <= u < 1.40625 */ e = (int) (m >> 16) - (int) 0x3ffe; m &= 0xffff; u.parts32.mswhi = m | 0x3ffe0000; m |= 0x10000; /* Find lookup table index k from high order bits of the significand. */ if (m < 0x16800) { k = (m - 0xff00) >> 9; /* t is the argument 0.5 + (k+26)/128 of the nearest item to u in the lookup table. */ t.parts32.mswhi = 0x3fff0000 + (k << 9); t.parts32.mswlo = 0; t.parts32.lswhi = 0; t.parts32.lswlo = 0; u.parts32.mswhi += 0x10000; e -= 1; k += 64; } else { k = (m - 0xfe00) >> 10; t.parts32.mswhi = 0x3ffe0000 + (k << 10); t.parts32.mswlo = 0; t.parts32.lswhi = 0; t.parts32.lswlo = 0; } /* On this interval the table is not used due to cancellation error. */ if ((x <= 1.0078125L) && (x >= 0.9921875L)) { z = x - 1.0L; k = 64; t.value = 1.0L; e = 0; } else { /* log(u) = log( t u/t ) = log(t) + log(u/t) log(t) is tabulated in the lookup table. Express log(u/t) = log(1+z), where z = u/t - 1 = (u-t)/t. cf. Cody & Waite. */ z = (u.value - t.value) / t.value; } /* Series expansion of log(1+z). */ w = z * z; y = ((((((((((((l15 * z + l14) * z + l13) * z + l12) * z + l11) * z + l10) * z + l9) * z + l8) * z + l7) * z + l6) * z + l5) * z + l4) * z + l3) * z * w; y -= 0.5 * w; y += e * ln2b; /* Base 2 exponent offset times ln(2). */ y += z; y += logtbl[k-26]; /* log(t) - (t-1) */ y += (t.value - 1.0L); y += e * ln2a; return y; } wcc-0.0.2/src/wsh/openlibm/ld128/s_nextafterl.c0000644000175000017500000000361513122010155017623 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* IEEE functions * nextafterl(x,y) * return the next machine floating-point number of x in the * direction toward y. * Special cases: */ #include #include "math_private.h" long double nextafterl(long double x, long double y) { int64_t hx,hy,ix,iy; u_int64_t lx,ly; GET_LDOUBLE_WORDS64(hx,lx,x); GET_LDOUBLE_WORDS64(hy,ly,y); ix = hx&0x7fffffffffffffffLL; /* |x| */ iy = hy&0x7fffffffffffffffLL; /* |y| */ if(((ix>=0x7fff000000000000LL)&&((ix-0x7fff000000000000LL)|lx)!=0) || /* x is nan */ ((iy>=0x7fff000000000000LL)&&((iy-0x7fff000000000000LL)|ly)!=0)) /* y is nan */ return x+y; if(x==y) return y; /* x=y, return y */ if((ix|lx)==0) { /* x == 0 */ volatile long double u; SET_LDOUBLE_WORDS64(x,hy&0x8000000000000000ULL,1);/* return +-minsubnormal */ u = x; u = u * u; /* raise underflow flag */ return x; } if(hx>=0) { /* x > 0 */ if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */ if(lx==0) hx--; lx--; } else { /* x < y, x += ulp */ lx++; if(lx==0) hx++; } } else { /* x < 0 */ if(hy>=0||hx>hy||((hx==hy)&&(lx>ly))){/* x < y, x -= ulp */ if(lx==0) hx--; lx--; } else { /* x > y, x += ulp */ lx++; if(lx==0) hx++; } } hy = hx&0x7fff000000000000LL; if(hy==0x7fff000000000000LL) return x+x;/* overflow */ if(hy==0) { volatile long double u = x*x; /* underflow */ } SET_LDOUBLE_WORDS64(x,hx,lx); return x; } __strong_alias(nexttowardl, nextafterl); wcc-0.0.2/src/wsh/openlibm/ld128/s_exp2l.c0000644000175000017500000003122513122010155016477 0ustar philphil/*- * Copyright (c) 2005-2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld128/s_exp2l.c,v 1.3 2008/02/13 10:44:44 bde Exp $"); #include #include #include #include "fpmath.h" #include "math_private.h" #define TBLBITS 7 #define TBLSIZE (1 << TBLBITS) #define BIAS (LDBL_MAX_EXP - 1) #define EXPMASK (BIAS + LDBL_MAX_EXP) #if 0 /* XXX Prevent gcc from erroneously constant folding this. */ static const long double twom10000 = 0x1p-10000L; #else static volatile long double twom10000 = 0x1p-10000L; #endif static const long double huge = 0x1p10000L, P1 = 0x1.62e42fefa39ef35793c7673007e6p-1L, P2 = 0x1.ebfbdff82c58ea86f16b06ec9736p-3L, P3 = 0x1.c6b08d704a0bf8b33a762bad3459p-5L, P4 = 0x1.3b2ab6fba4e7729ccbbe0b4f3fc2p-7L, P5 = 0x1.5d87fe78a67311071dee13fd11d9p-10L, P6 = 0x1.430912f86c7876f4b663b23c5fe5p-13L; static const double P7 = 0x1.ffcbfc588b041p-17, P8 = 0x1.62c0223a5c7c7p-20, P9 = 0x1.b52541ff59713p-24, P10 = 0x1.e4cf56a391e22p-28, redux = 0x1.8p112 / TBLSIZE; static const long double tbl[TBLSIZE] = { 0x1.6a09e667f3bcc908b2fb1366dfeap-1L, 0x1.6c012750bdabeed76a99800f4edep-1L, 0x1.6dfb23c651a2ef220e2cbe1bc0d4p-1L, 0x1.6ff7df9519483cf87e1b4f3e1e98p-1L, 0x1.71f75e8ec5f73dd2370f2ef0b148p-1L, 0x1.73f9a48a58173bd5c9a4e68ab074p-1L, 0x1.75feb564267c8bf6e9aa33a489a8p-1L, 0x1.780694fde5d3f619ae02808592a4p-1L, 0x1.7a11473eb0186d7d51023f6ccb1ap-1L, 0x1.7c1ed0130c1327c49334459378dep-1L, 0x1.7e2f336cf4e62105d02ba1579756p-1L, 0x1.80427543e1a11b60de67649a3842p-1L, 0x1.82589994cce128acf88afab34928p-1L, 0x1.8471a4623c7acce52f6b97c6444cp-1L, 0x1.868d99b4492ec80e41d90ac2556ap-1L, 0x1.88ac7d98a669966530bcdf2d4cc0p-1L, 0x1.8ace5422aa0db5ba7c55a192c648p-1L, 0x1.8cf3216b5448bef2aa1cd161c57ap-1L, 0x1.8f1ae991577362b982745c72eddap-1L, 0x1.9145b0b91ffc588a61b469f6b6a0p-1L, 0x1.93737b0cdc5e4f4501c3f2540ae8p-1L, 0x1.95a44cbc8520ee9b483695a0e7fep-1L, 0x1.97d829fde4e4f8b9e920f91e8eb6p-1L, 0x1.9a0f170ca07b9ba3109b8c467844p-1L, 0x1.9c49182a3f0901c7c46b071f28dep-1L, 0x1.9e86319e323231824ca78e64c462p-1L, 0x1.a0c667b5de564b29ada8b8cabbacp-1L, 0x1.a309bec4a2d3358c171f770db1f4p-1L, 0x1.a5503b23e255c8b424491caf88ccp-1L, 0x1.a799e1330b3586f2dfb2b158f31ep-1L, 0x1.a9e6b5579fdbf43eb243bdff53a2p-1L, 0x1.ac36bbfd3f379c0db966a3126988p-1L, 0x1.ae89f995ad3ad5e8734d17731c80p-1L, 0x1.b0e07298db66590842acdfc6fb4ep-1L, 0x1.b33a2b84f15faf6bfd0e7bd941b0p-1L, 0x1.b59728de559398e3881111648738p-1L, 0x1.b7f76f2fb5e46eaa7b081ab53ff6p-1L, 0x1.ba5b030a10649840cb3c6af5b74cp-1L, 0x1.bcc1e904bc1d2247ba0f45b3d06cp-1L, 0x1.bf2c25bd71e088408d7025190cd0p-1L, 0x1.c199bdd85529c2220cb12a0916bap-1L, 0x1.c40ab5fffd07a6d14df820f17deap-1L, 0x1.c67f12e57d14b4a2137fd20f2a26p-1L, 0x1.c8f6d9406e7b511acbc48805c3f6p-1L, 0x1.cb720dcef90691503cbd1e949d0ap-1L, 0x1.cdf0b555dc3f9c44f8958fac4f12p-1L, 0x1.d072d4a07897b8d0f22f21a13792p-1L, 0x1.d2f87080d89f18ade123989ea50ep-1L, 0x1.d5818dcfba48725da05aeb66dff8p-1L, 0x1.d80e316c98397bb84f9d048807a0p-1L, 0x1.da9e603db3285708c01a5b6d480cp-1L, 0x1.dd321f301b4604b695de3c0630c0p-1L, 0x1.dfc97337b9b5eb968cac39ed284cp-1L, 0x1.e264614f5a128a12761fa17adc74p-1L, 0x1.e502ee78b3ff6273d130153992d0p-1L, 0x1.e7a51fbc74c834b548b2832378a4p-1L, 0x1.ea4afa2a490d9858f73a18f5dab4p-1L, 0x1.ecf482d8e67f08db0312fb949d50p-1L, 0x1.efa1bee615a27771fd21a92dabb6p-1L, 0x1.f252b376bba974e8696fc3638f24p-1L, 0x1.f50765b6e4540674f84b762861a6p-1L, 0x1.f7bfdad9cbe138913b4bfe72bd78p-1L, 0x1.fa7c1819e90d82e90a7e74b26360p-1L, 0x1.fd3c22b8f71f10975ba4b32bd006p-1L, 0x1.0000000000000000000000000000p+0L, 0x1.0163da9fb33356d84a66ae336e98p+0L, 0x1.02c9a3e778060ee6f7caca4f7a18p+0L, 0x1.04315e86e7f84bd738f9a20da442p+0L, 0x1.059b0d31585743ae7c548eb68c6ap+0L, 0x1.0706b29ddf6ddc6dc403a9d87b1ep+0L, 0x1.0874518759bc808c35f25d942856p+0L, 0x1.09e3ecac6f3834521e060c584d5cp+0L, 0x1.0b5586cf9890f6298b92b7184200p+0L, 0x1.0cc922b7247f7407b705b893dbdep+0L, 0x1.0e3ec32d3d1a2020742e4f8af794p+0L, 0x1.0fb66affed31af232091dd8a169ep+0L, 0x1.11301d0125b50a4ebbf1aed9321cp+0L, 0x1.12abdc06c31cbfb92bad324d6f84p+0L, 0x1.1429aaea92ddfb34101943b2588ep+0L, 0x1.15a98c8a58e512480d573dd562aep+0L, 0x1.172b83c7d517adcdf7c8c50eb162p+0L, 0x1.18af9388c8de9bbbf70b9a3c269cp+0L, 0x1.1a35beb6fcb753cb698f692d2038p+0L, 0x1.1bbe084045cd39ab1e72b442810ep+0L, 0x1.1d4873168b9aa7805b8028990be8p+0L, 0x1.1ed5022fcd91cb8819ff61121fbep+0L, 0x1.2063b88628cd63b8eeb0295093f6p+0L, 0x1.21f49917ddc962552fd29294bc20p+0L, 0x1.2387a6e75623866c1fadb1c159c0p+0L, 0x1.251ce4fb2a63f3582ab7de9e9562p+0L, 0x1.26b4565e27cdd257a673281d3068p+0L, 0x1.284dfe1f5638096cf15cf03c9fa0p+0L, 0x1.29e9df51fdee12c25d15f5a25022p+0L, 0x1.2b87fd0dad98ffddea46538fca24p+0L, 0x1.2d285a6e4030b40091d536d0733ep+0L, 0x1.2ecafa93e2f5611ca0f45d5239a4p+0L, 0x1.306fe0a31b7152de8d5a463063bep+0L, 0x1.32170fc4cd8313539cf1c3009330p+0L, 0x1.33c08b26416ff4c9c8610d96680ep+0L, 0x1.356c55f929ff0c94623476373be4p+0L, 0x1.371a7373aa9caa7145502f45452ap+0L, 0x1.38cae6d05d86585a9cb0d9bed530p+0L, 0x1.3a7db34e59ff6ea1bc9299e0a1fep+0L, 0x1.3c32dc313a8e484001f228b58cf0p+0L, 0x1.3dea64c12342235b41223e13d7eep+0L, 0x1.3fa4504ac801ba0bf701aa417b9cp+0L, 0x1.4160a21f72e29f84325b8f3dbacap+0L, 0x1.431f5d950a896dc704439410b628p+0L, 0x1.44e086061892d03136f409df0724p+0L, 0x1.46a41ed1d005772512f459229f0ap+0L, 0x1.486a2b5c13cd013c1a3b69062f26p+0L, 0x1.4a32af0d7d3de672d8bcf46f99b4p+0L, 0x1.4bfdad5362a271d4397afec42e36p+0L, 0x1.4dcb299fddd0d63b36ef1a9e19dep+0L, 0x1.4f9b2769d2ca6ad33d8b69aa0b8cp+0L, 0x1.516daa2cf6641c112f52c84d6066p+0L, 0x1.5342b569d4f81df0a83c49d86bf4p+0L, 0x1.551a4ca5d920ec52ec620243540cp+0L, 0x1.56f4736b527da66ecb004764e61ep+0L, 0x1.58d12d497c7fd252bc2b7343d554p+0L, 0x1.5ab07dd48542958c93015191e9a8p+0L, 0x1.5c9268a5946b701c4b1b81697ed4p+0L, 0x1.5e76f15ad21486e9be4c20399d12p+0L, 0x1.605e1b976dc08b076f592a487066p+0L, 0x1.6247eb03a5584b1f0fa06fd2d9eap+0L, 0x1.6434634ccc31fc76f8714c4ee122p+0L, 0x1.66238825522249127d9e29b92ea2p+0L, 0x1.68155d44ca973081c57227b9f69ep+0L, }; static const float eps[TBLSIZE] = { -0x1.5c50p-101, -0x1.5d00p-106, 0x1.8e90p-102, -0x1.5340p-103, 0x1.1bd0p-102, -0x1.4600p-105, -0x1.7a40p-104, 0x1.d590p-102, -0x1.d590p-101, 0x1.b100p-103, -0x1.0d80p-105, 0x1.6b00p-103, -0x1.9f00p-105, 0x1.c400p-103, 0x1.e120p-103, -0x1.c100p-104, -0x1.9d20p-103, 0x1.a800p-108, 0x1.4c00p-106, -0x1.9500p-106, 0x1.6900p-105, -0x1.29d0p-100, 0x1.4c60p-103, 0x1.13a0p-102, -0x1.5b60p-103, -0x1.1c40p-103, 0x1.db80p-102, 0x1.91a0p-102, 0x1.dc00p-105, 0x1.44c0p-104, 0x1.9710p-102, 0x1.8760p-103, -0x1.a720p-103, 0x1.ed20p-103, -0x1.49c0p-102, -0x1.e000p-111, 0x1.86a0p-103, 0x1.2b40p-103, -0x1.b400p-108, 0x1.1280p-99, -0x1.02d8p-102, -0x1.e3d0p-103, -0x1.b080p-105, -0x1.f100p-107, -0x1.16c0p-105, -0x1.1190p-103, -0x1.a7d2p-100, 0x1.3450p-103, -0x1.67c0p-105, 0x1.4b80p-104, -0x1.c4e0p-103, 0x1.6000p-108, -0x1.3f60p-105, 0x1.93f0p-104, 0x1.5fe0p-105, 0x1.6f80p-107, -0x1.7600p-106, 0x1.21e0p-106, -0x1.3a40p-106, -0x1.40c0p-104, -0x1.9860p-105, -0x1.5d40p-108, -0x1.1d70p-106, 0x1.2760p-105, 0x0.0000p+0, 0x1.21e2p-104, -0x1.9520p-108, -0x1.5720p-106, -0x1.4810p-106, -0x1.be00p-109, 0x1.0080p-105, -0x1.5780p-108, -0x1.d460p-105, -0x1.6140p-105, 0x1.4630p-104, 0x1.ad50p-103, 0x1.82e0p-105, 0x1.1d3cp-101, 0x1.6100p-107, 0x1.ec30p-104, 0x1.f200p-108, 0x1.0b40p-103, 0x1.3660p-102, 0x1.d9d0p-103, -0x1.02d0p-102, 0x1.b070p-103, 0x1.b9c0p-104, -0x1.01c0p-103, -0x1.dfe0p-103, 0x1.1b60p-104, -0x1.ae94p-101, -0x1.3340p-104, 0x1.b3d8p-102, -0x1.6e40p-105, -0x1.3670p-103, 0x1.c140p-104, 0x1.1840p-101, 0x1.1ab0p-102, -0x1.a400p-104, 0x1.1f00p-104, -0x1.7180p-103, 0x1.4ce0p-102, 0x1.9200p-107, -0x1.54c0p-103, 0x1.1b80p-105, -0x1.1828p-101, 0x1.5720p-102, -0x1.a060p-100, 0x1.9160p-102, 0x1.a280p-104, 0x1.3400p-107, 0x1.2b20p-102, 0x1.7800p-108, 0x1.cfd0p-101, 0x1.2ef0p-102, -0x1.2760p-99, 0x1.b380p-104, 0x1.0048p-101, -0x1.60b0p-102, 0x1.a1ccp-100, -0x1.a640p-104, -0x1.08a0p-101, 0x1.7e60p-102, 0x1.22c0p-103, -0x1.7200p-106, 0x1.f0f0p-102, 0x1.eb4ep-99, 0x1.c6e0p-103, }; /* * exp2l(x): compute the base 2 exponential of x * * Accuracy: Peak error < 0.502 ulp. * * Method: (accurate tables) * * Reduce x: * x = 2**k + y, for integer k and |y| <= 1/2. * Thus we have exp2(x) = 2**k * exp2(y). * * Reduce y: * y = i/TBLSIZE + z - eps[i] for integer i near y * TBLSIZE. * Thus we have exp2(y) = exp2(i/TBLSIZE) * exp2(z - eps[i]), * with |z - eps[i]| <= 2**-8 + 2**-98 for the table used. * * We compute exp2(i/TBLSIZE) via table lookup and exp2(z - eps[i]) via * a degree-10 minimax polynomial with maximum error under 2**-120. * The values in exp2t[] and eps[] are chosen such that * exp2t[i] = exp2(i/TBLSIZE + eps[i]), and eps[i] is a small offset such * that exp2t[i] is accurate to 2**-122. * * Note that the range of i is +-TBLSIZE/2, so we actually index the tables * by i0 = i + TBLSIZE/2. * * This method is due to Gal, with many details due to Gal and Bachelis: * * Gal, S. and Bachelis, B. An Accurate Elementary Mathematical Library * for the IEEE Floating Point Standard. TOMS 17(1), 26-46 (1991). */ OLM_DLLEXPORT long double exp2l(long double x) { union IEEEl2bits u, v; long double r, t, twopk, twopkp10000, z; uint32_t hx, ix, i0; int k; u.e = x; /* Filter out exceptional cases. */ hx = u.xbits.expsign; ix = hx & EXPMASK; if (ix >= BIAS + 14) { /* |x| >= 16384 */ if (ix == BIAS + LDBL_MAX_EXP) { if (u.xbits.manh != 0 || u.xbits.manl != 0 || (hx & 0x8000) == 0) return (x + x); /* x is NaN or +Inf */ else return (0.0); /* x is -Inf */ } if (x >= 16384) return (huge * huge); /* overflow */ if (x <= -16495) return (twom10000 * twom10000); /* underflow */ } else if (ix <= BIAS - 115) { /* |x| < 0x1p-115 */ return (1.0 + x); } /* * Reduce x, computing z, i0, and k. The low bits of x + redux * contain the 16-bit integer part of the exponent (k) followed by * TBLBITS fractional bits (i0). We use bit tricks to extract these * as integers, then set z to the remainder. * * Example: Suppose x is 0xabc.123456p0 and TBLBITS is 8. * Then the low-order word of x + redux is 0x000abc12, * We split this into k = 0xabc and i0 = 0x12 (adjusted to * index into the table), then we compute z = 0x0.003456p0. * * XXX If the exponent is negative, the computation of k depends on * '>>' doing sign extension. */ u.e = x + redux; i0 = (u.bits.manl & 0xffffffff) + TBLSIZE / 2; k = (int)i0 >> TBLBITS; i0 = i0 & (TBLSIZE - 1); u.e -= redux; z = x - u.e; v.xbits.manh = 0; v.xbits.manl = 0; if (k >= LDBL_MIN_EXP) { v.xbits.expsign = LDBL_MAX_EXP - 1 + k; twopk = v.e; } else { v.xbits.expsign = LDBL_MAX_EXP - 1 + k + 10000; twopkp10000 = v.e; } /* Compute r = exp2(y) = exp2t[i0] * p(z - eps[i]). */ t = tbl[i0]; /* exp2t[i0] */ z -= eps[i0]; /* eps[i0] */ r = t + t * z * (P1 + z * (P2 + z * (P3 + z * (P4 + z * (P5 + z * (P6 + z * (P7 + z * (P8 + z * (P9 + z * P10))))))))); /* Scale by 2**k. */ if(k >= LDBL_MIN_EXP) { if (k == LDBL_MAX_EXP) return (r * 2.0 * 0x1p16383L); return (r * twopk); } else { return (r * twopkp10000 * twom10000); } } wcc-0.0.2/src/wsh/openlibm/ld128/e_log2l.c0000644000175000017500000001425313122010155016450 0ustar philphil/* $OpenBSD: e_log2l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* log2l.c * Base 2 logarithm, 128-bit long double precision * * * * SYNOPSIS: * * long double x, y, log2l(); * * y = log2l( x ); * * * * DESCRIPTION: * * Returns the base 2 logarithm of x. * * The argument is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the (natural) * logarithm of the fraction is approximated by * * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * log(x) = z + z^3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 100,000 2.6e-34 4.9e-35 * IEEE exp(+-10000) 100,000 9.6e-35 4.0e-35 * * In the tests over the interval exp(+-10000), the logarithms * of the random arguments were uniformly distributed over * [-10000, +10000]. * */ #include #include "math_private.h" /* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 5.3e-37, * relative peak error spread = 2.3e-14 */ static const long double P[13] = { 1.313572404063446165910279910527789794488E4L, 7.771154681358524243729929227226708890930E4L, 2.014652742082537582487669938141683759923E5L, 3.007007295140399532324943111654767187848E5L, 2.854829159639697837788887080758954924001E5L, 1.797628303815655343403735250238293741397E5L, 7.594356839258970405033155585486712125861E4L, 2.128857716871515081352991964243375186031E4L, 3.824952356185897735160588078446136783779E3L, 4.114517881637811823002128927449878962058E2L, 2.321125933898420063925789532045674660756E1L, 4.998469661968096229986658302195402690910E-1L, 1.538612243596254322971797716843006400388E-6L }; static const long double Q[12] = { 3.940717212190338497730839731583397586124E4L, 2.626900195321832660448791748036714883242E5L, 7.777690340007566932935753241556479363645E5L, 1.347518538384329112529391120390701166528E6L, 1.514882452993549494932585972882995548426E6L, 1.158019977462989115839826904108208787040E6L, 6.132189329546557743179177159925690841200E5L, 2.248234257620569139969141618556349415120E5L, 5.605842085972455027590989944010492125825E4L, 9.147150349299596453976674231612674085381E3L, 9.104928120962988414618126155557301584078E2L, 4.839208193348159620282142911143429644326E1L /* 1.000000000000000000000000000000000000000E0L, */ }; /* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 1.1e-35, * relative peak error spread 1.1e-9 */ static const long double R[6] = { 1.418134209872192732479751274970992665513E5L, -8.977257995689735303686582344659576526998E4L, 2.048819892795278657810231591630928516206E4L, -2.024301798136027039250415126250455056397E3L, 8.057002716646055371965756206836056074715E1L, -8.828896441624934385266096344596648080902E-1L }; static const long double S[6] = { 1.701761051846631278975701529965589676574E6L, -1.332535117259762928288745111081235577029E6L, 4.001557694070773974936904547424676279307E5L, -5.748542087379434595104154610899551484314E4L, 3.998526750980007367835804959888064681098E3L, -1.186359407982897997337150403816839480438E2L /* 1.000000000000000000000000000000000000000E0L, */ }; static const long double /* log2(e) - 1 */ LOG2EA = 4.4269504088896340735992468100189213742664595E-1L, /* sqrt(2)/2 */ SQRTH = 7.071067811865475244008443621048490392848359E-1L; /* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ static long double neval (long double x, const long double *p, int n) { long double y; p += n; y = *p--; do { y = y * x + *p--; } while (--n > 0); return y; } /* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ static long double deval (long double x, const long double *p, int n) { long double y; p += n; y = x + *p--; do { y = y * x + *p--; } while (--n > 0); return y; } long double log2l(long double x) { long double z; long double y; int e; int64_t hx, lx; /* Test for domain */ GET_LDOUBLE_WORDS64 (hx, lx, x); if (((hx & 0x7fffffffffffffffLL) | lx) == 0) return (-1.0L / (x - x)); if (hx < 0) return (x - x) / (x - x); if (hx >= 0x7fff000000000000LL) return (x + x); /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl (x, &e); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if ((e > 2) || (e < -2)) { if (x < SQRTH) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x * x; y = x * (z * neval (z, R, 5) / deval (z, S, 5)); goto done; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if (x < SQRTH) { e -= 1; x = 2.0 * x - 1.0L; /* 2x - 1 */ } else { x = x - 1.0L; } z = x * x; y = x * (z * neval (x, P, 12) / deval (x, Q, 11)); y = y - 0.5 * z; done: /* Multiply log of fraction by log2(e) * and base 2 exponent by 1 */ z = y * LOG2EA; z += x * LOG2EA; z += y; z += x; z += e; return (z); } wcc-0.0.2/src/wsh/openlibm/ld128/s_floorl.c0000644000175000017500000000322113122010155016735 0ustar philphil/* @(#)s_floor.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * floorl(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to floor(x). */ #include #include "math_private.h" static const long double huge = 1.0e4930L; long double floorl(long double x) { int64_t i0,i1,jj0; u_int64_t i,j; GET_LDOUBLE_WORDS64(i0,i1,x); jj0 = ((i0>>48)&0x7fff)-0x3fff; if(jj0<48) { if(jj0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) { if(i0>=0) return 0.0L; else if(((i0&0x7fffffffffffffffLL)|i1)!=0) return -1.0L; } } else { i = (0x0000ffffffffffffULL)>>jj0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0<0) i0 += (0x0001000000000000LL)>>jj0; i0 &= (~i); i1=0; } } } else if (jj0>111) { if(jj0==0x4000) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = -1ULL>>(jj0-48); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0<0) { if(jj0==48) i0+=1; else { j = i1+(1LL<<(112-jj0)); if(j * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/ld128/invtrig.h,v 1.1 2008/07/31 22:41:26 das Exp $ */ #include #include "fpmath.h" #define BIAS (LDBL_MAX_EXP - 1) #define MANH_SIZE (LDBL_MANH_SIZE + 1) /* Approximation thresholds. */ #define ASIN_LINEAR (BIAS - 56) /* 2**-56 */ #define ACOS_CONST (BIAS - 113) /* 2**-113 */ #define ATAN_CONST (BIAS + 113) /* 2**113 */ #define ATAN_LINEAR (BIAS - 56) /* 2**-56 */ /* 0.95 */ #define THRESH ((0xe666666666666666ULL>>(64-(MANH_SIZE-1)))|LDBL_NBIT) /* Constants shared by the long double inverse trig functions. */ #define pS0 _ItL_pS0 #define pS1 _ItL_pS1 #define pS2 _ItL_pS2 #define pS3 _ItL_pS3 #define pS4 _ItL_pS4 #define pS5 _ItL_pS5 #define pS6 _ItL_pS6 #define pS7 _ItL_pS7 #define pS8 _ItL_pS8 #define pS9 _ItL_pS9 #define qS1 _ItL_qS1 #define qS2 _ItL_qS2 #define qS3 _ItL_qS3 #define qS4 _ItL_qS4 #define qS5 _ItL_qS5 #define qS6 _ItL_qS6 #define qS7 _ItL_qS7 #define qS8 _ItL_qS8 #define qS9 _ItL_qS9 #define atanhi _ItL_atanhi #define atanlo _ItL_atanlo #define aT _ItL_aT #define pi_lo _ItL_pi_lo #define pio2_hi atanhi[3] #define pio2_lo atanlo[3] #define pio4_hi atanhi[1] /* Constants shared by the long double inverse trig functions. */ extern const long double pS0, pS1, pS2, pS3, pS4, pS5, pS6, pS7, pS8, pS9; extern const long double qS1, qS2, qS3, qS4, qS5, qS6, qS7, qS8, qS9; extern const long double atanhi[], atanlo[], aT[]; extern const long double pi_lo; static inline long double P(long double x) { return (x * (pS0 + x * (pS1 + x * (pS2 + x * (pS3 + x * \ (pS4 + x * (pS5 + x * (pS6 + x * (pS7 + x * (pS8 + x * \ pS9)))))))))); } static inline long double Q(long double x) { return (1.0 + x * (qS1 + x * (qS2 + x * (qS3 + x * (qS4 + x * \ (qS5 + x * (qS6 + x * (qS7 + x * (qS8 + x * qS9))))))))); } static inline long double T_even(long double x) { return (aT[0] + x * (aT[2] + x * (aT[4] + x * (aT[6] + x * \ (aT[8] + x * (aT[10] + x * (aT[12] + x * (aT[14] + x * \ (aT[16] + x * (aT[18] + x * (aT[20] + x * aT[22]))))))))))); } static inline long double T_odd(long double x) { return (aT[1] + x * (aT[3] + x * (aT[5] + x * (aT[7] + x * \ (aT[9] + x * (aT[11] + x * (aT[13] + x * (aT[15] + x * \ (aT[17] + x * (aT[19] + x * (aT[21] + x * aT[23]))))))))))); } wcc-0.0.2/src/wsh/openlibm/ld128/e_hypotl.c0000644000175000017500000000652113122010155016747 0ustar philphil/* @(#)e_hypot.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* hypotl(x,y) * * Method : * If (assume round-to-nearest) z=x*x+y*y * has error less than sqrtl(2)/2 ulp, than * sqrtl(z) has error less than 1 ulp (exercise). * * So, compute sqrtl(x*x+y*y) with some care as * follows to get the error below 1 ulp: * * Assume x>y>0; * (if possible, set rounding to round-to-nearest) * 1. if x > 2y use * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y * where x1 = x with lower 64 bits cleared, x2 = x-x1; else * 2. if x <= 2y use * t1*yy1+((x-y)*(x-y)+(t1*y2+t2*y)) * where t1 = 2x with lower 64 bits cleared, t2 = 2x-t1, * yy1= y with lower 64 bits chopped, y2 = y-yy1. * * NOTE: scaling may be necessary if some argument is too * large or too tiny * * Special cases: * hypotl(x,y) is INF if x or y is +INF or -INF; else * hypotl(x,y) is NAN if x or y is NAN. * * Accuracy: * hypotl(x,y) returns sqrtl(x^2+y^2) with error less * than 1 ulps (units in the last place) */ #include #include "math_private.h" long double hypotl(long double x, long double y) { long double a,b,t1,t2,yy1,y2,w; int64_t j,k,ha,hb; GET_LDOUBLE_MSW64(ha,x); ha &= 0x7fffffffffffffffLL; GET_LDOUBLE_MSW64(hb,y); hb &= 0x7fffffffffffffffLL; if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} SET_LDOUBLE_MSW64(a,ha); /* a <- |a| */ SET_LDOUBLE_MSW64(b,hb); /* b <- |b| */ if((ha-hb)>0x78000000000000LL) {return a+b;} /* x/y > 2**120 */ k=0; if(ha > 0x5f3f000000000000LL) { /* a>2**8000 */ if(ha >= 0x7fff000000000000LL) { /* Inf or NaN */ u_int64_t low; w = a+b; /* for sNaN */ GET_LDOUBLE_LSW64(low,a); if(((ha&0xffffffffffffLL)|low)==0) w = a; GET_LDOUBLE_LSW64(low,b); if(((hb^0x7fff000000000000LL)|low)==0) w = b; return w; } /* scale a and b by 2**-9600 */ ha -= 0x2580000000000000LL; hb -= 0x2580000000000000LL; k += 9600; SET_LDOUBLE_MSW64(a,ha); SET_LDOUBLE_MSW64(b,hb); } if(hb < 0x20bf000000000000LL) { /* b < 2**-8000 */ if(hb <= 0x0000ffffffffffffLL) { /* subnormal b or 0 */ u_int64_t low; GET_LDOUBLE_LSW64(low,b); if((hb|low)==0) return a; t1=0; SET_LDOUBLE_MSW64(t1,0x7ffd000000000000LL); /* t1=2^16382 */ b *= t1; a *= t1; k -= 16382; } else { /* scale a and b by 2^9600 */ ha += 0x2580000000000000LL; /* a *= 2^9600 */ hb += 0x2580000000000000LL; /* b *= 2^9600 */ k -= 9600; SET_LDOUBLE_MSW64(a,ha); SET_LDOUBLE_MSW64(b,hb); } } /* medium size a and b */ w = a-b; if (w>b) { t1 = 0; SET_LDOUBLE_MSW64(t1,ha); t2 = a-t1; w = sqrtl(t1*t1-(b*(-b)-t2*(a+t1))); } else { a = a+a; yy1 = 0; SET_LDOUBLE_MSW64(yy1,hb); y2 = b - yy1; t1 = 0; SET_LDOUBLE_MSW64(t1,ha+0x0001000000000000LL); t2 = a - t1; w = sqrtl(t1*yy1-(w*(-w)-(t1*y2+t2*b))); } if(k!=0) { u_int64_t high; t1 = 1.0L; GET_LDOUBLE_MSW64(high,t1); SET_LDOUBLE_MSW64(t1,high+(k<<48)); return t1*w; } else return w; } wcc-0.0.2/src/wsh/openlibm/ld128/s_nanl.c0000644000175000017500000000332313122010155016373 0ustar philphil/*- * Copyright (c) 2007 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/ld128/s_nanl.c,v 1.3 2008/03/02 20:16:55 das Exp $ */ #include #include "fpmath.h" #include "math_private.h" OLM_DLLEXPORT long double nanl(const char *s) { union { union IEEEl2bits ieee; uint32_t bits[4]; } u; __scan_nan(u.bits, 4, s); u.ieee.bits.exp = 0x7fff; u.ieee.bits.manh |= 1ULL << 47; /* make it a quiet NaN */ return (u.ieee.e); } wcc-0.0.2/src/wsh/openlibm/ld128/s_asinhl.c0000644000175000017500000000334313122010155016723 0ustar philphil/* @(#)s_asinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* asinhl(x) * Method : * Based on * asinhl(x) = signl(x) * logl [ |x| + sqrtl(x*x+1) ] * we have * asinhl(x) := x if 1+x*x=1, * := signl(x)*(logl(x)+ln2)) for large |x|, else * := signl(x)*logl(2|x|+1/(|x|+sqrtl(x*x+1))) if|x|>2, else * := signl(x)*log1pl(|x| + x^2/(1 + sqrtl(1+x^2))) */ #include #include "math_private.h" static const long double one = 1.0L, ln2 = 6.931471805599453094172321214581765681e-1L, huge = 1.0e+4900L; long double asinhl(long double x) { long double t, w; int32_t ix, sign; ieee_quad_shape_type u; u.value = x; sign = u.parts32.mswhi; ix = sign & 0x7fffffff; if (ix == 0x7fff0000) return x + x; /* x is inf or NaN */ if (ix < 0x3fc70000) { /* |x| < 2^ -56 */ if (huge + x > one) return x; /* return x inexact except 0 */ } u.parts32.mswhi = ix; if (ix > 0x40350000) { /* |x| > 2 ^ 54 */ w = logl (u.value) + ln2; } else if (ix >0x40000000) { /* 2^ 54 > |x| > 2.0 */ t = u.value; w = logl (2.0 * t + one / (sqrtl (x * x + one) + t)); } else { /* 2.0 > |x| > 2 ^ -56 */ t = x * x; w = log1pl (u.value + t / (one + sqrtl (one + t))); } if (sign & 0x80000000) return -w; else return w; } wcc-0.0.2/src/wsh/openlibm/ld128/s_tanhl.c0000644000175000017500000000635113122010155016555 0ustar philphil/* @(#)s_tanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* tanhl(x) * Return the Hyperbolic Tangent of x * * Method : * x -x * e - e * 0. tanhl(x) is defined to be ----------- * x -x * e + e * 1. reduce x to non-negative by tanhl(-x) = -tanhl(x). * 2. 0 <= x <= 2**-57 : tanhl(x) := x*(one+x) * -t * 2**-57 < x <= 1 : tanhl(x) := -----; t = expm1l(-2x) * t + 2 * 2 * 1 <= x <= 40.0 : tanhl(x) := 1- ----- ; t=expm1l(2x) * t + 2 * 40.0 < x <= INF : tanhl(x) := 1. * * Special cases: * tanhl(NaN) is NaN; * only tanhl(0)=0 is exact for finite argument. */ #include #include "math_private.h" static const long double one = 1.0, two = 2.0, tiny = 1.0e-4900L; long double tanhl(long double x) { long double t, z; u_int32_t jx, ix; ieee_quad_shape_type u; /* Words of |x|. */ u.value = x; jx = u.parts32.mswhi; ix = jx & 0x7fffffff; /* x is INF or NaN */ if (ix >= 0x7fff0000) { /* for NaN it's not important which branch: tanhl(NaN) = NaN */ if (jx & 0x80000000) return one / x - one; /* tanhl(-inf)= -1; */ else return one / x + one; /* tanhl(+inf)=+1 */ } /* |x| < 40 */ if (ix < 0x40044000) { if (u.value == 0) return x; /* x == +- 0 */ if (ix < 0x3fc60000) /* |x| < 2^-57 */ return x * (one + tiny); /* tanh(small) = small */ u.parts32.mswhi = ix; /* Absolute value of x. */ if (ix >= 0x3fff0000) { /* |x| >= 1 */ t = expm1l (two * u.value); z = one - two / (t + two); } else { t = expm1l (-two * u.value); z = -t / (t + two); } /* |x| > 40, return +-1 */ } else { z = one - tiny; /* raised inexact flag */ } return (jx & 0x80000000) ? -z : z; } wcc-0.0.2/src/wsh/openlibm/ld128/k_sinl.c0000644000175000017500000000372213122010155016403 0ustar philphil/* From: @(#)k_sin.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld128/k_sinl.c,v 1.1 2008/02/17 07:32:31 das Exp $"); /* * ld128 version of k_sin.c. See ../src/k_sin.c for most comments. */ #include "math_private.h" static const double half = 0.5; /* * Domain [-0.7854, 0.7854], range ~[-1.53e-37, 1.659e-37] * |sin(x)/x - s(x)| < 2**-122.1 * * See ../ld80/k_cosl.c for more details about the polynomial. */ static const long double S1 = -0.16666666666666666666666666666666666606732416116558L, S2 = 0.0083333333333333333333333333333331135404851288270047L, S3 = -0.00019841269841269841269841269839935785325638310428717L, S4 = 0.27557319223985890652557316053039946268333231205686e-5L, S5 = -0.25052108385441718775048214826384312253862930064745e-7L, S6 = 0.16059043836821614596571832194524392581082444805729e-9L, S7 = -0.76471637318198151807063387954939213287488216303768e-12L, S8 = 0.28114572543451292625024967174638477283187397621303e-14L; static const double S9 = -0.82206352458348947812512122163446202498005154296863e-17, S10 = 0.19572940011906109418080609928334380560135358385256e-19, S11 = -0.38680813379701966970673724299207480965452616911420e-22, S12 = 0.64038150078671872796678569586315881020659912139412e-25; long double __kernel_sinl(long double x, long double y, int iy) { long double z,r,v; z = x*x; v = z*x; r = S2+z*(S3+z*(S4+z*(S5+z*(S6+z*(S7+z*(S8+ z*(S9+z*(S10+z*(S11+z*S12))))))))); if(iy==0) return x+v*(S1+z*r); else return x-((z*(half*y-v*r)-y)-v*S1); } wcc-0.0.2/src/wsh/openlibm/ld128/e_expl.c0000644000175000017500000001034213122010155016374 0ustar philphil/* $OpenBSD: e_expl.c,v 1.3 2013/11/12 20:35:18 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* expl.c * * Exponential function, 128-bit long double precision * * * * SYNOPSIS: * * long double x, y, expl(); * * y = expl( x ); * * * * DESCRIPTION: * * Returns e (2.71828...) raised to the x power. * * Range reduction is accomplished by separating the argument * into an integer k and fraction f such that * * x k f * e = 2 e. * * A Pade' form of degree 2/3 is used to approximate exp(f) - 1 * in the basic range [-0.5 ln 2, 0.5 ln 2]. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE +-MAXLOG 100,000 2.6e-34 8.6e-35 * * * Error amplification in the exponential function can be * a serious matter. The error propagation involves * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), * which shows that a 1 lsb error in representing X produces * a relative error of X times 1 lsb in the function. * While the routine gives an accurate result for arguments * that are exactly represented by a long double precision * computer number, the result contains amplified roundoff * error for large arguments not exactly represented. * * * ERROR MESSAGES: * * message condition value returned * exp underflow x < MINLOG 0.0 * exp overflow x > MAXLOG MAXNUM * */ /* Exponential function */ #include #include #include "math_private.h" /* Pade' coefficients for exp(x) - 1 Theoretical peak relative error = 2.2e-37, relative peak error spread = 9.2e-38 */ static long double P[5] = { 3.279723985560247033712687707263393506266E-10L, 6.141506007208645008909088812338454698548E-7L, 2.708775201978218837374512615596512792224E-4L, 3.508710990737834361215404761139478627390E-2L, 9.999999999999999999999999999999999998502E-1L }; static long double Q[6] = { 2.980756652081995192255342779918052538681E-12L, 1.771372078166251484503904874657985291164E-8L, 1.504792651814944826817779302637284053660E-5L, 3.611828913847589925056132680618007270344E-3L, 2.368408864814233538909747618894558968880E-1L, 2.000000000000000000000000000000000000150E0L }; /* C1 + C2 = ln 2 */ static const long double C1 = -6.93145751953125E-1L; static const long double C2 = -1.428606820309417232121458176568075500134E-6L; static const long double LOG2EL = 1.442695040888963407359924681001892137426646L; static const long double MAXLOGL = 1.1356523406294143949491931077970764891253E4L; static const long double MINLOGL = -1.143276959615573793352782661133116431383730e4L; static const long double huge = 0x1p10000L; #if 0 /* XXX Prevent gcc from erroneously constant folding this. */ static const long double twom10000 = 0x1p-10000L; #else static volatile long double twom10000 = 0x1p-10000L; #endif long double expl(long double x) { long double px, xx; int n; if( x > MAXLOGL) return (huge*huge); /* overflow */ if( x < MINLOGL ) return (twom10000*twom10000); /* underflow */ /* Express e**x = e**g 2**n * = e**g e**( n loge(2) ) * = e**( g + n loge(2) ) */ px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */ n = px; x += px * C1; x += px * C2; /* rational approximation for exponential * of the fractional part: * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) */ xx = x * x; px = x * __polevll( xx, P, 4 ); xx = __polevll( xx, Q, 5 ); x = px/( xx - px ); x = 1.0L + x + x; x = ldexpl( x, n ); return(x); } wcc-0.0.2/src/wsh/openlibm/ld128/e_rem_pio2l.h0000644000175000017500000001025213122010155017321 0ustar philphil/* From: @(#)e_rem_pio2.c 1.4 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * Optimized by Bruce D. Evans. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld128/e_rem_pio2l.h,v 1.2 2011/05/30 19:41:28 kargl Exp $"); /* ld128 version of __ieee754_rem_pio2l(x,y) * * return the remainder of x rem pi/2 in y[0]+y[1] * use __kernel_rem_pio2() */ #include #include #include "math_private.h" #include "fpmath.h" #define BIAS (LDBL_MAX_EXP - 1) /* * XXX need to verify that nonzero integer multiples of pi/2 within the * range get no closer to a long double than 2**-140, or that * ilogb(x) + ilogb(min_delta) < 45 - -140. */ /* * invpio2: 113 bits of 2/pi * pio2_1: first 68 bits of pi/2 * pio2_1t: pi/2 - pio2_1 * pio2_2: second 68 bits of pi/2 * pio2_2t: pi/2 - (pio2_1+pio2_2) * pio2_3: third 68 bits of pi/2 * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3) */ static const double zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ two24 = 1.67772160000000000000e+07; /* 0x41700000, 0x00000000 */ static const long double invpio2 = 6.3661977236758134307553505349005747e-01L, /* 0x145f306dc9c882a53f84eafa3ea6a.0p-113 */ pio2_1 = 1.5707963267948966192292994253909555e+00L, /* 0x1921fb54442d18469800000000000.0p-112 */ pio2_1t = 2.0222662487959507323996846200947577e-21L, /* 0x13198a2e03707344a4093822299f3.0p-181 */ pio2_2 = 2.0222662487959507323994779168837751e-21L, /* 0x13198a2e03707344a400000000000.0p-181 */ pio2_2t = 2.0670321098263988236496903051604844e-43L, /* 0x127044533e63a0105df531d89cd91.0p-254 */ pio2_3 = 2.0670321098263988236499468110329591e-43L, /* 0x127044533e63a0105e00000000000.0p-254 */ pio2_3t = -2.5650587247459238361625433492959285e-65L; /* -0x159c4ec64ddaeb5f78671cbfb2210.0p-327 */ //VBS //static inline __always_inline int //__ieee754_rem_pio2l(long double x, long double *y) static inline int __ieee754_rem_pio2l(long double x, long double *y) { union IEEEl2bits u,u1; long double z,w,t,r,fn; double tx[5],ty[3]; int64_t n; int e0,ex,i,j,nx; int16_t expsign; u.e = x; expsign = u.xbits.expsign; ex = expsign & 0x7fff; if (ex < BIAS + 45 || ex == BIAS + 45 && u.bits.manh < 0x921fb54442d1LL) { /* |x| ~< 2^45*(pi/2), medium size */ /* Use a specialized rint() to get fn. Assume round-to-nearest. */ fn = x*invpio2+0x1.8p112; fn = fn-0x1.8p112; #ifdef HAVE_EFFICIENT_I64RINT n = i64rint(fn); #else n = fn; #endif r = x-fn*pio2_1; w = fn*pio2_1t; /* 1st round good to 180 bit */ { union IEEEl2bits u2; int ex1; j = ex; y[0] = r-w; u2.e = y[0]; ex1 = u2.xbits.expsign & 0x7fff; i = j-ex1; if(i>51) { /* 2nd iteration needed, good to 248 */ t = r; w = fn*pio2_2; r = t-w; w = fn*pio2_2t-((t-r)-w); y[0] = r-w; u2.e = y[0]; ex1 = u2.xbits.expsign & 0x7fff; i = j-ex1; if(i>119) { /* 3rd iteration need, 316 bits acc */ t = r; /* will cover all possible cases */ w = fn*pio2_3; r = t-w; w = fn*pio2_3t-((t-r)-w); y[0] = r-w; } } } y[1] = (r-y[0])-w; return n; } /* * all other (large) arguments */ if(ex==0x7fff) { /* x is inf or NaN */ y[0]=y[1]=x-x; return 0; } /* set z = scalbn(|x|,ilogb(x)-23) */ u1.e = x; e0 = ex - BIAS - 23; /* e0 = ilogb(|x|)-23; */ u1.xbits.expsign = ex - e0; z = u1.e; for(i=0;i<4;i++) { tx[i] = (double)((int32_t)(z)); z = (z-tx[i])*two24; } tx[4] = z; nx = 5; while(tx[nx-1]==zero) nx--; /* skip zero term */ n = __kernel_rem_pio2(tx,ty,e0,nx,3); t = (long double)ty[2] + ty[1]; r = t + ty[0]; w = ty[0] - (r - t); if(expsign<0) {y[0] = -r; y[1] = -w; return -n;} y[0] = r; y[1] = w; return n; } wcc-0.0.2/src/wsh/openlibm/ld128/s_nexttowardf.c0000644000175000017500000000333113122010155020007 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include "math_private.h" float nexttowardf(float x, long double y) { int32_t hx,ix; int64_t hy,iy; u_int64_t ly; GET_FLOAT_WORD(hx,x); GET_LDOUBLE_WORDS64(hy,ly,y); ix = hx&0x7fffffff; /* |x| */ iy = hy&0x7fffffffffffffffLL; /* |y| */ if((ix>0x7f800000) || /* x is nan */ ((iy>=0x7fff000000000000LL)&&((iy-0x7fff000000000000LL)|ly)!=0)) /* y is nan */ return x+y; if((long double) x==y) return y; /* x=y, return y */ if(ix==0) { /* x == 0 */ volatile float u; SET_FLOAT_WORD(x,(u_int32_t)((hy>>32)&0x80000000)|1);/* return +-minsub*/ u = x; u = u * u; /* raise underflow flag */ return x; } if(hx>=0) { /* x > 0 */ if(hy<0||(ix>>23)>(iy>>48)-0x3f80 || ((ix>>23)==(iy>>48)-0x3f80 && (ix&0x7fffff)>((hy>>25)&0x7fffff))) {/* x > y, x -= ulp */ hx -= 1; } else { /* x < y, x += ulp */ hx += 1; } } else { /* x < 0 */ if(hy>=0||(ix>>23)>(iy>>48)-0x3f80 || ((ix>>23)==(iy>>48)-0x3f80 && (ix&0x7fffff)>((hy>>25)&0x7fffff))) {/* x < y, x -= ulp */ hx -= 1; } else { /* x > y, x += ulp */ hx += 1; } } hy = hx&0x7f800000; if(hy>=0x7f800000) return x+x; /* overflow */ if(hy<0x00800000) { volatile float u = x*x; /* underflow */ } SET_FLOAT_WORD(x,hx); return x; } wcc-0.0.2/src/wsh/openlibm/ld128/s_erfl.c0000644000175000017500000007235413122010155016405 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* double erf(double x) * double erfc(double x) * x * 2 |\ * erf(x) = --------- | exp(-t*t)dt * sqrt(pi) \| * 0 * * erfc(x) = 1-erf(x) * Note that * erf(-x) = -erf(x) * erfc(-x) = 2 - erfc(x) * * Method: * 1. erf(x) = x + x*R(x^2) for |x| in [0, 7/8] * Remark. The formula is derived by noting * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....) * and that * 2/sqrt(pi) = 1.128379167095512573896158903121545171688 * is close to one. * * 1a. erf(x) = 1 - erfc(x), for |x| > 1.0 * erfc(x) = 1 - erf(x) if |x| < 1/4 * * 2. For |x| in [7/8, 1], let s = |x| - 1, and * c = 0.84506291151 rounded to single (24 bits) * erf(s + c) = sign(x) * (c + P1(s)/Q1(s)) * Remark: here we use the taylor series expansion at x=1. * erf(1+s) = erf(1) + s*Poly(s) * = 0.845.. + P1(s)/Q1(s) * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25] * * 3. For x in [1/4, 5/4], * erfc(s + const) = erfc(const) + s P1(s)/Q1(s) * for const = 1/4, 3/8, ..., 9/8 * and 0 <= s <= 1/8 . * * 4. For x in [5/4, 107], * erfc(x) = (1/x)*exp(-x*x-0.5625 + R(z)) * z=1/x^2 * The interval is partitioned into several segments * of width 1/8 in 1/x. * * Note1: * To compute exp(-x*x-0.5625+R/S), let s be a single * precision number and s := x; then * -x*x = -s*s + (s-x)*(s+x) * exp(-x*x-0.5626+R/S) = * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S); * Note2: * Here 4 and 5 make use of the asymptotic series * exp(-x*x) * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) ) * x*sqrt(pi) * * 5. For inf > x >= 107 * erf(x) = sign(x) *(1 - tiny) (raise inexact) * erfc(x) = tiny*tiny (raise underflow) if x > 0 * = 2 - tiny if x<0 * * 7. Special case: * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, * erfc/erf(NaN) is NaN */ #include #include "math_private.h" /* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ static long double neval (long double x, const long double *p, int n) { long double y; p += n; y = *p--; do { y = y * x + *p--; } while (--n > 0); return y; } /* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ static long double deval (long double x, const long double *p, int n) { long double y; p += n; y = x + *p--; do { y = y * x + *p--; } while (--n > 0); return y; } static const long double tiny = 1e-4931L, one = 1.0L, two = 2.0L, /* 2/sqrt(pi) - 1 */ efx = 1.2837916709551257389615890312154517168810E-1L, /* 8 * (2/sqrt(pi) - 1) */ efx8 = 1.0270333367641005911692712249723613735048E0L; /* erf(x) = x + x R(x^2) 0 <= x <= 7/8 Peak relative error 1.8e-35 */ #define NTN1 8 static const long double TN1[NTN1 + 1] = { -3.858252324254637124543172907442106422373E10L, 9.580319248590464682316366876952214879858E10L, 1.302170519734879977595901236693040544854E10L, 2.922956950426397417800321486727032845006E9L, 1.764317520783319397868923218385468729799E8L, 1.573436014601118630105796794840834145120E7L, 4.028077380105721388745632295157816229289E5L, 1.644056806467289066852135096352853491530E4L, 3.390868480059991640235675479463287886081E1L }; #define NTD1 8 static const long double TD1[NTD1 + 1] = { -3.005357030696532927149885530689529032152E11L, -1.342602283126282827411658673839982164042E11L, -2.777153893355340961288511024443668743399E10L, -3.483826391033531996955620074072768276974E9L, -2.906321047071299585682722511260895227921E8L, -1.653347985722154162439387878512427542691E7L, -6.245520581562848778466500301865173123136E5L, -1.402124304177498828590239373389110545142E4L, -1.209368072473510674493129989468348633579E2L /* 1.0E0 */ }; /* erf(z+1) = erf_const + P(z)/Q(z) -.125 <= z <= 0 Peak relative error 7.3e-36 */ static const long double erf_const = 0.845062911510467529296875L; #define NTN2 8 static const long double TN2[NTN2 + 1] = { -4.088889697077485301010486931817357000235E1L, 7.157046430681808553842307502826960051036E3L, -2.191561912574409865550015485451373731780E3L, 2.180174916555316874988981177654057337219E3L, 2.848578658049670668231333682379720943455E2L, 1.630362490952512836762810462174798925274E2L, 6.317712353961866974143739396865293596895E0L, 2.450441034183492434655586496522857578066E1L, 5.127662277706787664956025545897050896203E-1L }; #define NTD2 8 static const long double TD2[NTD2 + 1] = { 1.731026445926834008273768924015161048885E4L, 1.209682239007990370796112604286048173750E4L, 1.160950290217993641320602282462976163857E4L, 5.394294645127126577825507169061355698157E3L, 2.791239340533632669442158497532521776093E3L, 8.989365571337319032943005387378993827684E2L, 2.974016493766349409725385710897298069677E2L, 6.148192754590376378740261072533527271947E1L, 1.178502892490738445655468927408440847480E1L /* 1.0E0 */ }; /* erfc(x + 0.25) = erfc(0.25) + x R(x) 0 <= x < 0.125 Peak relative error 1.4e-35 */ #define NRNr13 8 static const long double RNr13[NRNr13 + 1] = { -2.353707097641280550282633036456457014829E3L, 3.871159656228743599994116143079870279866E2L, -3.888105134258266192210485617504098426679E2L, -2.129998539120061668038806696199343094971E1L, -8.125462263594034672468446317145384108734E1L, 8.151549093983505810118308635926270319660E0L, -5.033362032729207310462422357772568553670E0L, -4.253956621135136090295893547735851168471E-2L, -8.098602878463854789780108161581050357814E-2L }; #define NRDr13 7 static const long double RDr13[NRDr13 + 1] = { 2.220448796306693503549505450626652881752E3L, 1.899133258779578688791041599040951431383E2L, 1.061906712284961110196427571557149268454E3L, 7.497086072306967965180978101974566760042E1L, 2.146796115662672795876463568170441327274E2L, 1.120156008362573736664338015952284925592E1L, 2.211014952075052616409845051695042741074E1L, 6.469655675326150785692908453094054988938E-1L /* 1.0E0 */ }; /* erfc(0.25) = C13a + C13b to extra precision. */ static const long double C13a = 0.723663330078125L; static const long double C13b = 1.0279753638067014931732235184287934646022E-5L; /* erfc(x + 0.375) = erfc(0.375) + x R(x) 0 <= x < 0.125 Peak relative error 1.2e-35 */ #define NRNr14 8 static const long double RNr14[NRNr14 + 1] = { -2.446164016404426277577283038988918202456E3L, 6.718753324496563913392217011618096698140E2L, -4.581631138049836157425391886957389240794E2L, -2.382844088987092233033215402335026078208E1L, -7.119237852400600507927038680970936336458E1L, 1.313609646108420136332418282286454287146E1L, -6.188608702082264389155862490056401365834E0L, -2.787116601106678287277373011101132659279E-2L, -2.230395570574153963203348263549700967918E-2L }; #define NRDr14 7 static const long double RDr14[NRDr14 + 1] = { 2.495187439241869732696223349840963702875E3L, 2.503549449872925580011284635695738412162E2L, 1.159033560988895481698051531263861842461E3L, 9.493751466542304491261487998684383688622E1L, 2.276214929562354328261422263078480321204E2L, 1.367697521219069280358984081407807931847E1L, 2.276988395995528495055594829206582732682E1L, 7.647745753648996559837591812375456641163E-1L /* 1.0E0 */ }; /* erfc(0.375) = C14a + C14b to extra precision. */ static const long double C14a = 0.5958709716796875L; static const long double C14b = 1.2118885490201676174914080878232469565953E-5L; /* erfc(x + 0.5) = erfc(0.5) + x R(x) 0 <= x < 0.125 Peak relative error 4.7e-36 */ #define NRNr15 8 static const long double RNr15[NRNr15 + 1] = { -2.624212418011181487924855581955853461925E3L, 8.473828904647825181073831556439301342756E2L, -5.286207458628380765099405359607331669027E2L, -3.895781234155315729088407259045269652318E1L, -6.200857908065163618041240848728398496256E1L, 1.469324610346924001393137895116129204737E1L, -6.961356525370658572800674953305625578903E0L, 5.145724386641163809595512876629030548495E-3L, 1.990253655948179713415957791776180406812E-2L }; #define NRDr15 7 static const long double RDr15[NRDr15 + 1] = { 2.986190760847974943034021764693341524962E3L, 5.288262758961073066335410218650047725985E2L, 1.363649178071006978355113026427856008978E3L, 1.921707975649915894241864988942255320833E2L, 2.588651100651029023069013885900085533226E2L, 2.628752920321455606558942309396855629459E1L, 2.455649035885114308978333741080991380610E1L, 1.378826653595128464383127836412100939126E0L /* 1.0E0 */ }; /* erfc(0.5) = C15a + C15b to extra precision. */ static const long double C15a = 0.4794921875L; static const long double C15b = 7.9346869534623172533461080354712635484242E-6L; /* erfc(x + 0.625) = erfc(0.625) + x R(x) 0 <= x < 0.125 Peak relative error 5.1e-36 */ #define NRNr16 8 static const long double RNr16[NRNr16 + 1] = { -2.347887943200680563784690094002722906820E3L, 8.008590660692105004780722726421020136482E2L, -5.257363310384119728760181252132311447963E2L, -4.471737717857801230450290232600243795637E1L, -4.849540386452573306708795324759300320304E1L, 1.140885264677134679275986782978655952843E1L, -6.731591085460269447926746876983786152300E0L, 1.370831653033047440345050025876085121231E-1L, 2.022958279982138755020825717073966576670E-2L, }; #define NRDr16 7 static const long double RDr16[NRDr16 + 1] = { 3.075166170024837215399323264868308087281E3L, 8.730468942160798031608053127270430036627E2L, 1.458472799166340479742581949088453244767E3L, 3.230423687568019709453130785873540386217E2L, 2.804009872719893612081109617983169474655E2L, 4.465334221323222943418085830026979293091E1L, 2.612723259683205928103787842214809134746E1L, 2.341526751185244109722204018543276124997E0L, /* 1.0E0 */ }; /* erfc(0.625) = C16a + C16b to extra precision. */ static const long double C16a = 0.3767547607421875L; static const long double C16b = 4.3570693945275513594941232097252997287766E-6L; /* erfc(x + 0.75) = erfc(0.75) + x R(x) 0 <= x < 0.125 Peak relative error 1.7e-35 */ #define NRNr17 8 static const long double RNr17[NRNr17 + 1] = { -1.767068734220277728233364375724380366826E3L, 6.693746645665242832426891888805363898707E2L, -4.746224241837275958126060307406616817753E2L, -2.274160637728782675145666064841883803196E1L, -3.541232266140939050094370552538987982637E1L, 6.988950514747052676394491563585179503865E0L, -5.807687216836540830881352383529281215100E0L, 3.631915988567346438830283503729569443642E-1L, -1.488945487149634820537348176770282391202E-2L }; #define NRDr17 7 static const long double RDr17[NRDr17 + 1] = { 2.748457523498150741964464942246913394647E3L, 1.020213390713477686776037331757871252652E3L, 1.388857635935432621972601695296561952738E3L, 3.903363681143817750895999579637315491087E2L, 2.784568344378139499217928969529219886578E2L, 5.555800830216764702779238020065345401144E1L, 2.646215470959050279430447295801291168941E1L, 2.984905282103517497081766758550112011265E0L, /* 1.0E0 */ }; /* erfc(0.75) = C17a + C17b to extra precision. */ static const long double C17a = 0.2888336181640625L; static const long double C17b = 1.0748182422368401062165408589222625794046E-5L; /* erfc(x + 0.875) = erfc(0.875) + x R(x) 0 <= x < 0.125 Peak relative error 2.2e-35 */ #define NRNr18 8 static const long double RNr18[NRNr18 + 1] = { -1.342044899087593397419622771847219619588E3L, 6.127221294229172997509252330961641850598E2L, -4.519821356522291185621206350470820610727E2L, 1.223275177825128732497510264197915160235E1L, -2.730789571382971355625020710543532867692E1L, 4.045181204921538886880171727755445395862E0L, -4.925146477876592723401384464691452700539E0L, 5.933878036611279244654299924101068088582E-1L, -5.557645435858916025452563379795159124753E-2L }; #define NRDr18 7 static const long double RDr18[NRDr18 + 1] = { 2.557518000661700588758505116291983092951E3L, 1.070171433382888994954602511991940418588E3L, 1.344842834423493081054489613250688918709E3L, 4.161144478449381901208660598266288188426E2L, 2.763670252219855198052378138756906980422E2L, 5.998153487868943708236273854747564557632E1L, 2.657695108438628847733050476209037025318E1L, 3.252140524394421868923289114410336976512E0L, /* 1.0E0 */ }; /* erfc(0.875) = C18a + C18b to extra precision. */ static const long double C18a = 0.215911865234375L; static const long double C18b = 1.3073705765341685464282101150637224028267E-5L; /* erfc(x + 1.0) = erfc(1.0) + x R(x) 0 <= x < 0.125 Peak relative error 1.6e-35 */ #define NRNr19 8 static const long double RNr19[NRNr19 + 1] = { -1.139180936454157193495882956565663294826E3L, 6.134903129086899737514712477207945973616E2L, -4.628909024715329562325555164720732868263E2L, 4.165702387210732352564932347500364010833E1L, -2.286979913515229747204101330405771801610E1L, 1.870695256449872743066783202326943667722E0L, -4.177486601273105752879868187237000032364E0L, 7.533980372789646140112424811291782526263E-1L, -8.629945436917752003058064731308767664446E-2L }; #define NRDr19 7 static const long double RDr19[NRDr19 + 1] = { 2.744303447981132701432716278363418643778E3L, 1.266396359526187065222528050591302171471E3L, 1.466739461422073351497972255511919814273E3L, 4.868710570759693955597496520298058147162E2L, 2.993694301559756046478189634131722579643E2L, 6.868976819510254139741559102693828237440E1L, 2.801505816247677193480190483913753613630E1L, 3.604439909194350263552750347742663954481E0L, /* 1.0E0 */ }; /* erfc(1.0) = C19a + C19b to extra precision. */ static const long double C19a = 0.15728759765625L; static const long double C19b = 1.1609394035130658779364917390740703933002E-5L; /* erfc(x + 1.125) = erfc(1.125) + x R(x) 0 <= x < 0.125 Peak relative error 3.6e-36 */ #define NRNr20 8 static const long double RNr20[NRNr20 + 1] = { -9.652706916457973956366721379612508047640E2L, 5.577066396050932776683469951773643880634E2L, -4.406335508848496713572223098693575485978E2L, 5.202893466490242733570232680736966655434E1L, -1.931311847665757913322495948705563937159E1L, -9.364318268748287664267341457164918090611E-2L, -3.306390351286352764891355375882586201069E0L, 7.573806045289044647727613003096916516475E-1L, -9.611744011489092894027478899545635991213E-2L }; #define NRDr20 7 static const long double RDr20[NRDr20 + 1] = { 3.032829629520142564106649167182428189014E3L, 1.659648470721967719961167083684972196891E3L, 1.703545128657284619402511356932569292535E3L, 6.393465677731598872500200253155257708763E2L, 3.489131397281030947405287112726059221934E2L, 8.848641738570783406484348434387611713070E1L, 3.132269062552392974833215844236160958502E1L, 4.430131663290563523933419966185230513168E0L /* 1.0E0 */ }; /* erfc(1.125) = C20a + C20b to extra precision. */ static const long double C20a = 0.111602783203125L; static const long double C20b = 8.9850951672359304215530728365232161564636E-6L; /* erfc(1/x) = 1/x exp (-1/x^2 - 0.5625 + R(1/x^2)) 7/8 <= 1/x < 1 Peak relative error 1.4e-35 */ #define NRNr8 9 static const long double RNr8[NRNr8 + 1] = { 3.587451489255356250759834295199296936784E1L, 5.406249749087340431871378009874875889602E2L, 2.931301290625250886238822286506381194157E3L, 7.359254185241795584113047248898753470923E3L, 9.201031849810636104112101947312492532314E3L, 5.749697096193191467751650366613289284777E3L, 1.710415234419860825710780802678697889231E3L, 2.150753982543378580859546706243022719599E2L, 8.740953582272147335100537849981160931197E0L, 4.876422978828717219629814794707963640913E-2L }; #define NRDr8 8 static const long double RDr8[NRDr8 + 1] = { 6.358593134096908350929496535931630140282E1L, 9.900253816552450073757174323424051765523E2L, 5.642928777856801020545245437089490805186E3L, 1.524195375199570868195152698617273739609E4L, 2.113829644500006749947332935305800887345E4L, 1.526438562626465706267943737310282977138E4L, 5.561370922149241457131421914140039411782E3L, 9.394035530179705051609070428036834496942E2L, 6.147019596150394577984175188032707343615E1L /* 1.0E0 */ }; /* erfc(1/x) = 1/x exp (-1/x^2 - 0.5625 + R(1/x^2)) 0.75 <= 1/x <= 0.875 Peak relative error 2.0e-36 */ #define NRNr7 9 static const long double RNr7[NRNr7 + 1] = { 1.686222193385987690785945787708644476545E1L, 1.178224543567604215602418571310612066594E3L, 1.764550584290149466653899886088166091093E4L, 1.073758321890334822002849369898232811561E5L, 3.132840749205943137619839114451290324371E5L, 4.607864939974100224615527007793867585915E5L, 3.389781820105852303125270837910972384510E5L, 1.174042187110565202875011358512564753399E5L, 1.660013606011167144046604892622504338313E4L, 6.700393957480661937695573729183733234400E2L }; #define NRDr7 9 static const long double RDr7[NRDr7 + 1] = { -1.709305024718358874701575813642933561169E3L, -3.280033887481333199580464617020514788369E4L, -2.345284228022521885093072363418750835214E5L, -8.086758123097763971926711729242327554917E5L, -1.456900414510108718402423999575992450138E6L, -1.391654264881255068392389037292702041855E6L, -6.842360801869939983674527468509852583855E5L, -1.597430214446573566179675395199807533371E5L, -1.488876130609876681421645314851760773480E4L, -3.511762950935060301403599443436465645703E2L /* 1.0E0 */ }; /* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) 5/8 <= 1/x < 3/4 Peak relative error 1.9e-35 */ #define NRNr6 9 static const long double RNr6[NRNr6 + 1] = { 1.642076876176834390623842732352935761108E0L, 1.207150003611117689000664385596211076662E2L, 2.119260779316389904742873816462800103939E3L, 1.562942227734663441801452930916044224174E4L, 5.656779189549710079988084081145693580479E4L, 1.052166241021481691922831746350942786299E5L, 9.949798524786000595621602790068349165758E4L, 4.491790734080265043407035220188849562856E4L, 8.377074098301530326270432059434791287601E3L, 4.506934806567986810091824791963991057083E2L }; #define NRDr6 9 static const long double RDr6[NRDr6 + 1] = { -1.664557643928263091879301304019826629067E2L, -3.800035902507656624590531122291160668452E3L, -3.277028191591734928360050685359277076056E4L, -1.381359471502885446400589109566587443987E5L, -3.082204287382581873532528989283748656546E5L, -3.691071488256738343008271448234631037095E5L, -2.300482443038349815750714219117566715043E5L, -6.873955300927636236692803579555752171530E4L, -8.262158817978334142081581542749986845399E3L, -2.517122254384430859629423488157361983661E2L /* 1.00 */ }; /* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) 1/2 <= 1/x < 5/8 Peak relative error 4.6e-36 */ #define NRNr5 10 static const long double RNr5[NRNr5 + 1] = { -3.332258927455285458355550878136506961608E-3L, -2.697100758900280402659586595884478660721E-1L, -6.083328551139621521416618424949137195536E0L, -6.119863528983308012970821226810162441263E1L, -3.176535282475593173248810678636522589861E2L, -8.933395175080560925809992467187963260693E2L, -1.360019508488475978060917477620199499560E3L, -1.075075579828188621541398761300910213280E3L, -4.017346561586014822824459436695197089916E2L, -5.857581368145266249509589726077645791341E1L, -2.077715925587834606379119585995758954399E0L }; #define NRDr5 9 static const long double RDr5[NRDr5 + 1] = { 3.377879570417399341550710467744693125385E-1L, 1.021963322742390735430008860602594456187E1L, 1.200847646592942095192766255154827011939E2L, 7.118915528142927104078182863387116942836E2L, 2.318159380062066469386544552429625026238E3L, 4.238729853534009221025582008928765281620E3L, 4.279114907284825886266493994833515580782E3L, 2.257277186663261531053293222591851737504E3L, 5.570475501285054293371908382916063822957E2L, 5.142189243856288981145786492585432443560E1L /* 1.0E0 */ }; /* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) 3/8 <= 1/x < 1/2 Peak relative error 2.0e-36 */ #define NRNr4 10 static const long double RNr4[NRNr4 + 1] = { 3.258530712024527835089319075288494524465E-3L, 2.987056016877277929720231688689431056567E-1L, 8.738729089340199750734409156830371528862E0L, 1.207211160148647782396337792426311125923E2L, 8.997558632489032902250523945248208224445E2L, 3.798025197699757225978410230530640879762E3L, 9.113203668683080975637043118209210146846E3L, 1.203285891339933238608683715194034900149E4L, 8.100647057919140328536743641735339740855E3L, 2.383888249907144945837976899822927411769E3L, 2.127493573166454249221983582495245662319E2L }; #define NRDr4 10 static const long double RDr4[NRDr4 + 1] = { -3.303141981514540274165450687270180479586E-1L, -1.353768629363605300707949368917687066724E1L, -2.206127630303621521950193783894598987033E2L, -1.861800338758066696514480386180875607204E3L, -8.889048775872605708249140016201753255599E3L, -2.465888106627948210478692168261494857089E4L, -3.934642211710774494879042116768390014289E4L, -3.455077258242252974937480623730228841003E4L, -1.524083977439690284820586063729912653196E4L, -2.810541887397984804237552337349093953857E3L, -1.343929553541159933824901621702567066156E2L /* 1.0E0 */ }; /* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) 1/4 <= 1/x < 3/8 Peak relative error 8.4e-37 */ #define NRNr3 11 static const long double RNr3[NRNr3 + 1] = { -1.952401126551202208698629992497306292987E-6L, -2.130881743066372952515162564941682716125E-4L, -8.376493958090190943737529486107282224387E-3L, -1.650592646560987700661598877522831234791E-1L, -1.839290818933317338111364667708678163199E0L, -1.216278715570882422410442318517814388470E1L, -4.818759344462360427612133632533779091386E1L, -1.120994661297476876804405329172164436784E2L, -1.452850765662319264191141091859300126931E2L, -9.485207851128957108648038238656777241333E1L, -2.563663855025796641216191848818620020073E1L, -1.787995944187565676837847610706317833247E0L }; #define NRDr3 10 static const long double RDr3[NRDr3 + 1] = { 1.979130686770349481460559711878399476903E-4L, 1.156941716128488266238105813374635099057E-2L, 2.752657634309886336431266395637285974292E-1L, 3.482245457248318787349778336603569327521E0L, 2.569347069372696358578399521203959253162E1L, 1.142279000180457419740314694631879921561E2L, 3.056503977190564294341422623108332700840E2L, 4.780844020923794821656358157128719184422E2L, 4.105972727212554277496256802312730410518E2L, 1.724072188063746970865027817017067646246E2L, 2.815939183464818198705278118326590370435E1L /* 1.0E0 */ }; /* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) 1/8 <= 1/x < 1/4 Peak relative error 1.5e-36 */ #define NRNr2 11 static const long double RNr2[NRNr2 + 1] = { -2.638914383420287212401687401284326363787E-8L, -3.479198370260633977258201271399116766619E-6L, -1.783985295335697686382487087502222519983E-4L, -4.777876933122576014266349277217559356276E-3L, -7.450634738987325004070761301045014986520E-2L, -7.068318854874733315971973707247467326619E-1L, -4.113919921935944795764071670806867038732E0L, -1.440447573226906222417767283691888875082E1L, -2.883484031530718428417168042141288943905E1L, -2.990886974328476387277797361464279931446E1L, -1.325283914915104866248279787536128997331E1L, -1.572436106228070195510230310658206154374E0L }; #define NRDr2 10 static const long double RDr2[NRDr2 + 1] = { 2.675042728136731923554119302571867799673E-6L, 2.170997868451812708585443282998329996268E-4L, 7.249969752687540289422684951196241427445E-3L, 1.302040375859768674620410563307838448508E-1L, 1.380202483082910888897654537144485285549E0L, 8.926594113174165352623847870299170069350E0L, 3.521089584782616472372909095331572607185E1L, 8.233547427533181375185259050330809105570E1L, 1.072971579885803033079469639073292840135E2L, 6.943803113337964469736022094105143158033E1L, 1.775695341031607738233608307835017282662E1L /* 1.0E0 */ }; /* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) 1/128 <= 1/x < 1/8 Peak relative error 2.2e-36 */ #define NRNr1 9 static const long double RNr1[NRNr1 + 1] = { -4.250780883202361946697751475473042685782E-8L, -5.375777053288612282487696975623206383019E-6L, -2.573645949220896816208565944117382460452E-4L, -6.199032928113542080263152610799113086319E-3L, -8.262721198693404060380104048479916247786E-2L, -6.242615227257324746371284637695778043982E-1L, -2.609874739199595400225113299437099626386E0L, -5.581967563336676737146358534602770006970E0L, -5.124398923356022609707490956634280573882E0L, -1.290865243944292370661544030414667556649E0L }; #define NRDr1 8 static const long double RDr1[NRDr1 + 1] = { 4.308976661749509034845251315983612976224E-6L, 3.265390126432780184125233455960049294580E-4L, 9.811328839187040701901866531796570418691E-3L, 1.511222515036021033410078631914783519649E-1L, 1.289264341917429958858379585970225092274E0L, 6.147640356182230769548007536914983522270E0L, 1.573966871337739784518246317003956180750E1L, 1.955534123435095067199574045529218238263E1L, 9.472613121363135472247929109615785855865E0L /* 1.0E0 */ }; long double erfl(long double x) { long double a, y, z; int32_t i, ix, sign; ieee_quad_shape_type u; u.value = x; sign = u.parts32.mswhi; ix = sign & 0x7fffffff; if (ix >= 0x7fff0000) { /* erf(nan)=nan */ i = ((sign & 0xffff0000) >> 31) << 1; return (long double) (1 - i) + one / x; /* erf(+-inf)=+-1 */ } if (ix >= 0x3fff0000) /* |x| >= 1.0 */ { y = erfcl (x); return (one - y); /* return (one - erfcl (x)); */ } u.parts32.mswhi = ix; a = u.value; z = x * x; if (ix < 0x3ffec000) /* a < 0.875 */ { if (ix < 0x3fc60000) /* |x|<2**-57 */ { if (ix < 0x00080000) return 0.125 * (8.0 * x + efx8 * x); /*avoid underflow */ return x + efx * x; } y = a + a * neval (z, TN1, NTN1) / deval (z, TD1, NTD1); } else { a = a - one; y = erf_const + neval (a, TN2, NTN2) / deval (a, TD2, NTD2); } if (sign & 0x80000000) /* x < 0 */ y = -y; return( y ); } long double erfcl(long double x) { long double y, z, p, r; int32_t i, ix, sign; ieee_quad_shape_type u; u.value = x; sign = u.parts32.mswhi; ix = sign & 0x7fffffff; u.parts32.mswhi = ix; if (ix >= 0x7fff0000) { /* erfc(nan)=nan */ /* erfc(+-inf)=0,2 */ return (long double) (((u_int32_t) sign >> 31) << 1) + one / x; } if (ix < 0x3ffd0000) /* |x| <1/4 */ { if (ix < 0x3f8d0000) /* |x|<2**-114 */ return one - x; return one - erfl (x); } if (ix < 0x3fff4000) /* 1.25 */ { x = u.value; i = 8.0 * x; switch (i) { case 2: z = x - 0.25L; y = C13b + z * neval (z, RNr13, NRNr13) / deval (z, RDr13, NRDr13); y += C13a; break; case 3: z = x - 0.375L; y = C14b + z * neval (z, RNr14, NRNr14) / deval (z, RDr14, NRDr14); y += C14a; break; case 4: z = x - 0.5L; y = C15b + z * neval (z, RNr15, NRNr15) / deval (z, RDr15, NRDr15); y += C15a; break; case 5: z = x - 0.625L; y = C16b + z * neval (z, RNr16, NRNr16) / deval (z, RDr16, NRDr16); y += C16a; break; case 6: z = x - 0.75L; y = C17b + z * neval (z, RNr17, NRNr17) / deval (z, RDr17, NRDr17); y += C17a; break; case 7: z = x - 0.875L; y = C18b + z * neval (z, RNr18, NRNr18) / deval (z, RDr18, NRDr18); y += C18a; break; case 8: z = x - 1.0L; y = C19b + z * neval (z, RNr19, NRNr19) / deval (z, RDr19, NRDr19); y += C19a; break; case 9: z = x - 1.125L; y = C20b + z * neval (z, RNr20, NRNr20) / deval (z, RDr20, NRDr20); y += C20a; break; } if (sign & 0x80000000) y = 2.0L - y; return y; } /* 1.25 < |x| < 107 */ if (ix < 0x4005ac00) { /* x < -9 */ if ((ix >= 0x40022000) && (sign & 0x80000000)) return two - tiny; x = fabsl (x); z = one / (x * x); i = 8.0 / x; switch (i) { default: case 0: p = neval (z, RNr1, NRNr1) / deval (z, RDr1, NRDr1); break; case 1: p = neval (z, RNr2, NRNr2) / deval (z, RDr2, NRDr2); break; case 2: p = neval (z, RNr3, NRNr3) / deval (z, RDr3, NRDr3); break; case 3: p = neval (z, RNr4, NRNr4) / deval (z, RDr4, NRDr4); break; case 4: p = neval (z, RNr5, NRNr5) / deval (z, RDr5, NRDr5); break; case 5: p = neval (z, RNr6, NRNr6) / deval (z, RDr6, NRDr6); break; case 6: p = neval (z, RNr7, NRNr7) / deval (z, RDr7, NRDr7); break; case 7: p = neval (z, RNr8, NRNr8) / deval (z, RDr8, NRDr8); break; } u.value = x; u.parts32.lswlo = 0; u.parts32.lswhi &= 0xfe000000; z = u.value; r = expl (-z * z - 0.5625) * expl ((z - x) * (z + x) + p); if ((sign & 0x80000000) == 0) return r / x; else return two - r / x; } else { if ((sign & 0x80000000) == 0) return tiny * tiny; else return two - tiny; } } wcc-0.0.2/src/wsh/openlibm/ld128/e_lgammal_r.c0000644000175000017500000007653713122010155017401 0ustar philphil/* $OpenBSD: e_lgammal.c,v 1.3 2011/07/09 05:29:06 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* lgammal_r * * Natural logarithm of gamma function * * * * SYNOPSIS: * * long double x, y, lgammal_r(); * int signgam; * * y = lgammal_r(x, &signgam); * * * * DESCRIPTION: * * Returns the base e (2.718...) logarithm of the absolute * value of the gamma function of the argument. * The sign (+1 or -1) of the gamma function is returned through signgamp. * * The positive domain is partitioned into numerous segments for approximation. * For x > 10, * log gamma(x) = (x - 0.5) log(x) - x + log sqrt(2 pi) + 1/x R(1/x^2) * Near the minimum at x = x0 = 1.46... the approximation is * log gamma(x0 + z) = log gamma(x0) + z^2 P(z)/Q(z) * for small z. * Elsewhere between 0 and 10, * log gamma(n + z) = log gamma(n) + z P(z)/Q(z) * for various selected n and small z. * * The cosecant reflection formula is employed for negative arguments. * * * * ACCURACY: * * * arithmetic domain # trials peak rms * Relative error: * IEEE 10, 30 100000 3.9e-34 9.8e-35 * IEEE 0, 10 100000 3.8e-34 5.3e-35 * Absolute error: * IEEE -10, 0 100000 8.0e-34 8.0e-35 * IEEE -30, -10 100000 4.4e-34 1.0e-34 * IEEE -100, 100 100000 1.0e-34 * * The absolute error criterion is the same as relative error * when the function magnitude is greater than one but it is absolute * when the magnitude is less than one. * */ #include #include "math_private.h" static const long double PIL = 3.1415926535897932384626433832795028841972E0L; static const long double MAXLGM = 1.0485738685148938358098967157129705071571E4928L; static const long double one = 1.0L; static const long double huge = 1.0e4000L; /* log gamma(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x P(1/x^2) 1/x <= 0.0741 (x >= 13.495...) Peak relative error 1.5e-36 */ static const long double ls2pi = 9.1893853320467274178032973640561763986140E-1L; #define NRASY 12 static const long double RASY[NRASY + 1] = { 8.333333333333333333333333333310437112111E-2L, -2.777777777777777777777774789556228296902E-3L, 7.936507936507936507795933938448586499183E-4L, -5.952380952380952041799269756378148574045E-4L, 8.417508417507928904209891117498524452523E-4L, -1.917526917481263997778542329739806086290E-3L, 6.410256381217852504446848671499409919280E-3L, -2.955064066900961649768101034477363301626E-2L, 1.796402955865634243663453415388336954675E-1L, -1.391522089007758553455753477688592767741E0L, 1.326130089598399157988112385013829305510E1L, -1.420412699593782497803472576479997819149E2L, 1.218058922427762808938869872528846787020E3L }; /* log gamma(x+13) = log gamma(13) + x P(x)/Q(x) -0.5 <= x <= 0.5 12.5 <= x+13 <= 13.5 Peak relative error 1.1e-36 */ static const long double lgam13a = 1.9987213134765625E1L; static const long double lgam13b = 1.3608962611495173623870550785125024484248E-6L; #define NRN13 7 static const long double RN13[NRN13 + 1] = { 8.591478354823578150238226576156275285700E11L, 2.347931159756482741018258864137297157668E11L, 2.555408396679352028680662433943000804616E10L, 1.408581709264464345480765758902967123937E9L, 4.126759849752613822953004114044451046321E7L, 6.133298899622688505854211579222889943778E5L, 3.929248056293651597987893340755876578072E3L, 6.850783280018706668924952057996075215223E0L }; #define NRD13 6 static const long double RD13[NRD13 + 1] = { 3.401225382297342302296607039352935541669E11L, 8.756765276918037910363513243563234551784E10L, 8.873913342866613213078554180987647243903E9L, 4.483797255342763263361893016049310017973E8L, 1.178186288833066430952276702931512870676E7L, 1.519928623743264797939103740132278337476E5L, 7.989298844938119228411117593338850892311E2L /* 1.0E0L */ }; /* log gamma(x+12) = log gamma(12) + x P(x)/Q(x) -0.5 <= x <= 0.5 11.5 <= x+12 <= 12.5 Peak relative error 4.1e-36 */ static const long double lgam12a = 1.75023040771484375E1L; static const long double lgam12b = 3.7687254483392876529072161996717039575982E-6L; #define NRN12 7 static const long double RN12[NRN12 + 1] = { 4.709859662695606986110997348630997559137E11L, 1.398713878079497115037857470168777995230E11L, 1.654654931821564315970930093932954900867E10L, 9.916279414876676861193649489207282144036E8L, 3.159604070526036074112008954113411389879E7L, 5.109099197547205212294747623977502492861E5L, 3.563054878276102790183396740969279826988E3L, 6.769610657004672719224614163196946862747E0L }; #define NRD12 6 static const long double RD12[NRD12 + 1] = { 1.928167007860968063912467318985802726613E11L, 5.383198282277806237247492369072266389233E10L, 5.915693215338294477444809323037871058363E9L, 3.241438287570196713148310560147925781342E8L, 9.236680081763754597872713592701048455890E6L, 1.292246897881650919242713651166596478850E5L, 7.366532445427159272584194816076600211171E2L /* 1.0E0L */ }; /* log gamma(x+11) = log gamma(11) + x P(x)/Q(x) -0.5 <= x <= 0.5 10.5 <= x+11 <= 11.5 Peak relative error 1.8e-35 */ static const long double lgam11a = 1.5104400634765625E1L; static const long double lgam11b = 1.1938309890295225709329251070371882250744E-5L; #define NRN11 7 static const long double RN11[NRN11 + 1] = { 2.446960438029415837384622675816736622795E11L, 7.955444974446413315803799763901729640350E10L, 1.030555327949159293591618473447420338444E10L, 6.765022131195302709153994345470493334946E8L, 2.361892792609204855279723576041468347494E7L, 4.186623629779479136428005806072176490125E5L, 3.202506022088912768601325534149383594049E3L, 6.681356101133728289358838690666225691363E0L }; #define NRD11 6 static const long double RD11[NRD11 + 1] = { 1.040483786179428590683912396379079477432E11L, 3.172251138489229497223696648369823779729E10L, 3.806961885984850433709295832245848084614E9L, 2.278070344022934913730015420611609620171E8L, 7.089478198662651683977290023829391596481E6L, 1.083246385105903533237139380509590158658E5L, 6.744420991491385145885727942219463243597E2L /* 1.0E0L */ }; /* log gamma(x+10) = log gamma(10) + x P(x)/Q(x) -0.5 <= x <= 0.5 9.5 <= x+10 <= 10.5 Peak relative error 5.4e-37 */ static const long double lgam10a = 1.280181884765625E1L; static const long double lgam10b = 8.6324252196112077178745667061642811492557E-6L; #define NRN10 7 static const long double RN10[NRN10 + 1] = { -1.239059737177249934158597996648808363783E14L, -4.725899566371458992365624673357356908719E13L, -7.283906268647083312042059082837754850808E12L, -5.802855515464011422171165179767478794637E11L, -2.532349691157548788382820303182745897298E10L, -5.884260178023777312587193693477072061820E8L, -6.437774864512125749845840472131829114906E6L, -2.350975266781548931856017239843273049384E4L }; #define NRD10 7 static const long double RD10[NRD10 + 1] = { -5.502645997581822567468347817182347679552E13L, -1.970266640239849804162284805400136473801E13L, -2.819677689615038489384974042561531409392E12L, -2.056105863694742752589691183194061265094E11L, -8.053670086493258693186307810815819662078E9L, -1.632090155573373286153427982504851867131E8L, -1.483575879240631280658077826889223634921E6L, -4.002806669713232271615885826373550502510E3L /* 1.0E0L */ }; /* log gamma(x+9) = log gamma(9) + x P(x)/Q(x) -0.5 <= x <= 0.5 8.5 <= x+9 <= 9.5 Peak relative error 3.6e-36 */ static const long double lgam9a = 1.06045989990234375E1L; static const long double lgam9b = 3.9037218127284172274007216547549861681400E-6L; #define NRN9 7 static const long double RN9[NRN9 + 1] = { -4.936332264202687973364500998984608306189E13L, -2.101372682623700967335206138517766274855E13L, -3.615893404644823888655732817505129444195E12L, -3.217104993800878891194322691860075472926E11L, -1.568465330337375725685439173603032921399E10L, -4.073317518162025744377629219101510217761E8L, -4.983232096406156139324846656819246974500E6L, -2.036280038903695980912289722995505277253E4L }; #define NRD9 7 static const long double RD9[NRD9 + 1] = { -2.306006080437656357167128541231915480393E13L, -9.183606842453274924895648863832233799950E12L, -1.461857965935942962087907301194381010380E12L, -1.185728254682789754150068652663124298303E11L, -5.166285094703468567389566085480783070037E9L, -1.164573656694603024184768200787835094317E8L, -1.177343939483908678474886454113163527909E6L, -3.529391059783109732159524500029157638736E3L /* 1.0E0L */ }; /* log gamma(x+8) = log gamma(8) + x P(x)/Q(x) -0.5 <= x <= 0.5 7.5 <= x+8 <= 8.5 Peak relative error 2.4e-37 */ static const long double lgam8a = 8.525146484375E0L; static const long double lgam8b = 1.4876690414300165531036347125050759667737E-5L; #define NRN8 8 static const long double RN8[NRN8 + 1] = { 6.600775438203423546565361176829139703289E11L, 3.406361267593790705240802723914281025800E11L, 7.222460928505293914746983300555538432830E10L, 8.102984106025088123058747466840656458342E9L, 5.157620015986282905232150979772409345927E8L, 1.851445288272645829028129389609068641517E7L, 3.489261702223124354745894067468953756656E5L, 2.892095396706665774434217489775617756014E3L, 6.596977510622195827183948478627058738034E0L }; #define NRD8 7 static const long double RD8[NRD8 + 1] = { 3.274776546520735414638114828622673016920E11L, 1.581811207929065544043963828487733970107E11L, 3.108725655667825188135393076860104546416E10L, 3.193055010502912617128480163681842165730E9L, 1.830871482669835106357529710116211541839E8L, 5.790862854275238129848491555068073485086E6L, 9.305213264307921522842678835618803553589E4L, 6.216974105861848386918949336819572333622E2L /* 1.0E0L */ }; /* log gamma(x+7) = log gamma(7) + x P(x)/Q(x) -0.5 <= x <= 0.5 6.5 <= x+7 <= 7.5 Peak relative error 3.2e-36 */ static const long double lgam7a = 6.5792388916015625E0L; static const long double lgam7b = 1.2320408538495060178292903945321122583007E-5L; #define NRN7 8 static const long double RN7[NRN7 + 1] = { 2.065019306969459407636744543358209942213E11L, 1.226919919023736909889724951708796532847E11L, 2.996157990374348596472241776917953749106E10L, 3.873001919306801037344727168434909521030E9L, 2.841575255593761593270885753992732145094E8L, 1.176342515359431913664715324652399565551E7L, 2.558097039684188723597519300356028511547E5L, 2.448525238332609439023786244782810774702E3L, 6.460280377802030953041566617300902020435E0L }; #define NRD7 7 static const long double RD7[NRD7 + 1] = { 1.102646614598516998880874785339049304483E11L, 6.099297512712715445879759589407189290040E10L, 1.372898136289611312713283201112060238351E10L, 1.615306270420293159907951633566635172343E9L, 1.061114435798489135996614242842561967459E8L, 3.845638971184305248268608902030718674691E6L, 7.081730675423444975703917836972720495507E4L, 5.423122582741398226693137276201344096370E2L /* 1.0E0L */ }; /* log gamma(x+6) = log gamma(6) + x P(x)/Q(x) -0.5 <= x <= 0.5 5.5 <= x+6 <= 6.5 Peak relative error 6.2e-37 */ static const long double lgam6a = 4.7874908447265625E0L; static const long double lgam6b = 8.9805548349424770093452324304839959231517E-7L; #define NRN6 8 static const long double RN6[NRN6 + 1] = { -3.538412754670746879119162116819571823643E13L, -2.613432593406849155765698121483394257148E13L, -8.020670732770461579558867891923784753062E12L, -1.322227822931250045347591780332435433420E12L, -1.262809382777272476572558806855377129513E11L, -7.015006277027660872284922325741197022467E9L, -2.149320689089020841076532186783055727299E8L, -3.167210585700002703820077565539658995316E6L, -1.576834867378554185210279285358586385266E4L }; #define NRD6 8 static const long double RD6[NRD6 + 1] = { -2.073955870771283609792355579558899389085E13L, -1.421592856111673959642750863283919318175E13L, -4.012134994918353924219048850264207074949E12L, -6.013361045800992316498238470888523722431E11L, -5.145382510136622274784240527039643430628E10L, -2.510575820013409711678540476918249524123E9L, -6.564058379709759600836745035871373240904E7L, -7.861511116647120540275354855221373571536E5L, -2.821943442729620524365661338459579270561E3L /* 1.0E0L */ }; /* log gamma(x+5) = log gamma(5) + x P(x)/Q(x) -0.5 <= x <= 0.5 4.5 <= x+5 <= 5.5 Peak relative error 3.4e-37 */ static const long double lgam5a = 3.17803955078125E0L; static const long double lgam5b = 1.4279566695619646941601297055408873990961E-5L; #define NRN5 9 static const long double RN5[NRN5 + 1] = { 2.010952885441805899580403215533972172098E11L, 1.916132681242540921354921906708215338584E11L, 7.679102403710581712903937970163206882492E10L, 1.680514903671382470108010973615268125169E10L, 2.181011222911537259440775283277711588410E9L, 1.705361119398837808244780667539728356096E8L, 7.792391565652481864976147945997033946360E6L, 1.910741381027985291688667214472560023819E5L, 2.088138241893612679762260077783794329559E3L, 6.330318119566998299106803922739066556550E0L }; #define NRD5 8 static const long double RD5[NRD5 + 1] = { 1.335189758138651840605141370223112376176E11L, 1.174130445739492885895466097516530211283E11L, 4.308006619274572338118732154886328519910E10L, 8.547402888692578655814445003283720677468E9L, 9.934628078575618309542580800421370730906E8L, 6.847107420092173812998096295422311820672E7L, 2.698552646016599923609773122139463150403E6L, 5.526516251532464176412113632726150253215E4L, 4.772343321713697385780533022595450486932E2L /* 1.0E0L */ }; /* log gamma(x+4) = log gamma(4) + x P(x)/Q(x) -0.5 <= x <= 0.5 3.5 <= x+4 <= 4.5 Peak relative error 6.7e-37 */ static const long double lgam4a = 1.791748046875E0L; static const long double lgam4b = 1.1422353055000812477358380702272722990692E-5L; #define NRN4 9 static const long double RN4[NRN4 + 1] = { -1.026583408246155508572442242188887829208E13L, -1.306476685384622809290193031208776258809E13L, -7.051088602207062164232806511992978915508E12L, -2.100849457735620004967624442027793656108E12L, -3.767473790774546963588549871673843260569E11L, -4.156387497364909963498394522336575984206E10L, -2.764021460668011732047778992419118757746E9L, -1.036617204107109779944986471142938641399E8L, -1.895730886640349026257780896972598305443E6L, -1.180509051468390914200720003907727988201E4L }; #define NRD4 9 static const long double RD4[NRD4 + 1] = { -8.172669122056002077809119378047536240889E12L, -9.477592426087986751343695251801814226960E12L, -4.629448850139318158743900253637212801682E12L, -1.237965465892012573255370078308035272942E12L, -1.971624313506929845158062177061297598956E11L, -1.905434843346570533229942397763361493610E10L, -1.089409357680461419743730978512856675984E9L, -3.416703082301143192939774401370222822430E7L, -4.981791914177103793218433195857635265295E5L, -2.192507743896742751483055798411231453733E3L /* 1.0E0L */ }; /* log gamma(x+3) = log gamma(3) + x P(x)/Q(x) -0.25 <= x <= 0.5 2.75 <= x+3 <= 3.5 Peak relative error 6.0e-37 */ static const long double lgam3a = 6.93145751953125E-1L; static const long double lgam3b = 1.4286068203094172321214581765680755001344E-6L; #define NRN3 9 static const long double RN3[NRN3 + 1] = { -4.813901815114776281494823863935820876670E11L, -8.425592975288250400493910291066881992620E11L, -6.228685507402467503655405482985516909157E11L, -2.531972054436786351403749276956707260499E11L, -6.170200796658926701311867484296426831687E10L, -9.211477458528156048231908798456365081135E9L, -8.251806236175037114064561038908691305583E8L, -4.147886355917831049939930101151160447495E7L, -1.010851868928346082547075956946476932162E6L, -8.333374463411801009783402800801201603736E3L }; #define NRD3 9 static const long double RD3[NRD3 + 1] = { -5.216713843111675050627304523368029262450E11L, -8.014292925418308759369583419234079164391E11L, -5.180106858220030014546267824392678611990E11L, -1.830406975497439003897734969120997840011E11L, -3.845274631904879621945745960119924118925E10L, -4.891033385370523863288908070309417710903E9L, -3.670172254411328640353855768698287474282E8L, -1.505316381525727713026364396635522516989E7L, -2.856327162923716881454613540575964890347E5L, -1.622140448015769906847567212766206894547E3L /* 1.0E0L */ }; /* log gamma(x+2.5) = log gamma(2.5) + x P(x)/Q(x) -0.125 <= x <= 0.25 2.375 <= x+2.5 <= 2.75 */ static const long double lgam2r5a = 2.8466796875E-1L; static const long double lgam2r5b = 1.4901722919159632494669682701924320137696E-5L; #define NRN2r5 8 static const long double RN2r5[NRN2r5 + 1] = { -4.676454313888335499356699817678862233205E9L, -9.361888347911187924389905984624216340639E9L, -7.695353600835685037920815799526540237703E9L, -3.364370100981509060441853085968900734521E9L, -8.449902011848163568670361316804900559863E8L, -1.225249050950801905108001246436783022179E8L, -9.732972931077110161639900388121650470926E6L, -3.695711763932153505623248207576425983573E5L, -4.717341584067827676530426007495274711306E3L }; #define NRD2r5 8 static const long double RD2r5[NRD2r5 + 1] = { -6.650657966618993679456019224416926875619E9L, -1.099511409330635807899718829033488771623E10L, -7.482546968307837168164311101447116903148E9L, -2.702967190056506495988922973755870557217E9L, -5.570008176482922704972943389590409280950E8L, -6.536934032192792470926310043166993233231E7L, -4.101991193844953082400035444146067511725E6L, -1.174082735875715802334430481065526664020E5L, -9.932840389994157592102947657277692978511E2L /* 1.0E0L */ }; /* log gamma(x+2) = x P(x)/Q(x) -0.125 <= x <= +0.375 1.875 <= x+2 <= 2.375 Peak relative error 4.6e-36 */ #define NRN2 9 static const long double RN2[NRN2 + 1] = { -3.716661929737318153526921358113793421524E9L, -1.138816715030710406922819131397532331321E10L, -1.421017419363526524544402598734013569950E10L, -9.510432842542519665483662502132010331451E9L, -3.747528562099410197957514973274474767329E9L, -8.923565763363912474488712255317033616626E8L, -1.261396653700237624185350402781338231697E8L, -9.918402520255661797735331317081425749014E6L, -3.753996255897143855113273724233104768831E5L, -4.778761333044147141559311805999540765612E3L }; #define NRD2 9 static const long double RD2[NRD2 + 1] = { -8.790916836764308497770359421351673950111E9L, -2.023108608053212516399197678553737477486E10L, -1.958067901852022239294231785363504458367E10L, -1.035515043621003101254252481625188704529E10L, -3.253884432621336737640841276619272224476E9L, -6.186383531162456814954947669274235815544E8L, -6.932557847749518463038934953605969951466E7L, -4.240731768287359608773351626528479703758E6L, -1.197343995089189188078944689846348116630E5L, -1.004622911670588064824904487064114090920E3L /* 1.0E0 */ }; /* log gamma(x+1.75) = log gamma(1.75) + x P(x)/Q(x) -0.125 <= x <= +0.125 1.625 <= x+1.75 <= 1.875 Peak relative error 9.2e-37 */ static const long double lgam1r75a = -8.441162109375E-2L; static const long double lgam1r75b = 1.0500073264444042213965868602268256157604E-5L; #define NRN1r75 8 static const long double RN1r75[NRN1r75 + 1] = { -5.221061693929833937710891646275798251513E7L, -2.052466337474314812817883030472496436993E8L, -2.952718275974940270675670705084125640069E8L, -2.132294039648116684922965964126389017840E8L, -8.554103077186505960591321962207519908489E7L, -1.940250901348870867323943119132071960050E7L, -2.379394147112756860769336400290402208435E6L, -1.384060879999526222029386539622255797389E5L, -2.698453601378319296159355612094598695530E3L }; #define NRD1r75 8 static const long double RD1r75[NRD1r75 + 1] = { -2.109754689501705828789976311354395393605E8L, -5.036651829232895725959911504899241062286E8L, -4.954234699418689764943486770327295098084E8L, -2.589558042412676610775157783898195339410E8L, -7.731476117252958268044969614034776883031E7L, -1.316721702252481296030801191240867486965E7L, -1.201296501404876774861190604303728810836E6L, -5.007966406976106636109459072523610273928E4L, -6.155817990560743422008969155276229018209E2L /* 1.0E0L */ }; /* log gamma(x+x0) = y0 + x^2 P(x)/Q(x) -0.0867 <= x <= +0.1634 1.374932... <= x+x0 <= 1.625032... Peak relative error 4.0e-36 */ static const long double x0a = 1.4616241455078125L; static const long double x0b = 7.9994605498412626595423257213002588621246E-6L; static const long double y0a = -1.21490478515625E-1L; static const long double y0b = 4.1879797753919044854428223084178486438269E-6L; #define NRN1r5 8 static const long double RN1r5[NRN1r5 + 1] = { 6.827103657233705798067415468881313128066E5L, 1.910041815932269464714909706705242148108E6L, 2.194344176925978377083808566251427771951E6L, 1.332921400100891472195055269688876427962E6L, 4.589080973377307211815655093824787123508E5L, 8.900334161263456942727083580232613796141E4L, 9.053840838306019753209127312097612455236E3L, 4.053367147553353374151852319743594873771E2L, 5.040631576303952022968949605613514584950E0L }; #define NRD1r5 8 static const long double RD1r5[NRD1r5 + 1] = { 1.411036368843183477558773688484699813355E6L, 4.378121767236251950226362443134306184849E6L, 5.682322855631723455425929877581697918168E6L, 3.999065731556977782435009349967042222375E6L, 1.653651390456781293163585493620758410333E6L, 4.067774359067489605179546964969435858311E5L, 5.741463295366557346748361781768833633256E4L, 4.226404539738182992856094681115746692030E3L, 1.316980975410327975566999780608618774469E2L, /* 1.0E0L */ }; /* log gamma(x+1.25) = log gamma(1.25) + x P(x)/Q(x) -.125 <= x <= +.125 1.125 <= x+1.25 <= 1.375 Peak relative error = 4.9e-36 */ static const long double lgam1r25a = -9.82818603515625E-2L; static const long double lgam1r25b = 1.0023929749338536146197303364159774377296E-5L; #define NRN1r25 9 static const long double RN1r25[NRN1r25 + 1] = { -9.054787275312026472896002240379580536760E4L, -8.685076892989927640126560802094680794471E4L, 2.797898965448019916967849727279076547109E5L, 6.175520827134342734546868356396008898299E5L, 5.179626599589134831538516906517372619641E5L, 2.253076616239043944538380039205558242161E5L, 5.312653119599957228630544772499197307195E4L, 6.434329437514083776052669599834938898255E3L, 3.385414416983114598582554037612347549220E2L, 4.907821957946273805080625052510832015792E0L }; #define NRD1r25 8 static const long double RD1r25[NRD1r25 + 1] = { 3.980939377333448005389084785896660309000E5L, 1.429634893085231519692365775184490465542E6L, 2.145438946455476062850151428438668234336E6L, 1.743786661358280837020848127465970357893E6L, 8.316364251289743923178092656080441655273E5L, 2.355732939106812496699621491135458324294E5L, 3.822267399625696880571810137601310855419E4L, 3.228463206479133236028576845538387620856E3L, 1.152133170470059555646301189220117965514E2L /* 1.0E0L */ }; /* log gamma(x + 1) = x P(x)/Q(x) 0.0 <= x <= +0.125 1.0 <= x+1 <= 1.125 Peak relative error 1.1e-35 */ #define NRN1 8 static const long double RN1[NRN1 + 1] = { -9.987560186094800756471055681088744738818E3L, -2.506039379419574361949680225279376329742E4L, -1.386770737662176516403363873617457652991E4L, 1.439445846078103202928677244188837130744E4L, 2.159612048879650471489449668295139990693E4L, 1.047439813638144485276023138173676047079E4L, 2.250316398054332592560412486630769139961E3L, 1.958510425467720733041971651126443864041E2L, 4.516830313569454663374271993200291219855E0L }; #define NRD1 7 static const long double RD1[NRD1 + 1] = { 1.730299573175751778863269333703788214547E4L, 6.807080914851328611903744668028014678148E4L, 1.090071629101496938655806063184092302439E5L, 9.124354356415154289343303999616003884080E4L, 4.262071638655772404431164427024003253954E4L, 1.096981664067373953673982635805821283581E4L, 1.431229503796575892151252708527595787588E3L, 7.734110684303689320830401788262295992921E1L /* 1.0E0 */ }; /* log gamma(x + 1) = x P(x)/Q(x) -0.125 <= x <= 0 0.875 <= x+1 <= 1.0 Peak relative error 7.0e-37 */ #define NRNr9 8 static const long double RNr9[NRNr9 + 1] = { 4.441379198241760069548832023257571176884E5L, 1.273072988367176540909122090089580368732E6L, 9.732422305818501557502584486510048387724E5L, -5.040539994443998275271644292272870348684E5L, -1.208719055525609446357448132109723786736E6L, -7.434275365370936547146540554419058907156E5L, -2.075642969983377738209203358199008185741E5L, -2.565534860781128618589288075109372218042E4L, -1.032901669542994124131223797515913955938E3L, }; #define NRDr9 8 static const long double RDr9[NRDr9 + 1] = { -7.694488331323118759486182246005193998007E5L, -3.301918855321234414232308938454112213751E6L, -5.856830900232338906742924836032279404702E6L, -5.540672519616151584486240871424021377540E6L, -3.006530901041386626148342989181721176919E6L, -9.350378280513062139466966374330795935163E5L, -1.566179100031063346901755685375732739511E5L, -1.205016539620260779274902967231510804992E4L, -2.724583156305709733221564484006088794284E2L /* 1.0E0 */ }; /* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ static long double neval (long double x, const long double *p, int n) { long double y; p += n; y = *p--; do { y = y * x + *p--; } while (--n > 0); return y; } /* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ static long double deval (long double x, const long double *p, int n) { long double y; p += n; y = x + *p--; do { y = y * x + *p--; } while (--n > 0); return y; } long double lgammal_r(long double x, int *signgamp) { long double p, q, w, z, nx; int i, nn; *signgamp = 1; if (!isfinite (x)) return x * x; if (x == 0.0L) { if (signbit (x)) *signgamp = -1; return one / fabsl (x); } if (x < 0.0L) { q = -x; p = floorl (q); if (p == q) return (one / (p - p)); i = p; if ((i & 1) == 0) *signgamp = -1; else *signgamp = 1; z = q - p; if (z > 0.5L) { p += 1.0L; z = p - q; } z = q * sinl (PIL * z); if (z == 0.0L) return (*signgamp * huge * huge); w = lgammal (q); z = logl (PIL / z) - w; return (z); } if (x < 13.5L) { p = 0.0L; nx = floorl (x + 0.5L); nn = nx; switch (nn) { case 0: /* log gamma (x + 1) = log(x) + log gamma(x) */ if (x <= 0.125) { p = x * neval (x, RN1, NRN1) / deval (x, RD1, NRD1); } else if (x <= 0.375) { z = x - 0.25L; p = z * neval (z, RN1r25, NRN1r25) / deval (z, RD1r25, NRD1r25); p += lgam1r25b; p += lgam1r25a; } else if (x <= 0.625) { z = x + (1.0L - x0a); z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } else if (x <= 0.875) { z = x - 0.75L; p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); p += lgam1r75b; p += lgam1r75a; } else { z = x - 1.0L; p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); } p = p - logl (x); break; case 1: if (x < 0.875L) { if (x <= 0.625) { z = x + (1.0L - x0a); z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } else if (x <= 0.875) { z = x - 0.75L; p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); p += lgam1r75b; p += lgam1r75a; } else { z = x - 1.0L; p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); } p = p - logl (x); } else if (x < 1.0L) { z = x - 1.0L; p = z * neval (z, RNr9, NRNr9) / deval (z, RDr9, NRDr9); } else if (x == 1.0L) p = 0.0L; else if (x <= 1.125L) { z = x - 1.0L; p = z * neval (z, RN1, NRN1) / deval (z, RD1, NRD1); } else if (x <= 1.375) { z = x - 1.25L; p = z * neval (z, RN1r25, NRN1r25) / deval (z, RD1r25, NRD1r25); p += lgam1r25b; p += lgam1r25a; } else { /* 1.375 <= x+x0 <= 1.625 */ z = x - x0a; z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } break; case 2: if (x < 1.625L) { z = x - x0a; z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } else if (x < 1.875L) { z = x - 1.75L; p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); p += lgam1r75b; p += lgam1r75a; } else if (x == 2.0L) p = 0.0L; else if (x < 2.375L) { z = x - 2.0L; p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); } else { z = x - 2.5L; p = z * neval (z, RN2r5, NRN2r5) / deval (z, RD2r5, NRD2r5); p += lgam2r5b; p += lgam2r5a; } break; case 3: if (x < 2.75) { z = x - 2.5L; p = z * neval (z, RN2r5, NRN2r5) / deval (z, RD2r5, NRD2r5); p += lgam2r5b; p += lgam2r5a; } else { z = x - 3.0L; p = z * neval (z, RN3, NRN3) / deval (z, RD3, NRD3); p += lgam3b; p += lgam3a; } break; case 4: z = x - 4.0L; p = z * neval (z, RN4, NRN4) / deval (z, RD4, NRD4); p += lgam4b; p += lgam4a; break; case 5: z = x - 5.0L; p = z * neval (z, RN5, NRN5) / deval (z, RD5, NRD5); p += lgam5b; p += lgam5a; break; case 6: z = x - 6.0L; p = z * neval (z, RN6, NRN6) / deval (z, RD6, NRD6); p += lgam6b; p += lgam6a; break; case 7: z = x - 7.0L; p = z * neval (z, RN7, NRN7) / deval (z, RD7, NRD7); p += lgam7b; p += lgam7a; break; case 8: z = x - 8.0L; p = z * neval (z, RN8, NRN8) / deval (z, RD8, NRD8); p += lgam8b; p += lgam8a; break; case 9: z = x - 9.0L; p = z * neval (z, RN9, NRN9) / deval (z, RD9, NRD9); p += lgam9b; p += lgam9a; break; case 10: z = x - 10.0L; p = z * neval (z, RN10, NRN10) / deval (z, RD10, NRD10); p += lgam10b; p += lgam10a; break; case 11: z = x - 11.0L; p = z * neval (z, RN11, NRN11) / deval (z, RD11, NRD11); p += lgam11b; p += lgam11a; break; case 12: z = x - 12.0L; p = z * neval (z, RN12, NRN12) / deval (z, RD12, NRD12); p += lgam12b; p += lgam12a; break; case 13: z = x - 13.0L; p = z * neval (z, RN13, NRN13) / deval (z, RD13, NRD13); p += lgam13b; p += lgam13a; break; } return p; } if (x > MAXLGM) return (*signgamp * huge * huge); q = ls2pi - x; q = (x - 0.5L) * logl (x) + q; if (x > 1.0e18L) return (q); p = 1.0L / (x * x); q += neval (p, RASY, NRASY) / x; return (q); } wcc-0.0.2/src/wsh/openlibm/ld128/e_tgammal.c0000644000175000017500000000233413122010155017050 0ustar philphil/* $OpenBSD: e_tgammal.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ /* * Copyright (c) 2011 Martynas Venckus * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include "math_private.h" long double tgammal(long double x) { int64_t i0,i1; GET_LDOUBLE_WORDS64(i0,i1,x); if (((i0&0x7fffffffffffffffLL)|i1) == 0) return (1.0/x); if (i0<0 && (u_int64_t)i0<0xffff000000000000ULL && rintl(x)==x) return (x-x)/(x-x); if (i0==0xffff000000000000ULL && i1==0) return (x-x); return expl(lgammal(x)); } wcc-0.0.2/src/wsh/openlibm/ld128/s_nexttoward.c0000644000175000017500000000440413122010155017643 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* IEEE functions * nexttoward(x,y) * return the next machine floating-point number of x in the * direction toward y. * Special cases: */ #include #include #include "math_private.h" double nexttoward(double x, long double y) { int32_t hx,ix; int64_t hy,iy; u_int32_t lx; u_int64_t ly; EXTRACT_WORDS(hx,lx,x); GET_LDOUBLE_WORDS64(hy,ly,y); ix = hx&0x7fffffff; /* |x| */ iy = hy&0x7fffffffffffffffLL; /* |y| */ if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ ((iy>=0x7fff000000000000LL)&&((iy-0x7fff000000000000LL)|ly)!=0)) /* y is nan */ return x+y; if((long double) x==y) return y; /* x=y, return y */ if((ix|lx)==0) { /* x == 0 */ volatile double u; INSERT_WORDS(x,(u_int32_t)((hy>>32)&0x80000000),1);/* return +-minsub */ u = x; u = u * u; /* raise underflow flag */ return x; } if(hx>=0) { /* x > 0 */ if (hy<0||(ix>>20)>(iy>>48)-0x3c00 || ((ix>>20)==(iy>>48)-0x3c00 && (((((int64_t)hx)<<28)|(lx>>4))>(hy&0x0000ffffffffffffLL) || (((((int64_t)hx)<<28)|(lx>>4))==(hy&0x0000ffffffffffffLL) && (lx&0xf)>(ly>>60))))) { /* x > y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x < y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } else { /* x < 0 */ if (hy>=0||(ix>>20)>(iy>>48)-0x3c00 || ((ix>>20)==(iy>>48)-0x3c00 && (((((int64_t)hx)<<28)|(lx>>4))>(hy&0x0000ffffffffffffLL) || (((((int64_t)hx)<<28)|(lx>>4))==(hy&0x0000ffffffffffffLL) && (lx&0xf)>(ly>>60))))) { /* x < y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x > y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } hy = hx&0x7ff00000; if(hy>=0x7ff00000) { x = x+x; /* overflow */ return x; } if(hy<0x00100000) { volatile double u = x*x; /* underflow */ } INSERT_WORDS(x,hx,lx); return x; } wcc-0.0.2/src/wsh/openlibm/ld128/e_acoshl.c0000644000175000017500000000304713122010155016701 0ustar philphil/* @(#)e_acosh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* acoshl(x) * Method : * Based on * acoshl(x) = logl [ x + sqrtl(x*x-1) ] * we have * acoshl(x) := logl(x)+ln2, if x is large; else * acoshl(x) := logl(2x-1/(sqrtl(x*x-1)+x)) if x>2; else * acoshl(x) := log1pl(t+sqrtl(2.0*t+t*t)); where t=x-1. * * Special cases: * acoshl(x) is NaN with signal if x<1. * acoshl(NaN) is NaN without signal. */ #include #include "math_private.h" static const long double one = 1.0, ln2 = 0.6931471805599453094172321214581766L; long double acoshl(long double x) { long double t; u_int64_t lx; int64_t hx; GET_LDOUBLE_WORDS64(hx,lx,x); if(hx<0x3fff000000000000LL) { /* x < 1 */ return (x-x)/(x-x); } else if(hx >=0x4035000000000000LL) { /* x > 2**54 */ if(hx >=0x7fff000000000000LL) { /* x is inf of NaN */ return x+x; } else return logl(x)+ln2; /* acoshl(huge)=logl(2x) */ } else if(((hx-0x3fff000000000000LL)|lx)==0) { return 0.0L; /* acosh(1) = 0 */ } else if (hx > 0x4000000000000000LL) { /* 2**28 > x > 2 */ t=x*x; return logl(2.0L*x-one/(x+sqrtl(t-one))); } else { /* 1 * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* log10l.c * * Common logarithm, 128-bit long double precision * * * * SYNOPSIS: * * long double x, y, log10l(); * * y = log10l( x ); * * * * DESCRIPTION: * * Returns the base 10 logarithm of x. * * The argument is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the logarithm * of the fraction is approximated by * * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * log(x) = z + z^3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 30000 2.3e-34 4.9e-35 * IEEE exp(+-10000) 30000 1.0e-34 4.1e-35 * * In the tests over the interval exp(+-10000), the logarithms * of the random arguments were uniformly distributed over * [-10000, +10000]. * */ #include #include "math_private.h" /* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 5.3e-37, * relative peak error spread = 2.3e-14 */ static const long double P[13] = { 1.313572404063446165910279910527789794488E4L, 7.771154681358524243729929227226708890930E4L, 2.014652742082537582487669938141683759923E5L, 3.007007295140399532324943111654767187848E5L, 2.854829159639697837788887080758954924001E5L, 1.797628303815655343403735250238293741397E5L, 7.594356839258970405033155585486712125861E4L, 2.128857716871515081352991964243375186031E4L, 3.824952356185897735160588078446136783779E3L, 4.114517881637811823002128927449878962058E2L, 2.321125933898420063925789532045674660756E1L, 4.998469661968096229986658302195402690910E-1L, 1.538612243596254322971797716843006400388E-6L }; static const long double Q[12] = { 3.940717212190338497730839731583397586124E4L, 2.626900195321832660448791748036714883242E5L, 7.777690340007566932935753241556479363645E5L, 1.347518538384329112529391120390701166528E6L, 1.514882452993549494932585972882995548426E6L, 1.158019977462989115839826904108208787040E6L, 6.132189329546557743179177159925690841200E5L, 2.248234257620569139969141618556349415120E5L, 5.605842085972455027590989944010492125825E4L, 9.147150349299596453976674231612674085381E3L, 9.104928120962988414618126155557301584078E2L, 4.839208193348159620282142911143429644326E1L /* 1.000000000000000000000000000000000000000E0L, */ }; /* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 1.1e-35, * relative peak error spread 1.1e-9 */ static const long double R[6] = { 1.418134209872192732479751274970992665513E5L, -8.977257995689735303686582344659576526998E4L, 2.048819892795278657810231591630928516206E4L, -2.024301798136027039250415126250455056397E3L, 8.057002716646055371965756206836056074715E1L, -8.828896441624934385266096344596648080902E-1L }; static const long double S[6] = { 1.701761051846631278975701529965589676574E6L, -1.332535117259762928288745111081235577029E6L, 4.001557694070773974936904547424676279307E5L, -5.748542087379434595104154610899551484314E4L, 3.998526750980007367835804959888064681098E3L, -1.186359407982897997337150403816839480438E2L /* 1.000000000000000000000000000000000000000E0L, */ }; static const long double /* log10(2) */ L102A = 0.3125L, L102B = -1.14700043360188047862611052755069732318101185E-2L, /* log10(e) */ L10EA = 0.5L, L10EB = -6.570551809674817234887108108339491770560299E-2L, /* sqrt(2)/2 */ SQRTH = 7.071067811865475244008443621048490392848359E-1L; /* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ static long double neval (long double x, const long double *p, int n) { long double y; p += n; y = *p--; do { y = y * x + *p--; } while (--n > 0); return y; } /* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ static long double deval (long double x, const long double *p, int n) { long double y; p += n; y = x + *p--; do { y = y * x + *p--; } while (--n > 0); return y; } long double log10l(long double x) { long double z; long double y; int e; int64_t hx, lx; /* Test for domain */ GET_LDOUBLE_WORDS64 (hx, lx, x); if (((hx & 0x7fffffffffffffffLL) | lx) == 0) return (-1.0L / (x - x)); if (hx < 0) return (x - x) / (x - x); if (hx >= 0x7fff000000000000LL) return (x + x); /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl (x, &e); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if ((e > 2) || (e < -2)) { if (x < SQRTH) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x * x; y = x * (z * neval (z, R, 5) / deval (z, S, 5)); goto done; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if (x < SQRTH) { e -= 1; x = 2.0 * x - 1.0L; /* 2x - 1 */ } else { x = x - 1.0L; } z = x * x; y = x * (z * neval (x, P, 12) / deval (x, Q, 11)); y = y - 0.5 * z; done: /* Multiply log of fraction by log10(e) * and base 2 exponent by log10(2). */ z = y * L10EB; z += x * L10EB; z += e * L102B; z += y * L10EA; z += x * L10EA; z += e * L102A; return (z); } wcc-0.0.2/src/wsh/openlibm/ld128/e_sinhl.c0000644000175000017500000000616213122010155016546 0ustar philphil/* @(#)e_sinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* sinhl(x) * Method : * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 * 1. Replace x by |x| (sinhl(-x) = -sinhl(x)). * 2. * E + E/(E+1) * 0 <= x <= 25 : sinhl(x) := --------------, E=expm1l(x) * 2 * * 25 <= x <= lnovft : sinhl(x) := expl(x)/2 * lnovft <= x <= ln2ovft: sinhl(x) := expl(x/2)/2 * expl(x/2) * ln2ovft < x : sinhl(x) := x*shuge (overflow) * * Special cases: * sinhl(x) is |x| if x is +INF, -INF, or NaN. * only sinhl(0)=0 is exact for finite x. */ #include #include "math_private.h" static const long double one = 1.0, shuge = 1.0e4931L, ovf_thresh = 1.1357216553474703894801348310092223067821E4L; long double sinhl(long double x) { long double t, w, h; u_int32_t jx, ix; ieee_quad_shape_type u; /* Words of |x|. */ u.value = x; jx = u.parts32.mswhi; ix = jx & 0x7fffffff; /* x is INF or NaN */ if (ix >= 0x7fff0000) return x + x; h = 0.5; if (jx & 0x80000000) h = -h; /* Absolute value of x. */ u.parts32.mswhi = ix; /* |x| in [0,40], return sign(x)*0.5*(E+E/(E+1))) */ if (ix <= 0x40044000) { if (ix < 0x3fc60000) /* |x| < 2^-57 */ if (shuge + x > one) return x; /* sinh(tiny) = tiny with inexact */ t = expm1l (u.value); if (ix < 0x3fff0000) return h * (2.0 * t - t * t / (t + one)); return h * (t + t / (t + one)); } /* |x| in [40, log(maxdouble)] return 0.5*exp(|x|) */ if (ix <= 0x400c62e3) /* 11356.375 */ return h * expl (u.value); /* |x| in [log(maxdouble), overflowthreshold] Overflow threshold is log(2 * maxdouble). */ if (u.value <= ovf_thresh) { w = expl (0.5 * u.value); t = h * w; return t * w; } /* |x| > overflowthreshold, sinhl(x) overflow */ return x * shuge; } wcc-0.0.2/src/wsh/openlibm/ld128/e_powl.c0000644000175000017500000002722613122010155016416 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* powl(x,y) return x**y * * n * Method: Let x = 2 * (1+f) * 1. Compute and return log2(x) in two pieces: * log2(x) = w1 + w2, * where w1 has 113-53 = 60 bit trailing zeros. * 2. Perform y*log2(x) = n+y' by simulating muti-precision * arithmetic, where |y'|<=0.5. * 3. Return x**y = 2**n*exp(y'*log2) * * Special cases: * 1. (anything) ** 0 is 1 * 2. (anything) ** 1 is itself * 3. (anything) ** NAN is NAN * 4. NAN ** (anything except 0) is NAN * 5. +-(|x| > 1) ** +INF is +INF * 6. +-(|x| > 1) ** -INF is +0 * 7. +-(|x| < 1) ** +INF is +0 * 8. +-(|x| < 1) ** -INF is +INF * 9. +-1 ** +-INF is NAN * 10. +0 ** (+anything except 0, NAN) is +0 * 11. -0 ** (+anything except 0, NAN, odd integer) is +0 * 12. +0 ** (-anything except 0, NAN) is +INF * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF * 14. -0 ** (odd integer) = -( +0 ** (odd integer) ) * 15. +INF ** (+anything except 0,NAN) is +INF * 16. +INF ** (-anything except 0,NAN) is +0 * 17. -INF ** (anything) = -0 ** (-anything) * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer) * 19. (-anything except 0 and inf) ** (non-integer) is NAN * */ #include #include "math_private.h" static const long double bp[] = { 1.0L, 1.5L, }; /* log_2(1.5) */ static const long double dp_h[] = { 0.0, 5.8496250072115607565592654282227158546448E-1L }; /* Low part of log_2(1.5) */ static const long double dp_l[] = { 0.0, 1.0579781240112554492329533686862998106046E-16L }; static const long double zero = 0.0L, one = 1.0L, two = 2.0L, two113 = 1.0384593717069655257060992658440192E34L, huge = 1.0e3000L, tiny = 1.0e-3000L; /* 3/2 log x = 3 z + z^3 + z^3 (z^2 R(z^2)) z = (x-1)/(x+1) 1 <= x <= 1.25 Peak relative error 2.3e-37 */ static const long double LN[] = { -3.0779177200290054398792536829702930623200E1L, 6.5135778082209159921251824580292116201640E1L, -4.6312921812152436921591152809994014413540E1L, 1.2510208195629420304615674658258363295208E1L, -9.9266909031921425609179910128531667336670E-1L }; static const long double LD[] = { -5.129862866715009066465422805058933131960E1L, 1.452015077564081884387441590064272782044E2L, -1.524043275549860505277434040464085593165E2L, 7.236063513651544224319663428634139768808E1L, -1.494198912340228235853027849917095580053E1L /* 1.0E0 */ }; /* exp(x) = 1 + x - x / (1 - 2 / (x - x^2 R(x^2))) 0 <= x <= 0.5 Peak relative error 5.7e-38 */ static const long double PN[] = { 5.081801691915377692446852383385968225675E8L, 9.360895299872484512023336636427675327355E6L, 4.213701282274196030811629773097579432957E4L, 5.201006511142748908655720086041570288182E1L, 9.088368420359444263703202925095675982530E-3L, }; static const long double PD[] = { 3.049081015149226615468111430031590411682E9L, 1.069833887183886839966085436512368982758E8L, 8.259257717868875207333991924545445705394E5L, 1.872583833284143212651746812884298360922E3L, /* 1.0E0 */ }; static const long double /* ln 2 */ lg2 = 6.9314718055994530941723212145817656807550E-1L, lg2_h = 6.9314718055994528622676398299518041312695E-1L, lg2_l = 2.3190468138462996154948554638754786504121E-17L, ovt = 8.0085662595372944372e-0017L, /* 2/(3*log(2)) */ cp = 9.6179669392597560490661645400126142495110E-1L, cp_h = 9.6179669392597555432899980587535537779331E-1L, cp_l = 5.0577616648125906047157785230014751039424E-17L; long double powl(long double x, long double y) { long double z, ax, z_h, z_l, p_h, p_l; long double yy1, t1, t2, r, s, t, u, v, w; long double s2, s_h, s_l, t_h, t_l; int32_t i, j, k, yisint, n; u_int32_t ix, iy; int32_t hx, hy; ieee_quad_shape_type o, p, q; p.value = x; hx = p.parts32.mswhi; ix = hx & 0x7fffffff; q.value = y; hy = q.parts32.mswhi; iy = hy & 0x7fffffff; /* y==zero: x**0 = 1 */ if ((iy | q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) == 0) return one; /* 1.0**y = 1; -1.0**+-Inf = 1 */ if (x == one) return one; if (x == -1.0L && iy == 0x7fff0000 && (q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) == 0) return one; /* +-NaN return x+y */ if ((ix > 0x7fff0000) || ((ix == 0x7fff0000) && ((p.parts32.mswlo | p.parts32.lswhi | p.parts32.lswlo) != 0)) || (iy > 0x7fff0000) || ((iy == 0x7fff0000) && ((q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) != 0))) return x + y; /* determine if y is an odd int when x < 0 * yisint = 0 ... y is not an integer * yisint = 1 ... y is an odd int * yisint = 2 ... y is an even int */ yisint = 0; if (hx < 0) { if (iy >= 0x40700000) /* 2^113 */ yisint = 2; /* even integer y */ else if (iy >= 0x3fff0000) /* 1.0 */ { if (floorl (y) == y) { z = 0.5 * y; if (floorl (z) == z) yisint = 2; else yisint = 1; } } } /* special value of y */ if ((q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) == 0) { if (iy == 0x7fff0000) /* y is +-inf */ { if (((ix - 0x3fff0000) | p.parts32.mswlo | p.parts32.lswhi | p.parts32.lswlo) == 0) return y - y; /* +-1**inf is NaN */ else if (ix >= 0x3fff0000) /* (|x|>1)**+-inf = inf,0 */ return (hy >= 0) ? y : zero; else /* (|x|<1)**-,+inf = inf,0 */ return (hy < 0) ? -y : zero; } if (iy == 0x3fff0000) { /* y is +-1 */ if (hy < 0) return one / x; else return x; } if (hy == 0x40000000) return x * x; /* y is 2 */ if (hy == 0x3ffe0000) { /* y is 0.5 */ if (hx >= 0) /* x >= +0 */ return sqrtl (x); } } ax = fabsl (x); /* special value of x */ if ((p.parts32.mswlo | p.parts32.lswhi | p.parts32.lswlo) == 0) { if (ix == 0x7fff0000 || ix == 0 || ix == 0x3fff0000) { z = ax; /*x is +-0,+-inf,+-1 */ if (hy < 0) z = one / z; /* z = (1/|x|) */ if (hx < 0) { if (((ix - 0x3fff0000) | yisint) == 0) { z = (z - z) / (z - z); /* (-1)**non-int is NaN */ } else if (yisint == 1) z = -z; /* (x<0)**odd = -(|x|**odd) */ } return z; } } /* (x<0)**(non-int) is NaN */ if (((((u_int32_t) hx >> 31) - 1) | yisint) == 0) return (x - x) / (x - x); /* |y| is huge. 2^-16495 = 1/2 of smallest representable value. If (1 - 1/131072)^y underflows, y > 1.4986e9 */ if (iy > 0x401d654b) { /* if (1 - 2^-113)^y underflows, y > 1.1873e38 */ if (iy > 0x407d654b) { if (ix <= 0x3ffeffff) return (hy < 0) ? huge * huge : tiny * tiny; if (ix >= 0x3fff0000) return (hy > 0) ? huge * huge : tiny * tiny; } /* over/underflow if x is not close to one */ if (ix < 0x3ffeffff) return (hy < 0) ? huge * huge : tiny * tiny; if (ix > 0x3fff0000) return (hy > 0) ? huge * huge : tiny * tiny; } n = 0; /* take care subnormal number */ if (ix < 0x00010000) { ax *= two113; n -= 113; o.value = ax; ix = o.parts32.mswhi; } n += ((ix) >> 16) - 0x3fff; j = ix & 0x0000ffff; /* determine interval */ ix = j | 0x3fff0000; /* normalize ix */ if (j <= 0x3988) k = 0; /* |x|> 31) - 1) | (yisint - 1)) == 0) s = -one; /* (-ve)**(odd int) */ /* split up y into yy1+y2 and compute (yy1+y2)*(t1+t2) */ yy1 = y; o.value = yy1; o.parts32.lswlo = 0; o.parts32.lswhi &= 0xf8000000; yy1 = o.value; p_l = (y - yy1) * t1 + y * t2; p_h = yy1 * t1; z = p_l + p_h; o.value = z; j = o.parts32.mswhi; if (j >= 0x400d0000) /* z >= 16384 */ { /* if z > 16384 */ if (((j - 0x400d0000) | o.parts32.mswlo | o.parts32.lswhi | o.parts32.lswlo) != 0) return s * huge * huge; /* overflow */ else { if (p_l + ovt > z - p_h) return s * huge * huge; /* overflow */ } } else if ((j & 0x7fffffff) >= 0x400d01b9) /* z <= -16495 */ { /* z < -16495 */ if (((j - 0xc00d01bc) | o.parts32.mswlo | o.parts32.lswhi | o.parts32.lswlo) != 0) return s * tiny * tiny; /* underflow */ else { if (p_l <= z - p_h) return s * tiny * tiny; /* underflow */ } } /* compute 2**(p_h+p_l) */ i = j & 0x7fffffff; k = (i >> 16) - 0x3fff; n = 0; if (i > 0x3ffe0000) { /* if |z| > 0.5, set n = [z+0.5] */ n = floorl (z + 0.5L); t = n; p_h -= t; } t = p_l + p_h; o.value = t; o.parts32.lswlo = 0; o.parts32.lswhi &= 0xf8000000; t = o.value; u = t * lg2_h; v = (p_l - (t - p_h)) * lg2 + t * lg2_l; z = u + v; w = v - (z - u); /* exp(z) */ t = z * z; u = PN[0] + t * (PN[1] + t * (PN[2] + t * (PN[3] + t * PN[4]))); v = PD[0] + t * (PD[1] + t * (PD[2] + t * (PD[3] + t))); t1 = z - t * u / v; r = (z * t1) / (t1 - two) - (w + z * w); z = one - (r - z); o.value = z; j = o.parts32.mswhi; j += (n << 16); if ((j >> 16) <= 0) z = scalbnl (z, n); /* subnormal output */ else { o.parts32.mswhi = j; z = o.value; } return s * z; } wcc-0.0.2/src/wsh/openlibm/ld128/k_cosl.c0000644000175000017500000000367613122010155016406 0ustar philphil/* From: @(#)k_cos.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld128/k_cosl.c,v 1.1 2008/02/17 07:32:31 das Exp $"); /* * ld128 version of k_cos.c. See ../src/k_cos.c for most comments. */ #include "math_private.h" /* * Domain [-0.7854, 0.7854], range ~[-1.80e-37, 1.79e-37]: * |cos(x) - c(x))| < 2**-122.0 * * 113-bit precision requires more care than 64-bit precision, since * simple methods give a minimax polynomial with coefficient for x^2 * that is 1 ulp below 0.5, but we want it to be precisely 0.5. See * ../ld80/k_cosl.c for more details. */ static const double one = 1.0; static const long double C1 = 0.04166666666666666666666666666666658424671L, C2 = -0.001388888888888888888888888888863490893732L, C3 = 0.00002480158730158730158730158600795304914210L, C4 = -0.2755731922398589065255474947078934284324e-6L, C5 = 0.2087675698786809897659225313136400793948e-8L, C6 = -0.1147074559772972315817149986812031204775e-10L, C7 = 0.4779477332386808976875457937252120293400e-13L; static const double C8 = -0.1561920696721507929516718307820958119868e-15, C9 = 0.4110317413744594971475941557607804508039e-18, C10 = -0.8896592467191938803288521958313920156409e-21, C11 = 0.1601061435794535138244346256065192782581e-23; long double __kernel_cosl(long double x, long double y) { long double hz,z,r,w; z = x*x; r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*(C6+z*(C7+ z*(C8+z*(C9+z*(C10+z*C11)))))))))); hz = 0.5*z; w = one-hz; return w + (((one-w)-hz) + (z*r-x*y)); } wcc-0.0.2/src/wsh/openlibm/ld128/e_atanhl.c0000644000175000017500000000323113122010155016672 0ustar philphil/* @(#)e_atanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* atanhl(x) * Method : * 1.Reduced x to positive by atanh(-x) = -atanh(x) * 2.For x>=0.5 * 1 2x x * atanhl(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) * 2 1 - x 1 - x * * For x<0.5 * atanhl(x) = 0.5*log1pl(2x+2x*x/(1-x)) * * Special cases: * atanhl(x) is NaN if |x| > 1 with signal; * atanhl(NaN) is that NaN with no signal; * atanhl(+-1) is +-INF with signal. * */ #include #include "math_private.h" static const long double one = 1.0L, huge = 1e4900L; static const long double zero = 0.0L; long double atanhl(long double x) { long double t; u_int32_t jx, ix; ieee_quad_shape_type u; u.value = x; jx = u.parts32.mswhi; ix = jx & 0x7fffffff; u.parts32.mswhi = ix; if (ix >= 0x3fff0000) /* |x| >= 1.0 or infinity or NaN */ { if (u.value == one) return x/zero; else return (x-x)/(x-x); } if(ix<0x3fc60000 && (huge+x)>zero) return x; /* x < 2^-57 */ if(ix<0x3ffe0000) { /* x < 0.5 */ t = u.value+u.value; t = 0.5*log1pl(t+t*u.value/(one-u.value)); } else t = 0.5*log1pl((u.value+u.value)/(one-u.value)); if(jx & 0x80000000) return -t; else return t; } wcc-0.0.2/src/wsh/openlibm/ld128/invtrig.c0000644000175000017500000001016413122010155016604 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld128/invtrig.c,v 1.1 2008/07/31 22:41:26 das Exp $"); #include "ld128/invtrig.h" /* * asinl() and acosl() */ const long double pS0 = 1.66666666666666666666666666666700314e-01L, pS1 = -7.32816946414566252574527475428622708e-01L, pS2 = 1.34215708714992334609030036562143589e+00L, pS3 = -1.32483151677116409805070261790752040e+00L, pS4 = 7.61206183613632558824485341162121989e-01L, pS5 = -2.56165783329023486777386833928147375e-01L, pS6 = 4.80718586374448793411019434585413855e-02L, pS7 = -4.42523267167024279410230886239774718e-03L, pS8 = 1.44551535183911458253205638280410064e-04L, pS9 = -2.10558957916600254061591040482706179e-07L, qS1 = -4.84690167848739751544716485245697428e+00L, qS2 = 9.96619113536172610135016921140206980e+00L, qS3 = -1.13177895428973036660836798461641458e+01L, qS4 = 7.74004374389488266169304117714658761e+00L, qS5 = -3.25871986053534084709023539900339905e+00L, qS6 = 8.27830318881232209752469022352928864e-01L, qS7 = -1.18768052702942805423330715206348004e-01L, qS8 = 8.32600764660522313269101537926539470e-03L, qS9 = -1.99407384882605586705979504567947007e-04L; /* * atanl() */ const long double atanhi[] = { 4.63647609000806116214256231461214397e-01L, 7.85398163397448309615660845819875699e-01L, 9.82793723247329067985710611014666038e-01L, 1.57079632679489661923132169163975140e+00L, }; const long double atanlo[] = { 4.89509642257333492668618435220297706e-36L, 2.16795253253094525619926100651083806e-35L, -2.31288434538183565909319952098066272e-35L, 4.33590506506189051239852201302167613e-35L, }; const long double aT[] = { 3.33333333333333333333333333333333125e-01L, -1.99999999999999999999999999999180430e-01L, 1.42857142857142857142857142125269827e-01L, -1.11111111111111111111110834490810169e-01L, 9.09090909090909090908522355708623681e-02L, -7.69230769230769230696553844935357021e-02L, 6.66666666666666660390096773046256096e-02L, -5.88235294117646671706582985209643694e-02L, 5.26315789473666478515847092020327506e-02L, -4.76190476189855517021024424991436144e-02L, 4.34782608678695085948531993458097026e-02L, -3.99999999632663469330634215991142368e-02L, 3.70370363987423702891250829918659723e-02L, -3.44827496515048090726669907612335954e-02L, 3.22579620681420149871973710852268528e-02L, -3.03020767654269261041647570626778067e-02L, 2.85641979882534783223403715930946138e-02L, -2.69824879726738568189929461383741323e-02L, 2.54194698498808542954187110873675769e-02L, -2.35083879708189059926183138130183215e-02L, 2.04832358998165364349957325067131428e-02L, -1.54489555488544397858507248612362957e-02L, 8.64492360989278761493037861575248038e-03L, -2.58521121597609872727919154569765469e-03L, }; const long double pi_lo = 8.67181013012378102479704402604335225e-35L; wcc-0.0.2/src/wsh/openlibm/ld128/s_expm1l.c0000644000175000017500000001064213122010155016653 0ustar philphil/* $OpenBSD: s_expm1l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* expm1l.c * * Exponential function, minus 1 * 128-bit long double precision * * * * SYNOPSIS: * * long double x, y, expm1l(); * * y = expm1l( x ); * * * * DESCRIPTION: * * Returns e (2.71828...) raised to the x power, minus one. * * Range reduction is accomplished by separating the argument * into an integer k and fraction f such that * * x k f * e = 2 e. * * An expansion x + .5 x^2 + x^3 R(x) approximates exp(f) - 1 * in the basic range [-0.5 ln 2, 0.5 ln 2]. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -79,+MAXLOG 100,000 1.7e-34 4.5e-35 * */ #include #include #include "math_private.h" /* exp(x) - 1 = x + 0.5 x^2 + x^3 P(x)/Q(x) -.5 ln 2 < x < .5 ln 2 Theoretical peak relative error = 8.1e-36 */ static const long double P0 = 2.943520915569954073888921213330863757240E8L, P1 = -5.722847283900608941516165725053359168840E7L, P2 = 8.944630806357575461578107295909719817253E6L, P3 = -7.212432713558031519943281748462837065308E5L, P4 = 4.578962475841642634225390068461943438441E4L, P5 = -1.716772506388927649032068540558788106762E3L, P6 = 4.401308817383362136048032038528753151144E1L, P7 = -4.888737542888633647784737721812546636240E-1L, Q0 = 1.766112549341972444333352727998584753865E9L, Q1 = -7.848989743695296475743081255027098295771E8L, Q2 = 1.615869009634292424463780387327037251069E8L, Q3 = -2.019684072836541751428967854947019415698E7L, Q4 = 1.682912729190313538934190635536631941751E6L, Q5 = -9.615511549171441430850103489315371768998E4L, Q6 = 3.697714952261803935521187272204485251835E3L, Q7 = -8.802340681794263968892934703309274564037E1L, /* Q8 = 1.000000000000000000000000000000000000000E0 */ /* C1 + C2 = ln 2 */ C1 = 6.93145751953125E-1L, C2 = 1.428606820309417232121458176568075500134E-6L, /* ln (2^16384 * (1 - 2^-113)) */ maxlog = 1.1356523406294143949491931077970764891253E4L, /* ln 2^-114 */ minarg = -7.9018778583833765273564461846232128760607E1L, big = 1e4932L; long double expm1l(long double x) { long double px, qx, xx; int32_t ix, sign; ieee_quad_shape_type u; int k; /* Detect infinity and NaN. */ u.value = x; ix = u.parts32.mswhi; sign = ix & 0x80000000; ix &= 0x7fffffff; if (ix >= 0x7fff0000) { /* Infinity. */ if (((ix & 0xffff) | u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) { if (sign) return -1.0L; else return x; } /* NaN. No invalid exception. */ return x; } /* expm1(+- 0) = +- 0. */ if ((ix == 0) && (u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) return x; /* Overflow. */ if (x > maxlog) return (big * big); /* Minimum value. */ if (x < minarg) return (4.0/big - 1.0L); /* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */ xx = C1 + C2; /* ln 2. */ px = floorl (0.5 + x / xx); k = px; /* remainder times ln 2 */ x -= px * C1; x -= px * C2; /* Approximate exp(remainder ln 2). */ px = (((((((P7 * x + P6) * x + P5) * x + P4) * x + P3) * x + P2) * x + P1) * x + P0) * x; qx = (((((((x + Q7) * x + Q6) * x + Q5) * x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0; xx = x * x; qx = x + (0.5 * xx + xx * px / qx); /* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2). We have qx = exp(remainder ln 2) - 1, so exp(x) - 1 = 2^k (qx + 1) - 1 = 2^k qx + 2^k - 1. */ px = ldexpl (1.0L, k); x = px * qx + (px - 1.0); return x; } wcc-0.0.2/src/wsh/openlibm/ld128/s_log1pl.c0000644000175000017500000001472313122010155016647 0ustar philphil/* $OpenBSD: s_log1pl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* log1pl.c * * Relative error logarithm * Natural logarithm of 1+x, 128-bit long double precision * * * * SYNOPSIS: * * long double x, y, log1pl(); * * y = log1pl( x ); * * * * DESCRIPTION: * * Returns the base e (2.718...) logarithm of 1+x. * * The argument 1+x is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the logarithm * of the fraction is approximated by * * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). * * Otherwise, setting z = 2(w-1)/(w+1), * * log(w) = z + z^3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -1, 8 100000 1.9e-34 4.3e-35 */ #include #include "math_private.h" /* Coefficients for log(1+x) = x - x^2 / 2 + x^3 P(x)/Q(x) * 1/sqrt(2) <= 1+x < sqrt(2) * Theoretical peak relative error = 5.3e-37, * relative peak error spread = 2.3e-14 */ static const long double P12 = 1.538612243596254322971797716843006400388E-6L, P11 = 4.998469661968096229986658302195402690910E-1L, P10 = 2.321125933898420063925789532045674660756E1L, P9 = 4.114517881637811823002128927449878962058E2L, P8 = 3.824952356185897735160588078446136783779E3L, P7 = 2.128857716871515081352991964243375186031E4L, P6 = 7.594356839258970405033155585486712125861E4L, P5 = 1.797628303815655343403735250238293741397E5L, P4 = 2.854829159639697837788887080758954924001E5L, P3 = 3.007007295140399532324943111654767187848E5L, P2 = 2.014652742082537582487669938141683759923E5L, P1 = 7.771154681358524243729929227226708890930E4L, P0 = 1.313572404063446165910279910527789794488E4L, /* Q12 = 1.000000000000000000000000000000000000000E0L, */ Q11 = 4.839208193348159620282142911143429644326E1L, Q10 = 9.104928120962988414618126155557301584078E2L, Q9 = 9.147150349299596453976674231612674085381E3L, Q8 = 5.605842085972455027590989944010492125825E4L, Q7 = 2.248234257620569139969141618556349415120E5L, Q6 = 6.132189329546557743179177159925690841200E5L, Q5 = 1.158019977462989115839826904108208787040E6L, Q4 = 1.514882452993549494932585972882995548426E6L, Q3 = 1.347518538384329112529391120390701166528E6L, Q2 = 7.777690340007566932935753241556479363645E5L, Q1 = 2.626900195321832660448791748036714883242E5L, Q0 = 3.940717212190338497730839731583397586124E4L; /* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 1.1e-35, * relative peak error spread 1.1e-9 */ static const long double R5 = -8.828896441624934385266096344596648080902E-1L, R4 = 8.057002716646055371965756206836056074715E1L, R3 = -2.024301798136027039250415126250455056397E3L, R2 = 2.048819892795278657810231591630928516206E4L, R1 = -8.977257995689735303686582344659576526998E4L, R0 = 1.418134209872192732479751274970992665513E5L, /* S6 = 1.000000000000000000000000000000000000000E0L, */ S5 = -1.186359407982897997337150403816839480438E2L, S4 = 3.998526750980007367835804959888064681098E3L, S3 = -5.748542087379434595104154610899551484314E4L, S2 = 4.001557694070773974936904547424676279307E5L, S1 = -1.332535117259762928288745111081235577029E6L, S0 = 1.701761051846631278975701529965589676574E6L; /* C1 + C2 = ln 2 */ static const long double C1 = 6.93145751953125E-1L; static const long double C2 = 1.428606820309417232121458176568075500134E-6L; static const long double sqrth = 0.7071067811865475244008443621048490392848L; /* ln (2^16384 * (1 - 2^-113)) */ static const long double zero = 0.0L; long double log1pl(long double xm1) { long double x, y, z, r, s; ieee_quad_shape_type u; int32_t hx; int e; /* Test for NaN or infinity input. */ u.value = xm1; hx = u.parts32.mswhi; if (hx >= 0x7fff0000) return xm1; /* log1p(+- 0) = +- 0. */ if (((hx & 0x7fffffff) == 0) && (u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) return xm1; x = xm1 + 1.0L; /* log1p(-1) = -inf */ if (x <= 0.0L) { if (x == 0.0L) return (-1.0L / (x - x)); else return (zero / (x - x)); } /* Separate mantissa from exponent. */ /* Use frexp used so that denormal numbers will be handled properly. */ x = frexpl (x, &e); /* Logarithm using log(x) = z + z^3 P(z^2)/Q(z^2), where z = 2(x-1)/x+1). */ if ((e > 2) || (e < -2)) { if (x < sqrth) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x * x; r = ((((R5 * z + R4) * z + R3) * z + R2) * z + R1) * z + R0; s = (((((z + S5) * z + S4) * z + S3) * z + S2) * z + S1) * z + S0; z = x * (z * r / s); z = z + e * C2; z = z + x; z = z + e * C1; return (z); } /* Logarithm using log(1+x) = x - .5x^2 + x^3 P(x)/Q(x). */ if (x < sqrth) { e -= 1; if (e != 0) x = 2.0L * x - 1.0L; /* 2x - 1 */ else x = xm1; } else { if (e != 0) x = x - 1.0L; else x = xm1; } z = x * x; r = (((((((((((P12 * x + P11) * x + P10) * x + P9) * x + P8) * x + P7) * x + P6) * x + P5) * x + P4) * x + P3) * x + P2) * x + P1) * x + P0; s = (((((((((((x + Q11) * x + Q10) * x + Q9) * x + Q8) * x + Q7) * x + Q6) * x + Q5) * x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0; y = x * (z * r / s); y = y + e * C2; z = y - 0.5L * z; z = z + x; z = z + e * C1; return (z); } wcc-0.0.2/src/wsh/openlibm/ld128/s_modfl.c0000644000175000017500000000355513122010155016553 0ustar philphil/* @(#)s_modf.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * modfl(long double x, long double *iptr) * return fraction part of x, and return x's integral part in *iptr. * Method: * Bit twiddling. * * Exception: * No exception. */ #include #include "math_private.h" static const long double one = 1.0; long double modfl(long double x, long double *iptr) { int64_t i0,i1,jj0; u_int64_t i; GET_LDOUBLE_WORDS64(i0,i1,x); jj0 = ((i0>>48)&0x7fff)-0x3fff; /* exponent of x */ if(jj0<48) { /* integer part in high x */ if(jj0<0) { /* |x|<1 */ /* *iptr = +-0 */ SET_LDOUBLE_WORDS64(*iptr,i0&0x8000000000000000ULL,0); return x; } else { i = (0x0000ffffffffffffLL)>>jj0; if(((i0&i)|i1)==0) { /* x is integral */ *iptr = x; /* return +-0 */ SET_LDOUBLE_WORDS64(x,i0&0x8000000000000000ULL,0); return x; } else { SET_LDOUBLE_WORDS64(*iptr,i0&(~i),0); return x - *iptr; } } } else if (jj0>111) { /* no fraction part */ *iptr = x*one; /* We must handle NaNs separately. */ if (jj0 == 0x4000 && ((i0 & 0x0000ffffffffffffLL) | i1)) return x*one; /* return +-0 */ SET_LDOUBLE_WORDS64(x,i0&0x8000000000000000ULL,0); return x; } else { /* fraction part in low x */ i = -1ULL>>(jj0-48); if((i1&i)==0) { /* x is integral */ *iptr = x; /* return +-0 */ SET_LDOUBLE_WORDS64(x,i0&0x8000000000000000ULL,0); return x; } else { SET_LDOUBLE_WORDS64(*iptr,i0,i1&(~i)); return x - *iptr; } } } wcc-0.0.2/src/wsh/openlibm/ld128/s_truncl.c0000644000175000017500000000327513122010155016760 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * From: @(#)s_floor.c 5.1 93/09/24 */ /* * truncl(x) * Return x rounded toward 0 to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to truncl(x). */ #include #include #include #include #include #include "math_private.h" #ifdef LDBL_IMPLICIT_NBIT #define MANH_SIZE (EXT_FRACHBITS + EXT_FRACHMBITS + 1) #else #define MANH_SIZE (EXT_FRACHBITS + EXT_FRACHMBITS) #endif static const long double huge = 1.0e300; static const float zero[] = { 0.0, -0.0 }; long double truncl(long double x) { int e; int64_t ix0, ix1; GET_LDOUBLE_WORDS64(ix0,ix1,x); e = ((ix0>>48)&0x7fff) - LDBL_MAX_EXP + 1; if (e < MANH_SIZE - 1) { if (e < 0) { /* raise inexact if x != 0 */ if (huge + x > 0.0) return (zero[((ix0>>48)&0x8000)!=0]); } else { uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); if (((ix0 & m) | ix1) == 0) return (x); /* x is integral */ if (huge + x > 0.0) { /* raise inexact flag */ ix0 &= ~m; ix1 = 0; } } } else if (e < LDBL_MANT_DIG - 1) { uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); if ((ix1 & m) == 0) return (x); /* x is integral */ if (huge + x > 0.0) /* raise inexact flag */ ix1 &= ~m; } SET_LDOUBLE_WORDS64(x,ix0,ix1); return (x); } wcc-0.0.2/src/wsh/openlibm/ld128/e_coshl.c0000644000175000017500000000643013122010155016537 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* coshl(x) * Method : * mathematically coshl(x) if defined to be (exp(x)+exp(-x))/2 * 1. Replace x by |x| (coshl(x) = coshl(-x)). * 2. * [ exp(x) - 1 ]^2 * 0 <= x <= ln2/2 : coshl(x) := 1 + ------------------- * 2*exp(x) * * exp(x) + 1/exp(x) * ln2/2 <= x <= 22 : coshl(x) := ------------------- * 2 * 22 <= x <= lnovft : coshl(x) := expl(x)/2 * lnovft <= x <= ln2ovft: coshl(x) := expl(x/2)/2 * expl(x/2) * ln2ovft < x : coshl(x) := huge*huge (overflow) * * Special cases: * coshl(x) is |x| if x is +INF, -INF, or NaN. * only coshl(0)=1 is exact for finite x. */ #include #include "math_private.h" static const long double one = 1.0, half = 0.5, huge = 1.0e4900L, ovf_thresh = 1.1357216553474703894801348310092223067821E4L; long double coshl(long double x) { long double t, w; int32_t ex; ieee_quad_shape_type u; u.value = x; ex = u.parts32.mswhi & 0x7fffffff; /* Absolute value of x. */ u.parts32.mswhi = ex; /* x is INF or NaN */ if (ex >= 0x7fff0000) return x * x; /* |x| in [0,0.5*ln2], return 1+expm1l(|x|)^2/(2*expl(|x|)) */ if (ex < 0x3ffd62e4) /* 0.3465728759765625 */ { t = expm1l (u.value); w = one + t; if (ex < 0x3fb80000) /* |x| < 2^-116 */ return w; /* cosh(tiny) = 1 */ return one + (t * t) / (w + w); } /* |x| in [0.5*ln2,40], return (exp(|x|)+1/exp(|x|)/2; */ if (ex < 0x40044000) { t = expl (u.value); return half * t + half / t; } /* |x| in [22, ln(maxdouble)] return half*exp(|x|) */ if (ex <= 0x400c62e3) /* 11356.375 */ return half * expl (u.value); /* |x| in [log(maxdouble), overflowthresold] */ if (u.value <= ovf_thresh) { w = expl (half * u.value); t = half * w; return t * w; } /* |x| > overflowthresold, cosh(x) overflow */ return huge * huge; } wcc-0.0.2/src/wsh/openlibm/ld128/k_tanl.c0000644000175000017500000000727713122010155016405 0ustar philphil/* From: @(#)k_tan.c 1.5 04/04/22 SMI */ /* * ==================================================== * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld128/k_tanl.c,v 1.1 2008/02/17 07:32:31 das Exp $"); /* * ld128 version of k_tan.c. See ../src/k_tan.c for most comments. */ #include #include "math_private.h" /* * Domain [-0.67434, 0.67434], range ~[-3.37e-36, 1.982e-37] * |tan(x)/x - t(x)| < 2**-117.8 (XXX should be ~1e-37) * * See ../ld80/k_cosl.c for more details about the polynomial. */ static const long double T3 = 0x1.5555555555555555555555555553p-2L, T5 = 0x1.1111111111111111111111111eb5p-3L, T7 = 0x1.ba1ba1ba1ba1ba1ba1ba1b694cd6p-5L, T9 = 0x1.664f4882c10f9f32d6bbe09d8bcdp-6L, T11 = 0x1.226e355e6c23c8f5b4f5762322eep-7L, T13 = 0x1.d6d3d0e157ddfb5fed8e84e27b37p-9L, T15 = 0x1.7da36452b75e2b5fce9ee7c2c92ep-10L, T17 = 0x1.355824803674477dfcf726649efep-11L, T19 = 0x1.f57d7734d1656e0aceb716f614c2p-13L, T21 = 0x1.967e18afcb180ed942dfdc518d6cp-14L, T23 = 0x1.497d8eea21e95bc7e2aa79b9f2cdp-15L, T25 = 0x1.0b132d39f055c81be49eff7afd50p-16L, T27 = 0x1.b0f72d33eff7bfa2fbc1059d90b6p-18L, T29 = 0x1.5ef2daf21d1113df38d0fbc00267p-19L, T31 = 0x1.1c77d6eac0234988cdaa04c96626p-20L, T33 = 0x1.cd2a5a292b180e0bdd701057dfe3p-22L, T35 = 0x1.75c7357d0298c01a31d0a6f7d518p-23L, T37 = 0x1.2f3190f4718a9a520f98f50081fcp-24L, pio4 = 0x1.921fb54442d18469898cc51701b8p-1L, pio4lo = 0x1.cd129024e088a67cc74020bbea60p-116L; static const double T39 = 0.000000028443389121318352, /* 0x1e8a7592977938.0p-78 */ T41 = 0.000000011981013102001973, /* 0x19baa1b1223219.0p-79 */ T43 = 0.0000000038303578044958070, /* 0x107385dfb24529.0p-80 */ T45 = 0.0000000034664378216909893, /* 0x1dc6c702a05262.0p-81 */ T47 = -0.0000000015090641701997785, /* -0x19ecef3569ebb6.0p-82 */ T49 = 0.0000000029449552300483952, /* 0x194c0668da786a.0p-81 */ T51 = -0.0000000022006995706097711, /* -0x12e763b8845268.0p-81 */ T53 = 0.0000000015468200913196612, /* 0x1a92fc98c29554.0p-82 */ T55 = -0.00000000061311613386849674, /* -0x151106cbc779a9.0p-83 */ T57 = 1.4912469681508012e-10; /* 0x147edbdba6f43a.0p-85 */ long double __kernel_tanl(long double x, long double y, int iy) { long double z, r, v, w, s; long double osign; int i; iy = (iy == 1 ? -1 : 1); /* XXX recover original interface */ osign = (x >= 0 ? 1.0 : -1.0); /* XXX slow, probably wrong for -0 */ if (fabsl(x) >= 0.67434) { if (x < 0) { x = -x; y = -y; } z = pio4 - x; w = pio4lo - y; x = z + w; y = 0.0; i = 1; } else i = 0; z = x * x; w = z * z; r = T5 + w * (T9 + w * (T13 + w * (T17 + w * (T21 + w * (T25 + w * (T29 + w * (T33 + w * (T37 + w * (T41 + w * (T45 + w * (T49 + w * (T53 + w * T57)))))))))))); v = z * (T7 + w * (T11 + w * (T15 + w * (T19 + w * (T23 + w * (T27 + w * (T31 + w * (T35 + w * (T39 + w * (T43 + w * (T47 + w * (T51 + w * T55)))))))))))); s = z * x; r = y + z * (s * (r + v) + y); r += T3 * s; w = x + r; if (i == 1) { v = (long double) iy; return osign * (v - 2.0 * (x - (w * w / (w + v) - r))); } if (iy == 1) return w; else { /* * if allow error up to 2 ulp, simply return * -1.0 / (x+r) here */ /* compute -1.0 / (x+r) accurately */ long double a, t; z = w; z = z + 0x1p32 - 0x1p32; v = r - (z - x); /* z+v = r+x */ t = a = -1.0 / w; /* a = -1.0/w */ t = t + 0x1p32 - 0x1p32; s = 1.0 + t * z; return t + a * (s + t * v); } } wcc-0.0.2/src/wsh/openlibm/ld128/s_remquol.c0000644000175000017500000001101613122010155017125 0ustar philphil/* @(#)e_fmod.c 1.3 95/01/18 */ /*- * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include #include #include #include #include "math_private.h" #define BIAS (LDBL_MAX_EXP - 1) /* * These macros add and remove an explicit integer bit in front of the * fractional mantissa, if the architecture doesn't have such a bit by * default already. */ #ifdef LDBL_IMPLICIT_NBIT #define LDBL_NBIT 0 #define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) #define HFRAC_BITS (EXT_FRACHBITS + EXT_FRACHMBITS) #else #define LDBL_NBIT 0x80000000 #define SET_NBIT(hx) (hx) #define HFRAC_BITS (EXT_FRACHBITS + EXT_FRACHMBITS - 1) #endif #define MANL_SHIFT (EXT_FRACLMBITS + EXT_FRACLBITS - 1) static const long double Zero[] = {0.0L, -0.0L}; /* * Return the IEEE remainder and set *quo to the last n bits of the * quotient, rounded to the nearest integer. We choose n=31 because * we wind up computing all the integer bits of the quotient anyway as * a side-effect of computing the remainder by the shift and subtract * method. In practice, this is far more bits than are needed to use * remquo in reduction algorithms. * * Assumptions: * - The low part of the mantissa fits in a manl_t exactly. * - The high part of the mantissa fits in an int64_t with enough room * for an explicit integer bit in front of the fractional bits. */ long double remquol(long double x, long double y, int *quo) { int64_t hx,hz,hy,_hx; uint64_t lx,ly,lz; uint64_t sx,sxy; int ix,iy,n,q; GET_LDOUBLE_WORDS64(hx,lx,x); GET_LDOUBLE_WORDS64(hy,ly,y); sx = (hx>>48)&0x8000; sxy = sx ^ ((hy>>48)&0x8000); hx &= 0x7fffffffffffffffLL; /* |x| */ hy &= 0x7fffffffffffffffLL; /* |y| */ SET_LDOUBLE_WORDS64(x,hx,lx); SET_LDOUBLE_WORDS64(y,hy,ly); /* purge off exception values */ if((hy|ly)==0 || /* y=0 */ ((hx>>48) == BIAS + LDBL_MAX_EXP) || /* or x not finite */ ((hy>>48) == BIAS + LDBL_MAX_EXP && (((hy&0x0000ffffffffffffLL)&~LDBL_NBIT)|ly)!=0)) /* or y is NaN */ return (x*y)/(x*y); if((hx>>48)<=(hy>>48)) { if(((hx>>48)<(hy>>48)) || ((hx&0x0000ffffffffffffLL)<=(hy&0x0000ffffffffffffLL) && ((hx&0x0000ffffffffffffLL)<(hy&0x0000ffffffffffffLL) || lx>48) == 0) { /* subnormal x */ x *= 0x1.0p512; GET_LDOUBLE_WORDS64(hx,lx,x); ix = (hx>>48) - (BIAS + 512); } else { ix = (hx>>48) - BIAS; } /* determine iy = ilogb(y) */ if((hy>>48) == 0) { /* subnormal y */ y *= 0x1.0p512; GET_LDOUBLE_WORDS64(hy,ly,y); iy = (hy>>48) - (BIAS + 512); } else { iy = (hy>>48) - BIAS; } /* set up {hx,lx}, {hy,ly} and align y to x */ _hx = SET_NBIT(hx) & 0x0000ffffffffffffLL; hy = SET_NBIT(hy); /* fix point fmod */ n = ix - iy; q = 0; while(n--) { hz=_hx-hy;lz=lx-ly; if(lx>MANL_SHIFT); lx = lx+lx;} else {_hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; q++;} q <<= 1; } hz=_hx-hy;lz=lx-ly; if(lx=0) {_hx=hz;lx=lz;q++;} /* convert back to floating value and restore the sign */ if((_hx|lx)==0) { /* return sign(x)*0 */ *quo = (sxy ? -q : q); return Zero[sx!=0]; } while(_hx<(1ULL<>MANL_SHIFT); lx = lx+lx; iy -= 1; } hx = (hx&0xffff000000000000LL) | (_hx&0x0000ffffffffffffLL); if (iy < LDBL_MIN_EXP) { hx = (hx&0x0000ffffffffffffLL) | (uint64_t)(iy + BIAS + 512)<<48; SET_LDOUBLE_WORDS64(x,hx,lx); x *= 0x1p-512; GET_LDOUBLE_WORDS64(hx,lx,x); } else { hx = (hx&0x0000ffffffffffffLL) | (uint64_t)(iy + BIAS)<<48; } hx &= 0x7fffffffffffffffLL; SET_LDOUBLE_WORDS64(x,hx,lx); fixup: y = fabsl(y); if (y < LDBL_MIN * 2) { if (x+x>y || (x+x==y && (q & 1))) { q++; x-=y; } } else if (x>0.5*y || (x==0.5*y && (q & 1))) { q++; x-=y; } GET_LDOUBLE_MSW64(hx,x); hx ^= sx; SET_LDOUBLE_MSW64(x,hx); q &= 0x7fffffff; *quo = (sxy ? -q : q); return x; } wcc-0.0.2/src/wsh/openlibm/ld128/s_ceill.c0000644000175000017500000000326613122010155016541 0ustar philphil/* @(#)s_ceil.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * ceill(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to ceil(x). */ #include #include "math_private.h" static const long double huge = 1.0e4930L; long double ceill(long double x) { int64_t i0,i1,jj0; u_int64_t i,j; GET_LDOUBLE_WORDS64(i0,i1,x); jj0 = ((i0>>48)&0x7fff)-0x3fff; if(jj0<48) { if(jj0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ if(i0<0) {i0=0x8000000000000000ULL;i1=0;} else if((i0|i1)!=0) { i0=0x3fff000000000000ULL;i1=0;} } } else { i = (0x0000ffffffffffffULL)>>jj0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0>0) i0 += (0x0001000000000000LL)>>jj0; i0 &= (~i); i1=0; } } } else if (jj0>111) { if(jj0==0x4000) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = -1ULL>>(jj0-48); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0>0) { if(jj0==48) i0+=1; else { j = i1+(1LL<<(112-jj0)); if(j //#include #include #include #include #include "math_private.h" #define BIAS (LDBL_MAX_EXP - 1) /* * These macros add and remove an explicit integer bit in front of the * fractional mantissa, if the architecture doesn't have such a bit by * default already. */ #ifdef LDBL_IMPLICIT_NBIT #define LDBL_NBIT 0 #define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) #define HFRAC_BITS EXT_FRACHBITS #else #define LDBL_NBIT 0x80000000 #define SET_NBIT(hx) (hx) #define HFRAC_BITS (EXT_FRACHBITS - 1) #endif #define MANL_SHIFT (EXT_FRACLBITS - 1) static const long double one = 1.0, Zero[] = {0.0, -0.0,}; /* * fmodl(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract * * Assumptions: * - The low part of the mantissa fits in a manl_t exactly. * - The high part of the mantissa fits in an int64_t with enough room * for an explicit integer bit in front of the fractional bits. */ long double fmodl(long double x, long double y) { union { long double e; struct ieee_ext bits; } ux, uy; int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ uint32_t hy; uint32_t lx,ly,lz; int ix,iy,n,sx; ux.e = x; uy.e = y; sx = ux.bits.ext_sign; /* purge off exception values */ if((uy.bits.ext_exp|uy.bits.ext_frach|uy.bits.ext_fracl)==0 || /* y=0 */ (ux.bits.ext_exp == BIAS + LDBL_MAX_EXP) || /* or x not finite */ (uy.bits.ext_exp == BIAS + LDBL_MAX_EXP && ((uy.bits.ext_frach&~LDBL_NBIT)|uy.bits.ext_fracl)!=0)) /* or y is NaN */ return (x*y)/(x*y); if(ux.bits.ext_exp<=uy.bits.ext_exp) { if((ux.bits.ext_exp>MANL_SHIFT); lx = lx+lx;} else { if ((hz|lz)==0) /* return sign(x)*0 */ return Zero[sx]; hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; } } hz=hx-hy;lz=lx-ly; if(lx=0) {hx=hz;lx=lz;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) /* return sign(x)*0 */ return Zero[sx]; while(hx<(1ULL<>MANL_SHIFT); lx = lx+lx; iy -= 1; } ux.bits.ext_frach = hx; /* The mantissa is truncated here if needed. */ ux.bits.ext_fracl = lx; if (iy < LDBL_MIN_EXP) { ux.bits.ext_exp = iy + (BIAS + 512); ux.e *= 0x1p-512; } else { ux.bits.ext_exp = iy + BIAS; } x = ux.e * one; /* create necessary signal */ return x; /* exact output */ } wcc-0.0.2/src/wsh/openlibm/ld80/e_logl.c0000644000175000017500000001056713122010155016307 0ustar philphil/* $OpenBSD: e_logl.c,v 1.3 2013/11/12 20:35:19 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* logl.c * * Natural logarithm, long double precision * * * * SYNOPSIS: * * long double x, y, logl(); * * y = logl( x ); * * * * DESCRIPTION: * * Returns the base e (2.718...) logarithm of x. * * The argument is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the logarithm * of the fraction is approximated by * * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * log(x) = z + z**3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 150000 8.71e-20 2.75e-20 * IEEE exp(+-10000) 100000 5.39e-20 2.34e-20 * * In the tests over the interval exp(+-10000), the logarithms * of the random arguments were uniformly distributed over * [-10000, +10000]. * * ERROR MESSAGES: * * log singularity: x = 0; returns -INFINITY * log domain: x < 0; returns NAN */ #include #include "math_private.h" /* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 2.32e-20 */ static long double P[] = { 4.5270000862445199635215E-5L, 4.9854102823193375972212E-1L, 6.5787325942061044846969E0L, 2.9911919328553073277375E1L, 6.0949667980987787057556E1L, 5.7112963590585538103336E1L, 2.0039553499201281259648E1L, }; static long double Q[] = { /* 1.0000000000000000000000E0,*/ 1.5062909083469192043167E1L, 8.3047565967967209469434E1L, 2.2176239823732856465394E2L, 3.0909872225312059774938E2L, 2.1642788614495947685003E2L, 6.0118660497603843919306E1L, }; /* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 6.16e-22 */ static long double R[4] = { 1.9757429581415468984296E-3L, -7.1990767473014147232598E-1L, 1.0777257190312272158094E1L, -3.5717684488096787370998E1L, }; static long double S[4] = { /* 1.00000000000000000000E0L,*/ -2.6201045551331104417768E1L, 1.9361891836232102174846E2L, -4.2861221385716144629696E2L, }; static const long double C1 = 6.9314575195312500000000E-1L; static const long double C2 = 1.4286068203094172321215E-6L; #define SQRTH 0.70710678118654752440L long double logl(long double x) { long double y, z; int e; if( isnan(x) ) return(x); if( x == INFINITY ) return(x); /* Test for domain */ if( x <= 0.0L ) { if( x == 0.0L ) return( -INFINITY ); else return( NAN ); } /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl( x, &e ); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x*x; z = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); z = z + e * C2; z = z + x; z = z + e * C1; return( z ); } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ } else { x = x - 1.0L; } z = x*x; y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 6 ) ); y = y + e * C2; z = y - ldexpl( z, -1 ); /* y - 0.5 * z */ /* Note, the sum of above terms does not exceed x/4, * so it contributes at most about 1/4 lsb to the error. */ z = z + x; z = z + e * C1; /* This sum has an error of 1/2 lsb. */ return( z ); } wcc-0.0.2/src/wsh/openlibm/ld80/s_nextafterl.c0000644000175000017500000000441413122010155017536 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* IEEE functions * nextafterl(x,y) * return the next machine floating-point number of x in the * direction toward y. * Special cases: */ #include #include "math_private.h" long double nextafterl(long double x, long double y) { int32_t hx,hy,ix,iy; u_int32_t lx,ly,esx,esy; GET_LDOUBLE_WORDS(esx,hx,lx,x); GET_LDOUBLE_WORDS(esy,hy,ly,y); ix = esx&0x7fff; /* |x| */ iy = esy&0x7fff; /* |y| */ if (((ix==0x7fff)&&((hx&0x7fffffff|lx)!=0)) || /* x is nan */ ((iy==0x7fff)&&((hy&0x7fffffff|ly)!=0))) /* y is nan */ return x+y; if(x==y) return y; /* x=y, return y */ if((ix|hx|lx)==0) { /* x == 0 */ volatile long double u; SET_LDOUBLE_WORDS(x,esy&0x8000,0,1);/* return +-minsubnormal */ u = x; u = u * u; /* raise underflow flag */ return x; } if(esx<0x8000) { /* x > 0 */ if(ix>iy||((ix==iy) && (hx>hy||((hx==hy)&&(lx>ly))))) { /* x > y, x -= ulp */ if(lx==0) { if ((hx&0x7fffffff)==0) esx -= 1; hx = (hx - 1) | (hx & 0x80000000); } lx -= 1; } else { /* x < y, x += ulp */ lx += 1; if(lx==0) { hx = (hx + 1) | (hx & 0x80000000); if ((hx&0x7fffffff)==0) esx += 1; } } } else { /* x < 0 */ if(esy>=0||(ix>iy||((ix==iy)&&(hx>hy||((hx==hy)&&(lx>ly)))))){ /* x < y, x -= ulp */ if(lx==0) { if ((hx&0x7fffffff)==0) esx -= 1; hx = (hx - 1) | (hx & 0x80000000); } lx -= 1; } else { /* x > y, x += ulp */ lx += 1; if(lx==0) { hx = (hx + 1) | (hx & 0x80000000); if ((hx&0x7fffffff)==0) esx += 1; } } } esy = esx&0x7fff; if(esy==0x7fff) return x+x; /* overflow */ if(esy==0) { volatile long double u = x*x; /* underflow */ if(u==x) { SET_LDOUBLE_WORDS(x,esx,hx,lx); return x; } } SET_LDOUBLE_WORDS(x,esx,hx,lx); return x; } //__strong_alias(nexttowardl, nextafterl); wcc-0.0.2/src/wsh/openlibm/ld80/s_exp2l.c0000644000175000017500000002542313122010155016417 0ustar philphil/*- * Copyright (c) 2005-2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld80/s_exp2l.c,v 1.3 2008/02/13 10:44:44 bde Exp $"); #include #include #include "bsd_cdefs.h" #include "amd64/bsd_ieeefp.h" #include #include "math_private.h" #define TBLBITS 7 #define TBLSIZE (1 << TBLBITS) #define BIAS (LDBL_MAX_EXP - 1) #define EXPMASK (BIAS + LDBL_MAX_EXP) static const long double huge = 0x1p10000L; #if 0 /* XXX Prevent gcc from erroneously constant folding this. */ static const long double twom10000 = 0x1p-10000L; #else static volatile long double twom10000 = 0x1p-10000L; #endif static const double redux = 0x1.8p63 / TBLSIZE, P1 = 0x1.62e42fefa39efp-1, P2 = 0x1.ebfbdff82c58fp-3, P3 = 0x1.c6b08d7049fap-5, P4 = 0x1.3b2ab6fba4da5p-7, P5 = 0x1.5d8804780a736p-10, P6 = 0x1.430918835e33dp-13; static const double tbl[TBLSIZE * 2] = { 0x1.6a09e667f3bcdp-1, -0x1.bdd3413b2648p-55, 0x1.6c012750bdabfp-1, -0x1.2895667ff0cp-57, 0x1.6dfb23c651a2fp-1, -0x1.bbe3a683c88p-58, 0x1.6ff7df9519484p-1, -0x1.83c0f25860fp-56, 0x1.71f75e8ec5f74p-1, -0x1.16e4786887bp-56, 0x1.73f9a48a58174p-1, -0x1.0a8d96c65d5p-55, 0x1.75feb564267c9p-1, -0x1.0245957316ep-55, 0x1.780694fde5d3fp-1, 0x1.866b80a0216p-55, 0x1.7a11473eb0187p-1, -0x1.41577ee0499p-56, 0x1.7c1ed0130c132p-1, 0x1.f124cd1164ep-55, 0x1.7e2f336cf4e62p-1, 0x1.05d02ba157ap-57, 0x1.80427543e1a12p-1, -0x1.27c86626d97p-55, 0x1.82589994cce13p-1, -0x1.d4c1dd41533p-55, 0x1.8471a4623c7adp-1, -0x1.8d684a341cep-56, 0x1.868d99b4492edp-1, -0x1.fc6f89bd4f68p-55, 0x1.88ac7d98a6699p-1, 0x1.994c2f37cb5p-55, 0x1.8ace5422aa0dbp-1, 0x1.6e9f156864bp-55, 0x1.8cf3216b5448cp-1, -0x1.0d55e32e9e4p-57, 0x1.8f1ae99157736p-1, 0x1.5cc13a2e397p-56, 0x1.9145b0b91ffc6p-1, -0x1.dd6792e5825p-55, 0x1.93737b0cdc5e5p-1, -0x1.75fc781b58p-58, 0x1.95a44cbc8520fp-1, -0x1.64b7c96a5fp-57, 0x1.97d829fde4e5p-1, -0x1.d185b7c1b86p-55, 0x1.9a0f170ca07bap-1, -0x1.173bd91cee6p-55, 0x1.9c49182a3f09p-1, 0x1.c7c46b071f2p-57, 0x1.9e86319e32323p-1, 0x1.824ca78e64cp-57, 0x1.a0c667b5de565p-1, -0x1.359495d1cd5p-55, 0x1.a309bec4a2d33p-1, 0x1.6305c7ddc368p-55, 0x1.a5503b23e255dp-1, -0x1.d2f6edb8d42p-55, 0x1.a799e1330b358p-1, 0x1.bcb7ecac564p-55, 0x1.a9e6b5579fdbfp-1, 0x1.0fac90ef7fdp-55, 0x1.ac36bbfd3f37ap-1, -0x1.f9234cae76dp-56, 0x1.ae89f995ad3adp-1, 0x1.7a1cd345dcc8p-55, 0x1.b0e07298db666p-1, -0x1.bdef54c80e4p-55, 0x1.b33a2b84f15fbp-1, -0x1.2805e3084d8p-58, 0x1.b59728de5593ap-1, -0x1.c71dfbbba6ep-55, 0x1.b7f76f2fb5e47p-1, -0x1.5584f7e54acp-57, 0x1.ba5b030a1064ap-1, -0x1.efcd30e5429p-55, 0x1.bcc1e904bc1d2p-1, 0x1.23dd07a2d9fp-56, 0x1.bf2c25bd71e09p-1, -0x1.efdca3f6b9c8p-55, 0x1.c199bdd85529cp-1, 0x1.11065895049p-56, 0x1.c40ab5fffd07ap-1, 0x1.b4537e083c6p-55, 0x1.c67f12e57d14bp-1, 0x1.2884dff483c8p-55, 0x1.c8f6d9406e7b5p-1, 0x1.1acbc48805cp-57, 0x1.cb720dcef9069p-1, 0x1.503cbd1e94ap-57, 0x1.cdf0b555dc3fap-1, -0x1.dd83b53829dp-56, 0x1.d072d4a07897cp-1, -0x1.cbc3743797a8p-55, 0x1.d2f87080d89f2p-1, -0x1.d487b719d858p-55, 0x1.d5818dcfba487p-1, 0x1.2ed02d75b37p-56, 0x1.d80e316c98398p-1, -0x1.11ec18bedep-55, 0x1.da9e603db3285p-1, 0x1.c2300696db5p-55, 0x1.dd321f301b46p-1, 0x1.2da5778f019p-55, 0x1.dfc97337b9b5fp-1, -0x1.1a5cd4f184b8p-55, 0x1.e264614f5a129p-1, -0x1.7b627817a148p-55, 0x1.e502ee78b3ff6p-1, 0x1.39e8980a9cdp-56, 0x1.e7a51fbc74c83p-1, 0x1.2d522ca0c8ep-55, 0x1.ea4afa2a490dap-1, -0x1.e9c23179c288p-55, 0x1.ecf482d8e67f1p-1, -0x1.c93f3b411ad8p-55, 0x1.efa1bee615a27p-1, 0x1.dc7f486a4b68p-55, 0x1.f252b376bba97p-1, 0x1.3a1a5bf0d8e8p-55, 0x1.f50765b6e454p-1, 0x1.9d3e12dd8a18p-55, 0x1.f7bfdad9cbe14p-1, -0x1.dbb12d00635p-55, 0x1.fa7c1819e90d8p-1, 0x1.74853f3a593p-56, 0x1.fd3c22b8f71f1p-1, 0x1.2eb74966578p-58, 0x1p+0, 0x0p+0, 0x1.0163da9fb3335p+0, 0x1.b61299ab8cd8p-54, 0x1.02c9a3e778061p+0, -0x1.19083535b08p-56, 0x1.04315e86e7f85p+0, -0x1.0a31c1977c98p-54, 0x1.059b0d3158574p+0, 0x1.d73e2a475b4p-55, 0x1.0706b29ddf6dep+0, -0x1.c91dfe2b13cp-55, 0x1.0874518759bc8p+0, 0x1.186be4bb284p-57, 0x1.09e3ecac6f383p+0, 0x1.14878183161p-54, 0x1.0b5586cf9890fp+0, 0x1.8a62e4adc61p-54, 0x1.0cc922b7247f7p+0, 0x1.01edc16e24f8p-54, 0x1.0e3ec32d3d1a2p+0, 0x1.03a1727c58p-59, 0x1.0fb66affed31bp+0, -0x1.b9bedc44ebcp-57, 0x1.11301d0125b51p+0, -0x1.6c51039449bp-54, 0x1.12abdc06c31ccp+0, -0x1.1b514b36ca8p-58, 0x1.1429aaea92dep+0, -0x1.32fbf9af1368p-54, 0x1.15a98c8a58e51p+0, 0x1.2406ab9eeabp-55, 0x1.172b83c7d517bp+0, -0x1.19041b9d78ap-55, 0x1.18af9388c8deap+0, -0x1.11023d1970f8p-54, 0x1.1a35beb6fcb75p+0, 0x1.e5b4c7b4969p-55, 0x1.1bbe084045cd4p+0, -0x1.95386352ef6p-54, 0x1.1d4873168b9aap+0, 0x1.e016e00a264p-54, 0x1.1ed5022fcd91dp+0, -0x1.1df98027bb78p-54, 0x1.2063b88628cd6p+0, 0x1.dc775814a85p-55, 0x1.21f49917ddc96p+0, 0x1.2a97e9494a6p-55, 0x1.2387a6e756238p+0, 0x1.9b07eb6c7058p-54, 0x1.251ce4fb2a63fp+0, 0x1.ac155bef4f5p-55, 0x1.26b4565e27cddp+0, 0x1.2bd339940eap-55, 0x1.284dfe1f56381p+0, -0x1.a4c3a8c3f0d8p-54, 0x1.29e9df51fdee1p+0, 0x1.612e8afad12p-55, 0x1.2b87fd0dad99p+0, -0x1.10adcd6382p-59, 0x1.2d285a6e4030bp+0, 0x1.0024754db42p-54, 0x1.2ecafa93e2f56p+0, 0x1.1ca0f45d524p-56, 0x1.306fe0a31b715p+0, 0x1.6f46ad23183p-55, 0x1.32170fc4cd831p+0, 0x1.a9ce78e1804p-55, 0x1.33c08b26416ffp+0, 0x1.327218436598p-54, 0x1.356c55f929ff1p+0, -0x1.b5cee5c4e46p-55, 0x1.371a7373aa9cbp+0, -0x1.63aeabf42ebp-54, 0x1.38cae6d05d866p+0, -0x1.e958d3c99048p-54, 0x1.3a7db34e59ff7p+0, -0x1.5e436d661f6p-56, 0x1.3c32dc313a8e5p+0, -0x1.efff8375d2ap-54, 0x1.3dea64c123422p+0, 0x1.ada0911f09fp-55, 0x1.3fa4504ac801cp+0, -0x1.7d023f956fap-54, 0x1.4160a21f72e2ap+0, -0x1.ef3691c309p-58, 0x1.431f5d950a897p+0, -0x1.1c7dde35f7ap-55, 0x1.44e086061892dp+0, 0x1.89b7a04ef8p-59, 0x1.46a41ed1d0057p+0, 0x1.c944bd1648a8p-54, 0x1.486a2b5c13cdp+0, 0x1.3c1a3b69062p-56, 0x1.4a32af0d7d3dep+0, 0x1.9cb62f3d1be8p-54, 0x1.4bfdad5362a27p+0, 0x1.d4397afec42p-56, 0x1.4dcb299fddd0dp+0, 0x1.8ecdbbc6a78p-54, 0x1.4f9b2769d2ca7p+0, -0x1.4b309d25958p-54, 0x1.516daa2cf6642p+0, -0x1.f768569bd94p-55, 0x1.5342b569d4f82p+0, -0x1.07abe1db13dp-55, 0x1.551a4ca5d920fp+0, -0x1.d689cefede6p-55, 0x1.56f4736b527dap+0, 0x1.9bb2c011d938p-54, 0x1.58d12d497c7fdp+0, 0x1.295e15b9a1ep-55, 0x1.5ab07dd485429p+0, 0x1.6324c0546478p-54, 0x1.5c9268a5946b7p+0, 0x1.c4b1b81698p-60, 0x1.5e76f15ad2148p+0, 0x1.ba6f93080e68p-54, 0x1.605e1b976dc09p+0, -0x1.3e2429b56de8p-54, 0x1.6247eb03a5585p+0, -0x1.383c17e40b48p-54, 0x1.6434634ccc32p+0, -0x1.c483c759d89p-55, 0x1.6623882552225p+0, -0x1.bb60987591cp-54, 0x1.68155d44ca973p+0, 0x1.038ae44f74p-57, }; /* * exp2l(x): compute the base 2 exponential of x * * Accuracy: Peak error < 0.511 ulp. * * Method: (equally-spaced tables) * * Reduce x: * x = 2**k + y, for integer k and |y| <= 1/2. * Thus we have exp2l(x) = 2**k * exp2(y). * * Reduce y: * y = i/TBLSIZE + z for integer i near y * TBLSIZE. * Thus we have exp2(y) = exp2(i/TBLSIZE) * exp2(z), * with |z| <= 2**-(TBLBITS+1). * * We compute exp2(i/TBLSIZE) via table lookup and exp2(z) via a * degree-6 minimax polynomial with maximum error under 2**-69. * The table entries each have 104 bits of accuracy, encoded as * a pair of double precision values. */ OLM_DLLEXPORT long double exp2l(long double x) { union IEEEl2bits u, v; long double r, twopk, twopkp10000, z; uint32_t hx, ix, i0; int k; /* Filter out exceptional cases. */ u.e = x; hx = u.xbits.expsign; ix = hx & EXPMASK; if (ix >= BIAS + 14) { /* |x| >= 16384 or x is NaN */ if (ix == BIAS + LDBL_MAX_EXP) { if (u.xbits.man != 1ULL << 63 || (hx & 0x8000) == 0) return (x + x); /* x is +Inf or NaN */ else return (0.0); /* x is -Inf */ } if (x >= 16384) return (huge * huge); /* overflow */ if (x <= -16446) return (twom10000 * twom10000); /* underflow */ } else if (ix <= BIAS - 66) { /* |x| < 0x1p-66 */ return (1.0 + x); } #ifdef __i386__ /* * The default precision on i386 is 53 bits, so long doubles are * broken. Call exp2() to get an accurate (double precision) result. */ if (__fpgetprec() != FP_PE) return (exp2(x)); #endif /* * Reduce x, computing z, i0, and k. The low bits of x + redux * contain the 16-bit integer part of the exponent (k) followed by * TBLBITS fractional bits (i0). We use bit tricks to extract these * as integers, then set z to the remainder. * * Example: Suppose x is 0xabc.123456p0 and TBLBITS is 8. * Then the low-order word of x + redux is 0x000abc12, * We split this into k = 0xabc and i0 = 0x12 (adjusted to * index into the table), then we compute z = 0x0.003456p0. * * XXX If the exponent is negative, the computation of k depends on * '>>' doing sign extension. */ u.e = x + redux; i0 = u.bits.manl + TBLSIZE / 2; k = (int)i0 >> TBLBITS; i0 = (i0 & (TBLSIZE - 1)) << 1; u.e -= redux; z = x - u.e; v.xbits.man = 1ULL << 63; if (k >= LDBL_MIN_EXP) { v.xbits.expsign = LDBL_MAX_EXP - 1 + k; twopk = v.e; } else { v.xbits.expsign = LDBL_MAX_EXP - 1 + k + 10000; twopkp10000 = v.e; } /* Compute r = exp2l(y) = exp2lt[i0] * p(z). */ long double t_hi = tbl[i0]; long double t_lo = tbl[i0 + 1]; /* XXX This gives > 1 ulp errors outside of FE_TONEAREST mode */ r = t_lo + (t_hi + t_lo) * z * (P1 + z * (P2 + z * (P3 + z * (P4 + z * (P5 + z * P6))))) + t_hi; /* Scale by 2**k. */ if (k >= LDBL_MIN_EXP) { if (k == LDBL_MAX_EXP) return (r * 2.0 * 0x1p16383L); return (r * twopk); } else { return (r * twopkp10000 * twom10000); } } wcc-0.0.2/src/wsh/openlibm/ld80/e_log2l.c0000644000175000017500000001060613122010155016363 0ustar philphil/* $OpenBSD: e_log2l.c,v 1.2 2013/11/12 20:35:19 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* log2l.c * * Base 2 logarithm, long double precision * * * * SYNOPSIS: * * long double x, y, log2l(); * * y = log2l( x ); * * * * DESCRIPTION: * * Returns the base 2 logarithm of x. * * The argument is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the (natural) * logarithm of the fraction is approximated by * * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * log(x) = z + z**3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 30000 9.8e-20 2.7e-20 * IEEE exp(+-10000) 70000 5.4e-20 2.3e-20 * * In the tests over the interval exp(+-10000), the logarithms * of the random arguments were uniformly distributed over * [-10000, +10000]. * * ERROR MESSAGES: * * log singularity: x = 0; returns -INFINITY * log domain: x < 0; returns NAN */ #include #include "math_private.h" /* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 6.2e-22 */ static long double P[] = { 4.9962495940332550844739E-1L, 1.0767376367209449010438E1L, 7.7671073698359539859595E1L, 2.5620629828144409632571E2L, 4.2401812743503691187826E2L, 3.4258224542413922935104E2L, 1.0747524399916215149070E2L, }; static long double Q[] = { /* 1.0000000000000000000000E0,*/ 2.3479774160285863271658E1L, 1.9444210022760132894510E2L, 7.7952888181207260646090E2L, 1.6911722418503949084863E3L, 2.0307734695595183428202E3L, 1.2695660352705325274404E3L, 3.2242573199748645407652E2L, }; /* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 6.16e-22 */ static long double R[4] = { 1.9757429581415468984296E-3L, -7.1990767473014147232598E-1L, 1.0777257190312272158094E1L, -3.5717684488096787370998E1L, }; static long double S[4] = { /* 1.00000000000000000000E0L,*/ -2.6201045551331104417768E1L, 1.9361891836232102174846E2L, -4.2861221385716144629696E2L, }; /* log2(e) - 1 */ #define LOG2EA 4.4269504088896340735992e-1L #define SQRTH 0.70710678118654752440L long double log2l(long double x) { volatile long double z; long double y; int e; if( isnan(x) ) return(x); if( x == INFINITY ) return(x); /* Test for domain */ if( x <= 0.0L ) { if( x == 0.0L ) return( -INFINITY ); else return( NAN ); } /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl( x, &e ); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x*x; y = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); goto done; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ } else { x = x - 1.0L; } z = x*x; y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 7 ) ); y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */ done: /* Multiply log of fraction by log2(e) * and base 2 exponent by 1 * * ***CAUTION*** * * This sequence of operations is critical and it may * be horribly defeated by some compiler optimizers. */ z = y * LOG2EA; z += x * LOG2EA; z += y; z += x; z += e; return( z ); } wcc-0.0.2/src/wsh/openlibm/ld80/s_floorl.c0000644000175000017500000000340413122010155016655 0ustar philphil/* @(#)s_floor.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * floorl(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to floor(x). */ #include #include "math_private.h" static const long double huge = 1.0e4930L; long double floorl(long double x) { int32_t i1,jj0; u_int32_t i,j,se,i0,sx; GET_LDOUBLE_WORDS(se,i0,i1,x); sx = (se>>15)&1; jj0 = (se&0x7fff)-0x3fff; if(jj0<31) { if(jj0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) { if(sx==0) return 0.0L; else if(((se&0x7fff)|i0|i1)!=0) return -1.0L; } } else { i = (0x7fffffff)>>jj0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(sx) { if (jj0>0 && (i0+(0x80000000>>jj0))>i0) i0 += (0x80000000)>>jj0; else { i = 0x7fffffff; ++se; } } i0 &= (~i); i1=0; } } } else if (jj0>62) { if(jj0==0x4000) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(jj0-31); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(sx) { if(jj0==31) i0+=1; else { j = i1+(1<<(63-jj0)); if(j * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/ld80/invtrig.h,v 1.2 2008/08/02 03:56:22 das Exp $ */ #include #include #define BIAS (LDBL_MAX_EXP - 1) #define MANH_SIZE LDBL_MANH_SIZE /* Approximation thresholds. */ #define ASIN_LINEAR (BIAS - 32) /* 2**-32 */ #define ACOS_CONST (BIAS - 65) /* 2**-65 */ #define ATAN_CONST (BIAS + 65) /* 2**65 */ #define ATAN_LINEAR (BIAS - 32) /* 2**-32 */ /* 0.95 */ #define THRESH ((0xe666666666666666ULL>>(64-(MANH_SIZE-1)))|LDBL_NBIT) /* Constants shared by the long double inverse trig functions. */ #define pS0 _ItL_pS0 #define pS1 _ItL_pS1 #define pS2 _ItL_pS2 #define pS3 _ItL_pS3 #define pS4 _ItL_pS4 #define pS5 _ItL_pS5 #define pS6 _ItL_pS6 #define qS1 _ItL_qS1 #define qS2 _ItL_qS2 #define qS3 _ItL_qS3 #define qS4 _ItL_qS4 #define qS5 _ItL_qS5 #define atanhi _ItL_atanhi #define atanlo _ItL_atanlo #define aT _ItL_aT #define pi_lo _ItL_pi_lo #define pio2_hi atanhi[3] #define pio2_lo atanlo[3] #define pio4_hi atanhi[1] #ifdef STRUCT_DECLS typedef struct longdouble { uint64_t mant; uint16_t expsign; } LONGDOUBLE; #else typedef long double LONGDOUBLE; #endif extern const LONGDOUBLE pS0, pS1, pS2, pS3, pS4, pS5, pS6; extern const LONGDOUBLE qS1, qS2, qS3, qS4, qS5; extern const LONGDOUBLE atanhi[], atanlo[], aT[]; extern const LONGDOUBLE pi_lo; #ifndef STRUCT_DECLS static inline long double P(long double x) { return (x * (pS0 + x * (pS1 + x * (pS2 + x * (pS3 + x * \ (pS4 + x * (pS5 + x * pS6))))))); } static inline long double Q(long double x) { return (1.0 + x * (qS1 + x * (qS2 + x * (qS3 + x * (qS4 + x * qS5))))); } static inline long double T_even(long double x) { return (aT[0] + x * (aT[2] + x * (aT[4] + x * (aT[6] + x * \ (aT[8] + x * (aT[10] + x * aT[12])))))); } static inline long double T_odd(long double x) { return (aT[1] + x * (aT[3] + x * (aT[5] + x * (aT[7] + x * \ (aT[9] + x * aT[11]))))); } #endif wcc-0.0.2/src/wsh/openlibm/ld80/e_hypotl.c0000644000175000017500000000640013122010155016660 0ustar philphil/* @(#)e_hypot.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* hypotl(x,y) * * Method : * If (assume round-to-nearest) z=x*x+y*y * has error less than sqrt(2)/2 ulp, than * sqrt(z) has error less than 1 ulp (exercise). * * So, compute sqrt(x*x+y*y) with some care as * follows to get the error below 1 ulp: * * Assume x>y>0; * (if possible, set rounding to round-to-nearest) * 1. if x > 2y use * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y * where x1 = x with lower 32 bits cleared, x2 = x-x1; else * 2. if x <= 2y use * t1*yy1+((x-y)*(x-y)+(t1*y2+t2*y)) * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1, * yy1= y with lower 32 bits chopped, y2 = y-yy1. * * NOTE: scaling may be necessary if some argument is too * large or too tiny * * Special cases: * hypot(x,y) is INF if x or y is +INF or -INF; else * hypot(x,y) is NAN if x or y is NAN. * * Accuracy: * hypot(x,y) returns sqrt(x^2+y^2) with error less * than 1 ulps (units in the last place) */ #include #include "math_private.h" long double hypotl(long double x, long double y) { long double a,b,t1,t2,yy1,y2,w; u_int32_t j,k,ea,eb; GET_LDOUBLE_EXP(ea,x); ea &= 0x7fff; GET_LDOUBLE_EXP(eb,y); eb &= 0x7fff; if(eb > ea) {a=y;b=x;j=ea; ea=eb;eb=j;} else {a=x;b=y;} SET_LDOUBLE_EXP(a,ea); /* a <- |a| */ SET_LDOUBLE_EXP(b,eb); /* b <- |b| */ if((ea-eb)>0x46) {return a+b;} /* x/y > 2**70 */ k=0; if(ea > 0x5f3f) { /* a>2**8000 */ if(ea == 0x7fff) { /* Inf or NaN */ u_int32_t es,high,low; w = a+b; /* for sNaN */ GET_LDOUBLE_WORDS(es,high,low,a); if(((high&0x7fffffff)|low)==0) w = a; GET_LDOUBLE_WORDS(es,high,low,b); if(((eb^0x7fff)|(high&0x7fffffff)|low)==0) w = b; return w; } /* scale a and b by 2**-9600 */ ea -= 0x2580; eb -= 0x2580; k += 9600; SET_LDOUBLE_EXP(a,ea); SET_LDOUBLE_EXP(b,eb); } if(eb < 0x20bf) { /* b < 2**-8000 */ if(eb == 0) { /* subnormal b or 0 */ u_int32_t es,high,low; GET_LDOUBLE_WORDS(es,high,low,b); if((high|low)==0) return a; SET_LDOUBLE_WORDS(t1, 0x7ffd, 0, 0); /* t1=2^16382 */ b *= t1; a *= t1; k -= 16382; } else { /* scale a and b by 2^9600 */ ea += 0x2580; /* a *= 2^9600 */ eb += 0x2580; /* b *= 2^9600 */ k -= 9600; SET_LDOUBLE_EXP(a,ea); SET_LDOUBLE_EXP(b,eb); } } /* medium size a and b */ w = a-b; if (w>b) { u_int32_t high; GET_LDOUBLE_MSW(high,a); SET_LDOUBLE_WORDS(t1,ea,high,0); t2 = a-t1; w = sqrtl(t1*t1-(b*(-b)-t2*(a+t1))); } else { u_int32_t high; GET_LDOUBLE_MSW(high,b); a = a+a; SET_LDOUBLE_WORDS(yy1,eb,high,0); y2 = b - yy1; GET_LDOUBLE_MSW(high,a); SET_LDOUBLE_WORDS(t1,ea+1,high,0); t2 = a - t1; w = sqrtl(t1*yy1-(w*(-w)-(t1*y2+t2*b))); } if(k!=0) { u_int32_t es; t1 = 1.0; GET_LDOUBLE_EXP(es,t1); SET_LDOUBLE_EXP(t1,es+k); return t1*w; } else return w; } wcc-0.0.2/src/wsh/openlibm/ld80/s_nanl.c0000644000175000017500000000327613122010155016317 0ustar philphil/*- * Copyright (c) 2007 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $FreeBSD: src/lib/msun/ld80/s_nanl.c,v 1.2 2007/12/18 23:46:31 das Exp $ */ #include #include "math_private.h" OLM_DLLEXPORT long double nanl(const char *s) { union { union IEEEl2bits ieee; uint32_t bits[3]; } u; __scan_nan(u.bits, 3, s); u.ieee.bits.exp = 0x7fff; u.ieee.bits.manh |= 0xc0000000; /* make it a quiet NaN */ return (u.ieee.e); } wcc-0.0.2/src/wsh/openlibm/ld80/s_asinhl.c0000644000175000017500000000304513122010155016637 0ustar philphil/* @(#)s_asinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* asinhl(x) * Method : * Based on * asinhl(x) = signl(x) * logl [ |x| + sqrtl(x*x+1) ] * we have * asinhl(x) := x if 1+x*x=1, * := signl(x)*(logl(x)+ln2)) for large |x|, else * := signl(x)*logl(2|x|+1/(|x|+sqrtl(x*x+1))) if|x|>2, else * := signl(x)*log1pl(|x| + x^2/(1 + sqrtl(1+x^2))) */ #include #include "math_private.h" static const long double one = 1.000000000000000000000e+00L, /* 0x3FFF, 0x00000000, 0x00000000 */ ln2 = 6.931471805599453094287e-01L, /* 0x3FFE, 0xB17217F7, 0xD1CF79AC */ huge= 1.000000000000000000e+4900L; long double asinhl(long double x) { long double t,w; int32_t hx,ix; GET_LDOUBLE_EXP(hx,x); ix = hx&0x7fff; if(ix==0x7fff) return x+x; /* x is inf or NaN */ if(ix< 0x3fde) { /* |x|<2**-34 */ if(huge+x>one) return x; /* return x inexact except 0 */ } if(ix>0x4020) { /* |x| > 2**34 */ w = logl(fabsl(x))+ln2; } else if (ix>0x4000) { /* 2**34 > |x| > 2.0 */ t = fabsl(x); w = logl(2.0*t+one/(sqrtl(x*x+one)+t)); } else { /* 2.0 > |x| > 2**-28 */ t = x*x; w =log1pl(fabsl(x)+t/(one+sqrtl(one+t))); } if(hx&0x8000) return -w; else return w; } wcc-0.0.2/src/wsh/openlibm/ld80/s_tanhl.c0000644000175000017500000000406213122010155016467 0ustar philphil/* @(#)s_tanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* tanhl(x) * Return the Hyperbolic Tangent of x * * Method : * x -x * e - e * 0. tanhl(x) is defined to be ----------- * x -x * e + e * 1. reduce x to non-negative by tanhl(-x) = -tanhl(x). * 2. 0 <= x <= 2**-55 : tanhl(x) := x*(one+x) * -t * 2**-55 < x <= 1 : tanhl(x) := -----; t = expm1l(-2x) * t + 2 * 2 * 1 <= x <= 23.0 : tanhl(x) := 1- ----- ; t=expm1l(2x) * t + 2 * 23.0 < x <= INF : tanhl(x) := 1. * * Special cases: * tanhl(NaN) is NaN; * only tanhl(0)=0 is exact for finite argument. */ #include #include "math_private.h" static const long double one=1.0, two=2.0, tiny = 1.0e-4900L; long double tanhl(long double x) { long double t,z; int32_t se; u_int32_t jj0,jj1,ix; /* High word of |x|. */ GET_LDOUBLE_WORDS(se,jj0,jj1,x); ix = se&0x7fff; /* x is INF or NaN */ if(ix==0x7fff) { /* for NaN it's not important which branch: tanhl(NaN) = NaN */ if (se&0x8000) return one/x-one; /* tanhl(-inf)= -1; */ else return one/x+one; /* tanhl(+inf)=+1 */ } /* |x| < 23 */ if (ix < 0x4003 || (ix == 0x4003 && jj0 < 0xb8000000u)) {/* |x|<23 */ if ((ix|jj0|jj1) == 0) return x; /* x == +- 0 */ if (ix<0x3fc8) /* |x|<2**-55 */ return x*(one+tiny); /* tanh(small) = small */ if (ix>=0x3fff) { /* |x|>=1 */ t = expm1l(two*fabsl(x)); z = one - two/(t+two); } else { t = expm1l(-two*fabsl(x)); z= -t/(t+two); } /* |x| > 23, return +-1 */ } else { z = one - tiny; /* raised inexact flag */ } return (se&0x8000)? -z: z; } wcc-0.0.2/src/wsh/openlibm/ld80/k_sinl.c0000644000175000017500000000373313122010155016322 0ustar philphil/* From: @(#)k_sin.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld80/k_sinl.c,v 1.1 2008/02/17 07:32:14 das Exp $"); /* * ld80 version of k_sin.c. See ../src/k_sin.c for most comments. */ #include "math_private.h" static const double half = 0.5; /* * Domain [-0.7854, 0.7854], range ~[-1.89e-22, 1.915e-22] * |sin(x)/x - s(x)| < 2**-72.1 * * See ../ld80/k_cosl.c for more details about the polynomial. */ #if defined(__amd64__) || defined(__i386__) /* Long double constants are slow on these arches, and broken on i386. */ static const volatile double S1hi = -0.16666666666666666, /* -0x15555555555555.0p-55 */ S1lo = -9.2563760475949941e-18; /* -0x15580000000000.0p-109 */ #define S1 ((long double)S1hi + S1lo) #else static const long double S1 = -0.166666666666666666671L; /* -0xaaaaaaaaaaaaaaab.0p-66 */ #endif static const double S2 = 0.0083333333333333332, /* 0x11111111111111.0p-59 */ S3 = -0.00019841269841269427, /* -0x1a01a01a019f81.0p-65 */ S4 = 0.0000027557319223597490, /* 0x171de3a55560f7.0p-71 */ S5 = -0.000000025052108218074604, /* -0x1ae64564f16cad.0p-78 */ S6 = 1.6059006598854211e-10, /* 0x161242b90243b5.0p-85 */ S7 = -7.6429779983024564e-13, /* -0x1ae42ebd1b2e00.0p-93 */ S8 = 2.6174587166648325e-15; /* 0x179372ea0b3f64.0p-101 */ long double __kernel_sinl(long double x, long double y, int iy) { long double z,r,v; z = x*x; v = z*x; r = S2+z*(S3+z*(S4+z*(S5+z*(S6+z*(S7+z*S8))))); if(iy==0) return x+v*(S1+z*r); else return x-((z*(half*y-v*r)-y)-v*S1); } wcc-0.0.2/src/wsh/openlibm/ld80/e_expl.c0000644000175000017500000000670313122010155016317 0ustar philphil/* $OpenBSD: e_expl.c,v 1.3 2013/11/12 20:35:19 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* expl.c * * Exponential function, long double precision * * * * SYNOPSIS: * * long double x, y, expl(); * * y = expl( x ); * * * * DESCRIPTION: * * Returns e (2.71828...) raised to the x power. * * Range reduction is accomplished by separating the argument * into an integer k and fraction f such that * * x k f * e = 2 e. * * A Pade' form of degree 2/3 is used to approximate exp(f) - 1 * in the basic range [-0.5 ln 2, 0.5 ln 2]. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE +-10000 50000 1.12e-19 2.81e-20 * * * Error amplification in the exponential function can be * a serious matter. The error propagation involves * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), * which shows that a 1 lsb error in representing X produces * a relative error of X times 1 lsb in the function. * While the routine gives an accurate result for arguments * that are exactly represented by a long double precision * computer number, the result contains amplified roundoff * error for large arguments not exactly represented. * * * ERROR MESSAGES: * * message condition value returned * exp underflow x < MINLOG 0.0 * exp overflow x > MAXLOG MAXNUM * */ /* Exponential function */ #include #include "math_private.h" static long double P[3] = { 1.2617719307481059087798E-4L, 3.0299440770744196129956E-2L, 9.9999999999999999991025E-1L, }; static long double Q[4] = { 3.0019850513866445504159E-6L, 2.5244834034968410419224E-3L, 2.2726554820815502876593E-1L, 2.0000000000000000000897E0L, }; static const long double C1 = 6.9314575195312500000000E-1L; static const long double C2 = 1.4286068203094172321215E-6L; static const long double MAXLOGL = 1.1356523406294143949492E4L; static const long double MINLOGL = -1.13994985314888605586758E4L; static const long double LOG2EL = 1.4426950408889634073599E0L; long double expl(long double x) { long double px, xx; int n; if( isnan(x) ) return(x); if( x > MAXLOGL) return( INFINITY ); if( x < MINLOGL ) return(0.0L); /* Express e**x = e**g 2**n * = e**g e**( n loge(2) ) * = e**( g + n loge(2) ) */ px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */ n = px; x -= px * C1; x -= px * C2; /* rational approximation for exponential * of the fractional part: * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) */ xx = x * x; px = x * __polevll( xx, P, 2 ); x = px/( __polevll( xx, Q, 3 ) - px ); x = 1.0L + ldexpl( x, 1 ); x = ldexpl( x, n ); return(x); } wcc-0.0.2/src/wsh/openlibm/ld80/e_rem_pio2l.h0000644000175000017500000001116213122010155017237 0ustar philphil/* From: @(#)e_rem_pio2.c 1.4 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * Optimized by Bruce D. Evans. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld80/e_rem_pio2l.h,v 1.3 2011/06/18 13:56:33 benl Exp $"); /* ld80 version of __ieee754_rem_pio2l(x,y) * * return the remainder of x rem pi/2 in y[0]+y[1] * use __kernel_rem_pio2() */ #include #include #include "math_private.h" #define BIAS (LDBL_MAX_EXP - 1) /* * invpio2: 64 bits of 2/pi * pio2_1: first 39 bits of pi/2 * pio2_1t: pi/2 - pio2_1 * pio2_2: second 39 bits of pi/2 * pio2_2t: pi/2 - (pio2_1+pio2_2) * pio2_3: third 39 bits of pi/2 * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3) */ static const double zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */ pio2_1 = 1.57079632679597125389e+00, /* 0x3FF921FB, 0x54444000 */ pio2_2 = -1.07463465549783099519e-12, /* -0x12e7b967674000.0p-92 */ pio2_3 = 6.36831716351370313614e-25; /* 0x18a2e037074000.0p-133 */ #if defined(__amd64__) || defined(__i386__) /* Long double constants are slow on these arches, and broken on i386. */ static const volatile double invpio2hi = 6.3661977236758138e-01, /* 0x145f306dc9c883.0p-53 */ invpio2lo = -3.9356538861223811e-17, /* -0x16b00000000000.0p-107 */ pio2_1thi = -1.0746346554971943e-12, /* -0x12e7b9676733af.0p-92 */ pio2_1tlo = 8.8451028997905949e-29, /* 0x1c080000000000.0p-146 */ pio2_2thi = 6.3683171635109499e-25, /* 0x18a2e03707344a.0p-133 */ pio2_2tlo = 2.3183081793789774e-41, /* 0x10280000000000.0p-187 */ pio2_3thi = -2.7529965190440717e-37, /* -0x176b7ed8fbbacc.0p-174 */ pio2_3tlo = -4.2006647512740502e-54; /* -0x19c00000000000.0p-230 */ #define invpio2 ((long double)invpio2hi + invpio2lo) #define pio2_1t ((long double)pio2_1thi + pio2_1tlo) #define pio2_2t ((long double)pio2_2thi + pio2_2tlo) #define pio2_3t ((long double)pio2_3thi + pio2_3tlo) #else static const long double invpio2 = 6.36619772367581343076e-01L, /* 0xa2f9836e4e44152a.0p-64 */ pio2_1t = -1.07463465549719416346e-12L, /* -0x973dcb3b399d747f.0p-103 */ pio2_2t = 6.36831716351095013979e-25L, /* 0xc51701b839a25205.0p-144 */ pio2_3t = -2.75299651904407171810e-37L; /* -0xbb5bf6c7ddd660ce.0p-185 */ #endif //VBS //static inline __always_inline int //__ieee754_rem_pio2l(long double x, long double *y) static inline int __ieee754_rem_pio2l(long double x, long double *y) { union IEEEl2bits u,u1; long double z,w,t,r,fn; double tx[3],ty[2]; int e0,ex,i,j,nx,n; int16_t expsign; u.e = x; expsign = u.xbits.expsign; ex = expsign & 0x7fff; if (ex < BIAS + 25 || (ex == BIAS + 25 && u.bits.manh < 0xc90fdaa2)) { /* |x| ~< 2^25*(pi/2), medium size */ /* Use a specialized rint() to get fn. Assume round-to-nearest. */ fn = x*invpio2+0x1.8p63; fn = fn-0x1.8p63; #ifdef HAVE_EFFICIENT_IRINT n = irint(fn); #else n = fn; #endif r = x-fn*pio2_1; w = fn*pio2_1t; /* 1st round good to 102 bit */ { union IEEEl2bits u2; int ex1; j = ex; y[0] = r-w; u2.e = y[0]; ex1 = u2.xbits.expsign & 0x7fff; i = j-ex1; if(i>22) { /* 2nd iteration needed, good to 141 */ t = r; w = fn*pio2_2; r = t-w; w = fn*pio2_2t-((t-r)-w); y[0] = r-w; u2.e = y[0]; ex1 = u2.xbits.expsign & 0x7fff; i = j-ex1; if(i>61) { /* 3rd iteration need, 180 bits acc */ t = r; /* will cover all possible cases */ w = fn*pio2_3; r = t-w; w = fn*pio2_3t-((t-r)-w); y[0] = r-w; } } } y[1] = (r-y[0])-w; return n; } /* * all other (large) arguments */ if(ex==0x7fff) { /* x is inf or NaN */ y[0]=y[1]=x-x; return 0; } /* set z = scalbn(|x|,ilogb(x)-23) */ u1.e = x; e0 = ex - BIAS - 23; /* e0 = ilogb(|x|)-23; */ u1.xbits.expsign = ex - e0; z = u1.e; for(i=0;i<2;i++) { tx[i] = (double)((int32_t)(z)); z = (z-tx[i])*two24; } tx[2] = z; nx = 3; while(tx[nx-1]==zero) nx--; /* skip zero term */ n = __kernel_rem_pio2(tx,ty,e0,nx,2); r = (long double)ty[0] + ty[1]; w = ty[1] - (r - ty[0]); if(expsign<0) {y[0] = -r; y[1] = -w; return -n;} y[0] = r; y[1] = w; return n; } wcc-0.0.2/src/wsh/openlibm/ld80/s_nexttowardf.c0000644000175000017500000000331313122010155017724 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include #include "math_private.h" float nexttowardf(float x, long double y) { int32_t hx,ix,iy; u_int32_t hy,ly,esy; GET_FLOAT_WORD(hx,x); GET_LDOUBLE_WORDS(esy,hy,ly,y); ix = hx&0x7fffffff; /* |x| */ iy = esy&0x7fff; /* |y| */ if((ix>0x7f800000) || /* x is nan */ (iy>=0x7fff&&((hy|ly)!=0))) /* y is nan */ return x+y; if((long double) x==y) return y; /* x=y, return y */ if(ix==0) { /* x == 0 */ volatile float u; SET_FLOAT_WORD(x,((esy&0x8000)<<16)|1);/* return +-minsub*/ u = x; u = u * u; /* raise underflow flag */ return x; } if(hx>=0) { /* x > 0 */ if(esy>=0x8000||((ix>>23)&0xff)>iy-0x3f80 || (((ix>>23)&0xff)==iy-0x3f80 && ((ix&0x7fffff)<<8)>(hy&0x7fffffff))) {/* x > y, x -= ulp */ hx -= 1; } else { /* x < y, x += ulp */ hx += 1; } } else { /* x < 0 */ if(esy<0x8000||((ix>>23)&0xff)>iy-0x3f80 || (((ix>>23)&0xff)==iy-0x3f80 && ((ix&0x7fffff)<<8)>(hy&0x7fffffff))) {/* x < y, x -= ulp */ hx -= 1; } else { /* x > y, x += ulp */ hx += 1; } } hy = hx&0x7f800000; if(hy>=0x7f800000) { x = x+x; /* overflow */ return x; } if(hy<0x00800000) { volatile float u = x*x; /* underflow */ } SET_FLOAT_WORD(x,hx); return x; } wcc-0.0.2/src/wsh/openlibm/ld80/s_erfl.c0000644000175000017500000003316413122010155016316 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* double erf(double x) * double erfc(double x) * x * 2 |\ * erf(x) = --------- | exp(-t*t)dt * sqrt(pi) \| * 0 * * erfc(x) = 1-erf(x) * Note that * erf(-x) = -erf(x) * erfc(-x) = 2 - erfc(x) * * Method: * 1. For |x| in [0, 0.84375] * erf(x) = x + x*R(x^2) * erfc(x) = 1 - erf(x) if x in [-.84375,0.25] * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375] * Remark. The formula is derived by noting * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....) * and that * 2/sqrt(pi) = 1.128379167095512573896158903121545171688 * is close to one. The interval is chosen because the fix * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is * near 0.6174), and by some experiment, 0.84375 is chosen to * guarantee the error is less than one ulp for erf. * * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and * c = 0.84506291151 rounded to single (24 bits) * erf(x) = sign(x) * (c + P1(s)/Q1(s)) * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0 * 1+(c+P1(s)/Q1(s)) if x < 0 * Remark: here we use the taylor series expansion at x=1. * erf(1+s) = erf(1) + s*Poly(s) * = 0.845.. + P1(s)/Q1(s) * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25] * * 3. For x in [1.25,1/0.35(~2.857143)], * erfc(x) = (1/x)*exp(-x*x-0.5625+R1(z)/S1(z)) * z=1/x^2 * erf(x) = 1 - erfc(x) * * 4. For x in [1/0.35,107] * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0 * = 2.0 - (1/x)*exp(-x*x-0.5625+R2(z)/S2(z)) * if -6.666 x >= 107 * erf(x) = sign(x) *(1 - tiny) (raise inexact) * erfc(x) = tiny*tiny (raise underflow) if x > 0 * = 2 - tiny if x<0 * * 7. Special case: * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, * erfc/erf(NaN) is NaN */ #include #include "math_private.h" static const long double tiny = 1e-4931L, half = 0.5L, one = 1.0L, two = 2.0L, /* c = (float)0.84506291151 */ erx = 0.845062911510467529296875L, /* * Coefficients for approximation to erf on [0,0.84375] */ /* 2/sqrt(pi) - 1 */ efx = 1.2837916709551257389615890312154517168810E-1L, /* 8 * (2/sqrt(pi) - 1) */ efx8 = 1.0270333367641005911692712249723613735048E0L, pp[6] = { 1.122751350964552113068262337278335028553E6L, -2.808533301997696164408397079650699163276E6L, -3.314325479115357458197119660818768924100E5L, -6.848684465326256109712135497895525446398E4L, -2.657817695110739185591505062971929859314E3L, -1.655310302737837556654146291646499062882E2L, }, qq[6] = { 8.745588372054466262548908189000448124232E6L, 3.746038264792471129367533128637019611485E6L, 7.066358783162407559861156173539693900031E5L, 7.448928604824620999413120955705448117056E4L, 4.511583986730994111992253980546131408924E3L, 1.368902937933296323345610240009071254014E2L, /* 1.000000000000000000000000000000000000000E0 */ }, /* * Coefficients for approximation to erf in [0.84375,1.25] */ /* erf(x+1) = 0.845062911510467529296875 + pa(x)/qa(x) -0.15625 <= x <= +.25 Peak relative error 8.5e-22 */ pa[8] = { -1.076952146179812072156734957705102256059E0L, 1.884814957770385593365179835059971587220E2L, -5.339153975012804282890066622962070115606E1L, 4.435910679869176625928504532109635632618E1L, 1.683219516032328828278557309642929135179E1L, -2.360236618396952560064259585299045804293E0L, 1.852230047861891953244413872297940938041E0L, 9.394994446747752308256773044667843200719E-2L, }, qa[7] = { 4.559263722294508998149925774781887811255E2L, 3.289248982200800575749795055149780689738E2L, 2.846070965875643009598627918383314457912E2L, 1.398715859064535039433275722017479994465E2L, 6.060190733759793706299079050985358190726E1L, 2.078695677795422351040502569964299664233E1L, 4.641271134150895940966798357442234498546E0L, /* 1.000000000000000000000000000000000000000E0 */ }, /* * Coefficients for approximation to erfc in [1.25,1/0.35] */ /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + ra(x^2)/sa(x^2)) 1/2.85711669921875 < 1/x < 1/1.25 Peak relative error 3.1e-21 */ ra[] = { 1.363566591833846324191000679620738857234E-1L, 1.018203167219873573808450274314658434507E1L, 1.862359362334248675526472871224778045594E2L, 1.411622588180721285284945138667933330348E3L, 5.088538459741511988784440103218342840478E3L, 8.928251553922176506858267311750789273656E3L, 7.264436000148052545243018622742770549982E3L, 2.387492459664548651671894725748959751119E3L, 2.220916652813908085449221282808458466556E2L, }, sa[] = { -1.382234625202480685182526402169222331847E1L, -3.315638835627950255832519203687435946482E2L, -2.949124863912936259747237164260785326692E3L, -1.246622099070875940506391433635999693661E4L, -2.673079795851665428695842853070996219632E4L, -2.880269786660559337358397106518918220991E4L, -1.450600228493968044773354186390390823713E4L, -2.874539731125893533960680525192064277816E3L, -1.402241261419067750237395034116942296027E2L, /* 1.000000000000000000000000000000000000000E0 */ }, /* * Coefficients for approximation to erfc in [1/.35,107] */ /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rb(x^2)/sb(x^2)) 1/6.6666259765625 < 1/x < 1/2.85711669921875 Peak relative error 4.2e-22 */ rb[] = { -4.869587348270494309550558460786501252369E-5L, -4.030199390527997378549161722412466959403E-3L, -9.434425866377037610206443566288917589122E-2L, -9.319032754357658601200655161585539404155E-1L, -4.273788174307459947350256581445442062291E0L, -8.842289940696150508373541814064198259278E0L, -7.069215249419887403187988144752613025255E0L, -1.401228723639514787920274427443330704764E0L, }, sb[] = { 4.936254964107175160157544545879293019085E-3L, 1.583457624037795744377163924895349412015E-1L, 1.850647991850328356622940552450636420484E0L, 9.927611557279019463768050710008450625415E0L, 2.531667257649436709617165336779212114570E1L, 2.869752886406743386458304052862814690045E1L, 1.182059497870819562441683560749192539345E1L, /* 1.000000000000000000000000000000000000000E0 */ }, /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rc(x^2)/sc(x^2)) 1/107 <= 1/x <= 1/6.6666259765625 Peak relative error 1.1e-21 */ rc[] = { -8.299617545269701963973537248996670806850E-5L, -6.243845685115818513578933902532056244108E-3L, -1.141667210620380223113693474478394397230E-1L, -7.521343797212024245375240432734425789409E-1L, -1.765321928311155824664963633786967602934E0L, -1.029403473103215800456761180695263439188E0L, }, sc[] = { 8.413244363014929493035952542677768808601E-3L, 2.065114333816877479753334599639158060979E-1L, 1.639064941530797583766364412782135680148E0L, 4.936788463787115555582319302981666347450E0L, 5.005177727208955487404729933261347679090E0L, /* 1.000000000000000000000000000000000000000E0 */ }; long double erfl(long double x) { long double R, S, P, Q, s, y, z, r; int32_t ix, i; u_int32_t se, i0, i1; GET_LDOUBLE_WORDS (se, i0, i1, x); ix = se & 0x7fff; if (ix >= 0x7fff) { /* erf(nan)=nan */ i = ((se & 0xffff) >> 15) << 1; return (long double) (1 - i) + one / x; /* erf(+-inf)=+-1 */ } ix = (ix << 16) | (i0 >> 16); if (ix < 0x3ffed800) /* |x|<0.84375 */ { if (ix < 0x3fde8000) /* |x|<2**-33 */ { if (ix < 0x00080000) return 0.125 * (8.0 * x + efx8 * x); /*avoid underflow */ return x + efx * x; } z = x * x; r = pp[0] + z * (pp[1] + z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); s = qq[0] + z * (qq[1] + z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); y = r / s; return x + x * y; } if (ix < 0x3fffa000) /* 1.25 */ { /* 0.84375 <= |x| < 1.25 */ s = fabsl (x) - one; P = pa[0] + s * (pa[1] + s * (pa[2] + s * (pa[3] + s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7])))))); Q = qa[0] + s * (qa[1] + s * (qa[2] + s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s)))))); if ((se & 0x8000) == 0) return erx + P / Q; else return -erx - P / Q; } if (ix >= 0x4001d555) /* 6.6666259765625 */ { /* inf>|x|>=6.666 */ if ((se & 0x8000) == 0) return one - tiny; else return tiny - one; } x = fabsl (x); s = one / (x * x); if (ix < 0x4000b6db) /* 2.85711669921875 */ { R = ra[0] + s * (ra[1] + s * (ra[2] + s * (ra[3] + s * (ra[4] + s * (ra[5] + s * (ra[6] + s * (ra[7] + s * ra[8]))))))); S = sa[0] + s * (sa[1] + s * (sa[2] + s * (sa[3] + s * (sa[4] + s * (sa[5] + s * (sa[6] + s * (sa[7] + s * (sa[8] + s)))))))); } else { /* |x| >= 1/0.35 */ R = rb[0] + s * (rb[1] + s * (rb[2] + s * (rb[3] + s * (rb[4] + s * (rb[5] + s * (rb[6] + s * rb[7])))))); S = sb[0] + s * (sb[1] + s * (sb[2] + s * (sb[3] + s * (sb[4] + s * (sb[5] + s * (sb[6] + s)))))); } z = x; GET_LDOUBLE_WORDS (i, i0, i1, z); i1 = 0; SET_LDOUBLE_WORDS (z, i, i0, i1); r = expl (-z * z - 0.5625) * expl ((z - x) * (z + x) + R / S); if ((se & 0x8000) == 0) return one - r / x; else return r / x - one; } long double erfcl(long double x) { int32_t hx, ix; long double R, S, P, Q, s, y, z, r; u_int32_t se, i0, i1; GET_LDOUBLE_WORDS (se, i0, i1, x); ix = se & 0x7fff; if (ix >= 0x7fff) { /* erfc(nan)=nan */ /* erfc(+-inf)=0,2 */ return (long double) (((se & 0xffff) >> 15) << 1) + one / x; } ix = (ix << 16) | (i0 >> 16); if (ix < 0x3ffed800) /* |x|<0.84375 */ { if (ix < 0x3fbe0000) /* |x|<2**-65 */ return one - x; z = x * x; r = pp[0] + z * (pp[1] + z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); s = qq[0] + z * (qq[1] + z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); y = r / s; if (ix < 0x3ffd8000) /* x<1/4 */ { return one - (x + x * y); } else { r = x * y; r += (x - half); return half - r; } } if (ix < 0x3fffa000) /* 1.25 */ { /* 0.84375 <= |x| < 1.25 */ s = fabsl (x) - one; P = pa[0] + s * (pa[1] + s * (pa[2] + s * (pa[3] + s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7])))))); Q = qa[0] + s * (qa[1] + s * (qa[2] + s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s)))))); if ((se & 0x8000) == 0) { z = one - erx; return z - P / Q; } else { z = erx + P / Q; return one + z; } } if (ix < 0x4005d600) /* 107 */ { /* |x|<107 */ x = fabsl (x); s = one / (x * x); if (ix < 0x4000b6db) /* 2.85711669921875 */ { /* |x| < 1/.35 ~ 2.857143 */ R = ra[0] + s * (ra[1] + s * (ra[2] + s * (ra[3] + s * (ra[4] + s * (ra[5] + s * (ra[6] + s * (ra[7] + s * ra[8]))))))); S = sa[0] + s * (sa[1] + s * (sa[2] + s * (sa[3] + s * (sa[4] + s * (sa[5] + s * (sa[6] + s * (sa[7] + s * (sa[8] + s)))))))); } else if (ix < 0x4001d555) /* 6.6666259765625 */ { /* 6.666 > |x| >= 1/.35 ~ 2.857143 */ R = rb[0] + s * (rb[1] + s * (rb[2] + s * (rb[3] + s * (rb[4] + s * (rb[5] + s * (rb[6] + s * rb[7])))))); S = sb[0] + s * (sb[1] + s * (sb[2] + s * (sb[3] + s * (sb[4] + s * (sb[5] + s * (sb[6] + s)))))); } else { /* |x| >= 6.666 */ if (se & 0x8000) return two - tiny; /* x < -6.666 */ R = rc[0] + s * (rc[1] + s * (rc[2] + s * (rc[3] + s * (rc[4] + s * rc[5])))); S = sc[0] + s * (sc[1] + s * (sc[2] + s * (sc[3] + s * (sc[4] + s)))); } z = x; GET_LDOUBLE_WORDS (hx, i0, i1, z); i1 = 0; i0 &= 0xffffff00; SET_LDOUBLE_WORDS (z, hx, i0, i1); r = expl (-z * z - 0.5625) * expl ((z - x) * (z + x) + R / S); if ((se & 0x8000) == 0) return r / x; else return two - r / x; } else { if ((se & 0x8000) == 0) return tiny * tiny; else return two - tiny; } } wcc-0.0.2/src/wsh/openlibm/ld80/e_lgammal_r.c0000644000175000017500000003032513122010155017277 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* lgammal_r(x, signgamp) * Reentrant version of the logarithm of the Gamma function * with user provide pointer for the sign of Gamma(x). * * Method: * 1. Argument Reduction for 0 < x <= 8 * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may * reduce x to a number in [1.5,2.5] by * lgamma(1+s) = log(s) + lgamma(s) * for example, * lgamma(7.3) = log(6.3) + lgamma(6.3) * = log(6.3*5.3) + lgamma(5.3) * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3) * 2. Polynomial approximation of lgamma around its * minimun ymin=1.461632144968362245 to maintain monotonicity. * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use * Let z = x-ymin; * lgamma(x) = -1.214862905358496078218 + z^2*poly(z) * 2. Rational approximation in the primary interval [2,3] * We use the following approximation: * s = x-2.0; * lgamma(x) = 0.5*s + s*P(s)/Q(s) * Our algorithms are based on the following observation * * zeta(2)-1 2 zeta(3)-1 3 * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ... * 2 3 * * where Euler = 0.5771... is the Euler constant, which is very * close to 0.5. * * 3. For x>=8, we have * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+.... * (better formula: * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...) * Let z = 1/x, then we approximation * f(z) = lgamma(x) - (x-0.5)(log(x)-1) * by * 3 5 11 * w = w0 + w1*z + w2*z + w3*z + ... + w6*z * * 4. For negative x, since (G is gamma function) * -x*G(-x)*G(x) = pi/sin(pi*x), * we have * G(x) = pi/(sin(pi*x)*(-x)*G(-x)) * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0 * Hence, for x<0, signgam = sign(sin(pi*x)) and * lgamma(x) = log(|Gamma(x)|) * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x); * Note: one should avoid compute pi*(-x) directly in the * computation of sin(pi*(-x)). * * 5. Special Cases * lgamma(2+s) ~ s*(1-Euler) for tiny s * lgamma(1)=lgamma(2)=0 * lgamma(x) ~ -log(x) for tiny x * lgamma(0) = lgamma(inf) = inf * lgamma(-integer) = +-inf * */ #include #include "math_private.h" static const long double half = 0.5L, one = 1.0L, pi = 3.14159265358979323846264L, two63 = 9.223372036854775808e18L, /* lgam(1+x) = 0.5 x + x a(x)/b(x) -0.268402099609375 <= x <= 0 peak relative error 6.6e-22 */ a0 = -6.343246574721079391729402781192128239938E2L, a1 = 1.856560238672465796768677717168371401378E3L, a2 = 2.404733102163746263689288466865843408429E3L, a3 = 8.804188795790383497379532868917517596322E2L, a4 = 1.135361354097447729740103745999661157426E2L, a5 = 3.766956539107615557608581581190400021285E0L, b0 = 8.214973713960928795704317259806842490498E3L, b1 = 1.026343508841367384879065363925870888012E4L, b2 = 4.553337477045763320522762343132210919277E3L, b3 = 8.506975785032585797446253359230031874803E2L, b4 = 6.042447899703295436820744186992189445813E1L, /* b5 = 1.000000000000000000000000000000000000000E0 */ tc = 1.4616321449683623412626595423257213284682E0L, tf = -1.2148629053584961146050602565082954242826E-1,/* double precision */ /* tt = (tail of tf), i.e. tf + tt has extended precision. */ tt = 3.3649914684731379602768989080467587736363E-18L, /* lgam ( 1.4616321449683623412626595423257213284682E0 ) = -1.2148629053584960809551455717769158215135617312999903886372437313313530E-1 */ /* lgam (x + tc) = tf + tt + x g(x)/h(x) - 0.230003726999612341262659542325721328468 <= x <= 0.2699962730003876587373404576742786715318 peak relative error 2.1e-21 */ g0 = 3.645529916721223331888305293534095553827E-18L, g1 = 5.126654642791082497002594216163574795690E3L, g2 = 8.828603575854624811911631336122070070327E3L, g3 = 5.464186426932117031234820886525701595203E3L, g4 = 1.455427403530884193180776558102868592293E3L, g5 = 1.541735456969245924860307497029155838446E2L, g6 = 4.335498275274822298341872707453445815118E0L, h0 = 1.059584930106085509696730443974495979641E4L, h1 = 2.147921653490043010629481226937850618860E4L, h2 = 1.643014770044524804175197151958100656728E4L, h3 = 5.869021995186925517228323497501767586078E3L, h4 = 9.764244777714344488787381271643502742293E2L, h5 = 6.442485441570592541741092969581997002349E1L, /* h6 = 1.000000000000000000000000000000000000000E0 */ /* lgam (x+1) = -0.5 x + x u(x)/v(x) -0.100006103515625 <= x <= 0.231639862060546875 peak relative error 1.3e-21 */ u0 = -8.886217500092090678492242071879342025627E1L, u1 = 6.840109978129177639438792958320783599310E2L, u2 = 2.042626104514127267855588786511809932433E3L, u3 = 1.911723903442667422201651063009856064275E3L, u4 = 7.447065275665887457628865263491667767695E2L, u5 = 1.132256494121790736268471016493103952637E2L, u6 = 4.484398885516614191003094714505960972894E0L, v0 = 1.150830924194461522996462401210374632929E3L, v1 = 3.399692260848747447377972081399737098610E3L, v2 = 3.786631705644460255229513563657226008015E3L, v3 = 1.966450123004478374557778781564114347876E3L, v4 = 4.741359068914069299837355438370682773122E2L, v5 = 4.508989649747184050907206782117647852364E1L, /* v6 = 1.000000000000000000000000000000000000000E0 */ /* lgam (x+2) = .5 x + x s(x)/r(x) 0 <= x <= 1 peak relative error 7.2e-22 */ s0 = 1.454726263410661942989109455292824853344E6L, s1 = -3.901428390086348447890408306153378922752E6L, s2 = -6.573568698209374121847873064292963089438E6L, s3 = -3.319055881485044417245964508099095984643E6L, s4 = -7.094891568758439227560184618114707107977E5L, s5 = -6.263426646464505837422314539808112478303E4L, s6 = -1.684926520999477529949915657519454051529E3L, r0 = -1.883978160734303518163008696712983134698E7L, r1 = -2.815206082812062064902202753264922306830E7L, r2 = -1.600245495251915899081846093343626358398E7L, r3 = -4.310526301881305003489257052083370058799E6L, r4 = -5.563807682263923279438235987186184968542E5L, r5 = -3.027734654434169996032905158145259713083E4L, r6 = -4.501995652861105629217250715790764371267E2L, /* r6 = 1.000000000000000000000000000000000000000E0 */ /* lgam(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x w(1/x^2) x >= 8 Peak relative error 1.51e-21 w0 = LS2PI - 0.5 */ w0 = 4.189385332046727417803e-1L, w1 = 8.333333333333331447505E-2L, w2 = -2.777777777750349603440E-3L, w3 = 7.936507795855070755671E-4L, w4 = -5.952345851765688514613E-4L, w5 = 8.412723297322498080632E-4L, w6 = -1.880801938119376907179E-3L, w7 = 4.885026142432270781165E-3L; static const long double zero = 0.0L; static long double sin_pi(long double x) { long double y, z; int n, ix; u_int32_t se, i0, i1; GET_LDOUBLE_WORDS (se, i0, i1, x); ix = se & 0x7fff; ix = (ix << 16) | (i0 >> 16); if (ix < 0x3ffd8000) /* 0.25 */ return sinl (pi * x); y = -x; /* x is assume negative */ /* * argument reduction, make sure inexact flag not raised if input * is an integer */ z = floorl (y); if (z != y) { /* inexact anyway */ y *= 0.5; y = 2.0*(y - floorl(y)); /* y = |x| mod 2.0 */ n = (int) (y*4.0); } else { if (ix >= 0x403f8000) /* 2^64 */ { y = zero; n = 0; /* y must be even */ } else { if (ix < 0x403e8000) /* 2^63 */ z = y + two63; /* exact */ GET_LDOUBLE_WORDS (se, i0, i1, z); n = i1 & 1; y = n; n <<= 2; } } switch (n) { case 0: y = sinl (pi * y); break; case 1: case 2: y = cosl (pi * (half - y)); break; case 3: case 4: y = sinl (pi * (one - y)); break; case 5: case 6: y = -cosl (pi * (y - 1.5)); break; default: y = sinl (pi * (y - 2.0)); break; } return -y; } long double lgammal_r(long double x, int *signgamp) { long double t, y, z, nadj, p, p1, p2, q, r, w; int i, ix; u_int32_t se, i0, i1; *signgamp = 1; GET_LDOUBLE_WORDS (se, i0, i1, x); ix = se & 0x7fff; if ((ix | i0 | i1) == 0) { if (se & 0x8000) *signgamp = -1; return one / fabsl (x); } ix = (ix << 16) | (i0 >> 16); /* purge off +-inf, NaN, +-0, and negative arguments */ if (ix >= 0x7fff0000) return x * x; if (ix < 0x3fc08000) /* 2^-63 */ { /* |x|<2**-63, return -log(|x|) */ if (se & 0x8000) { *signgamp = -1; return -logl (-x); } else return -logl (x); } if (se & 0x8000) { t = sin_pi (x); if (t == zero) return one / fabsl (t); /* -integer */ nadj = logl (pi / fabsl (t * x)); if (t < zero) *signgamp = -1; x = -x; } /* purge off 1 and 2 */ if ((((ix - 0x3fff8000) | i0 | i1) == 0) || (((ix - 0x40008000) | i0 | i1) == 0)) r = 0; else if (ix < 0x40008000) /* 2.0 */ { /* x < 2.0 */ if (ix <= 0x3ffee666) /* 8.99993896484375e-1 */ { /* lgamma(x) = lgamma(x+1) - log(x) */ r = -logl (x); if (ix >= 0x3ffebb4a) /* 7.31597900390625e-1 */ { y = x - one; i = 0; } else if (ix >= 0x3ffced33)/* 2.31639862060546875e-1 */ { y = x - (tc - one); i = 1; } else { /* x < 0.23 */ y = x; i = 2; } } else { r = zero; if (ix >= 0x3fffdda6) /* 1.73162841796875 */ { /* [1.7316,2] */ y = x - 2.0; i = 0; } else if (ix >= 0x3fff9da6)/* 1.23162841796875 */ { /* [1.23,1.73] */ y = x - tc; i = 1; } else { /* [0.9, 1.23] */ y = x - one; i = 2; } } switch (i) { case 0: p1 = a0 + y * (a1 + y * (a2 + y * (a3 + y * (a4 + y * a5)))); p2 = b0 + y * (b1 + y * (b2 + y * (b3 + y * (b4 + y)))); r += half * y + y * p1/p2; break; case 1: p1 = g0 + y * (g1 + y * (g2 + y * (g3 + y * (g4 + y * (g5 + y * g6))))); p2 = h0 + y * (h1 + y * (h2 + y * (h3 + y * (h4 + y * (h5 + y))))); p = tt + y * p1/p2; r += (tf + p); break; case 2: p1 = y * (u0 + y * (u1 + y * (u2 + y * (u3 + y * (u4 + y * (u5 + y * u6)))))); p2 = v0 + y * (v1 + y * (v2 + y * (v3 + y * (v4 + y * (v5 + y))))); r += (-half * y + p1 / p2); } } else if (ix < 0x40028000) /* 8.0 */ { /* x < 8.0 */ i = (int) x; t = zero; y = x - (double) i; p = y * (s0 + y * (s1 + y * (s2 + y * (s3 + y * (s4 + y * (s5 + y * s6)))))); q = r0 + y * (r1 + y * (r2 + y * (r3 + y * (r4 + y * (r5 + y * (r6 + y)))))); r = half * y + p / q; z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ switch (i) { case 7: z *= (y + 6.0); /* FALLTHRU */ case 6: z *= (y + 5.0); /* FALLTHRU */ case 5: z *= (y + 4.0); /* FALLTHRU */ case 4: z *= (y + 3.0); /* FALLTHRU */ case 3: z *= (y + 2.0); /* FALLTHRU */ r += logl (z); break; } } else if (ix < 0x40418000) /* 2^66 */ { /* 8.0 <= x < 2**66 */ t = logl (x); z = one / x; y = z * z; w = w0 + z * (w1 + y * (w2 + y * (w3 + y * (w4 + y * (w5 + y * (w6 + y * w7)))))); r = (x - half) * (t - one) + w; } else /* 2**66 <= x <= inf */ r = x * (logl (x) - one); if (se & 0x8000) r = nadj - r; return r; } wcc-0.0.2/src/wsh/openlibm/ld80/e_tgammal.c0000644000175000017500000001466513122010155016777 0ustar philphil/* $OpenBSD: e_tgammal.c,v 1.4 2013/11/12 20:35:19 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* tgammal.c * * Gamma function * * * * SYNOPSIS: * * long double x, y, tgammal(); * * y = tgammal( x ); * * * * DESCRIPTION: * * Returns gamma function of the argument. The result is correctly * signed. This variable is also filled in by the logarithmic gamma * function lgamma(). * * Arguments |x| <= 13 are reduced by recurrence and the function * approximated by a rational function of degree 7/8 in the * interval (2,3). Large arguments are handled by Stirling's * formula. Large negative arguments are made positive using * a reflection formula. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -40,+40 10000 3.6e-19 7.9e-20 * IEEE -1755,+1755 10000 4.8e-18 6.5e-19 * * Accuracy for large arguments is dominated by error in powl(). * */ #include #include #include "math_private.h" /* tgamma(x+2) = tgamma(x+2) P(x)/Q(x) 0 <= x <= 1 Relative error n=7, d=8 Peak error = 1.83e-20 Relative error spread = 8.4e-23 */ static long double P[8] = { 4.212760487471622013093E-5L, 4.542931960608009155600E-4L, 4.092666828394035500949E-3L, 2.385363243461108252554E-2L, 1.113062816019361559013E-1L, 3.629515436640239168939E-1L, 8.378004301573126728826E-1L, 1.000000000000000000009E0L, }; static long double Q[9] = { -1.397148517476170440917E-5L, 2.346584059160635244282E-4L, -1.237799246653152231188E-3L, -7.955933682494738320586E-4L, 2.773706565840072979165E-2L, -4.633887671244534213831E-2L, -2.243510905670329164562E-1L, 4.150160950588455434583E-1L, 9.999999999999999999908E-1L, }; /* static long double P[] = { -3.01525602666895735709e0L, -3.25157411956062339893e1L, -2.92929976820724030353e2L, -1.70730828800510297666e3L, -7.96667499622741999770e3L, -2.59780216007146401957e4L, -5.99650230220855581642e4L, -7.15743521530849602425e4L }; static long double Q[] = { 1.00000000000000000000e0L, -1.67955233807178858919e1L, 8.85946791747759881659e1L, 5.69440799097468430177e1L, -1.98526250512761318471e3L, 3.31667508019495079814e3L, 1.60577839621734713377e4L, -2.97045081369399940529e4L, -7.15743521530849602412e4L }; */ #define MAXGAML 1755.455L /*static const long double LOGPI = 1.14472988584940017414L;*/ /* Stirling's formula for the gamma function tgamma(x) = sqrt(2 pi) x^(x-.5) exp(-x) (1 + 1/x P(1/x)) z(x) = x 13 <= x <= 1024 Relative error n=8, d=0 Peak error = 9.44e-21 Relative error spread = 8.8e-4 */ static long double STIR[9] = { 7.147391378143610789273E-4L, -2.363848809501759061727E-5L, -5.950237554056330156018E-4L, 6.989332260623193171870E-5L, 7.840334842744753003862E-4L, -2.294719747873185405699E-4L, -2.681327161876304418288E-3L, 3.472222222230075327854E-3L, 8.333333333333331800504E-2L, }; #define MAXSTIR 1024.0L static const long double SQTPI = 2.50662827463100050242E0L; /* 1/tgamma(x) = z P(z) * z(x) = 1/x * 0 < x < 0.03125 * Peak relative error 4.2e-23 */ static long double S[9] = { -1.193945051381510095614E-3L, 7.220599478036909672331E-3L, -9.622023360406271645744E-3L, -4.219773360705915470089E-2L, 1.665386113720805206758E-1L, -4.200263503403344054473E-2L, -6.558780715202540684668E-1L, 5.772156649015328608253E-1L, 1.000000000000000000000E0L, }; /* 1/tgamma(-x) = z P(z) * z(x) = 1/x * 0 < x < 0.03125 * Peak relative error 5.16e-23 * Relative error spread = 2.5e-24 */ static long double SN[9] = { 1.133374167243894382010E-3L, 7.220837261893170325704E-3L, 9.621911155035976733706E-3L, -4.219773343731191721664E-2L, -1.665386113944413519335E-1L, -4.200263503402112910504E-2L, 6.558780715202536547116E-1L, 5.772156649015328608727E-1L, -1.000000000000000000000E0L, }; static const long double PIL = 3.1415926535897932384626L; static long double stirf ( long double ); /* Gamma function computed by Stirling's formula. */ static long double stirf(long double x) { long double y, w, v; w = 1.0L/x; /* For large x, use rational coefficients from the analytical expansion. */ if( x > 1024.0L ) w = (((((6.97281375836585777429E-5L * w + 7.84039221720066627474E-4L) * w - 2.29472093621399176955E-4L) * w - 2.68132716049382716049E-3L) * w + 3.47222222222222222222E-3L) * w + 8.33333333333333333333E-2L) * w + 1.0L; else w = 1.0L + w * __polevll( w, STIR, 8 ); y = expl(x); if( x > MAXSTIR ) { /* Avoid overflow in pow() */ v = powl( x, 0.5L * x - 0.25L ); y = v * (v / y); } else { y = powl( x, x - 0.5L ) / y; } y = SQTPI * y * w; return( y ); } long double tgammal(long double x) { long double p, q, z; int i; if( isnan(x) ) return(NAN); if(x == INFINITY) return(INFINITY); if(x == -INFINITY) return(x - x); if( x == 0.0L ) return( 1.0L / x ); q = fabsl(x); if( q > 13.0L ) { int sign = 1; if( q > MAXGAML ) goto goverf; if( x < 0.0L ) { p = floorl(q); if( p == q ) return (x - x) / (x - x); i = p; if( (i & 1) == 0 ) sign = -1; z = q - p; if( z > 0.5L ) { p += 1.0L; z = q - p; } z = q * sinl( PIL * z ); z = fabsl(z) * stirf(q); if( z <= PIL/LDBL_MAX ) { goverf: return( sign * INFINITY); } z = PIL/z; } else { z = stirf(x); } return( sign * z ); } z = 1.0L; while( x >= 3.0L ) { x -= 1.0L; z *= x; } while( x < -0.03125L ) { z /= x; x += 1.0L; } if( x <= 0.03125L ) goto small; while( x < 2.0L ) { z /= x; x += 1.0L; } if( x == 2.0L ) return(z); x -= 2.0L; p = __polevll( x, P, 7 ); q = __polevll( x, Q, 8 ); z = z * p / q; return z; small: if( x == 0.0L ) return (x - x) / (x - x); else { if( x < 0.0L ) { x = -x; q = z / (x * __polevll( x, SN, 8 )); } else q = z / (x * __polevll( x, S, 8 )); } return q; } wcc-0.0.2/src/wsh/openlibm/ld80/s_nexttoward.c0000644000175000017500000000423513122010155017562 0ustar philphil/* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* IEEE functions * nexttoward(x,y) * return the next machine floating-point number of x in the * direction toward y. * Special cases: */ #include #include #include "math_private.h" double nexttoward(double x, long double y) { int32_t hx,ix,iy; u_int32_t lx,hy,ly,esy; EXTRACT_WORDS(hx,lx,x); GET_LDOUBLE_WORDS(esy,hy,ly,y); ix = hx&0x7fffffff; /* |x| */ iy = esy&0x7fff; /* |y| */ if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ ((iy>=0x7fff)&&(hy|ly)!=0)) /* y is nan */ return x+y; if((long double) x==y) return y; /* x=y, return y */ if((ix|lx)==0) { /* x == 0 */ volatile double u; INSERT_WORDS(x,(esy&0x8000)<<16,1); /* return +-minsub */ u = x; u = u * u; /* raise underflow flag */ return x; } if(hx>=0) { /* x > 0 */ if (esy>=0x8000||((ix>>20)&0x7ff)>iy-0x3c00 || (((ix>>20)&0x7ff)==iy-0x3c00 && (((hx<<11)|(lx>>21))>(hy&0x7fffffff) || (((hx<<11)|(lx>>21))==(hy&0x7fffffff) && (lx<<11)>ly)))) { /* x > y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x < y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } else { /* x < 0 */ if (esy<0x8000||((ix>>20)&0x7ff)>iy-0x3c00 || (((ix>>20)&0x7ff)==iy-0x3c00 && (((hx<<11)|(lx>>21))>(hy&0x7fffffff) || (((hx<<11)|(lx>>21))==(hy&0x7fffffff) && (lx<<11)>ly)))) {/* x < y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x > y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } hy = hx&0x7ff00000; if(hy>=0x7ff00000) { x = x+x; /* overflow */ return x; } if(hy<0x00100000) { volatile double u = x*x; /* underflow */ if(u==x) { INSERT_WORDS(x,hx,lx); return x; } } INSERT_WORDS(x,hx,lx); return x; } wcc-0.0.2/src/wsh/openlibm/ld80/e_acoshl.c0000644000175000017500000000300613122010155016611 0ustar philphil/* @(#)e_acosh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* acoshl(x) * Method : * Based on * acoshl(x) = logl [ x + sqrtl(x*x-1) ] * we have * acoshl(x) := logl(x)+ln2, if x is large; else * acoshl(x) := logl(2x-1/(sqrtl(x*x-1)+x)) if x>2; else * acoshl(x) := log1pl(t+sqrtl(2.0*t+t*t)); where t=x-1. * * Special cases: * acoshl(x) is NaN with signal if x<1. * acoshl(NaN) is NaN without signal. */ #include #include "math_private.h" static const long double one = 1.0, ln2 = 6.931471805599453094287e-01L; /* 0x3FFE, 0xB17217F7, 0xD1CF79AC */ long double acoshl(long double x) { long double t; u_int32_t se,i0,i1; GET_LDOUBLE_WORDS(se,i0,i1,x); if(se<0x3fff || se & 0x8000) { /* x < 1 */ return (x-x)/(x-x); } else if(se >=0x401d) { /* x > 2**30 */ if(se >=0x7fff) { /* x is inf of NaN */ return x+x; } else return logl(x)+ln2; /* acoshl(huge)=logl(2x) */ } else if(((se-0x3fff)|i0|i1)==0) { return 0.0; /* acosh(1) = 0 */ } else if (se > 0x4000) { /* 2**28 > x > 2 */ t=x*x; return logl(2.0*x-one/(x+sqrtl(t-one))); } else { /* 1 * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* log10l.c * * Common logarithm, long double precision * * * * SYNOPSIS: * * long double x, y, log10l(); * * y = log10l( x ); * * * * DESCRIPTION: * * Returns the base 10 logarithm of x. * * The argument is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the logarithm * of the fraction is approximated by * * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * log(x) = z + z**3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 30000 9.0e-20 2.6e-20 * IEEE exp(+-10000) 30000 6.0e-20 2.3e-20 * * In the tests over the interval exp(+-10000), the logarithms * of the random arguments were uniformly distributed over * [-10000, +10000]. * * ERROR MESSAGES: * * log singularity: x = 0; returns MINLOG * log domain: x < 0; returns MINLOG */ #include #include "math_private.h" /* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 6.2e-22 */ static long double P[] = { 4.9962495940332550844739E-1L, 1.0767376367209449010438E1L, 7.7671073698359539859595E1L, 2.5620629828144409632571E2L, 4.2401812743503691187826E2L, 3.4258224542413922935104E2L, 1.0747524399916215149070E2L, }; static long double Q[] = { /* 1.0000000000000000000000E0,*/ 2.3479774160285863271658E1L, 1.9444210022760132894510E2L, 7.7952888181207260646090E2L, 1.6911722418503949084863E3L, 2.0307734695595183428202E3L, 1.2695660352705325274404E3L, 3.2242573199748645407652E2L, }; /* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 6.16e-22 */ static long double R[4] = { 1.9757429581415468984296E-3L, -7.1990767473014147232598E-1L, 1.0777257190312272158094E1L, -3.5717684488096787370998E1L, }; static long double S[4] = { /* 1.00000000000000000000E0L,*/ -2.6201045551331104417768E1L, 1.9361891836232102174846E2L, -4.2861221385716144629696E2L, }; /* log10(2) */ #define L102A 0.3125L #define L102B -1.1470004336018804786261e-2L /* log10(e) */ #define L10EA 0.5L #define L10EB -6.5705518096748172348871e-2L #define SQRTH 0.70710678118654752440L long double log10l(long double x) { long double y; volatile long double z; int e; if( isnan(x) ) return(x); /* Test for domain */ if( x <= 0.0L ) { if( x == 0.0L ) return (-1.0L / (x - x)); else return (x - x) / (x - x); } if( x == INFINITY ) return(INFINITY); /* separate mantissa from exponent */ /* Note, frexp is used so that denormal numbers * will be handled properly. */ x = frexpl( x, &e ); /* logarithm using log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x*x; y = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); goto done; } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ } else { x = x - 1.0L; } z = x*x; y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 7 ) ); y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */ done: /* Multiply log of fraction by log10(e) * and base 2 exponent by log10(2). * * ***CAUTION*** * * This sequence of operations is critical and it may * be horribly defeated by some compiler optimizers. */ z = y * (L10EB); z += x * (L10EB); z += e * (L102B); z += y * (L10EA); z += x * (L10EA); z += e * (L102A); return( z ); } wcc-0.0.2/src/wsh/openlibm/ld80/e_sinhl.c0000644000175000017500000000415213122010155016460 0ustar philphil/* @(#)e_sinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* sinhl(x) * Method : * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 * 1. Replace x by |x| (sinhl(-x) = -sinhl(x)). * 2. * E + E/(E+1) * 0 <= x <= 25 : sinhl(x) := --------------, E=expm1l(x) * 2 * * 25 <= x <= lnovft : sinhl(x) := expl(x)/2 * lnovft <= x <= ln2ovft: sinhl(x) := expl(x/2)/2 * expl(x/2) * ln2ovft < x : sinhl(x) := x*shuge (overflow) * * Special cases: * sinhl(x) is |x| if x is +INF, -INF, or NaN. * only sinhl(0)=0 is exact for finite x. */ #include #include "math_private.h" static const long double one = 1.0, shuge = 1.0e4931L; long double sinhl(long double x) { long double t,w,h; u_int32_t jx,ix,i0,i1; /* Words of |x|. */ GET_LDOUBLE_WORDS(jx,i0,i1,x); ix = jx&0x7fff; /* x is INF or NaN */ if(ix==0x7fff) return x+x; h = 0.5; if (jx & 0x8000) h = -h; /* |x| in [0,25], return sign(x)*0.5*(E+E/(E+1))) */ if (ix < 0x4003 || (ix == 0x4003 && i0 <= 0xc8000000)) { /* |x|<25 */ if (ix<0x3fdf) /* |x|<2**-32 */ if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ t = expm1l(fabsl(x)); if(ix<0x3fff) return h*(2.0*t-t*t/(t+one)); return h*(t+t/(t+one)); } /* |x| in [25, log(maxdouble)] return 0.5*exp(|x|) */ if (ix < 0x400c || (ix == 0x400c && i0 < 0xb17217f7)) return h*expl(fabsl(x)); /* |x| in [log(maxdouble), overflowthreshold] */ if (ix<0x400c || (ix == 0x400c && (i0 < 0xb174ddc0 || (i0 == 0xb174ddc0 && i1 <= 0x31aec0ea)))) { w = expl(0.5*fabsl(x)); t = h*w; return t*w; } /* |x| > overflowthreshold, sinhl(x) overflow */ return x*shuge; } wcc-0.0.2/src/wsh/openlibm/ld80/e_powl.c0000644000175000017500000003060013122010155016321 0ustar philphil/* $OpenBSD: e_powl.c,v 1.5 2013/11/12 20:35:19 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* powl.c * * Power function, long double precision * * * * SYNOPSIS: * * long double x, y, z, powl(); * * z = powl( x, y ); * * * * DESCRIPTION: * * Computes x raised to the yth power. Analytically, * * x**y = exp( y log(x) ). * * Following Cody and Waite, this program uses a lookup table * of 2**-i/32 and pseudo extended precision arithmetic to * obtain several extra bits of accuracy in both the logarithm * and the exponential. * * * * ACCURACY: * * The relative error of pow(x,y) can be estimated * by y dl ln(2), where dl is the absolute error of * the internally computed base 2 logarithm. At the ends * of the approximation interval the logarithm equal 1/32 * and its relative error is about 1 lsb = 1.1e-19. Hence * the predicted relative error in the result is 2.3e-21 y . * * Relative error: * arithmetic domain # trials peak rms * * IEEE +-1000 40000 2.8e-18 3.7e-19 * .001 < x < 1000, with log(x) uniformly distributed. * -1000 < y < 1000, y uniformly distributed. * * IEEE 0,8700 60000 6.5e-18 1.0e-18 * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed. * * * ERROR MESSAGES: * * message condition value returned * pow overflow x**y > MAXNUM INFINITY * pow underflow x**y < 1/MAXNUM 0.0 * pow domain x<0 and y noninteger 0.0 * */ #include #include #include "math_private.h" /* Table size */ #define NXT 32 /* log2(Table size) */ #define LNXT 5 /* log(1+x) = x - .5x^2 + x^3 * P(z)/Q(z) * on the domain 2^(-1/32) - 1 <= x <= 2^(1/32) - 1 */ static long double P[] = { 8.3319510773868690346226E-4L, 4.9000050881978028599627E-1L, 1.7500123722550302671919E0L, 1.4000100839971580279335E0L, }; static long double Q[] = { /* 1.0000000000000000000000E0L,*/ 5.2500282295834889175431E0L, 8.4000598057587009834666E0L, 4.2000302519914740834728E0L, }; /* A[i] = 2^(-i/32), rounded to IEEE long double precision. * If i is even, A[i] + B[i/2] gives additional accuracy. */ static long double A[33] = { 1.0000000000000000000000E0L, 9.7857206208770013448287E-1L, 9.5760328069857364691013E-1L, 9.3708381705514995065011E-1L, 9.1700404320467123175367E-1L, 8.9735453750155359320742E-1L, 8.7812608018664974155474E-1L, 8.5930964906123895780165E-1L, 8.4089641525371454301892E-1L, 8.2287773907698242225554E-1L, 8.0524516597462715409607E-1L, 7.8799042255394324325455E-1L, 7.7110541270397041179298E-1L, 7.5458221379671136985669E-1L, 7.3841307296974965571198E-1L, 7.2259040348852331001267E-1L, 7.0710678118654752438189E-1L, 6.9195494098191597746178E-1L, 6.7712777346844636413344E-1L, 6.6261832157987064729696E-1L, 6.4841977732550483296079E-1L, 6.3452547859586661129850E-1L, 6.2092890603674202431705E-1L, 6.0762367999023443907803E-1L, 5.9460355750136053334378E-1L, 5.8186242938878875689693E-1L, 5.6939431737834582684856E-1L, 5.5719337129794626814472E-1L, 5.4525386633262882960438E-1L, 5.3357020033841180906486E-1L, 5.2213689121370692017331E-1L, 5.1094857432705833910408E-1L, 5.0000000000000000000000E-1L, }; static long double B[17] = { 0.0000000000000000000000E0L, 2.6176170809902549338711E-20L, -1.0126791927256478897086E-20L, 1.3438228172316276937655E-21L, 1.2207982955417546912101E-20L, -6.3084814358060867200133E-21L, 1.3164426894366316434230E-20L, -1.8527916071632873716786E-20L, 1.8950325588932570796551E-20L, 1.5564775779538780478155E-20L, 6.0859793637556860974380E-21L, -2.0208749253662532228949E-20L, 1.4966292219224761844552E-20L, 3.3540909728056476875639E-21L, -8.6987564101742849540743E-22L, -1.2327176863327626135542E-20L, 0.0000000000000000000000E0L, }; /* 2^x = 1 + x P(x), * on the interval -1/32 <= x <= 0 */ static long double R[] = { 1.5089970579127659901157E-5L, 1.5402715328927013076125E-4L, 1.3333556028915671091390E-3L, 9.6181291046036762031786E-3L, 5.5504108664798463044015E-2L, 2.4022650695910062854352E-1L, 6.9314718055994530931447E-1L, }; #define douba(k) A[k] #define doubb(k) B[k] #define MEXP (NXT*16384.0L) /* The following if denormal numbers are supported, else -MEXP: */ #define MNEXP (-NXT*(16384.0L+64.0L)) /* log2(e) - 1 */ #define LOG2EA 0.44269504088896340735992L #define F W #define Fa Wa #define Fb Wb #define G W #define Ga Wa #define Gb u #define H W #define Ha Wb #define Hb Wb static const long double MAXLOGL = 1.1356523406294143949492E4L; static const long double MINLOGL = -1.13994985314888605586758E4L; static const long double LOGE2L = 6.9314718055994530941723E-1L; static volatile long double z; static long double w, W, Wa, Wb, ya, yb, u; static const long double huge = 0x1p10000L; #if 0 /* XXX Prevent gcc from erroneously constant folding this. */ static const long double twom10000 = 0x1p-10000L; #else static volatile long double twom10000 = 0x1p-10000L; #endif static long double reducl( long double ); static long double powil ( long double, int ); long double powl(long double x, long double y) { /* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */ int i, nflg, iyflg, yoddint; long e; if( y == 0.0L ) return( 1.0L ); if( x == 1.0L ) return( 1.0L ); if( isnan(x) ) return( x ); if( isnan(y) ) return( y ); if( y == 1.0L ) return( x ); if( !isfinite(y) && x == -1.0L ) return( 1.0L ); if( y >= LDBL_MAX ) { if( x > 1.0L ) return( INFINITY ); if( x > 0.0L && x < 1.0L ) return( 0.0L ); if( x < -1.0L ) return( INFINITY ); if( x > -1.0L && x < 0.0L ) return( 0.0L ); } if( y <= -LDBL_MAX ) { if( x > 1.0L ) return( 0.0L ); if( x > 0.0L && x < 1.0L ) return( INFINITY ); if( x < -1.0L ) return( 0.0L ); if( x > -1.0L && x < 0.0L ) return( INFINITY ); } if( x >= LDBL_MAX ) { if( y > 0.0L ) return( INFINITY ); return( 0.0L ); } w = floorl(y); /* Set iyflg to 1 if y is an integer. */ iyflg = 0; if( w == y ) iyflg = 1; /* Test for odd integer y. */ yoddint = 0; if( iyflg ) { ya = fabsl(y); ya = floorl(0.5L * ya); yb = 0.5L * fabsl(w); if( ya != yb ) yoddint = 1; } if( x <= -LDBL_MAX ) { if( y > 0.0L ) { if( yoddint ) return( -INFINITY ); return( INFINITY ); } if( y < 0.0L ) { if( yoddint ) return( -0.0L ); return( 0.0 ); } } nflg = 0; /* flag = 1 if x<0 raised to integer power */ if( x <= 0.0L ) { if( x == 0.0L ) { if( y < 0.0 ) { if( signbit(x) && yoddint ) return( -INFINITY ); return( INFINITY ); } if( y > 0.0 ) { if( signbit(x) && yoddint ) return( -0.0L ); return( 0.0 ); } if( y == 0.0L ) return( 1.0L ); /* 0**0 */ else return( 0.0L ); /* 0**y */ } else { if( iyflg == 0 ) return (x - x) / (x - x); /* (x<0)**(non-int) is NaN */ nflg = 1; } } /* Integer power of an integer. */ if( iyflg ) { i = w; w = floorl(x); if( (w == x) && (fabsl(y) < 32768.0) ) { w = powil( x, (int) y ); return( w ); } } if( nflg ) x = fabsl(x); /* separate significand from exponent */ x = frexpl( x, &i ); e = i; /* find significand in antilog table A[] */ i = 1; if( x <= douba(17) ) i = 17; if( x <= douba(i+8) ) i += 8; if( x <= douba(i+4) ) i += 4; if( x <= douba(i+2) ) i += 2; if( x >= douba(1) ) i = -1; i += 1; /* Find (x - A[i])/A[i] * in order to compute log(x/A[i]): * * log(x) = log( a x/a ) = log(a) + log(x/a) * * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a */ x -= douba(i); x -= doubb(i/2); x /= douba(i); /* rational approximation for log(1+v): * * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v) */ z = x*x; w = x * ( z * __polevll( x, P, 3 ) / __p1evll( x, Q, 3 ) ); w = w - ldexpl( z, -1 ); /* w - 0.5 * z */ /* Convert to base 2 logarithm: * multiply by log2(e) = 1 + LOG2EA */ z = LOG2EA * w; z += w; z += LOG2EA * x; z += x; /* Compute exponent term of the base 2 logarithm. */ w = -i; w = ldexpl( w, -LNXT ); /* divide by NXT */ w += e; /* Now base 2 log of x is w + z. */ /* Multiply base 2 log by y, in extended precision. */ /* separate y into large part ya * and small part yb less than 1/NXT */ ya = reducl(y); yb = y - ya; /* (w+z)(ya+yb) * = w*ya + w*yb + z*y */ F = z * y + w * yb; Fa = reducl(F); Fb = F - Fa; G = Fa + w * ya; Ga = reducl(G); Gb = G - Ga; H = Fb + Gb; Ha = reducl(H); w = ldexpl( Ga+Ha, LNXT ); /* Test the power of 2 for overflow */ if( w > MEXP ) return (huge * huge); /* overflow */ if( w < MNEXP ) return (twom10000 * twom10000); /* underflow */ e = w; Hb = H - Ha; if( Hb > 0.0L ) { e += 1; Hb -= (1.0L/NXT); /*0.0625L;*/ } /* Now the product y * log2(x) = Hb + e/NXT. * * Compute base 2 exponential of Hb, * where -0.0625 <= Hb <= 0. */ z = Hb * __polevll( Hb, R, 6 ); /* z = 2**Hb - 1 */ /* Express e/NXT as an integer plus a negative number of (1/NXT)ths. * Find lookup table entry for the fractional power of 2. */ if( e < 0 ) i = 0; else i = 1; i = e/NXT + i; e = NXT*i - e; w = douba( e ); z = w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */ z = z + w; z = ldexpl( z, i ); /* multiply by integer power of 2 */ if( nflg ) { /* For negative x, * find out if the integer exponent * is odd or even. */ w = ldexpl( y, -1 ); w = floorl(w); w = ldexpl( w, 1 ); if( w != y ) z = -z; /* odd exponent */ } return( z ); } /* Find a multiple of 1/NXT that is within 1/NXT of x. */ static long double reducl(long double x) { long double t; t = ldexpl( x, LNXT ); t = floorl( t ); t = ldexpl( t, -LNXT ); return(t); } /* powil.c * * Real raised to integer power, long double precision * * * * SYNOPSIS: * * long double x, y, powil(); * int n; * * y = powil( x, n ); * * * * DESCRIPTION: * * Returns argument x raised to the nth power. * The routine efficiently decomposes n as a sum of powers of * two. The desired power is a product of two-to-the-kth * powers of x. Thus to compute the 32767 power of x requires * 28 multiplications instead of 32767 multiplications. * * * * ACCURACY: * * * Relative error: * arithmetic x domain n domain # trials peak rms * IEEE .001,1000 -1022,1023 50000 4.3e-17 7.8e-18 * IEEE 1,2 -1022,1023 20000 3.9e-17 7.6e-18 * IEEE .99,1.01 0,8700 10000 3.6e-16 7.2e-17 * * Returns MAXNUM on overflow, zero on underflow. * */ static long double powil(long double x, int nn) { long double ww, y; long double s; int n, e, sign, asign, lx; if( x == 0.0L ) { if( nn == 0 ) return( 1.0L ); else if( nn < 0 ) return( LDBL_MAX ); else return( 0.0L ); } if( nn == 0 ) return( 1.0L ); if( x < 0.0L ) { asign = -1; x = -x; } else asign = 0; if( nn < 0 ) { sign = -1; n = -nn; } else { sign = 1; n = nn; } /* Overflow detection */ /* Calculate approximate logarithm of answer */ s = x; s = frexpl( s, &lx ); e = (lx - 1)*n; if( (e == 0) || (e > 64) || (e < -64) ) { s = (s - 7.0710678118654752e-1L) / (s + 7.0710678118654752e-1L); s = (2.9142135623730950L * s - 0.5L + lx) * nn * LOGE2L; } else { s = LOGE2L * e; } if( s > MAXLOGL ) return (huge * huge); /* overflow */ if( s < MINLOGL ) return (twom10000 * twom10000); /* underflow */ /* Handle tiny denormal answer, but with less accuracy * since roundoff error in 1.0/x will be amplified. * The precise demarcation should be the gradual underflow threshold. */ if( s < (-MAXLOGL+2.0L) ) { x = 1.0L/x; sign = -sign; } /* First bit of the power */ if( n & 1 ) y = x; else { y = 1.0L; asign = 0; } ww = x; n >>= 1; while( n ) { ww = ww * ww; /* arg to the 2-to-the-kth power */ if( n & 1 ) /* if that bit is set, then include in product */ y *= ww; n >>= 1; } if( asign ) y = -y; /* odd power of negative number */ if( sign < 0 ) y = 1.0L/y; return(y); } wcc-0.0.2/src/wsh/openlibm/ld80/k_cosl.c0000644000175000017500000000553713122010155016321 0ustar philphil/* From: @(#)k_cos.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld80/k_cosl.c,v 1.1 2008/02/17 07:32:14 das Exp $"); /* * ld80 version of k_cos.c. See ../src/k_cos.c for most comments. */ #include "math_private.h" /* * Domain [-0.7854, 0.7854], range ~[-2.43e-23, 2.425e-23]: * |cos(x) - c(x)| < 2**-75.1 * * The coefficients of c(x) were generated by a pari-gp script using * a Remez algorithm that searches for the best higher coefficients * after rounding leading coefficients to a specified precision. * * Simpler methods like Chebyshev or basic Remez barely suffice for * cos() in 64-bit precision, because we want the coefficient of x^2 * to be precisely -0.5 so that multiplying by it is exact, and plain * rounding of the coefficients of a good polynomial approximation only * gives this up to about 64-bit precision. Plain rounding also gives * a mediocre approximation for the coefficient of x^4, but a rounding * error of 0.5 ulps for this coefficient would only contribute ~0.01 * ulps to the final error, so this is unimportant. Rounding errors in * higher coefficients are even less important. * * In fact, coefficients above the x^4 one only need to have 53-bit * precision, and this is more efficient. We get this optimization * almost for free from the complications needed to search for the best * higher coefficients. */ static const double one = 1.0; #if defined(__amd64__) || defined(__i386__) /* Long double constants are slow on these arches, and broken on i386. */ static const volatile double C1hi = 0.041666666666666664, /* 0x15555555555555.0p-57 */ C1lo = 2.2598839032744733e-18; /* 0x14d80000000000.0p-111 */ #define C1 ((long double)C1hi + C1lo) #else static const long double C1 = 0.0416666666666666666136L; /* 0xaaaaaaaaaaaaaa9b.0p-68 */ #endif static const double C2 = -0.0013888888888888874, /* -0x16c16c16c16c10.0p-62 */ C3 = 0.000024801587301571716, /* 0x1a01a01a018e22.0p-68 */ C4 = -0.00000027557319215507120, /* -0x127e4fb7602f22.0p-74 */ C5 = 0.0000000020876754400407278, /* 0x11eed8caaeccf1.0p-81 */ C6 = -1.1470297442401303e-11, /* -0x19393412bd1529.0p-89 */ C7 = 4.7383039476436467e-14; /* 0x1aac9d9af5c43e.0p-97 */ long double __kernel_cosl(long double x, long double y) { long double hz,z,r,w; z = x*x; r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*(C6+z*C7)))))); hz = 0.5*z; w = one-hz; return w + (((one-w)-hz) + (z*r-x*y)); } wcc-0.0.2/src/wsh/openlibm/ld80/e_atanhl.c0000644000175000017500000000310113122010155016603 0ustar philphil/* @(#)e_atanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* atanhl(x) * Method : * 1.Reduced x to positive by atanh(-x) = -atanh(x) * 2.For x>=0.5 * 1 2x x * atanhl(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) * 2 1 - x 1 - x * * For x<0.5 * atanhl(x) = 0.5*log1pl(2x+2x*x/(1-x)) * * Special cases: * atanhl(x) is NaN if |x| > 1 with signal; * atanhl(NaN) is that NaN with no signal; * atanhl(+-1) is +-INF with signal. * */ #include #include "math_private.h" static const long double one = 1.0, huge = 1e4900L; static const long double zero = 0.0; long double atanhl(long double x) { long double t; int32_t ix; u_int32_t se,i0,i1; GET_LDOUBLE_WORDS(se,i0,i1,x); ix = se&0x7fff; if ((ix+((((i0&0x7fffffff)|i1)|(-((i0&0x7fffffff)|i1)))>>31))>0x3fff) /* |x|>1 */ return (x-x)/(x-x); if(ix==0x3fff) return x/zero; if(ix<0x3fe3&&(huge+x)>zero) return x; /* x<2**-28 */ SET_LDOUBLE_EXP(x,ix); if(ix<0x3ffe) { /* x < 0.5 */ t = x+x; t = 0.5*log1pl(t+t*x/(one-x)); } else t = 0.5*log1pl((x+x)/(one-x)); if(se<=0x7fff) return t; else return -t; } wcc-0.0.2/src/wsh/openlibm/ld80/invtrig.c0000644000175000017500000000541013122010155016517 0ustar philphil/*- * Copyright (c) 2008 David Schultz * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld80/invtrig.c,v 1.1 2008/07/31 22:41:26 das Exp $"); #include "ld80/invtrig.h" /* * asinl() and acosl() */ const long double pS0 = 1.66666666666666666631e-01L, pS1 = -4.16313987993683104320e-01L, pS2 = 3.69068046323246813704e-01L, pS3 = -1.36213932016738603108e-01L, pS4 = 1.78324189708471965733e-02L, pS5 = -2.19216428382605211588e-04L, pS6 = -7.10526623669075243183e-06L, qS1 = -2.94788392796209867269e+00L, qS2 = 3.27309890266528636716e+00L, qS3 = -1.68285799854822427013e+00L, qS4 = 3.90699412641738801874e-01L, qS5 = -3.14365703596053263322e-02L; /* * atanl() */ const long double atanhi[] = { 4.63647609000806116202e-01L, 7.85398163397448309628e-01L, 9.82793723247329067960e-01L, 1.57079632679489661926e+00L, }; const long double atanlo[] = { 1.18469937025062860669e-20L, -1.25413940316708300586e-20L, 2.55232234165405176172e-20L, -2.50827880633416601173e-20L, }; const long double aT[] = { 3.33333333333333333017e-01L, -1.99999999999999632011e-01L, 1.42857142857046531280e-01L, -1.11111111100562372733e-01L, 9.09090902935647302252e-02L, -7.69230552476207730353e-02L, 6.66661718042406260546e-02L, -5.88158892835030888692e-02L, 5.25499891539726639379e-02L, -4.70119845393155721494e-02L, 4.03539201366454414072e-02L, -2.91303858419364158725e-02L, 1.24822046299269234080e-02L, }; const long double pi_lo = -5.01655761266833202345e-20L; wcc-0.0.2/src/wsh/openlibm/ld80/s_expm1l.c0000644000175000017500000000702413122010155016570 0ustar philphil/* $OpenBSD: s_expm1l.c,v 1.2 2011/07/20 21:02:51 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* expm1l.c * * Exponential function, minus 1 * Long double precision * * * SYNOPSIS: * * long double x, y, expm1l(); * * y = expm1l( x ); * * * * DESCRIPTION: * * Returns e (2.71828...) raised to the x power, minus 1. * * Range reduction is accomplished by separating the argument * into an integer k and fraction f such that * * x k f * e = 2 e. * * An expansion x + .5 x^2 + x^3 R(x) approximates exp(f) - 1 * in the basic range [-0.5 ln 2, 0.5 ln 2]. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -45,+MAXLOG 200,000 1.2e-19 2.5e-20 * * ERROR MESSAGES: * * message condition value returned * expm1l overflow x > MAXLOG MAXNUM * */ #include static const long double MAXLOGL = 1.1356523406294143949492E4L; /* exp(x) - 1 = x + 0.5 x^2 + x^3 P(x)/Q(x) -.5 ln 2 < x < .5 ln 2 Theoretical peak relative error = 3.4e-22 */ static const long double P0 = -1.586135578666346600772998894928250240826E4L, P1 = 2.642771505685952966904660652518429479531E3L, P2 = -3.423199068835684263987132888286791620673E2L, P3 = 1.800826371455042224581246202420972737840E1L, P4 = -5.238523121205561042771939008061958820811E-1L, Q0 = -9.516813471998079611319047060563358064497E4L, Q1 = 3.964866271411091674556850458227710004570E4L, Q2 = -7.207678383830091850230366618190187434796E3L, Q3 = 7.206038318724600171970199625081491823079E2L, Q4 = -4.002027679107076077238836622982900945173E1L, /* Q5 = 1.000000000000000000000000000000000000000E0 */ /* C1 + C2 = ln 2 */ C1 = 6.93145751953125E-1L, C2 = 1.428606820309417232121458176568075500134E-6L, /* ln 2^-65 */ minarg = -4.5054566736396445112120088E1L; static const long double huge = 0x1p10000L; long double expm1l(long double x) { long double px, qx, xx; int k; /* Overflow. */ if (x > MAXLOGL) return (huge*huge); /* overflow */ if (x == 0.0) return x; /* Minimum value. */ if (x < minarg) return -1.0L; xx = C1 + C2; /* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */ px = floorl (0.5 + x / xx); k = px; /* remainder times ln 2 */ x -= px * C1; x -= px * C2; /* Approximate exp(remainder ln 2). */ px = (((( P4 * x + P3) * x + P2) * x + P1) * x + P0) * x; qx = (((( x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0; xx = x * x; qx = x + (0.5 * xx + xx * px / qx); /* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2). We have qx = exp(remainder ln 2) - 1, so exp(x) - 1 = 2^k (qx + 1) - 1 = 2^k qx + 2^k - 1. */ px = ldexpl(1.0L, k); x = px * qx + (px - 1.0); return x; } wcc-0.0.2/src/wsh/openlibm/ld80/s_log1pl.c0000644000175000017500000001022013122010155016550 0ustar philphil/* $OpenBSD: s_log1pl.c,v 1.3 2013/11/12 20:35:19 martynas Exp $ */ /* * Copyright (c) 2008 Stephen L. Moshier * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* log1pl.c * * Relative error logarithm * Natural logarithm of 1+x, long double precision * * * * SYNOPSIS: * * long double x, y, log1pl(); * * y = log1pl( x ); * * * * DESCRIPTION: * * Returns the base e (2.718...) logarithm of 1+x. * * The argument 1+x is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the logarithm * of the fraction is approximated by * * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * log(x) = z + z^3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -1.0, 9.0 100000 8.2e-20 2.5e-20 * * ERROR MESSAGES: * * log singularity: x-1 = 0; returns -INFINITY * log domain: x-1 < 0; returns NAN */ #include #include "math_private.h" /* Coefficients for log(1+x) = x - x^2 / 2 + x^3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 2.32e-20 */ static long double P[] = { 4.5270000862445199635215E-5L, 4.9854102823193375972212E-1L, 6.5787325942061044846969E0L, 2.9911919328553073277375E1L, 6.0949667980987787057556E1L, 5.7112963590585538103336E1L, 2.0039553499201281259648E1L, }; static long double Q[] = { /* 1.0000000000000000000000E0,*/ 1.5062909083469192043167E1L, 8.3047565967967209469434E1L, 2.2176239823732856465394E2L, 3.0909872225312059774938E2L, 2.1642788614495947685003E2L, 6.0118660497603843919306E1L, }; /* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 6.16e-22 */ static long double R[4] = { 1.9757429581415468984296E-3L, -7.1990767473014147232598E-1L, 1.0777257190312272158094E1L, -3.5717684488096787370998E1L, }; static long double S[4] = { /* 1.00000000000000000000E0L,*/ -2.6201045551331104417768E1L, 1.9361891836232102174846E2L, -4.2861221385716144629696E2L, }; static const long double C1 = 6.9314575195312500000000E-1L; static const long double C2 = 1.4286068203094172321215E-6L; #define SQRTH 0.70710678118654752440L long double log1pl(long double xm1) { long double x, y, z; int e; if( isnan(xm1) ) return(xm1); if( xm1 == INFINITY ) return(xm1); if(xm1 == 0.0) return(xm1); x = xm1 + 1.0L; /* Test for domain errors. */ if( x <= 0.0L ) { if( x == 0.0L ) return( -INFINITY ); else return( NAN ); } /* Separate mantissa from exponent. Use frexp so that denormal numbers will be handled properly. */ x = frexpl( x, &e ); /* logarithm using log(x) = z + z^3 P(z)/Q(z), where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5L; y = 0.5L * z + 0.5L; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5L; z -= 0.5L; y = 0.5L * x + 0.5L; } x = z / y; z = x*x; z = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); z = z + e * C2; z = z + x; z = z + e * C1; return( z ); } /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; if (e != 0) x = 2.0 * x - 1.0L; else x = xm1; } else { if (e != 0) x = x - 1.0L; else x = xm1; } z = x*x; y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 6 ) ); y = y + e * C2; z = y - 0.5 * z; z = z + x; z = z + e * C1; return( z ); } wcc-0.0.2/src/wsh/openlibm/ld80/s_modfl.c0000644000175000017500000000344113122010155016462 0ustar philphil/* @(#)s_modf.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * modfl(long double x, long double *iptr) * return fraction part of x, and return x's integral part in *iptr. * Method: * Bit twiddling. * * Exception: * No exception. */ #include #include "math_private.h" static const long double one = 1.0; long double modfl(long double x, long double *iptr) { int32_t i0,i1,jj0; u_int32_t i,se; GET_LDOUBLE_WORDS(se,i0,i1,x); jj0 = (se&0x7fff)-0x3fff; /* exponent of x */ if(jj0<32) { /* integer part in high x */ if(jj0<0) { /* |x|<1 */ SET_LDOUBLE_WORDS(*iptr,se&0x8000,0,0); /* *iptr = +-0 */ return x; } else { i = (0x7fffffff)>>jj0; if(((i0&i)|i1)==0) { /* x is integral */ *iptr = x; SET_LDOUBLE_WORDS(x,se&0x8000,0,0); /* return +-0 */ return x; } else { SET_LDOUBLE_WORDS(*iptr,se,i0&(~i),0); return x - *iptr; } } } else if (jj0>63) { /* no fraction part */ *iptr = x*one; /* We must handle NaNs separately. */ if (jj0 == 0x4000 && ((i0 & 0x7fffffff) | i1)) return x*one; SET_LDOUBLE_WORDS(x,se&0x8000,0,0); /* return +-0 */ return x; } else { /* fraction part in low x */ i = ((u_int32_t)(0x7fffffff))>>(jj0-32); if((i1&i)==0) { /* x is integral */ *iptr = x; SET_LDOUBLE_WORDS(x,se&0x8000,0,0); /* return +-0 */ return x; } else { SET_LDOUBLE_WORDS(*iptr,se,i0,i1&(~i)); return x - *iptr; } } } wcc-0.0.2/src/wsh/openlibm/ld80/s_truncl.c0000644000175000017500000000322413122010155016667 0ustar philphil/* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * * From: @(#)s_floor.c 5.1 93/09/24 */ /* * truncl(x) * Return x rounded toward 0 to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to truncl(x). */ #include //#include #include #include #include #include "math_private.h" #ifdef LDBL_IMPLICIT_NBIT #define MANH_SIZE (EXT_FRACHBITS + 1) #else #define MANH_SIZE EXT_FRACHBITS #endif static const long double huge = 1.0e300; static const float zero[] = { 0.0, -0.0 }; long double truncl(long double x) { int e, es; uint32_t ix0, ix1; GET_LDOUBLE_WORDS(es,ix0,ix1,x); e = (es&0x7fff) - LDBL_MAX_EXP + 1; if (e < MANH_SIZE - 1) { if (e < 0) { /* raise inexact if x != 0 */ if (huge + x > 0.0) return (zero[(es&0x8000)!=0]); } else { uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); if (((ix0 & m) | ix1) == 0) return (x); /* x is integral */ if (huge + x > 0.0) { /* raise inexact flag */ ix0 &= ~m; ix1 = 0; } } } else if (e < LDBL_MANT_DIG - 1) { uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); if ((ix1 & m) == 0) return (x); /* x is integral */ if (huge + x > 0.0) /* raise inexact flag */ ix1 &= ~m; } SET_LDOUBLE_WORDS(x,es,ix0,ix1); return (x); } wcc-0.0.2/src/wsh/openlibm/ld80/e_coshl.c0000644000175000017500000000447613122010155016464 0ustar philphil/* @(#)e_cosh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* coshl(x) * Method : * mathematically coshl(x) if defined to be (exp(x)+exp(-x))/2 * 1. Replace x by |x| (coshl(x) = coshl(-x)). * 2. * [ exp(x) - 1 ]^2 * 0 <= x <= ln2/2 : coshl(x) := 1 + ------------------- * 2*exp(x) * * exp(x) + 1/exp(x) * ln2/2 <= x <= 22 : coshl(x) := ------------------- * 2 * 22 <= x <= lnovft : coshl(x) := expl(x)/2 * lnovft <= x <= ln2ovft: coshl(x) := expl(x/2)/2 * expl(x/2) * ln2ovft < x : coshl(x) := huge*huge (overflow) * * Special cases: * coshl(x) is |x| if x is +INF, -INF, or NaN. * only coshl(0)=1 is exact for finite x. */ #include #include "math_private.h" static const long double one = 1.0, half=0.5, huge = 1.0e4900L; long double coshl(long double x) { long double t,w; int32_t ex; u_int32_t mx,lx; /* High word of |x|. */ GET_LDOUBLE_WORDS(ex,mx,lx,x); ex &= 0x7fff; /* x is INF or NaN */ if(ex==0x7fff) return x*x; /* |x| in [0,0.5*ln2], return 1+expm1l(|x|)^2/(2*expl(|x|)) */ if(ex < 0x3ffd || (ex == 0x3ffd && mx < 0xb17217f7u)) { t = expm1l(fabsl(x)); w = one+t; if (ex<0x3fbc) return w; /* cosh(tiny) = 1 */ return one+(t*t)/(w+w); } /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */ if (ex < 0x4003 || (ex == 0x4003 && mx < 0xb0000000u)) { t = expl(fabsl(x)); return half*t+half/t; } /* |x| in [22, ln(maxdouble)] return half*exp(|x|) */ if (ex < 0x400c || (ex == 0x400c && mx < 0xb1700000u)) return half*expl(fabsl(x)); /* |x| in [log(maxdouble), log(2*maxdouble)) */ if (ex == 0x400c && (mx < 0xb174ddc0u || (mx == 0xb174ddc0u && lx < 0x31aec0ebu))) { w = expl(half*fabsl(x)); t = half*w; return t*w; } /* |x| >= log(2*maxdouble), cosh(x) overflow */ return huge*huge; } wcc-0.0.2/src/wsh/openlibm/ld80/k_tanl.c0000644000175000017500000001013013122010155016300 0ustar philphil/* From: @(#)k_tan.c 1.5 04/04/22 SMI */ /* * ==================================================== * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved. * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans. * * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include "cdefs-compat.h" //__FBSDID("$FreeBSD: src/lib/msun/ld80/k_tanl.c,v 1.3 2008/02/18 15:39:52 bde Exp $"); /* * ld80 version of k_tan.c. See ../src/k_tan.c for most comments. */ #include #include "math_private.h" /* * Domain [-0.67434, 0.67434], range ~[-2.25e-22, 1.921e-22] * |tan(x)/x - t(x)| < 2**-71.9 * * See k_cosl.c for more details about the polynomial. */ #if defined(__amd64__) || defined(__i386__) /* Long double constants are slow on these arches, and broken on i386. */ static const volatile double T3hi = 0.33333333333333331, /* 0x15555555555555.0p-54 */ T3lo = 1.8350121769317163e-17, /* 0x15280000000000.0p-108 */ T5hi = 0.13333333333333336, /* 0x11111111111112.0p-55 */ T5lo = 1.3051083651294260e-17, /* 0x1e180000000000.0p-109 */ T7hi = 0.053968253968250494, /* 0x1ba1ba1ba1b827.0p-57 */ T7lo = 3.1509625637859973e-18, /* 0x1d100000000000.0p-111 */ pio4_hi = 0.78539816339744828, /* 0x1921fb54442d18.0p-53 */ pio4_lo = 3.0628711372715500e-17, /* 0x11a80000000000.0p-107 */ pio4lo_hi = -1.2541394031670831e-20, /* -0x1d9cceba3f91f2.0p-119 */ pio4lo_lo = 6.1493048227390915e-37; /* 0x1a280000000000.0p-173 */ #define T3 ((long double)T3hi + T3lo) #define T5 ((long double)T5hi + T5lo) #define T7 ((long double)T7hi + T7lo) #define pio4 ((long double)pio4_hi + pio4_lo) #define pio4lo ((long double)pio4lo_hi + pio4lo_lo) #else static const long double T3 = 0.333333333333333333180L, /* 0xaaaaaaaaaaaaaaa5.0p-65 */ T5 = 0.133333333333333372290L, /* 0x88888888888893c3.0p-66 */ T7 = 0.0539682539682504975744L, /* 0xdd0dd0dd0dc13ba2.0p-68 */ pio4 = 0.785398163397448309628L, /* 0xc90fdaa22168c235.0p-64 */ pio4lo = -1.25413940316708300586e-20L; /* -0xece675d1fc8f8cbb.0p-130 */ #endif static const double T9 = 0.021869488536312216, /* 0x1664f4882cc1c2.0p-58 */ T11 = 0.0088632355256619590, /* 0x1226e355c17612.0p-59 */ T13 = 0.0035921281113786528, /* 0x1d6d3d185d7ff8.0p-61 */ T15 = 0.0014558334756312418, /* 0x17da354aa3f96b.0p-62 */ T17 = 0.00059003538700862256, /* 0x13559358685b83.0p-63 */ T19 = 0.00023907843576635544, /* 0x1f56242026b5be.0p-65 */ T21 = 0.000097154625656538905, /* 0x1977efc26806f4.0p-66 */ T23 = 0.000038440165747303162, /* 0x14275a09b3ceac.0p-67 */ T25 = 0.000018082171885432524, /* 0x12f5e563e5487e.0p-68 */ T27 = 0.0000024196006108814377, /* 0x144c0d80cc6896.0p-71 */ T29 = 0.0000078293456938132840, /* 0x106b59141a6cb3.0p-69 */ T31 = -0.0000032609076735050182, /* -0x1b5abef3ba4b59.0p-71 */ T33 = 0.0000023261313142559411; /* 0x13835436c0c87f.0p-71 */ long double __kernel_tanl(long double x, long double y, int iy) { long double z, r, v, w, s; long double osign; int i; iy = (iy == 1 ? -1 : 1); /* XXX recover original interface */ osign = (x >= 0 ? 1.0 : -1.0); /* XXX slow, probably wrong for -0 */ if (fabsl(x) >= 0.67434) { if (x < 0) { x = -x; y = -y; } z = pio4 - x; w = pio4lo - y; x = z + w; y = 0.0; i = 1; } else i = 0; z = x * x; w = z * z; r = T5 + w * (T9 + w * (T13 + w * (T17 + w * (T21 + w * (T25 + w * (T29 + w * T33)))))); v = z * (T7 + w * (T11 + w * (T15 + w * (T19 + w * (T23 + w * (T27 + w * T31)))))); s = z * x; r = y + z * (s * (r + v) + y); r += T3 * s; w = x + r; if (i == 1) { v = (long double) iy; return osign * (v - 2.0 * (x - (w * w / (w + v) - r))); } if (iy == 1) return w; else { /* * if allow error up to 2 ulp, simply return * -1.0 / (x+r) here */ /* compute -1.0 / (x+r) accurately */ long double a, t; z = w; z = z + 0x1p32 - 0x1p32; v = r - (z - x); /* z+v = r+x */ t = a = -1.0 / w; /* a = -1.0/w */ t = t + 0x1p32 - 0x1p32; s = 1.0 + t * z; return t + a * (s + t * v); } } wcc-0.0.2/src/wsh/openlibm/ld80/s_remquol.c0000644000175000017500000001017113122010155017043 0ustar philphil/* @(#)e_fmod.c 1.3 95/01/18 */ /*- * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include #include #include #include #include #include "math_private.h" #define BIAS (LDBL_MAX_EXP - 1) /* * These macros add and remove an explicit integer bit in front of the * fractional mantissa, if the architecture doesn't have such a bit by * default already. */ #ifdef LDBL_IMPLICIT_NBIT #define LDBL_NBIT 0 #define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) #define HFRAC_BITS EXT_FRACHBITS #else #define LDBL_NBIT 0x80000000 #define SET_NBIT(hx) (hx) #define HFRAC_BITS (EXT_FRACHBITS - 1) #endif #define MANL_SHIFT (EXT_FRACLBITS - 1) static const long double Zero[] = {0.0L, -0.0L}; /* * Return the IEEE remainder and set *quo to the last n bits of the * quotient, rounded to the nearest integer. We choose n=31 because * we wind up computing all the integer bits of the quotient anyway as * a side-effect of computing the remainder by the shift and subtract * method. In practice, this is far more bits than are needed to use * remquo in reduction algorithms. * * Assumptions: * - The low part of the mantissa fits in a manl_t exactly. * - The high part of the mantissa fits in an int64_t with enough room * for an explicit integer bit in front of the fractional bits. */ long double remquol(long double x, long double y, int *quo) { int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ uint32_t hy; uint32_t lx,ly,lz; uint32_t esx, esy; int ix,iy,n,q,sx,sxy; GET_LDOUBLE_WORDS(esx,hx,lx,x); GET_LDOUBLE_WORDS(esy,hy,ly,y); sx = esx & 0x8000; sxy = sx ^ (esy & 0x8000); esx &= 0x7fff; /* |x| */ esy &= 0x7fff; /* |y| */ SET_LDOUBLE_EXP(x,esx); SET_LDOUBLE_EXP(y,esy); /* purge off exception values */ if((esy|hy|ly)==0 || /* y=0 */ (esx == BIAS + LDBL_MAX_EXP) || /* or x not finite */ (esy == BIAS + LDBL_MAX_EXP && ((hy&~LDBL_NBIT)|ly)!=0)) /* or y is NaN */ return (x*y)/(x*y); if(esx<=esy) { if((esx>MANL_SHIFT); lx = lx+lx;} else {hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; q++;} q <<= 1; } hz=hx-hy;lz=lx-ly; if(lx=0) {hx=hz;lx=lz;q++;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) { /* return sign(x)*0 */ *quo = (sxy ? -q : q); return Zero[sx!=0]; } while(hx<(1ULL<>MANL_SHIFT); lx = lx+lx; iy -= 1; } if (iy < LDBL_MIN_EXP) { esx = (iy + BIAS + 512) & 0x7fff; SET_LDOUBLE_WORDS(x,esx,hx,lx); x *= 0x1p-512; GET_LDOUBLE_WORDS(esx,hx,lx,x); } else { esx = (iy + BIAS) & 0x7fff; } SET_LDOUBLE_WORDS(x,esx,hx,lx); fixup: y = fabsl(y); if (y < LDBL_MIN * 2) { if (x+x>y || (x+x==y && (q & 1))) { q++; x-=y; } } else if (x>0.5*y || (x==0.5*y && (q & 1))) { q++; x-=y; } GET_LDOUBLE_EXP(esx,x); esx ^= sx; SET_LDOUBLE_EXP(x,esx); q &= 0x7fffffff; *quo = (sxy ? -q : q); return x; } wcc-0.0.2/src/wsh/openlibm/ld80/s_ceill.c0000644000175000017500000000344213122010155016452 0ustar philphil/* @(#)s_ceil.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * ceill(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to ceil(x). */ #include #include "math_private.h" static const long double huge = 1.0e4930L; long double ceill(long double x) { int32_t i1,jj0; u_int32_t i,j,se,i0,sx; GET_LDOUBLE_WORDS(se,i0,i1,x); sx = (se>>15)&1; jj0 = (se&0x7fff)-0x3fff; if(jj0<31) { if(jj0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ if(sx) {se=0x8000;i0=0;i1=0;} else if((i0|i1)!=0) { se=0x3fff;i0=0;i1=0;} } } else { i = (0x7fffffff)>>jj0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(sx==0) { if (jj0>0 && (i0+(0x80000000>>jj0))>i0) i0+=0x80000000>>jj0; else { i = 0x7fffffff; ++se; } } i0 &= (~i); i1=0; } } } else if (jj0>62) { if(jj0==0x4000) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(jj0-31); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(sx==0) { if(jj0==31) i0+=1; else { j = i1 + (1<<(63-jj0)); if(j= 0 and data < 256 then -- print(string.format("writting at:0x%x data:0x%x (byte)", pos, data)) return rawmemwrite(pos, string.format("%c", data) , 1) else -- print(string.format("writting at:0x%x data:0x%x (ptr) len:%d", pos, data, string.len(tostring(data)))) print(string.format("ERROR: Data too large (over 1 byte) when writting at:0x%x data:0x%x %s (ptr)", pos, data, tostring(data))) -- local n = string.format("%x", data) -- return rawmemwrite(pos, n , 4) end end end return 0 end mt1 = { __len = function() return 0 end, __newindex = memnewindex, __index = memindex } memory = {} -- display memory usage function memory:usage() return rawmemusage() end -- display hexadecimal of len bytes from address addr function memory:hex(addr, len) local nlen if not len then nlen = 1 else nlen = len end hexdump(addr, nlen) end -- return a pointer to the object passed as argument (shall be a string/userdata/...) function memory:addr(addr) return rawmemaddr(addr) end -- read len bytes from memory at address addr and return them as a string function memory:read(addr, len) local nlen if not len then nlen = 1 else nlen = len end return rawmemread(addr, nlen) end -- write len bytes of data at addr function memory:write(addr, data, len) local nlen if not len then nlen = 1 else nlen = len end return rawmemwrite(addr, data, nlen) end -- read a string (null terminated) from addr function memory:tostring(addr) return rawmemstr(addr) end -- return string length of data at addr function memory:strlen(addr) return rawmemstrlen(addr) end function memory.__index(k) print("no index" .. k) return 4 end setmetatable( memory, mt1 ) wcc-0.0.2/src/wsh/scripts/internals.lua0000644000175000017500000000001413110675433016516 0ustar philphilinternals() wcc-0.0.2/src/wsh/scripts/headers0000644000175000017500000000002213110675433015351 0ustar philphilheaders() exit(0) wcc-0.0.2/src/wsh/scripts/store0000644000175000017500000000011613110675433015076 0ustar philphil-- this function gets overriden by an other script function storerun(t) end wcc-0.0.2/src/wsh/scripts/callmain.wsh0000644000175000017500000000021713110675433016324 0ustar philphil a = array.new(1000) for i=1,array.size(a) do array.set(a, i, 0x41) end printf("0x%02x\n" , array.get(a, 10)) hexdump(a,1000) exit(0) wcc-0.0.2/src/wsh/scripts/hexdump0000644000175000017500000000061513110675433015420 0ustar philphil function hex_dump(buf) for i=1,math.ceil(#buf/16) * 16 do if (i-1) % 16 == 0 then io.write(string.format('%08X ', i-1)) end io.write( i > #buf and ' ' or string.format('%02X ', buf:byte(i)) ) if i % 8 == 0 then io.write(' ') end if i % 16 == 0 then io.write( buf:sub(i-16+1, i):gsub('%c','.'), '\n' ) end end end -- hex_dump("aaaaaaaaa") wcc-0.0.2/src/wsh/scripts/md5.wsh0000755000175000017500000000127313110675433015237 0ustar philphil#!/home/jonathan/solution-exp/unlinking/awareness/self/wcc/src/wsh/wsh -- Computing a MD5 sum using cryptographic functions from foreign binaries (eg: sshd/OpenSSL) function str2md5(input) -- out = calloc(33, 1) -- ctx = calloc(1024, 1) out = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ctx = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" MD5_Init(ctx) MD5_Update(ctx, input, strlen(input)) MD5_Final(out, ctx) -- free(ctx) return out end input = "Message needing hashing\n" hash = str2md5(input) hexdump(hash,16) exit(0) wcc-0.0.2/src/wsh/scripts/searchobj0000644000175000017500000000042413110675433015704 0ustar philphil function searchobj(pattern,b) count = 0 for n,v in pairs(_G) do if(string.find(n,pattern)) then if type(v)~="function" then print("object:", n) count = count + 1 end end end print("") print(" -- ", count, "object match") end -- search("getenv") wcc-0.0.2/src/wsh/scripts/dumptable0000644000175000017500000000764513110675433015735 0ustar philphilfunction pairsByKeys (t, f) local a = {} if not t then return a end for n in pairs(t) do table.insert(a, n) end table.sort(a, f) local i = 0 -- iterator variable local iter = function () -- iterator function i = i + 1 if a[i] == nil then return nil else return a[i], t[a[i]] end end return iter end ----- set runs and metadata runs = {} runsidx = {} mt = { __index = runsidx } setmetatable(runs, mt) --------- function dumptable(t) local indexes = {} local i = 1 -- table.sort(t) -- for x,v in pairs(t) do print(x,v) end for x,v in pairsByKeys(t) do print(x,v) ; indexes[i] = x; i = i+1 ; end return indexes end function dt(t) return dumptable(t) end -- Print contents of `tbl`, with indentation. -- `indent` sets the initial level of indentation. -- There are 8 primitive types: nil, boolean, number, string, function, userdata, thread, and table. function dtt (tbl, indent, rec) if not tbl then return ; end if not indent then indent = 1 end if not rec then rec = 0 end local res = "" local ncount = 0 if rec == 0 then res = "{\n" end for k, v in pairsByKeys(tbl) do local formatting = "" if type(k) == "number" then formatting = string.rep(" ", indent) .. "[" .. k .. "]" .. "=" else formatting = string.rep(" ", indent) .. k .. "=" end ncount = ncount + 1 if type(v) == "table" then res = res .. formatting .. "{\n" .. dtt(v, indent + 1, rec + 1) .. "\n" .. string.rep(" ", indent) .. "},\n" elseif type(v) == "number" then res = res .. string.format("%s0x%x,\n",formatting, v) elseif type(v) == "boolean" then res = res .. formatting .. tostring(v) .. ",\n" elseif type(v) == "string" then res = res .. formatting .. "\"" .. v .. "\",\n" else res = res .. formatting .. tostring(v) .. ",\n" end end res = res:sub(1, -3) if rec == 0 then if res ~= "" then res = res .. "\n" .. "}\n-- total:" .. ncount end print(res) end return res end function dts (tbl, indent, rec) if not indent then indent = 0 end if not rec then rec = 0 end res = "" if rec == 0 then res = "{" end for k, v in pairsByKeys(tbl) do formatting = string.rep(" ", indent) .. k .. "=" if type(v) == "table" then res = res .. formatting .. "{" .. dts(v, indent, rec + 1) .. "}," elseif type(v) == "number" then res = res .. string.format("%s0x%x,",formatting, v) elseif type(v) == "boolean" then res = res .. formatting .. tostring(v) .. "," elseif type(v) == "string" then res = res .. formatting .. "\"" .. v .. "\"," else res = res .. formatting .. tostring(v) .. "," end end res = res:sub(1, -2) -- if rec == 0 then print(res) end if rec == 0 then res = res .. "}" end return res end function rchecksum(t) input = string.format("%s:%u:%s:%s:%s:%s:%s:%x:%s:%1.f",t.alibcall,t.argnum,t.signal,t.mode,t.sicode,t.errnostr,t.caller,t.calleraddr&0xfff,tostring(t.faultaddr ~= 0),math.log(tonumber(t.retval),16)) hash = sha256(input) -- print("rchecksum: " .. input .. " --> " .. hash) hash = "run" .. hash -- prepend a string to hash so it doesn't look like a number to lua return hash end function reindexhash() local i=1; for x,v in pairs(runs) do runsidx[i] = runs[x]; i=i+1; end end function storerun(t) -- print("within storerun") if not t then print(" !! missing input table") end -- print(t) hash = rchecksum(t) -- do not overwrite if already present if runs[hash] == nil then runs[hash] = t ; reindexhash() ; end end function tablemerge(t1, t2) for k,v in pairs(t2) do if type(v) == "table" then if type(t1[k] or false) == "table" then tablemerge(t1[k] or {}, t2[k] or {}) else t1[k] = v end else t1[k] = v end end return t1 end function tableinvert(t) local s={} for k,v in pairs(t) do s[v]=k end return s end wcc-0.0.2/src/wsh/scripts/map0000644000175000017500000000023013110675433014514 0ustar philphil path = calloc(1, 100) mem = calloc(1, 40960) snprintf(path, 99, "/proc/%u/maps", getpid()) fd = open(path) read(fd, mem, 40959) printf("%s", mem) wcc-0.0.2/src/wsh/scripts/search0000644000175000017500000000114413110675433015211 0ustar philphilfunction string.starts(String,Start) return string.sub(String,1,string.len(Start))==Start end function string.ends(String,End) return End=='' or string.sub(String,-string.len(End))==End end function search(pattern,b) -- print("searching", pattern) -- print("") count = 0 for n,v in pairs(_G) do -- print(n) -- if(n == pattern) then if(string.find(n,pattern)) then if type(v)=="function" then if string.starts(n,"reflect_") then print(v, "\t", string.sub(n,9)) count = count + 1 end end end end print("") print(" -- ", count, "functions match") end -- search("getenv") wcc-0.0.2/src/wsh/scripts/breakpoints0000644000175000017500000000025413110675433016266 0ustar philphilbreakpoint(real_setenv, 5) breakpoint(real_getenv, 10) b=getenv("PATH") s=setenv("PATH_COPY", b, 1) printf(" -- total Breakpoint points: %u\n", bp_points) exit(bp_points) wcc-0.0.2/src/wsh/scripts/scope0000644000175000017500000000101713110675433015054 0ustar philphilfunction locals() local variables = {} local idx = 1 while true do local ln, lv = debug.getlocal(2, idx) if ln ~= nil then variables[ln] = lv else break end idx = 1 + idx end return variables end function upvalues() local variables = {} local idx = 1 local func = debug.getinfo(2, "f").func while true do local ln, lv = debug.getupvalue(func, idx) if ln ~= nil then variables[ln] = lv else break end idx = 1 + idx end return variables end wcc-0.0.2/src/wsh/scripts/hashing0000644000175000017500000001363313110675433015373 0ustar philphil -- -- Adaptation of the Secure Hashing Algorithm (SHA-244/256) -- Found Here: http://lua-users.org/wiki/SecureHashAlgorithm -- -- Using an adapted version of the bit library -- Found Here: https://bitbucket.org/Boolsheet/bslf/src/1ee664885805/bit.lua -- local MOD = 2^32 local MODM = MOD-1 local function memoize(f) local mt = {} local t = setmetatable({}, mt) function mt:__index(k) local v = f(k) t[k] = v return v end return t end local function make_bitop_uncached(t, m) local function bitop(a, b) local res,p = 0,1 while a ~= 0 and b ~= 0 do local am, bm = a % m, b % m res = res + t[am][bm] * p a = (a - am) / m b = (b - bm) / m p = p*m end res = res + (a + b) * p return res end return bitop end local function make_bitop(t) local op1 = make_bitop_uncached(t,2^1) local op2 = memoize(function(a) return memoize(function(b) return op1(a, b) end) end) return make_bitop_uncached(op2, 2 ^ (t.n or 1)) end local bxor1 = make_bitop({[0] = {[0] = 0,[1] = 1}, [1] = {[0] = 1, [1] = 0}, n = 4}) local function bxor(a, b, c, ...) local z = nil if b then a = a % MOD b = b % MOD z = bxor1(a, b) if c then z = bxor(z, c, ...) end return z elseif a then return a % MOD else return 0 end end local function band(a, b, c, ...) local z if b then a = a % MOD b = b % MOD z = ((a + b) - bxor1(a,b)) / 2 if c then z = bit32_band(z, c, ...) end return z elseif a then return a % MOD else return MODM end end local function bnot(x) return (-1 - x) % MOD end local function rshift1(a, disp) if disp < 0 then return lshift(a,-disp) end return math.floor(a % 2 ^ 32 / 2 ^ disp) end local function rshift(x, disp) if disp > 31 or disp < -31 then return 0 end return rshift1(x % MOD, disp) end local function lshift(a, disp) if disp < 0 then return rshift(a,-disp) end return (a * 2 ^ disp) % 2 ^ 32 end local function rrotate(x, disp) x = x % MOD disp = disp % 32 local low = band(x, 2 ^ disp - 1) return rshift(x, disp) + lshift(low, 32 - disp) end local k = { 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2, } local function str2hexa(s) return (string.gsub(s, ".", function(c) return string.format("%02x", string.byte(c)) end)) end local function num2s(l, n) local s = "" for i = 1, n do local rem = l % 256 s = string.char(rem) .. s l = (l - rem) / 256 end return s end local function s232num(s, i) local n = 0 for i = i, i + 3 do n = n*256 + string.byte(s, i) end return n end local function preproc(msg, len) local extra = 64 - ((len + 9) % 64) len = num2s(8 * len, 8) msg = msg .. "\128" .. string.rep("\0", extra) .. len assert(#msg % 64 == 0) return msg end local function initH256(H) H[1] = 0x6a09e667 H[2] = 0xbb67ae85 H[3] = 0x3c6ef372 H[4] = 0xa54ff53a H[5] = 0x510e527f H[6] = 0x9b05688c H[7] = 0x1f83d9ab H[8] = 0x5be0cd19 return H end local function digestblock(msg, i, H) local w = {} for j = 1, 16 do w[j] = s232num(msg, i + (j - 1)*4) end for j = 17, 64 do local v = w[j - 15] local s0 = bxor(rrotate(v, 7), rrotate(v, 18), rshift(v, 3)) v = w[j - 2] w[j] = w[j - 16] + s0 + w[j - 7] + bxor(rrotate(v, 17), rrotate(v, 19), rshift(v, 10)) end local a, b, c, d, e, f, g, h = H[1], H[2], H[3], H[4], H[5], H[6], H[7], H[8] for i = 1, 64 do local s0 = bxor(rrotate(a, 2), rrotate(a, 13), rrotate(a, 22)) local maj = bxor(band(a, b), band(a, c), band(b, c)) local t2 = s0 + maj local s1 = bxor(rrotate(e, 6), rrotate(e, 11), rrotate(e, 25)) local ch = bxor (band(e, f), band(bnot(e), g)) local t1 = h + s1 + ch + k[i] + w[i] h, g, f, e, d, c, b, a = g, f, e, d + t1, c, b, a, t1 + t2 end H[1] = band(H[1] + a) H[2] = band(H[2] + b) H[3] = band(H[3] + c) H[4] = band(H[4] + d) H[5] = band(H[5] + e) H[6] = band(H[6] + f) H[7] = band(H[7] + g) H[8] = band(H[8] + h) end function sha256(msg) msg = preproc(msg, #msg) local H = initH256({}) for i = 1, #msg, 64 do digestblock(msg, i, H) end return str2hexa(num2s(H[1], 4) .. num2s(H[2], 4) .. num2s(H[3], 4) .. num2s(H[4], 4) .. num2s(H[5], 4) .. num2s(H[6], 4) .. num2s(H[7], 4) .. num2s(H[8], 4)) end wcc-0.0.2/src/wsh/scripts/md5_bsd.wsh0000644000175000017500000000053413110675433016063 0ustar philphil-- Computing a MD5 sum using cryptographic functions from foreign binaries (eg: sshd/OpenSSL) function str2md5(input) out = calloc(33, 1) ctx = calloc(1024, 1) MD5Init(ctx) MD5Update(ctx, input, strlen(input)) MD5Final(out, ctx) -- free(ctx) return out end input = "Message needing hashing\n" hash = str2md5(input) hexdump(hash,16) wcc-0.0.2/src/wsh/scripts/INDEX0000644000175000017500000000063213110675433014614 0ustar philphilscript("/usr/share/wcc/scripts/store") script("/usr/share/wcc/scripts/hashing") script("/usr/share/wcc/scripts/dumptable") script("/usr/share/wcc/scripts/libmain") script("/usr/share/wcc/scripts/scope") script("/usr/share/wcc/scripts/search") script("/usr/share/wcc/scripts/searchobj") script("/usr/share/wcc/scripts/hexdump") script("/usr/share/wcc/scripts/annotate") script("/usr/share/wcc/scripts/memory") wcc-0.0.2/src/wsh/scripts/annotate0000644000175000017500000000731513110675433015563 0ustar philphil -- prepapre test context arg1rec = xalloc(1024, 0, 1) arg2rec = xalloc(1024, 0, 1) arg3rec = xalloc(1024, 0, 1) arg4rec = xalloc(1024, 0, 1) arg5rec = xalloc(1024, 0, 1) arg6rec = xalloc(1024, 0, 1) arg1r = ralloc(100,0x41); arg2r = ralloc(100,0x42); arg3r = ralloc(100,0x43); arg4r = ralloc(100,0x44); arg5r = ralloc(100,0x45); arg6r = ralloc(100,0x46); function swap(array, index1, index2) array[index1], array[index2] = array[index2], array[index1] end function shuffle(array) local counter = #array while counter > 1 do local index = math.random(counter) swap(array, index, counter) counter = counter - 1 end end function fuzzargs(a,b,c,d,e,f, seed, rate) -- math.randomseed(seed) -- math.randomseed(os.time()) rargs = { -128, -1, 0, 1, 16, 32, 64, 100, 127, -32768, -129, 128, 255, 256, 512, 1000, 1024, 4096, 32767, -2147483648, -100663046, -32769, 32768, 65535, 65536, 100663045, 2147483647, 2, 5, 13, "/etc/passwd", "/invalid/nonexistent", "/tmp/out.txt", "/bin/ls", "/bin/sh", "/tmp/", "/etc/shadow", "/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz", "%n%n%n%n%n%n", "%h%h%h%h%h%h%h%s%s%s%s" } aout,bout,cout,dout,eout,fout = a,b,c,d,e,f if math.random(100) < rate then aout = rargs[math.random(40)]; end if math.random(100) < rate then bout = rargs[math.random(40)]; end if math.random(100) < rate then cout = rargs[math.random(40)]; end if math.random(100) < rate then dout = rargs[math.random(40)]; end if math.random(100) < rate then eout = rargs[math.random(40)]; end if math.random(100) < rate then fout = rargs[math.random(40)]; end return aout,bout,cout,dout,eout,fout end function annotate(fun,a,b,c,d,e,f, seed, rate) -- prepare fuzzed arguments if needed if seed ~= 0 then a,b,c,d,e,f = fuzzargs(a,b,c,d,e,f, seed, rate); end -- Make the call, with a max timeout ret,ctx=fun(a,b,c,d,e,f) -- storerun(ctx) -- alarm(0); end function testfunc(f, num) local n, maxnum -- polute .bss -- bsspolute() arg1s = "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" arg2s = "/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" arg3s = "/cccccccccccccccccccccccccccccccc" arg4s = "/dddddddddddddddddddddddddddddddd" arg5s = "/eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee" arg6s = "/ffffffffffffffffffffffffffffffff" testarg = { arg1 = { 0x41414141, arg1rec, arg1s, arg1r, arg1s }, arg2 = { 0x42424242, arg2rec, arg2s, arg2r, arg2s }, arg3 = { 0x43434343, arg3rec, arg3s, arg3r, arg3s }, arg4 = { 0x44444444, arg4rec, arg4s, arg4r, arg4s }, arg5 = { 0x45454545, arg5rec, arg5s, arg5r, arg5s }, arg6 = { 0x46464646, arg6rec, arg6s, arg6r, arg6s } } -- Run determinist test cases for n=1,5 do annotate(f, testarg.arg1[n], testarg.arg2[n], testarg.arg3[n], testarg.arg4[n], testarg.arg5[n], testarg.arg6[n], 0, 0) end -- Run random test cases math.randomseed(os.time()) maxnum = 0 if num ~= nil then maxnum = num end for n=0,maxnum do annotate(f, testarg.arg1[math.random(6)], testarg.arg2[math.random(6)], testarg.arg3[math.random(6)], testarg.arg4[math.random(6)], testarg.arg5[math.random(6)], testarg.arg6[math.random(6)], math.random(1000), 50) end print(" [*] all tests done (" .. maxnum + 5 .. " calls)") -- alarm(0); end function testlib(name, num) local world = functions("",name,1) math.randomseed(os.time()) shuffle(world) for x,v in pairs(world) do print(" [*] Testing", x, v) testfunc(v, num) end end function retest(hash) local h = runs[hash] print(h.alibcall .. "()") end -- testfunc(gzclose_w) -- testfunc(gzwrite) -- testfunc(snprintf) -- testfunc(execlp) -- testfunc() -- testfunc(memcpy) -- testfunc(sprintf) -- testfunc(sscanf) -- testfunc(execlp) wcc-0.0.2/src/wsh/scripts/print_G0000755000175000017500000000006313110675433015350 0ustar philphil#!/usr/bin/lua for n in pairs(_G) do print(n) end wcc-0.0.2/src/wsh/scripts/main.wsh0000755000175000017500000000177213110675433015502 0ustar philphillocal ffi = require("ffi") ffi.cdef[[ unsigned long compressBound(unsigned long sourceLen); int compress2(uint8_t *dest, unsigned long *destLen, const uint8_t *source, unsigned long sourceLen, int level); int uncompress(uint8_t *dest, unsigned long *destLen, const uint8_t *source, unsigned long sourceLen); ]] local zlib = ffi.load(ffi.os == "Windows" and "zlib1" or "z") local function compress(txt) local n = zlib.compressBound(#txt) local buf = ffi.new("uint8_t[?]", n) local buflen = ffi.new("unsigned long[1]", n) local res = zlib.compress2(buf, buflen, txt, #txt, 9) assert(res == 0) return ffi.string(buf, buflen[0]) end local function uncompress(comp, n) local buf = ffi.new("uint8_t[?]", n) local buflen = ffi.new("unsigned long[1]", n) local res = zlib.uncompress(buf, buflen, comp, #comp) assert(res == 0) return ffi.string(buf, buflen[0]) end argc = 2 argv = ffi.new("char[?]", argc) argv[1] = "mama" -- argv[2] = "foobar" -- main(argc, argv) exit(0) wcc-0.0.2/src/wsh/scripts/debug0000755000175000017500000000001613110675433015032 0ustar philphildebug.debug() wcc-0.0.2/src/wsh/scripts/dumpbin.wsh0000755000175000017500000000064613110675433016213 0ustar philphil f = io.open("/bin/pwd", "rb") block = 48 totbytes = 0 while true do bytes = f:read(block) if not bytes then break end io.write(string.format("0x%08x: ", totbytes)) totbytes = totbytes + block for b in string.gmatch(bytes, ".") do io.write(string.format("%02X ", string.byte(b))) end io.write(string.rep(" ", block - string.len(bytes) + 1)) io.write(string.gsub(bytes, "%c", "."), "\n") end exit(0) wcc-0.0.2/src/wsh/Makefile0000644000175000017500000000320513110675433013772 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # OBJLIB := ./lua/src/liblua.a ./openlibm/libopenlibm.a #CFLAGS := -rdynamic -W -Wall -Wextra -O0 -mpreferred-stack-boundary=12 -mstackrealign -ggdb -g3 -Wno-unused-but-set-variable -Wno-unused-parameter -I./include -rdynamic -I../../include/ -I./luajit-2.0/src/ -Wl,-E -Wl,-z,now #OBJLIB := ./luajit-2.0/src/libluajit.a ./openlibm/libopenlibm.a all:: cd openlibm && make CFLAGS="-fpie -fPIC" cd lua && make linux CFLAGS="-fpie -fPIC" $(CC) $(CFLAGS) wsh.c -o wsh.o -c -fpie -fPIC -ldl -lreadline $(CC) $(CFLAGS) wshmain.c -o wshmain.o -c -fpie -fPIC -ldl -lreadline $(CC) $(CFLAGS) helper.c -o helper.o -c -fpie -fPIC $(CC) $(CFLAGS) linenoise/linenoise.c -o linenoise.o -c -fpie -fPIC $(CC) $(CFLAGS) wsh.o helper.o linenoise.o -shared -fPIC -o libwitch.so ar cr libwitch.a wsh.o helper.o linenoise.o $(CC) $(CFLAGS) wsh.o helper.o linenoise.o wshmain.o -o wsh -Wl,-T -Wl,script.lds -liberty $(OBJLIB) -ldl cp wsh ../../bin/ test: cd tests && make clean:: rm wsh helper.o wsh.o wshmain.o libwitch.so libwitch.a linenoise.o learnwitch.log -f cd openlibm && make clean cd lua && make clean cd tests && make clean deepclean: cd openlibm && make clean cd lua && make clean make clean install:: mkdir -p $(DESTDIR)/usr/share/wcc/ cp -r ./scripts $(DESTDIR)/usr/share/wcc/ cp wsh $(DESTDIR)/usr/bin/wsh uninstall:: rm -rf $(DESTDIR)/usr/share/wcc/ rm -f $(DESTDIR)/usr/bin/wsh binfmt: sudo update-binfmts --install wsh /usr/bin/wsh --extension wsh wcc-0.0.2/src/wsh/luajit-2.0/0000755000175000017500000000000013122010155014102 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/Makefile0000644000175000017500000001273313122010155015550 0ustar philphil############################################################################## # LuaJIT top level Makefile for installation. Requires GNU Make. # # Please read doc/install.html before changing any variables! # # Suitable for POSIX platforms (Linux, *BSD, OSX etc.). # Note: src/Makefile has many more configurable options. # # ##### This Makefile is NOT useful for Windows! ##### # For MSVC, please follow the instructions given in src/msvcbuild.bat. # For MinGW and Cygwin, cd to src and run make with the Makefile there. # # Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ############################################################################## MAJVER= 2 MINVER= 0 RELVER= 4 VERSION= $(MAJVER).$(MINVER).$(RELVER) ABIVER= 5.1 ############################################################################## # # Change the installation path as needed. This automatically adjusts # the paths in src/luaconf.h, too. Note: PREFIX must be an absolute path! # export PREFIX= /usr/local export MULTILIB= lib ############################################################################## DPREFIX= $(DESTDIR)$(PREFIX) INSTALL_BIN= $(DPREFIX)/bin INSTALL_LIB= $(DPREFIX)/$(MULTILIB) INSTALL_SHARE= $(DPREFIX)/share INSTALL_INC= $(DPREFIX)/include/luajit-$(MAJVER).$(MINVER) INSTALL_LJLIBD= $(INSTALL_SHARE)/luajit-$(VERSION) INSTALL_JITLIB= $(INSTALL_LJLIBD)/jit INSTALL_LMODD= $(INSTALL_SHARE)/lua INSTALL_LMOD= $(INSTALL_LMODD)/$(ABIVER) INSTALL_CMODD= $(INSTALL_LIB)/lua INSTALL_CMOD= $(INSTALL_CMODD)/$(ABIVER) INSTALL_MAN= $(INSTALL_SHARE)/man/man1 INSTALL_PKGCONFIG= $(INSTALL_LIB)/pkgconfig INSTALL_TNAME= luajit-$(VERSION) INSTALL_TSYMNAME= luajit INSTALL_ANAME= libluajit-$(ABIVER).a INSTALL_SOSHORT1= libluajit-$(ABIVER).so INSTALL_SOSHORT2= libluajit-$(ABIVER).so.$(MAJVER) INSTALL_SONAME= $(INSTALL_SOSHORT2).$(MINVER).$(RELVER) INSTALL_DYLIBSHORT1= libluajit-$(ABIVER).dylib INSTALL_DYLIBSHORT2= libluajit-$(ABIVER).$(MAJVER).dylib INSTALL_DYLIBNAME= libluajit-$(ABIVER).$(MAJVER).$(MINVER).$(RELVER).dylib INSTALL_PCNAME= luajit.pc INSTALL_STATIC= $(INSTALL_LIB)/$(INSTALL_ANAME) INSTALL_DYN= $(INSTALL_LIB)/$(INSTALL_SONAME) INSTALL_SHORT1= $(INSTALL_LIB)/$(INSTALL_SOSHORT1) INSTALL_SHORT2= $(INSTALL_LIB)/$(INSTALL_SOSHORT2) INSTALL_T= $(INSTALL_BIN)/$(INSTALL_TNAME) INSTALL_TSYM= $(INSTALL_BIN)/$(INSTALL_TSYMNAME) INSTALL_PC= $(INSTALL_PKGCONFIG)/$(INSTALL_PCNAME) INSTALL_DIRS= $(INSTALL_BIN) $(INSTALL_LIB) $(INSTALL_INC) $(INSTALL_MAN) \ $(INSTALL_PKGCONFIG) $(INSTALL_JITLIB) $(INSTALL_LMOD) $(INSTALL_CMOD) UNINSTALL_DIRS= $(INSTALL_JITLIB) $(INSTALL_LJLIBD) $(INSTALL_INC) \ $(INSTALL_LMOD) $(INSTALL_LMODD) $(INSTALL_CMOD) $(INSTALL_CMODD) RM= rm -f MKDIR= mkdir -p RMDIR= rmdir 2>/dev/null SYMLINK= ln -sf INSTALL_X= install -m 0755 INSTALL_F= install -m 0644 UNINSTALL= $(RM) LDCONFIG= ldconfig -n SED_PC= sed -e "s|^prefix=.*|prefix=$(PREFIX)|" \ -e "s|^multilib=.*|multilib=$(MULTILIB)|" FILE_T= luajit FILE_A= libluajit.a FILE_SO= libluajit.so FILE_MAN= luajit.1 FILE_PC= luajit.pc FILES_INC= lua.h lualib.h lauxlib.h luaconf.h lua.hpp luajit.h FILES_JITLIB= bc.lua v.lua dump.lua dis_x86.lua dis_x64.lua dis_arm.lua \ dis_ppc.lua dis_mips.lua dis_mipsel.lua bcsave.lua vmdef.lua ifeq (,$(findstring Windows,$(OS))) HOST_SYS:= $(shell uname -s) else HOST_SYS= Windows endif TARGET_SYS?= $(HOST_SYS) ifeq (Darwin,$(TARGET_SYS)) INSTALL_SONAME= $(INSTALL_DYLIBNAME) INSTALL_SOSHORT1= $(INSTALL_DYLIBSHORT1) INSTALL_SOSHORT2= $(INSTALL_DYLIBSHORT2) LDCONFIG= : endif ############################################################################## INSTALL_DEP= src/luajit default all $(INSTALL_DEP): @echo "==== Building LuaJIT $(VERSION) ====" $(MAKE) -C src @echo "==== Successfully built LuaJIT $(VERSION) ====" install: $(INSTALL_DEP) @echo "==== Installing LuaJIT $(VERSION) to $(PREFIX) ====" $(MKDIR) $(INSTALL_DIRS) cd src && $(INSTALL_X) $(FILE_T) $(INSTALL_T) cd src && test -f $(FILE_A) && $(INSTALL_F) $(FILE_A) $(INSTALL_STATIC) || : $(RM) $(INSTALL_TSYM) $(INSTALL_DYN) $(INSTALL_SHORT1) $(INSTALL_SHORT2) cd src && test -f $(FILE_SO) && \ $(INSTALL_X) $(FILE_SO) $(INSTALL_DYN) && \ $(LDCONFIG) $(INSTALL_LIB) && \ $(SYMLINK) $(INSTALL_SONAME) $(INSTALL_SHORT1) && \ $(SYMLINK) $(INSTALL_SONAME) $(INSTALL_SHORT2) || : cd etc && $(INSTALL_F) $(FILE_MAN) $(INSTALL_MAN) cd etc && $(SED_PC) $(FILE_PC) > $(FILE_PC).tmp && \ $(INSTALL_F) $(FILE_PC).tmp $(INSTALL_PC) && \ $(RM) $(FILE_PC).tmp cd src && $(INSTALL_F) $(FILES_INC) $(INSTALL_INC) cd src/jit && $(INSTALL_F) $(FILES_JITLIB) $(INSTALL_JITLIB) $(SYMLINK) $(INSTALL_TNAME) $(INSTALL_TSYM) @echo "==== Successfully installed LuaJIT $(VERSION) to $(PREFIX) ====" uninstall: @echo "==== Uninstalling LuaJIT $(VERSION) from $(PREFIX) ====" $(UNINSTALL) $(INSTALL_TSYM) $(INSTALL_T) $(INSTALL_STATIC) $(INSTALL_DYN) $(INSTALL_SHORT1) $(INSTALL_SHORT2) $(INSTALL_MAN)/$(FILE_MAN) $(INSTALL_PC) for file in $(FILES_JITLIB); do \ $(UNINSTALL) $(INSTALL_JITLIB)/$$file; \ done for file in $(FILES_INC); do \ $(UNINSTALL) $(INSTALL_INC)/$$file; \ done $(LDCONFIG) $(INSTALL_LIB) $(RMDIR) $(UNINSTALL_DIRS) || : @echo "==== Successfully uninstalled LuaJIT $(VERSION) from $(PREFIX) ====" ############################################################################## amalg: @echo "Building LuaJIT $(VERSION)" $(MAKE) -C src amalg clean: $(MAKE) -C src clean .PHONY: all install amalg clean ############################################################################## wcc-0.0.2/src/wsh/luajit-2.0/src/0000755000175000017500000000000013122010155014671 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/src/lj_opt_sink.c0000644000175000017500000001566413122010155017364 0ustar philphil/* ** SINK: Allocation Sinking and Store Sinking. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_opt_sink_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" #include "lj_target.h" /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) /* Check whether the store ref points to an eligible allocation. */ static IRIns *sink_checkalloc(jit_State *J, IRIns *irs) { IRIns *ir = IR(irs->op1); if (!irref_isk(ir->op2)) return NULL; /* Non-constant key. */ if (ir->o == IR_HREFK || ir->o == IR_AREF) ir = IR(ir->op1); else if (!(ir->o == IR_HREF || ir->o == IR_NEWREF || ir->o == IR_FREF || ir->o == IR_ADD)) return NULL; /* Unhandled reference type (for XSTORE). */ ir = IR(ir->op1); if (!(ir->o == IR_TNEW || ir->o == IR_TDUP || ir->o == IR_CNEW)) return NULL; /* Not an allocation. */ return ir; /* Return allocation. */ } /* Recursively check whether a value depends on a PHI. */ static int sink_phidep(jit_State *J, IRRef ref) { IRIns *ir = IR(ref); if (irt_isphi(ir->t)) return 1; if (ir->op1 >= REF_FIRST && sink_phidep(J, ir->op1)) return 1; if (ir->op2 >= REF_FIRST && sink_phidep(J, ir->op2)) return 1; return 0; } /* Check whether a value is a sinkable PHI or loop-invariant. */ static int sink_checkphi(jit_State *J, IRIns *ira, IRRef ref) { if (ref >= REF_FIRST) { IRIns *ir = IR(ref); if (irt_isphi(ir->t) || (ir->o == IR_CONV && ir->op2 == IRCONV_NUM_INT && irt_isphi(IR(ir->op1)->t))) { ira->prev++; return 1; /* Sinkable PHI. */ } /* Otherwise the value must be loop-invariant. */ return ref < J->loopref && !sink_phidep(J, ref); } return 1; /* Constant (non-PHI). */ } /* Mark non-sinkable allocations using single-pass backward propagation. ** ** Roots for the marking process are: ** - Some PHIs or snapshots (see below). ** - Non-PHI, non-constant values stored to PHI allocations. ** - All guards. ** - Any remaining loads not eliminated by store-to-load forwarding. ** - Stores with non-constant keys. ** - All stored values. */ static void sink_mark_ins(jit_State *J) { IRIns *ir, *irlast = IR(J->cur.nins-1); for (ir = irlast ; ; ir--) { switch (ir->o) { case IR_BASE: return; /* Finished. */ case IR_CALLL: /* IRCALL_lj_tab_len */ case IR_ALOAD: case IR_HLOAD: case IR_XLOAD: case IR_TBAR: irt_setmark(IR(ir->op1)->t); /* Mark ref for remaining loads. */ break; case IR_FLOAD: if (irt_ismarked(ir->t) || ir->op2 == IRFL_TAB_META) irt_setmark(IR(ir->op1)->t); /* Mark table for remaining loads. */ break; case IR_ASTORE: case IR_HSTORE: case IR_FSTORE: case IR_XSTORE: { IRIns *ira = sink_checkalloc(J, ir); if (!ira || (irt_isphi(ira->t) && !sink_checkphi(J, ira, ir->op2))) irt_setmark(IR(ir->op1)->t); /* Mark ineligible ref. */ irt_setmark(IR(ir->op2)->t); /* Mark stored value. */ break; } #if LJ_HASFFI case IR_CNEWI: if (irt_isphi(ir->t) && (!sink_checkphi(J, ir, ir->op2) || (LJ_32 && ir+1 < irlast && (ir+1)->o == IR_HIOP && !sink_checkphi(J, ir, (ir+1)->op2)))) irt_setmark(ir->t); /* Mark ineligible allocation. */ /* fallthrough */ #endif case IR_USTORE: irt_setmark(IR(ir->op2)->t); /* Mark stored value. */ break; #if LJ_HASFFI case IR_CALLXS: #endif case IR_CALLS: irt_setmark(IR(ir->op1)->t); /* Mark (potentially) stored values. */ break; case IR_PHI: { IRIns *irl = IR(ir->op1), *irr = IR(ir->op2); irl->prev = irr->prev = 0; /* Clear PHI value counts. */ if (irl->o == irr->o && (irl->o == IR_TNEW || irl->o == IR_TDUP || (LJ_HASFFI && (irl->o == IR_CNEW || irl->o == IR_CNEWI)))) break; irt_setmark(irl->t); irt_setmark(irr->t); break; } default: if (irt_ismarked(ir->t) || irt_isguard(ir->t)) { /* Propagate mark. */ if (ir->op1 >= REF_FIRST) irt_setmark(IR(ir->op1)->t); if (ir->op2 >= REF_FIRST) irt_setmark(IR(ir->op2)->t); } break; } } } /* Mark all instructions referenced by a snapshot. */ static void sink_mark_snap(jit_State *J, SnapShot *snap) { SnapEntry *map = &J->cur.snapmap[snap->mapofs]; MSize n, nent = snap->nent; for (n = 0; n < nent; n++) { IRRef ref = snap_ref(map[n]); if (!irref_isk(ref)) irt_setmark(IR(ref)->t); } } /* Iteratively remark PHI refs with differing marks or PHI value counts. */ static void sink_remark_phi(jit_State *J) { IRIns *ir; int remark; do { remark = 0; for (ir = IR(J->cur.nins-1); ir->o == IR_PHI; ir--) { IRIns *irl = IR(ir->op1), *irr = IR(ir->op2); if (!((irl->t.irt ^ irr->t.irt) & IRT_MARK) && irl->prev == irr->prev) continue; remark |= (~(irl->t.irt & irr->t.irt) & IRT_MARK); irt_setmark(IR(ir->op1)->t); irt_setmark(IR(ir->op2)->t); } } while (remark); } /* Sweep instructions and tag sunken allocations and stores. */ static void sink_sweep_ins(jit_State *J) { IRIns *ir, *irfirst = IR(J->cur.nk); for (ir = IR(J->cur.nins-1) ; ir >= irfirst; ir--) { switch (ir->o) { case IR_ASTORE: case IR_HSTORE: case IR_FSTORE: case IR_XSTORE: { IRIns *ira = sink_checkalloc(J, ir); if (ira && !irt_ismarked(ira->t)) { int delta = (int)(ir - ira); ir->prev = REGSP(RID_SINK, delta > 255 ? 255 : delta); } else { ir->prev = REGSP_INIT; } break; } case IR_NEWREF: if (!irt_ismarked(IR(ir->op1)->t)) { ir->prev = REGSP(RID_SINK, 0); } else { irt_clearmark(ir->t); ir->prev = REGSP_INIT; } break; #if LJ_HASFFI case IR_CNEW: case IR_CNEWI: #endif case IR_TNEW: case IR_TDUP: if (!irt_ismarked(ir->t)) { ir->t.irt &= ~IRT_GUARD; ir->prev = REGSP(RID_SINK, 0); J->cur.sinktags = 1; /* Signal present SINK tags to assembler. */ } else { irt_clearmark(ir->t); ir->prev = REGSP_INIT; } break; case IR_PHI: { IRIns *ira = IR(ir->op2); if (!irt_ismarked(ira->t) && (ira->o == IR_TNEW || ira->o == IR_TDUP || (LJ_HASFFI && (ira->o == IR_CNEW || ira->o == IR_CNEWI)))) { ir->prev = REGSP(RID_SINK, 0); } else { ir->prev = REGSP_INIT; } break; } default: irt_clearmark(ir->t); ir->prev = REGSP_INIT; break; } } } /* Allocation sinking and store sinking. ** ** 1. Mark all non-sinkable allocations. ** 2. Then sink all remaining allocations and the related stores. */ void lj_opt_sink(jit_State *J) { const uint32_t need = (JIT_F_OPT_SINK|JIT_F_OPT_FWD| JIT_F_OPT_DCE|JIT_F_OPT_CSE|JIT_F_OPT_FOLD); if ((J->flags & need) == need && (J->chain[IR_TNEW] || J->chain[IR_TDUP] || (LJ_HASFFI && (J->chain[IR_CNEW] || J->chain[IR_CNEWI])))) { if (!J->loopref) sink_mark_snap(J, &J->cur.snap[J->cur.nsnap-1]); sink_mark_ins(J); if (J->loopref) sink_remark_phi(J); sink_sweep_ins(J); } } #undef IR #endif wcc-0.0.2/src/wsh/luajit-2.0/src/xedkbuild.bat0000644000175000017500000000607713122010155017346 0ustar philphil@rem Script to build LuaJIT with the Xbox 360 SDK. @rem Donated to the public domain. @rem @rem Open a "Visual Studio .NET Command Prompt" (32 bit host compiler) @rem Then cd to this directory and run this script. @if not defined INCLUDE goto :FAIL @if not defined XEDK goto :FAIL @setlocal @rem ---- Host compiler ---- @set LJCOMPILE=cl /nologo /c /MD /O2 /W3 /D_CRT_SECURE_NO_DEPRECATE @set LJLINK=link /nologo @set LJMT=mt /nologo @set DASMDIR=..\dynasm @set DASM=%DASMDIR%\dynasm.lua @set ALL_LIB=lib_base.c lib_math.c lib_bit.c lib_string.c lib_table.c lib_io.c lib_os.c lib_package.c lib_debug.c lib_jit.c lib_ffi.c %LJCOMPILE% host\minilua.c @if errorlevel 1 goto :BAD %LJLINK% /out:minilua.exe minilua.obj @if errorlevel 1 goto :BAD if exist minilua.exe.manifest^ %LJMT% -manifest minilua.exe.manifest -outputresource:minilua.exe @rem Error out for 64 bit host compiler @minilua @if errorlevel 8 goto :FAIL @set DASMFLAGS=-D GPR64 -D FRAME32 -D PPE -D SQRT -D DUALNUM minilua %DASM% -LN %DASMFLAGS% -o host\buildvm_arch.h vm_ppc.dasc @if errorlevel 1 goto :BAD %LJCOMPILE% /I "." /I %DASMDIR% /D_XBOX_VER=200 /DLUAJIT_TARGET=LUAJIT_ARCH_PPC host\buildvm*.c @if errorlevel 1 goto :BAD %LJLINK% /out:buildvm.exe buildvm*.obj @if errorlevel 1 goto :BAD if exist buildvm.exe.manifest^ %LJMT% -manifest buildvm.exe.manifest -outputresource:buildvm.exe buildvm -m peobj -o lj_vm.obj @if errorlevel 1 goto :BAD buildvm -m bcdef -o lj_bcdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m ffdef -o lj_ffdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m libdef -o lj_libdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m recdef -o lj_recdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m vmdef -o jit\vmdef.lua %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m folddef -o lj_folddef.h lj_opt_fold.c @if errorlevel 1 goto :BAD @rem ---- Cross compiler ---- @set LJCOMPILE="%XEDK%\bin\win32\cl" /nologo /c /MT /O2 /W3 /GF /Gm- /GR- /GS- /Gy /openmp- /D_CRT_SECURE_NO_DEPRECATE /DNDEBUG /D_XBOX /D_LIB /DLUAJIT_USE_SYSMALLOC @set LJLIB="%XEDK%\bin\win32\lib" /nologo @set "INCLUDE=%XEDK%\include\xbox" @if "%1" neq "debug" goto :NODEBUG @shift @set "LJCOMPILE=%LJCOMPILE% /Zi" :NODEBUG @if "%1"=="amalg" goto :AMALG %LJCOMPILE% /DLUA_BUILD_AS_DLL lj_*.c lib_*.c @if errorlevel 1 goto :BAD %LJLIB% /OUT:luajit20.lib lj_*.obj lib_*.obj @if errorlevel 1 goto :BAD @goto :NOAMALG :AMALG %LJCOMPILE% /DLUA_BUILD_AS_DLL ljamalg.c @if errorlevel 1 goto :BAD %LJLIB% /OUT:luajit20.lib ljamalg.obj lj_vm.obj @if errorlevel 1 goto :BAD :NOAMALG @del *.obj *.manifest minilua.exe buildvm.exe @echo. @echo === Successfully built LuaJIT for Xbox 360 === @goto :END :BAD @echo. @echo ******************************************************* @echo *** Build FAILED -- Please check the error messages *** @echo ******************************************************* @goto :END :FAIL @echo To run this script you must open a "Visual Studio .NET Command Prompt" @echo (32 bit host compiler). The Xbox 360 SDK must be installed, too. :END wcc-0.0.2/src/wsh/luajit-2.0/src/vm_x86.dasc0000644000175000017500000051465113122010155016670 0ustar philphil|// Low-level VM code for x86 CPUs. |// Bytecode interpreter, fast functions and helper functions. |// Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h | |.if P64 |.arch x64 |.else |.arch x86 |.endif |.section code_op, code_sub | |.actionlist build_actionlist |.globals GLOB_ |.globalnames globnames |.externnames extnames | |//----------------------------------------------------------------------- | |.if P64 |.define X64, 1 |.define SSE, 1 |.if WIN |.define X64WIN, 1 |.endif |.endif | |// Fixed register assignments for the interpreter. |// This is very fragile and has many dependencies. Caveat emptor. |.define BASE, edx // Not C callee-save, refetched anyway. |.if not X64 |.define KBASE, edi // Must be C callee-save. |.define KBASEa, KBASE |.define PC, esi // Must be C callee-save. |.define PCa, PC |.define DISPATCH, ebx // Must be C callee-save. |.elif X64WIN |.define KBASE, edi // Must be C callee-save. |.define KBASEa, rdi |.define PC, esi // Must be C callee-save. |.define PCa, rsi |.define DISPATCH, ebx // Must be C callee-save. |.else |.define KBASE, r15d // Must be C callee-save. |.define KBASEa, r15 |.define PC, ebx // Must be C callee-save. |.define PCa, rbx |.define DISPATCH, r14d // Must be C callee-save. |.endif | |.define RA, ecx |.define RAH, ch |.define RAL, cl |.define RB, ebp // Must be ebp (C callee-save). |.define RC, eax // Must be eax. |.define RCW, ax |.define RCH, ah |.define RCL, al |.define OP, RB |.define RD, RC |.define RDW, RCW |.define RDL, RCL |.if X64 |.define RAa, rcx |.define RBa, rbp |.define RCa, rax |.define RDa, rax |.else |.define RAa, RA |.define RBa, RB |.define RCa, RC |.define RDa, RD |.endif | |.if not X64 |.define FCARG1, ecx // x86 fastcall arguments. |.define FCARG2, edx |.elif X64WIN |.define CARG1, rcx // x64/WIN64 C call arguments. |.define CARG2, rdx |.define CARG3, r8 |.define CARG4, r9 |.define CARG1d, ecx |.define CARG2d, edx |.define CARG3d, r8d |.define CARG4d, r9d |.define FCARG1, CARG1d // Upwards compatible to x86 fastcall. |.define FCARG2, CARG2d |.else |.define CARG1, rdi // x64/POSIX C call arguments. |.define CARG2, rsi |.define CARG3, rdx |.define CARG4, rcx |.define CARG5, r8 |.define CARG6, r9 |.define CARG1d, edi |.define CARG2d, esi |.define CARG3d, edx |.define CARG4d, ecx |.define CARG5d, r8d |.define CARG6d, r9d |.define FCARG1, CARG1d // Simulate x86 fastcall. |.define FCARG2, CARG2d |.endif | |// Type definitions. Some of these are only used for documentation. |.type L, lua_State |.type GL, global_State |.type TVALUE, TValue |.type GCOBJ, GCobj |.type STR, GCstr |.type TAB, GCtab |.type LFUNC, GCfuncL |.type CFUNC, GCfuncC |.type PROTO, GCproto |.type UPVAL, GCupval |.type NODE, Node |.type NARGS, int |.type TRACE, GCtrace | |// Stack layout while in interpreter. Must match with lj_frame.h. |//----------------------------------------------------------------------- |.if not X64 // x86 stack layout. | |.define CFRAME_SPACE, aword*7 // Delta for esp (see <--). |.macro saveregs_ | push edi; push esi; push ebx | sub esp, CFRAME_SPACE |.endmacro |.macro saveregs | push ebp; saveregs_ |.endmacro |.macro restoreregs | add esp, CFRAME_SPACE | pop ebx; pop esi; pop edi; pop ebp |.endmacro | |.define SAVE_ERRF, aword [esp+aword*15] // vm_pcall/vm_cpcall only. |.define SAVE_NRES, aword [esp+aword*14] |.define SAVE_CFRAME, aword [esp+aword*13] |.define SAVE_L, aword [esp+aword*12] |//----- 16 byte aligned, ^^^ arguments from C caller |.define SAVE_RET, aword [esp+aword*11] //<-- esp entering interpreter. |.define SAVE_R4, aword [esp+aword*10] |.define SAVE_R3, aword [esp+aword*9] |.define SAVE_R2, aword [esp+aword*8] |//----- 16 byte aligned |.define SAVE_R1, aword [esp+aword*7] //<-- esp after register saves. |.define SAVE_PC, aword [esp+aword*6] |.define TMP2, aword [esp+aword*5] |.define TMP1, aword [esp+aword*4] |//----- 16 byte aligned |.define ARG4, aword [esp+aword*3] |.define ARG3, aword [esp+aword*2] |.define ARG2, aword [esp+aword*1] |.define ARG1, aword [esp] //<-- esp while in interpreter. |//----- 16 byte aligned, ^^^ arguments for C callee | |// FPARGx overlaps ARGx and ARG(x+1) on x86. |.define FPARG3, qword [esp+qword*1] |.define FPARG1, qword [esp] |// TMPQ overlaps TMP1/TMP2. ARG5/MULTRES overlap TMP1/TMP2 (and TMPQ). |.define TMPQ, qword [esp+aword*4] |.define TMP3, ARG4 |.define ARG5, TMP1 |.define TMPa, TMP1 |.define MULTRES, TMP2 | |// Arguments for vm_call and vm_pcall. |.define INARG_BASE, SAVE_CFRAME // Overwritten by SAVE_CFRAME! | |// Arguments for vm_cpcall. |.define INARG_CP_CALL, SAVE_ERRF |.define INARG_CP_UD, SAVE_NRES |.define INARG_CP_FUNC, SAVE_CFRAME | |//----------------------------------------------------------------------- |.elif X64WIN // x64/Windows stack layout | |.define CFRAME_SPACE, aword*5 // Delta for rsp (see <--). |.macro saveregs_ | push rdi; push rsi; push rbx | sub rsp, CFRAME_SPACE |.endmacro |.macro saveregs | push rbp; saveregs_ |.endmacro |.macro restoreregs | add rsp, CFRAME_SPACE | pop rbx; pop rsi; pop rdi; pop rbp |.endmacro | |.define SAVE_CFRAME, aword [rsp+aword*13] |.define SAVE_PC, dword [rsp+dword*25] |.define SAVE_L, dword [rsp+dword*24] |.define SAVE_ERRF, dword [rsp+dword*23] |.define SAVE_NRES, dword [rsp+dword*22] |.define TMP2, dword [rsp+dword*21] |.define TMP1, dword [rsp+dword*20] |//----- 16 byte aligned, ^^^ 32 byte register save area, owned by interpreter |.define SAVE_RET, aword [rsp+aword*9] //<-- rsp entering interpreter. |.define SAVE_R4, aword [rsp+aword*8] |.define SAVE_R3, aword [rsp+aword*7] |.define SAVE_R2, aword [rsp+aword*6] |.define SAVE_R1, aword [rsp+aword*5] //<-- rsp after register saves. |.define ARG5, aword [rsp+aword*4] |.define CSAVE_4, aword [rsp+aword*3] |.define CSAVE_3, aword [rsp+aword*2] |.define CSAVE_2, aword [rsp+aword*1] |.define CSAVE_1, aword [rsp] //<-- rsp while in interpreter. |//----- 16 byte aligned, ^^^ 32 byte register save area, owned by callee | |// TMPQ overlaps TMP1/TMP2. MULTRES overlaps TMP2 (and TMPQ). |.define TMPQ, qword [rsp+aword*10] |.define MULTRES, TMP2 |.define TMPa, ARG5 |.define ARG5d, dword [rsp+aword*4] |.define TMP3, ARG5d | |//----------------------------------------------------------------------- |.else // x64/POSIX stack layout | |.define CFRAME_SPACE, aword*5 // Delta for rsp (see <--). |.macro saveregs_ | push rbx; push r15; push r14 |.if NO_UNWIND | push r13; push r12 |.endif | sub rsp, CFRAME_SPACE |.endmacro |.macro saveregs | push rbp; saveregs_ |.endmacro |.macro restoreregs | add rsp, CFRAME_SPACE |.if NO_UNWIND | pop r12; pop r13 |.endif | pop r14; pop r15; pop rbx; pop rbp |.endmacro | |//----- 16 byte aligned, |.if NO_UNWIND |.define SAVE_RET, aword [rsp+aword*11] //<-- rsp entering interpreter. |.define SAVE_R4, aword [rsp+aword*10] |.define SAVE_R3, aword [rsp+aword*9] |.define SAVE_R2, aword [rsp+aword*8] |.define SAVE_R1, aword [rsp+aword*7] |.define SAVE_RU2, aword [rsp+aword*6] |.define SAVE_RU1, aword [rsp+aword*5] //<-- rsp after register saves. |.else |.define SAVE_RET, aword [rsp+aword*9] //<-- rsp entering interpreter. |.define SAVE_R4, aword [rsp+aword*8] |.define SAVE_R3, aword [rsp+aword*7] |.define SAVE_R2, aword [rsp+aword*6] |.define SAVE_R1, aword [rsp+aword*5] //<-- rsp after register saves. |.endif |.define SAVE_CFRAME, aword [rsp+aword*4] |.define SAVE_PC, dword [rsp+dword*7] |.define SAVE_L, dword [rsp+dword*6] |.define SAVE_ERRF, dword [rsp+dword*5] |.define SAVE_NRES, dword [rsp+dword*4] |.define TMPa, aword [rsp+aword*1] |.define TMP2, dword [rsp+dword*1] |.define TMP1, dword [rsp] //<-- rsp while in interpreter. |//----- 16 byte aligned | |// TMPQ overlaps TMP1/TMP2. MULTRES overlaps TMP2 (and TMPQ). |.define TMPQ, qword [rsp] |.define TMP3, dword [rsp+aword*1] |.define MULTRES, TMP2 | |.endif | |//----------------------------------------------------------------------- | |// Instruction headers. |.macro ins_A; .endmacro |.macro ins_AD; .endmacro |.macro ins_AJ; .endmacro |.macro ins_ABC; movzx RB, RCH; movzx RC, RCL; .endmacro |.macro ins_AB_; movzx RB, RCH; .endmacro |.macro ins_A_C; movzx RC, RCL; .endmacro |.macro ins_AND; not RDa; .endmacro | |// Instruction decode+dispatch. Carefully tuned (nope, lodsd is not faster). |.macro ins_NEXT | mov RC, [PC] | movzx RA, RCH | movzx OP, RCL | add PC, 4 | shr RC, 16 |.if X64 | jmp aword [DISPATCH+OP*8] |.else | jmp aword [DISPATCH+OP*4] |.endif |.endmacro | |// Instruction footer. |.if 1 | // Replicated dispatch. Less unpredictable branches, but higher I-Cache use. | .define ins_next, ins_NEXT | .define ins_next_, ins_NEXT |.else | // Common dispatch. Lower I-Cache use, only one (very) unpredictable branch. | // Affects only certain kinds of benchmarks (and only with -j off). | // Around 10%-30% slower on Core2, a lot more slower on P4. | .macro ins_next | jmp ->ins_next | .endmacro | .macro ins_next_ | ->ins_next: | ins_NEXT | .endmacro |.endif | |// Call decode and dispatch. |.macro ins_callt | // BASE = new base, RB = LFUNC, RD = nargs+1, [BASE-4] = PC | mov PC, LFUNC:RB->pc | mov RA, [PC] | movzx OP, RAL | movzx RA, RAH | add PC, 4 |.if X64 | jmp aword [DISPATCH+OP*8] |.else | jmp aword [DISPATCH+OP*4] |.endif |.endmacro | |.macro ins_call | // BASE = new base, RB = LFUNC, RD = nargs+1 | mov [BASE-4], PC | ins_callt |.endmacro | |//----------------------------------------------------------------------- | |// Macros to test operand types. |.macro checktp, reg, tp; cmp dword [BASE+reg*8+4], tp; .endmacro |.macro checknum, reg, target; checktp reg, LJ_TISNUM; jae target; .endmacro |.macro checkint, reg, target; checktp reg, LJ_TISNUM; jne target; .endmacro |.macro checkstr, reg, target; checktp reg, LJ_TSTR; jne target; .endmacro |.macro checktab, reg, target; checktp reg, LJ_TTAB; jne target; .endmacro | |// These operands must be used with movzx. |.define PC_OP, byte [PC-4] |.define PC_RA, byte [PC-3] |.define PC_RB, byte [PC-1] |.define PC_RC, byte [PC-2] |.define PC_RD, word [PC-2] | |.macro branchPC, reg | lea PC, [PC+reg*4-BCBIAS_J*4] |.endmacro | |// Assumes DISPATCH is relative to GL. #define DISPATCH_GL(field) (GG_DISP2G + (int)offsetof(global_State, field)) #define DISPATCH_J(field) (GG_DISP2J + (int)offsetof(jit_State, field)) | #define PC2PROTO(field) ((int)offsetof(GCproto, field)-(int)sizeof(GCproto)) | |// Decrement hashed hotcount and trigger trace recorder if zero. |.macro hotloop, reg | mov reg, PC | shr reg, 1 | and reg, HOTCOUNT_PCMASK | sub word [DISPATCH+reg+GG_DISP2HOT], HOTCOUNT_LOOP | jb ->vm_hotloop |.endmacro | |.macro hotcall, reg | mov reg, PC | shr reg, 1 | and reg, HOTCOUNT_PCMASK | sub word [DISPATCH+reg+GG_DISP2HOT], HOTCOUNT_CALL | jb ->vm_hotcall |.endmacro | |// Set current VM state. |.macro set_vmstate, st | mov dword [DISPATCH+DISPATCH_GL(vmstate)], ~LJ_VMST_..st |.endmacro | |// x87 compares. |.macro fcomparepp // Compare and pop st0 >< st1. | fucomip st1 | fpop |.endmacro | |.macro fdup; fld st0; .endmacro |.macro fpop1; fstp st1; .endmacro | |// Synthesize SSE FP constants. |.macro sseconst_abs, reg, tmp // Synthesize abs mask. |.if X64 | mov64 tmp, U64x(7fffffff,ffffffff); movd reg, tmp |.else | pxor reg, reg; pcmpeqd reg, reg; psrlq reg, 1 |.endif |.endmacro | |.macro sseconst_hi, reg, tmp, val // Synthesize hi-32 bit const. |.if X64 | mov64 tmp, U64x(val,00000000); movd reg, tmp |.else | mov tmp, 0x .. val; movd reg, tmp; pshufd reg, reg, 0x51 |.endif |.endmacro | |.macro sseconst_sign, reg, tmp // Synthesize sign mask. | sseconst_hi reg, tmp, 80000000 |.endmacro |.macro sseconst_1, reg, tmp // Synthesize 1.0. | sseconst_hi reg, tmp, 3ff00000 |.endmacro |.macro sseconst_m1, reg, tmp // Synthesize -1.0. | sseconst_hi reg, tmp, bff00000 |.endmacro |.macro sseconst_2p52, reg, tmp // Synthesize 2^52. | sseconst_hi reg, tmp, 43300000 |.endmacro |.macro sseconst_tobit, reg, tmp // Synthesize 2^52 + 2^51. | sseconst_hi reg, tmp, 43380000 |.endmacro | |// Move table write barrier back. Overwrites reg. |.macro barrierback, tab, reg | and byte tab->marked, (uint8_t)~LJ_GC_BLACK // black2gray(tab) | mov reg, [DISPATCH+DISPATCH_GL(gc.grayagain)] | mov [DISPATCH+DISPATCH_GL(gc.grayagain)], tab | mov tab->gclist, reg |.endmacro | |//----------------------------------------------------------------------- /* Generate subroutines used by opcodes and other parts of the VM. */ /* The .code_sub section should be last to help static branch prediction. */ static void build_subroutines(BuildCtx *ctx) { |.code_sub | |//----------------------------------------------------------------------- |//-- Return handling ---------------------------------------------------- |//----------------------------------------------------------------------- | |->vm_returnp: | test PC, FRAME_P | jz ->cont_dispatch | | // Return from pcall or xpcall fast func. | and PC, -8 | sub BASE, PC // Restore caller base. | lea RAa, [RA+PC-8] // Rebase RA and prepend one result. | mov PC, [BASE-4] // Fetch PC of previous frame. | // Prepending may overwrite the pcall frame, so do it at the end. | mov dword [BASE+RA+4], LJ_TTRUE // Prepend true to results. | |->vm_returnc: | add RD, 1 // RD = nresults+1 | jz ->vm_unwind_yield | mov MULTRES, RD | test PC, FRAME_TYPE | jz ->BC_RET_Z // Handle regular return to Lua. | |->vm_return: | // BASE = base, RA = resultofs, RD = nresults+1 (= MULTRES), PC = return | xor PC, FRAME_C | test PC, FRAME_TYPE | jnz ->vm_returnp | | // Return to C. | set_vmstate C | and PC, -8 | sub PC, BASE | neg PC // Previous base = BASE - delta. | | sub RD, 1 | jz >2 |1: // Move results down. |.if X64 | mov RBa, [BASE+RA] | mov [BASE-8], RBa |.else | mov RB, [BASE+RA] | mov [BASE-8], RB | mov RB, [BASE+RA+4] | mov [BASE-4], RB |.endif | add BASE, 8 | sub RD, 1 | jnz <1 |2: | mov L:RB, SAVE_L | mov L:RB->base, PC |3: | mov RD, MULTRES | mov RA, SAVE_NRES // RA = wanted nresults+1 |4: | cmp RA, RD | jne >6 // More/less results wanted? |5: | sub BASE, 8 | mov L:RB->top, BASE | |->vm_leave_cp: | mov RAa, SAVE_CFRAME // Restore previous C frame. | mov L:RB->cframe, RAa | xor eax, eax // Ok return status for vm_pcall. | |->vm_leave_unw: | restoreregs | ret | |6: | jb >7 // Less results wanted? | // More results wanted. Check stack size and fill up results with nil. | cmp BASE, L:RB->maxstack | ja >8 | mov dword [BASE-4], LJ_TNIL | add BASE, 8 | add RD, 1 | jmp <4 | |7: // Less results wanted. | test RA, RA | jz <5 // But check for LUA_MULTRET+1. | sub RA, RD // Negative result! | lea BASE, [BASE+RA*8] // Correct top. | jmp <5 | |8: // Corner case: need to grow stack for filling up results. | // This can happen if: | // - A C function grows the stack (a lot). | // - The GC shrinks the stack in between. | // - A return back from a lua_call() with (high) nresults adjustment. | mov L:RB->top, BASE // Save current top held in BASE (yes). | mov MULTRES, RD // Need to fill only remainder with nil. | mov FCARG2, RA | mov FCARG1, L:RB | call extern lj_state_growstack@8 // (lua_State *L, int n) | mov BASE, L:RB->top // Need the (realloced) L->top in BASE. | jmp <3 | |->vm_unwind_yield: | mov al, LUA_YIELD | jmp ->vm_unwind_c_eh | |->vm_unwind_c@8: // Unwind C stack, return from vm_pcall. | // (void *cframe, int errcode) |.if X64 | mov eax, CARG2d // Error return status for vm_pcall. | mov rsp, CARG1 |.else | mov eax, FCARG2 // Error return status for vm_pcall. | mov esp, FCARG1 |.endif |->vm_unwind_c_eh: // Landing pad for external unwinder. | mov L:RB, SAVE_L | mov GL:RB, L:RB->glref | mov dword GL:RB->vmstate, ~LJ_VMST_C | jmp ->vm_leave_unw | |->vm_unwind_rethrow: |.if X64 and not X64WIN | mov FCARG1, SAVE_L | mov FCARG2, eax | restoreregs | jmp extern lj_err_throw@8 // (lua_State *L, int errcode) |.endif | |->vm_unwind_ff@4: // Unwind C stack, return from ff pcall. | // (void *cframe) |.if X64 | and CARG1, CFRAME_RAWMASK | mov rsp, CARG1 |.else | and FCARG1, CFRAME_RAWMASK | mov esp, FCARG1 |.endif |->vm_unwind_ff_eh: // Landing pad for external unwinder. | mov L:RB, SAVE_L | mov RAa, -8 // Results start at BASE+RA = BASE-8. | mov RD, 1+1 // Really 1+2 results, incr. later. | mov BASE, L:RB->base | mov DISPATCH, L:RB->glref // Setup pointer to dispatch table. | add DISPATCH, GG_G2DISP | mov PC, [BASE-4] // Fetch PC of previous frame. | mov dword [BASE-4], LJ_TFALSE // Prepend false to error message. | set_vmstate INTERP | jmp ->vm_returnc // Increments RD/MULTRES and returns. | |//----------------------------------------------------------------------- |//-- Grow stack for calls ----------------------------------------------- |//----------------------------------------------------------------------- | |->vm_growstack_c: // Grow stack for C function. | mov FCARG2, LUA_MINSTACK | jmp >2 | |->vm_growstack_v: // Grow stack for vararg Lua function. | sub RD, 8 | jmp >1 | |->vm_growstack_f: // Grow stack for fixarg Lua function. | // BASE = new base, RD = nargs+1, RB = L, PC = first PC | lea RD, [BASE+NARGS:RD*8-8] |1: | movzx RA, byte [PC-4+PC2PROTO(framesize)] | add PC, 4 // Must point after first instruction. | mov L:RB->base, BASE | mov L:RB->top, RD | mov SAVE_PC, PC | mov FCARG2, RA |2: | // RB = L, L->base = new base, L->top = top | mov FCARG1, L:RB | call extern lj_state_growstack@8 // (lua_State *L, int n) | mov BASE, L:RB->base | mov RD, L:RB->top | mov LFUNC:RB, [BASE-8] | sub RD, BASE | shr RD, 3 | add NARGS:RD, 1 | // BASE = new base, RB = LFUNC, RD = nargs+1 | ins_callt // Just retry the call. | |//----------------------------------------------------------------------- |//-- Entry points into the assembler VM --------------------------------- |//----------------------------------------------------------------------- | |->vm_resume: // Setup C frame and resume thread. | // (lua_State *L, TValue *base, int nres1 = 0, ptrdiff_t ef = 0) | saveregs |.if X64 | mov L:RB, CARG1d // Caveat: CARG1d may be RA. | mov SAVE_L, CARG1d | mov RA, CARG2d |.else | mov L:RB, SAVE_L | mov RA, INARG_BASE // Caveat: overlaps SAVE_CFRAME! |.endif | mov PC, FRAME_CP | xor RD, RD | lea KBASEa, [esp+CFRAME_RESUME] | mov DISPATCH, L:RB->glref // Setup pointer to dispatch table. | add DISPATCH, GG_G2DISP | mov L:RB->cframe, KBASEa | mov SAVE_PC, RD // Any value outside of bytecode is ok. | mov SAVE_CFRAME, RDa |.if X64 | mov SAVE_NRES, RD | mov SAVE_ERRF, RD |.endif | cmp byte L:RB->status, RDL | je >3 // Initial resume (like a call). | | // Resume after yield (like a return). | set_vmstate INTERP | mov byte L:RB->status, RDL | mov BASE, L:RB->base | mov RD, L:RB->top | sub RD, RA | shr RD, 3 | add RD, 1 // RD = nresults+1 | sub RA, BASE // RA = resultofs | mov PC, [BASE-4] | mov MULTRES, RD | test PC, FRAME_TYPE | jz ->BC_RET_Z | jmp ->vm_return | |->vm_pcall: // Setup protected C frame and enter VM. | // (lua_State *L, TValue *base, int nres1, ptrdiff_t ef) | saveregs | mov PC, FRAME_CP |.if X64 | mov SAVE_ERRF, CARG4d |.endif | jmp >1 | |->vm_call: // Setup C frame and enter VM. | // (lua_State *L, TValue *base, int nres1) | saveregs | mov PC, FRAME_C | |1: // Entry point for vm_pcall above (PC = ftype). |.if X64 | mov SAVE_NRES, CARG3d | mov L:RB, CARG1d // Caveat: CARG1d may be RA. | mov SAVE_L, CARG1d | mov RA, CARG2d |.else | mov L:RB, SAVE_L | mov RA, INARG_BASE // Caveat: overlaps SAVE_CFRAME! |.endif | | mov KBASEa, L:RB->cframe // Add our C frame to cframe chain. | mov SAVE_CFRAME, KBASEa | mov SAVE_PC, L:RB // Any value outside of bytecode is ok. |.if X64 | mov L:RB->cframe, rsp |.else | mov L:RB->cframe, esp |.endif | |2: // Entry point for vm_cpcall below (RA = base, RB = L, PC = ftype). | mov DISPATCH, L:RB->glref // Setup pointer to dispatch table. | add DISPATCH, GG_G2DISP | |3: // Entry point for vm_resume above (RA = base, RB = L, PC = ftype). | set_vmstate INTERP | mov BASE, L:RB->base // BASE = old base (used in vmeta_call). | add PC, RA | sub PC, BASE // PC = frame delta + frame type | | mov RD, L:RB->top | sub RD, RA | shr NARGS:RD, 3 | add NARGS:RD, 1 // RD = nargs+1 | |->vm_call_dispatch: | mov LFUNC:RB, [RA-8] | cmp dword [RA-4], LJ_TFUNC | jne ->vmeta_call // Ensure KBASE defined and != BASE. | |->vm_call_dispatch_f: | mov BASE, RA | ins_call | // BASE = new base, RB = func, RD = nargs+1, PC = caller PC | |->vm_cpcall: // Setup protected C frame, call C. | // (lua_State *L, lua_CFunction func, void *ud, lua_CPFunction cp) | saveregs |.if X64 | mov L:RB, CARG1d // Caveat: CARG1d may be RA. | mov SAVE_L, CARG1d |.else | mov L:RB, SAVE_L | // Caveat: INARG_CP_* and SAVE_CFRAME/SAVE_NRES/SAVE_ERRF overlap! | mov RC, INARG_CP_UD // Get args before they are overwritten. | mov RA, INARG_CP_FUNC | mov BASE, INARG_CP_CALL |.endif | mov SAVE_PC, L:RB // Any value outside of bytecode is ok. | | mov KBASE, L:RB->stack // Compute -savestack(L, L->top). | sub KBASE, L:RB->top | mov SAVE_ERRF, 0 // No error function. | mov SAVE_NRES, KBASE // Neg. delta means cframe w/o frame. | // Handler may change cframe_nres(L->cframe) or cframe_errfunc(L->cframe). | |.if X64 | mov KBASEa, L:RB->cframe // Add our C frame to cframe chain. | mov SAVE_CFRAME, KBASEa | mov L:RB->cframe, rsp | | call CARG4 // (lua_State *L, lua_CFunction func, void *ud) |.else | mov ARG3, RC // Have to copy args downwards. | mov ARG2, RA | mov ARG1, L:RB | | mov KBASE, L:RB->cframe // Add our C frame to cframe chain. | mov SAVE_CFRAME, KBASE | mov L:RB->cframe, esp | | call BASE // (lua_State *L, lua_CFunction func, void *ud) |.endif | // TValue * (new base) or NULL returned in eax (RC). | test RC, RC | jz ->vm_leave_cp // No base? Just remove C frame. | mov RA, RC | mov PC, FRAME_CP | jmp <2 // Else continue with the call. | |//----------------------------------------------------------------------- |//-- Metamethod handling ------------------------------------------------ |//----------------------------------------------------------------------- | |//-- Continuation dispatch ---------------------------------------------- | |->cont_dispatch: | // BASE = meta base, RA = resultofs, RD = nresults+1 (also in MULTRES) | add RA, BASE | and PC, -8 | mov RB, BASE | sub BASE, PC // Restore caller BASE. | mov dword [RA+RD*8-4], LJ_TNIL // Ensure one valid arg. | mov RC, RA // ... in [RC] | mov PC, [RB-12] // Restore PC from [cont|PC]. |.if X64 | movsxd RAa, dword [RB-16] // May be negative on WIN64 with debug. |.if FFI | cmp RA, 1 | jbe >1 |.endif | lea KBASEa, qword [=>0] | add RAa, KBASEa |.else | mov RA, dword [RB-16] |.if FFI | cmp RA, 1 | jbe >1 |.endif |.endif | mov LFUNC:KBASE, [BASE-8] | mov KBASE, LFUNC:KBASE->pc | mov KBASE, [KBASE+PC2PROTO(k)] | // BASE = base, RC = result, RB = meta base | jmp RAa // Jump to continuation. | |.if FFI |1: | je ->cont_ffi_callback // cont = 1: return from FFI callback. | // cont = 0: Tail call from C function. | sub RB, BASE | shr RB, 3 | lea RD, [RB-1] | jmp ->vm_call_tail |.endif | |->cont_cat: // BASE = base, RC = result, RB = mbase | movzx RA, PC_RB | sub RB, 16 | lea RA, [BASE+RA*8] | sub RA, RB | je ->cont_ra | neg RA | shr RA, 3 |.if X64WIN | mov CARG3d, RA | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE | mov RCa, [RC] | mov [RB], RCa | mov CARG2d, RB |.elif X64 | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE | mov CARG3d, RA | mov RAa, [RC] | mov [RB], RAa | mov CARG2d, RB |.else | mov ARG3, RA | mov RA, [RC+4] | mov RC, [RC] | mov [RB+4], RA | mov [RB], RC | mov ARG2, RB |.endif | jmp ->BC_CAT_Z | |//-- Table indexing metamethods ----------------------------------------- | |->vmeta_tgets: | mov TMP1, RC // RC = GCstr * | mov TMP2, LJ_TSTR | lea RCa, TMP1 // Store temp. TValue in TMP1/TMP2. | cmp PC_OP, BC_GGET | jne >1 | lea RA, [DISPATCH+DISPATCH_GL(tmptv)] // Store fn->l.env in g->tmptv. | mov [RA], TAB:RB // RB = GCtab * | mov dword [RA+4], LJ_TTAB | mov RB, RA | jmp >2 | |->vmeta_tgetb: | movzx RC, PC_RC |.if DUALNUM | mov TMP2, LJ_TISNUM | mov TMP1, RC |.elif SSE | cvtsi2sd xmm0, RC | movsd TMPQ, xmm0 |.else | mov ARG4, RC | fild ARG4 | fstp TMPQ |.endif | lea RCa, TMPQ // Store temp. TValue in TMPQ. | jmp >1 | |->vmeta_tgetv: | movzx RC, PC_RC // Reload TValue *k from RC. | lea RC, [BASE+RC*8] |1: | movzx RB, PC_RB // Reload TValue *t from RB. | lea RB, [BASE+RB*8] |2: |.if X64 | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE // Caveat: CARG2d/CARG3d may be BASE. | mov CARG2d, RB | mov CARG3, RCa // May be 64 bit ptr to stack. | mov L:RB, L:CARG1d |.else | mov ARG2, RB | mov L:RB, SAVE_L | mov ARG3, RC | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | call extern lj_meta_tget // (lua_State *L, TValue *o, TValue *k) | // TValue * (finished) or NULL (metamethod) returned in eax (RC). | mov BASE, L:RB->base | test RC, RC | jz >3 |->cont_ra: // BASE = base, RC = result | movzx RA, PC_RA |.if X64 | mov RBa, [RC] | mov [BASE+RA*8], RBa |.else | mov RB, [RC+4] | mov RC, [RC] | mov [BASE+RA*8+4], RB | mov [BASE+RA*8], RC |.endif | ins_next | |3: // Call __index metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k | mov RA, L:RB->top | mov [RA-12], PC // [cont|PC] | lea PC, [RA+FRAME_CONT] | sub PC, BASE | mov LFUNC:RB, [RA-8] // Guaranteed to be a function here. | mov NARGS:RD, 2+1 // 2 args for func(t, k). | jmp ->vm_call_dispatch_f | |//----------------------------------------------------------------------- | |->vmeta_tsets: | mov TMP1, RC // RC = GCstr * | mov TMP2, LJ_TSTR | lea RCa, TMP1 // Store temp. TValue in TMP1/TMP2. | cmp PC_OP, BC_GSET | jne >1 | lea RA, [DISPATCH+DISPATCH_GL(tmptv)] // Store fn->l.env in g->tmptv. | mov [RA], TAB:RB // RB = GCtab * | mov dword [RA+4], LJ_TTAB | mov RB, RA | jmp >2 | |->vmeta_tsetb: | movzx RC, PC_RC |.if DUALNUM | mov TMP2, LJ_TISNUM | mov TMP1, RC |.elif SSE | cvtsi2sd xmm0, RC | movsd TMPQ, xmm0 |.else | mov ARG4, RC | fild ARG4 | fstp TMPQ |.endif | lea RCa, TMPQ // Store temp. TValue in TMPQ. | jmp >1 | |->vmeta_tsetv: | movzx RC, PC_RC // Reload TValue *k from RC. | lea RC, [BASE+RC*8] |1: | movzx RB, PC_RB // Reload TValue *t from RB. | lea RB, [BASE+RB*8] |2: |.if X64 | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE // Caveat: CARG2d/CARG3d may be BASE. | mov CARG2d, RB | mov CARG3, RCa // May be 64 bit ptr to stack. | mov L:RB, L:CARG1d |.else | mov ARG2, RB | mov L:RB, SAVE_L | mov ARG3, RC | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | call extern lj_meta_tset // (lua_State *L, TValue *o, TValue *k) | // TValue * (finished) or NULL (metamethod) returned in eax (RC). | mov BASE, L:RB->base | test RC, RC | jz >3 | // NOBARRIER: lj_meta_tset ensures the table is not black. | movzx RA, PC_RA |.if X64 | mov RBa, [BASE+RA*8] | mov [RC], RBa |.else | mov RB, [BASE+RA*8+4] | mov RA, [BASE+RA*8] | mov [RC+4], RB | mov [RC], RA |.endif |->cont_nop: // BASE = base, (RC = result) | ins_next | |3: // Call __newindex metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k/(v) | mov RA, L:RB->top | mov [RA-12], PC // [cont|PC] | movzx RC, PC_RA | // Copy value to third argument. |.if X64 | mov RBa, [BASE+RC*8] | mov [RA+16], RBa |.else | mov RB, [BASE+RC*8+4] | mov RC, [BASE+RC*8] | mov [RA+20], RB | mov [RA+16], RC |.endif | lea PC, [RA+FRAME_CONT] | sub PC, BASE | mov LFUNC:RB, [RA-8] // Guaranteed to be a function here. | mov NARGS:RD, 3+1 // 3 args for func(t, k, v). | jmp ->vm_call_dispatch_f | |//-- Comparison metamethods --------------------------------------------- | |->vmeta_comp: |.if X64 | mov L:RB, SAVE_L | mov L:RB->base, BASE // Caveat: CARG2d/CARG3d == BASE. |.if X64WIN | lea CARG3d, [BASE+RD*8] | lea CARG2d, [BASE+RA*8] |.else | lea CARG2d, [BASE+RA*8] | lea CARG3d, [BASE+RD*8] |.endif | mov CARG1d, L:RB // Caveat: CARG1d/CARG4d == RA. | movzx CARG4d, PC_OP |.else | movzx RB, PC_OP | lea RD, [BASE+RD*8] | lea RA, [BASE+RA*8] | mov ARG4, RB | mov L:RB, SAVE_L | mov ARG3, RD | mov ARG2, RA | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | call extern lj_meta_comp // (lua_State *L, TValue *o1, *o2, int op) | // 0/1 or TValue * (metamethod) returned in eax (RC). |3: | mov BASE, L:RB->base | cmp RC, 1 | ja ->vmeta_binop |4: | lea PC, [PC+4] | jb >6 |5: | movzx RD, PC_RD | branchPC RD |6: | ins_next | |->cont_condt: // BASE = base, RC = result | add PC, 4 | cmp dword [RC+4], LJ_TISTRUECOND // Branch if result is true. | jb <5 | jmp <6 | |->cont_condf: // BASE = base, RC = result | cmp dword [RC+4], LJ_TISTRUECOND // Branch if result is false. | jmp <4 | |->vmeta_equal: | sub PC, 4 |.if X64WIN | mov CARG3d, RD | mov CARG4d, RB | mov L:RB, SAVE_L | mov L:RB->base, BASE // Caveat: CARG2d == BASE. | mov CARG2d, RA | mov CARG1d, L:RB // Caveat: CARG1d == RA. |.elif X64 | mov CARG2d, RA | mov CARG4d, RB // Caveat: CARG4d == RA. | mov L:RB, SAVE_L | mov L:RB->base, BASE // Caveat: CARG3d == BASE. | mov CARG3d, RD | mov CARG1d, L:RB |.else | mov ARG4, RB | mov L:RB, SAVE_L | mov ARG3, RD | mov ARG2, RA | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | call extern lj_meta_equal // (lua_State *L, GCobj *o1, *o2, int ne) | // 0/1 or TValue * (metamethod) returned in eax (RC). | jmp <3 | |->vmeta_equal_cd: |.if FFI | sub PC, 4 | mov L:RB, SAVE_L | mov L:RB->base, BASE | mov FCARG1, L:RB | mov FCARG2, dword [PC-4] | mov SAVE_PC, PC | call extern lj_meta_equal_cd@8 // (lua_State *L, BCIns ins) | // 0/1 or TValue * (metamethod) returned in eax (RC). | jmp <3 |.endif | |//-- Arithmetic metamethods --------------------------------------------- | |->vmeta_arith_vno: |.if DUALNUM | movzx RB, PC_RB |.endif |->vmeta_arith_vn: | lea RC, [KBASE+RC*8] | jmp >1 | |->vmeta_arith_nvo: |.if DUALNUM | movzx RC, PC_RC |.endif |->vmeta_arith_nv: | lea RC, [KBASE+RC*8] | lea RB, [BASE+RB*8] | xchg RB, RC | jmp >2 | |->vmeta_unm: | lea RC, [BASE+RD*8] | mov RB, RC | jmp >2 | |->vmeta_arith_vvo: |.if DUALNUM | movzx RB, PC_RB |.endif |->vmeta_arith_vv: | lea RC, [BASE+RC*8] |1: | lea RB, [BASE+RB*8] |2: | lea RA, [BASE+RA*8] |.if X64WIN | mov CARG3d, RB | mov CARG4d, RC | movzx RC, PC_OP | mov ARG5d, RC | mov L:RB, SAVE_L | mov L:RB->base, BASE // Caveat: CARG2d == BASE. | mov CARG2d, RA | mov CARG1d, L:RB // Caveat: CARG1d == RA. |.elif X64 | movzx CARG5d, PC_OP | mov CARG2d, RA | mov CARG4d, RC // Caveat: CARG4d == RA. | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE // Caveat: CARG3d == BASE. | mov CARG3d, RB | mov L:RB, L:CARG1d |.else | mov ARG3, RB | mov L:RB, SAVE_L | mov ARG4, RC | movzx RC, PC_OP | mov ARG2, RA | mov ARG5, RC | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | call extern lj_meta_arith // (lua_State *L, TValue *ra,*rb,*rc, BCReg op) | // NULL (finished) or TValue * (metamethod) returned in eax (RC). | mov BASE, L:RB->base | test RC, RC | jz ->cont_nop | | // Call metamethod for binary op. |->vmeta_binop: | // BASE = base, RC = new base, stack = cont/func/o1/o2 | mov RA, RC | sub RC, BASE | mov [RA-12], PC // [cont|PC] | lea PC, [RC+FRAME_CONT] | mov NARGS:RD, 2+1 // 2 args for func(o1, o2). | jmp ->vm_call_dispatch | |->vmeta_len: | mov L:RB, SAVE_L | mov L:RB->base, BASE | lea FCARG2, [BASE+RD*8] // Caveat: FCARG2 == BASE | mov L:FCARG1, L:RB | mov SAVE_PC, PC | call extern lj_meta_len@8 // (lua_State *L, TValue *o) | // NULL (retry) or TValue * (metamethod) returned in eax (RC). | mov BASE, L:RB->base #if LJ_52 | test RC, RC | jne ->vmeta_binop // Binop call for compatibility. | movzx RD, PC_RD | mov TAB:FCARG1, [BASE+RD*8] | jmp ->BC_LEN_Z #else | jmp ->vmeta_binop // Binop call for compatibility. #endif | |//-- Call metamethod ---------------------------------------------------- | |->vmeta_call_ra: | lea RA, [BASE+RA*8+8] |->vmeta_call: // Resolve and call __call metamethod. | // BASE = old base, RA = new base, RC = nargs+1, PC = return | mov TMP2, RA // Save RA, RC for us. | mov TMP1, NARGS:RD | sub RA, 8 |.if X64 | mov L:RB, SAVE_L | mov L:RB->base, BASE // Caveat: CARG2d/CARG3d may be BASE. | mov CARG2d, RA | lea CARG3d, [RA+NARGS:RD*8] | mov CARG1d, L:RB // Caveat: CARG1d may be RA. |.else | lea RC, [RA+NARGS:RD*8] | mov L:RB, SAVE_L | mov ARG2, RA | mov ARG3, RC | mov ARG1, L:RB | mov L:RB->base, BASE // This is the callers base! |.endif | mov SAVE_PC, PC | call extern lj_meta_call // (lua_State *L, TValue *func, TValue *top) | mov BASE, L:RB->base | mov RA, TMP2 | mov NARGS:RD, TMP1 | mov LFUNC:RB, [RA-8] | add NARGS:RD, 1 | // This is fragile. L->base must not move, KBASE must always be defined. | cmp KBASE, BASE // Continue with CALLT if flag set. | je ->BC_CALLT_Z | mov BASE, RA | ins_call // Otherwise call resolved metamethod. | |//-- Argument coercion for 'for' statement ------------------------------ | |->vmeta_for: | mov L:RB, SAVE_L | mov L:RB->base, BASE | mov FCARG2, RA // Caveat: FCARG2 == BASE | mov L:FCARG1, L:RB // Caveat: FCARG1 == RA | mov SAVE_PC, PC | call extern lj_meta_for@8 // (lua_State *L, TValue *base) | mov BASE, L:RB->base | mov RC, [PC-4] | movzx RA, RCH | movzx OP, RCL | shr RC, 16 |.if X64 | jmp aword [DISPATCH+OP*8+GG_DISP2STATIC] // Retry FORI or JFORI. |.else | jmp aword [DISPATCH+OP*4+GG_DISP2STATIC] // Retry FORI or JFORI. |.endif | |//----------------------------------------------------------------------- |//-- Fast functions ----------------------------------------------------- |//----------------------------------------------------------------------- | |.macro .ffunc, name |->ff_ .. name: |.endmacro | |.macro .ffunc_1, name |->ff_ .. name: | cmp NARGS:RD, 1+1; jb ->fff_fallback |.endmacro | |.macro .ffunc_2, name |->ff_ .. name: | cmp NARGS:RD, 2+1; jb ->fff_fallback |.endmacro | |.macro .ffunc_n, name | .ffunc_1 name | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback | fld qword [BASE] |.endmacro | |.macro .ffunc_n, name, op | .ffunc_1 name | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback | op | fld qword [BASE] |.endmacro | |.macro .ffunc_nsse, name, op | .ffunc_1 name | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback | op xmm0, qword [BASE] |.endmacro | |.macro .ffunc_nsse, name | .ffunc_nsse name, movsd |.endmacro | |.macro .ffunc_nn, name | .ffunc_2 name | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback | cmp dword [BASE+12], LJ_TISNUM; jae ->fff_fallback | fld qword [BASE] | fld qword [BASE+8] |.endmacro | |.macro .ffunc_nnsse, name | .ffunc_2 name | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback | cmp dword [BASE+12], LJ_TISNUM; jae ->fff_fallback | movsd xmm0, qword [BASE] | movsd xmm1, qword [BASE+8] |.endmacro | |.macro .ffunc_nnr, name | .ffunc_2 name | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback | cmp dword [BASE+12], LJ_TISNUM; jae ->fff_fallback | fld qword [BASE+8] | fld qword [BASE] |.endmacro | |// Inlined GC threshold check. Caveat: uses label 1. |.macro ffgccheck | mov RB, [DISPATCH+DISPATCH_GL(gc.total)] | cmp RB, [DISPATCH+DISPATCH_GL(gc.threshold)] | jb >1 | call ->fff_gcstep |1: |.endmacro | |//-- Base library: checks ----------------------------------------------- | |.ffunc_1 assert | mov RB, [BASE+4] | cmp RB, LJ_TISTRUECOND; jae ->fff_fallback | mov PC, [BASE-4] | mov MULTRES, RD | mov [BASE-4], RB | mov RB, [BASE] | mov [BASE-8], RB | sub RD, 2 | jz >2 | mov RA, BASE |1: | add RA, 8 |.if X64 | mov RBa, [RA] | mov [RA-8], RBa |.else | mov RB, [RA+4] | mov [RA-4], RB | mov RB, [RA] | mov [RA-8], RB |.endif | sub RD, 1 | jnz <1 |2: | mov RD, MULTRES | jmp ->fff_res_ | |.ffunc_1 type | mov RB, [BASE+4] |.if X64 | mov RA, RB | sar RA, 15 | cmp RA, -2 | je >3 |.endif | mov RC, ~LJ_TNUMX | not RB | cmp RC, RB | cmova RC, RB |2: | mov CFUNC:RB, [BASE-8] | mov STR:RC, [CFUNC:RB+RC*8+((char *)(&((GCfuncC *)0)->upvalue))] | mov PC, [BASE-4] | mov dword [BASE-4], LJ_TSTR | mov [BASE-8], STR:RC | jmp ->fff_res1 |.if X64 |3: | mov RC, ~LJ_TLIGHTUD | jmp <2 |.endif | |//-- Base library: getters and setters --------------------------------- | |.ffunc_1 getmetatable | mov RB, [BASE+4] | mov PC, [BASE-4] | cmp RB, LJ_TTAB; jne >6 |1: // Field metatable must be at same offset for GCtab and GCudata! | mov TAB:RB, [BASE] | mov TAB:RB, TAB:RB->metatable |2: | test TAB:RB, TAB:RB | mov dword [BASE-4], LJ_TNIL | jz ->fff_res1 | mov STR:RC, [DISPATCH+DISPATCH_GL(gcroot)+4*(GCROOT_MMNAME+MM_metatable)] | mov dword [BASE-4], LJ_TTAB // Store metatable as default result. | mov [BASE-8], TAB:RB | mov RA, TAB:RB->hmask | and RA, STR:RC->hash | imul RA, #NODE | add NODE:RA, TAB:RB->node |3: // Rearranged logic, because we expect _not_ to find the key. | cmp dword NODE:RA->key.it, LJ_TSTR | jne >4 | cmp dword NODE:RA->key.gcr, STR:RC | je >5 |4: | mov NODE:RA, NODE:RA->next | test NODE:RA, NODE:RA | jnz <3 | jmp ->fff_res1 // Not found, keep default result. |5: | mov RB, [RA+4] | cmp RB, LJ_TNIL; je ->fff_res1 // Ditto for nil value. | mov RC, [RA] | mov [BASE-4], RB // Return value of mt.__metatable. | mov [BASE-8], RC | jmp ->fff_res1 | |6: | cmp RB, LJ_TUDATA; je <1 |.if X64 | cmp RB, LJ_TNUMX; ja >8 | cmp RB, LJ_TISNUM; jbe >7 | mov RB, LJ_TLIGHTUD | jmp >8 |7: |.else | cmp RB, LJ_TISNUM; ja >8 |.endif | mov RB, LJ_TNUMX |8: | not RB | mov TAB:RB, [DISPATCH+RB*4+DISPATCH_GL(gcroot[GCROOT_BASEMT])] | jmp <2 | |.ffunc_2 setmetatable | cmp dword [BASE+4], LJ_TTAB; jne ->fff_fallback | // Fast path: no mt for table yet and not clearing the mt. | mov TAB:RB, [BASE] | cmp dword TAB:RB->metatable, 0; jne ->fff_fallback | cmp dword [BASE+12], LJ_TTAB; jne ->fff_fallback | mov TAB:RC, [BASE+8] | mov TAB:RB->metatable, TAB:RC | mov PC, [BASE-4] | mov dword [BASE-4], LJ_TTAB // Return original table. | mov [BASE-8], TAB:RB | test byte TAB:RB->marked, LJ_GC_BLACK // isblack(table) | jz >1 | // Possible write barrier. Table is black, but skip iswhite(mt) check. | barrierback TAB:RB, RC |1: | jmp ->fff_res1 | |.ffunc_2 rawget | cmp dword [BASE+4], LJ_TTAB; jne ->fff_fallback |.if X64WIN | mov RB, BASE // Save BASE. | lea CARG3d, [BASE+8] | mov CARG2d, [BASE] // Caveat: CARG2d == BASE. | mov CARG1d, SAVE_L |.elif X64 | mov RB, BASE // Save BASE. | mov CARG2d, [BASE] | lea CARG3d, [BASE+8] // Caveat: CARG3d == BASE. | mov CARG1d, SAVE_L |.else | mov TAB:RD, [BASE] | mov L:RB, SAVE_L | mov ARG2, TAB:RD | mov ARG1, L:RB | mov RB, BASE // Save BASE. | add BASE, 8 | mov ARG3, BASE |.endif | call extern lj_tab_get // (lua_State *L, GCtab *t, cTValue *key) | // cTValue * returned in eax (RD). | mov BASE, RB // Restore BASE. | // Copy table slot. |.if X64 | mov RBa, [RD] | mov PC, [BASE-4] | mov [BASE-8], RBa |.else | mov RB, [RD] | mov RD, [RD+4] | mov PC, [BASE-4] | mov [BASE-8], RB | mov [BASE-4], RD |.endif | jmp ->fff_res1 | |//-- Base library: conversions ------------------------------------------ | |.ffunc tonumber | // Only handles the number case inline (without a base argument). | cmp NARGS:RD, 1+1; jne ->fff_fallback // Exactly one argument. | cmp dword [BASE+4], LJ_TISNUM |.if DUALNUM | jne >1 | mov RB, dword [BASE]; jmp ->fff_resi |1: | ja ->fff_fallback |.else | jae ->fff_fallback |.endif |.if SSE | movsd xmm0, qword [BASE]; jmp ->fff_resxmm0 |.else | fld qword [BASE]; jmp ->fff_resn |.endif | |.ffunc_1 tostring | // Only handles the string or number case inline. | mov PC, [BASE-4] | cmp dword [BASE+4], LJ_TSTR; jne >3 | // A __tostring method in the string base metatable is ignored. | mov STR:RD, [BASE] |2: | mov dword [BASE-4], LJ_TSTR | mov [BASE-8], STR:RD | jmp ->fff_res1 |3: // Handle numbers inline, unless a number base metatable is present. | cmp dword [BASE+4], LJ_TISNUM; ja ->fff_fallback | cmp dword [DISPATCH+DISPATCH_GL(gcroot[GCROOT_BASEMT_NUM])], 0 | jne ->fff_fallback | ffgccheck // Caveat: uses label 1. | mov L:RB, SAVE_L | mov L:RB->base, BASE // Add frame since C call can throw. | mov SAVE_PC, PC // Redundant (but a defined value). |.if X64 and not X64WIN | mov FCARG2, BASE // Otherwise: FCARG2 == BASE |.endif | mov L:FCARG1, L:RB |.if DUALNUM | call extern lj_str_fromnumber@8 // (lua_State *L, cTValue *o) |.else | call extern lj_str_fromnum@8 // (lua_State *L, lua_Number *np) |.endif | // GCstr returned in eax (RD). | mov BASE, L:RB->base | jmp <2 | |//-- Base library: iterators ------------------------------------------- | |.ffunc_1 next | je >2 // Missing 2nd arg? |1: | cmp dword [BASE+4], LJ_TTAB; jne ->fff_fallback | mov L:RB, SAVE_L | mov L:RB->base, BASE // Add frame since C call can throw. | mov L:RB->top, BASE // Dummy frame length is ok. | mov PC, [BASE-4] |.if X64WIN | lea CARG3d, [BASE+8] | mov CARG2d, [BASE] // Caveat: CARG2d == BASE. | mov CARG1d, L:RB |.elif X64 | mov CARG2d, [BASE] | lea CARG3d, [BASE+8] // Caveat: CARG3d == BASE. | mov CARG1d, L:RB |.else | mov TAB:RD, [BASE] | mov ARG2, TAB:RD | mov ARG1, L:RB | add BASE, 8 | mov ARG3, BASE |.endif | mov SAVE_PC, PC // Needed for ITERN fallback. | call extern lj_tab_next // (lua_State *L, GCtab *t, TValue *key) | // Flag returned in eax (RD). | mov BASE, L:RB->base | test RD, RD; jz >3 // End of traversal? | // Copy key and value to results. |.if X64 | mov RBa, [BASE+8] | mov RDa, [BASE+16] | mov [BASE-8], RBa | mov [BASE], RDa |.else | mov RB, [BASE+8] | mov RD, [BASE+12] | mov [BASE-8], RB | mov [BASE-4], RD | mov RB, [BASE+16] | mov RD, [BASE+20] | mov [BASE], RB | mov [BASE+4], RD |.endif |->fff_res2: | mov RD, 1+2 | jmp ->fff_res |2: // Set missing 2nd arg to nil. | mov dword [BASE+12], LJ_TNIL | jmp <1 |3: // End of traversal: return nil. | mov dword [BASE-4], LJ_TNIL | jmp ->fff_res1 | |.ffunc_1 pairs | mov TAB:RB, [BASE] | cmp dword [BASE+4], LJ_TTAB; jne ->fff_fallback #if LJ_52 | cmp dword TAB:RB->metatable, 0; jne ->fff_fallback #endif | mov CFUNC:RB, [BASE-8] | mov CFUNC:RD, CFUNC:RB->upvalue[0] | mov PC, [BASE-4] | mov dword [BASE-4], LJ_TFUNC | mov [BASE-8], CFUNC:RD | mov dword [BASE+12], LJ_TNIL | mov RD, 1+3 | jmp ->fff_res | |.ffunc_2 ipairs_aux | cmp dword [BASE+4], LJ_TTAB; jne ->fff_fallback | cmp dword [BASE+12], LJ_TISNUM |.if DUALNUM | jne ->fff_fallback |.else | jae ->fff_fallback |.endif | mov PC, [BASE-4] |.if DUALNUM | mov RD, dword [BASE+8] | add RD, 1 | mov dword [BASE-4], LJ_TISNUM | mov dword [BASE-8], RD |.elif SSE | movsd xmm0, qword [BASE+8] | sseconst_1 xmm1, RBa | addsd xmm0, xmm1 | cvtsd2si RD, xmm0 | movsd qword [BASE-8], xmm0 |.else | fld qword [BASE+8] | fld1 | faddp st1 | fist ARG1 | fstp qword [BASE-8] | mov RD, ARG1 |.endif | mov TAB:RB, [BASE] | cmp RD, TAB:RB->asize; jae >2 // Not in array part? | shl RD, 3 | add RD, TAB:RB->array |1: | cmp dword [RD+4], LJ_TNIL; je ->fff_res0 | // Copy array slot. |.if X64 | mov RBa, [RD] | mov [BASE], RBa |.else | mov RB, [RD] | mov RD, [RD+4] | mov [BASE], RB | mov [BASE+4], RD |.endif | jmp ->fff_res2 |2: // Check for empty hash part first. Otherwise call C function. | cmp dword TAB:RB->hmask, 0; je ->fff_res0 | mov FCARG1, TAB:RB | mov RB, BASE // Save BASE. | mov FCARG2, RD // Caveat: FCARG2 == BASE | call extern lj_tab_getinth@8 // (GCtab *t, int32_t key) | // cTValue * or NULL returned in eax (RD). | mov BASE, RB | test RD, RD | jnz <1 |->fff_res0: | mov RD, 1+0 | jmp ->fff_res | |.ffunc_1 ipairs | mov TAB:RB, [BASE] | cmp dword [BASE+4], LJ_TTAB; jne ->fff_fallback #if LJ_52 | cmp dword TAB:RB->metatable, 0; jne ->fff_fallback #endif | mov CFUNC:RB, [BASE-8] | mov CFUNC:RD, CFUNC:RB->upvalue[0] | mov PC, [BASE-4] | mov dword [BASE-4], LJ_TFUNC | mov [BASE-8], CFUNC:RD |.if DUALNUM | mov dword [BASE+12], LJ_TISNUM | mov dword [BASE+8], 0 |.elif SSE | xorps xmm0, xmm0 | movsd qword [BASE+8], xmm0 |.else | fldz | fstp qword [BASE+8] |.endif | mov RD, 1+3 | jmp ->fff_res | |//-- Base library: catch errors ---------------------------------------- | |.ffunc_1 pcall | lea RA, [BASE+8] | sub NARGS:RD, 1 | mov PC, 8+FRAME_PCALL |1: | movzx RB, byte [DISPATCH+DISPATCH_GL(hookmask)] | shr RB, HOOK_ACTIVE_SHIFT | and RB, 1 | add PC, RB // Remember active hook before pcall. | jmp ->vm_call_dispatch | |.ffunc_2 xpcall | cmp dword [BASE+12], LJ_TFUNC; jne ->fff_fallback | mov RB, [BASE+4] // Swap function and traceback. | mov [BASE+12], RB | mov dword [BASE+4], LJ_TFUNC | mov LFUNC:RB, [BASE] | mov PC, [BASE+8] | mov [BASE+8], LFUNC:RB | mov [BASE], PC | lea RA, [BASE+16] | sub NARGS:RD, 2 | mov PC, 16+FRAME_PCALL | jmp <1 | |//-- Coroutine library -------------------------------------------------- | |.macro coroutine_resume_wrap, resume |.if resume |.ffunc_1 coroutine_resume | mov L:RB, [BASE] |.else |.ffunc coroutine_wrap_aux | mov CFUNC:RB, [BASE-8] | mov L:RB, CFUNC:RB->upvalue[0].gcr |.endif | mov PC, [BASE-4] | mov SAVE_PC, PC |.if X64 | mov TMP1, L:RB |.else | mov ARG1, L:RB |.endif |.if resume | cmp dword [BASE+4], LJ_TTHREAD; jne ->fff_fallback |.endif | cmp aword L:RB->cframe, 0; jne ->fff_fallback | cmp byte L:RB->status, LUA_YIELD; ja ->fff_fallback | mov RA, L:RB->top | je >1 // Status != LUA_YIELD (i.e. 0)? | cmp RA, L:RB->base // Check for presence of initial func. | je ->fff_fallback |1: |.if resume | lea PC, [RA+NARGS:RD*8-16] // Check stack space (-1-thread). |.else | lea PC, [RA+NARGS:RD*8-8] // Check stack space (-1). |.endif | cmp PC, L:RB->maxstack; ja ->fff_fallback | mov L:RB->top, PC | | mov L:RB, SAVE_L | mov L:RB->base, BASE |.if resume | add BASE, 8 // Keep resumed thread in stack for GC. |.endif | mov L:RB->top, BASE |.if resume | lea RB, [BASE+NARGS:RD*8-24] // RB = end of source for stack move. |.else | lea RB, [BASE+NARGS:RD*8-16] // RB = end of source for stack move. |.endif | sub RBa, PCa // Relative to PC. | | cmp PC, RA | je >3 |2: // Move args to coroutine. |.if X64 | mov RCa, [PC+RB] | mov [PC-8], RCa |.else | mov RC, [PC+RB+4] | mov [PC-4], RC | mov RC, [PC+RB] | mov [PC-8], RC |.endif | sub PC, 8 | cmp PC, RA | jne <2 |3: |.if X64 | mov CARG2d, RA | mov CARG1d, TMP1 |.else | mov ARG2, RA | xor RA, RA | mov ARG4, RA | mov ARG3, RA |.endif | call ->vm_resume // (lua_State *L, TValue *base, 0, 0) | set_vmstate INTERP | | mov L:RB, SAVE_L |.if X64 | mov L:PC, TMP1 |.else | mov L:PC, ARG1 // The callee doesn't modify SAVE_L. |.endif | mov BASE, L:RB->base | cmp eax, LUA_YIELD | ja >8 |4: | mov RA, L:PC->base | mov KBASE, L:PC->top | mov L:PC->top, RA // Clear coroutine stack. | mov PC, KBASE | sub PC, RA | je >6 // No results? | lea RD, [BASE+PC] | shr PC, 3 | cmp RD, L:RB->maxstack | ja >9 // Need to grow stack? | | mov RB, BASE | sub RBa, RAa |5: // Move results from coroutine. |.if X64 | mov RDa, [RA] | mov [RA+RB], RDa |.else | mov RD, [RA] | mov [RA+RB], RD | mov RD, [RA+4] | mov [RA+RB+4], RD |.endif | add RA, 8 | cmp RA, KBASE | jne <5 |6: |.if resume | lea RD, [PC+2] // nresults+1 = 1 + true + results. | mov dword [BASE-4], LJ_TTRUE // Prepend true to results. |.else | lea RD, [PC+1] // nresults+1 = 1 + results. |.endif |7: | mov PC, SAVE_PC | mov MULTRES, RD |.if resume | mov RAa, -8 |.else | xor RA, RA |.endif | test PC, FRAME_TYPE | jz ->BC_RET_Z | jmp ->vm_return | |8: // Coroutine returned with error (at co->top-1). |.if resume | mov dword [BASE-4], LJ_TFALSE // Prepend false to results. | mov RA, L:PC->top | sub RA, 8 | mov L:PC->top, RA // Clear error from coroutine stack. | // Copy error message. |.if X64 | mov RDa, [RA] | mov [BASE], RDa |.else | mov RD, [RA] | mov [BASE], RD | mov RD, [RA+4] | mov [BASE+4], RD |.endif | mov RD, 1+2 // nresults+1 = 1 + false + error. | jmp <7 |.else | mov FCARG2, L:PC | mov FCARG1, L:RB | call extern lj_ffh_coroutine_wrap_err@8 // (lua_State *L, lua_State *co) | // Error function does not return. |.endif | |9: // Handle stack expansion on return from yield. |.if X64 | mov L:RA, TMP1 |.else | mov L:RA, ARG1 // The callee doesn't modify SAVE_L. |.endif | mov L:RA->top, KBASE // Undo coroutine stack clearing. | mov FCARG2, PC | mov FCARG1, L:RB | call extern lj_state_growstack@8 // (lua_State *L, int n) |.if X64 | mov L:PC, TMP1 |.else | mov L:PC, ARG1 |.endif | mov BASE, L:RB->base | jmp <4 // Retry the stack move. |.endmacro | | coroutine_resume_wrap 1 // coroutine.resume | coroutine_resume_wrap 0 // coroutine.wrap | |.ffunc coroutine_yield | mov L:RB, SAVE_L | test aword L:RB->cframe, CFRAME_RESUME | jz ->fff_fallback | mov L:RB->base, BASE | lea RD, [BASE+NARGS:RD*8-8] | mov L:RB->top, RD | xor RD, RD | mov aword L:RB->cframe, RDa | mov al, LUA_YIELD | mov byte L:RB->status, al | jmp ->vm_leave_unw | |//-- Math library ------------------------------------------------------- | |.if not DUALNUM |->fff_resi: // Dummy. |.endif | |.if SSE |->fff_resn: | mov PC, [BASE-4] | fstp qword [BASE-8] | jmp ->fff_res1 |.endif | | .ffunc_1 math_abs |.if DUALNUM | cmp dword [BASE+4], LJ_TISNUM; jne >2 | mov RB, dword [BASE] | cmp RB, 0; jns ->fff_resi | neg RB; js >1 |->fff_resbit: |->fff_resi: | mov PC, [BASE-4] | mov dword [BASE-4], LJ_TISNUM | mov dword [BASE-8], RB | jmp ->fff_res1 |1: | mov PC, [BASE-4] | mov dword [BASE-4], 0x41e00000 // 2^31. | mov dword [BASE-8], 0 | jmp ->fff_res1 |2: | ja ->fff_fallback |.else | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback |.endif | |.if SSE | movsd xmm0, qword [BASE] | sseconst_abs xmm1, RDa | andps xmm0, xmm1 |->fff_resxmm0: | mov PC, [BASE-4] | movsd qword [BASE-8], xmm0 | // fallthrough |.else | fld qword [BASE] | fabs | // fallthrough |->fff_resxmm0: // Dummy. |->fff_resn: | mov PC, [BASE-4] | fstp qword [BASE-8] |.endif | |->fff_res1: | mov RD, 1+1 |->fff_res: | mov MULTRES, RD |->fff_res_: | test PC, FRAME_TYPE | jnz >7 |5: | cmp PC_RB, RDL // More results expected? | ja >6 | // Adjust BASE. KBASE is assumed to be set for the calling frame. | movzx RA, PC_RA | not RAa // Note: ~RA = -(RA+1) | lea BASE, [BASE+RA*8] // base = base - (RA+1)*8 | ins_next | |6: // Fill up results with nil. | mov dword [BASE+RD*8-12], LJ_TNIL | add RD, 1 | jmp <5 | |7: // Non-standard return case. | mov RAa, -8 // Results start at BASE+RA = BASE-8. | jmp ->vm_return | |.macro math_round, func | .ffunc math_ .. func |.if DUALNUM | cmp dword [BASE+4], LJ_TISNUM; jne >1 | mov RB, dword [BASE]; jmp ->fff_resi |1: | ja ->fff_fallback |.else | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback |.endif |.if SSE | movsd xmm0, qword [BASE] | call ->vm_ .. func | .if DUALNUM | cvtsd2si RB, xmm0 | cmp RB, 0x80000000 | jne ->fff_resi | cvtsi2sd xmm1, RB | ucomisd xmm0, xmm1 | jp ->fff_resxmm0 | je ->fff_resi | .endif | jmp ->fff_resxmm0 |.else | fld qword [BASE] | call ->vm_ .. func | .if DUALNUM | fist ARG1 | mov RB, ARG1 | cmp RB, 0x80000000; jne >2 | fdup | fild ARG1 | fcomparepp | jp ->fff_resn | jne ->fff_resn |2: | fpop | jmp ->fff_resi | .else | jmp ->fff_resn | .endif |.endif |.endmacro | | math_round floor | math_round ceil | |.if SSE |.ffunc_nsse math_sqrt, sqrtsd; jmp ->fff_resxmm0 |.else |.ffunc_n math_sqrt; fsqrt; jmp ->fff_resn |.endif | |.ffunc math_log | cmp NARGS:RD, 1+1; jne ->fff_fallback // Exactly one argument. | cmp dword [BASE+4], LJ_TISNUM; jae ->fff_fallback | fldln2; fld qword [BASE]; fyl2x; jmp ->fff_resn | |.ffunc_n math_log10, fldlg2; fyl2x; jmp ->fff_resn |.ffunc_n math_exp; call ->vm_exp_x87; jmp ->fff_resn | |.ffunc_n math_sin; fsin; jmp ->fff_resn |.ffunc_n math_cos; fcos; jmp ->fff_resn |.ffunc_n math_tan; fptan; fpop; jmp ->fff_resn | |.ffunc_n math_asin | fdup; fmul st0; fld1; fsubrp st1; fsqrt; fpatan | jmp ->fff_resn |.ffunc_n math_acos | fdup; fmul st0; fld1; fsubrp st1; fsqrt; fxch; fpatan | jmp ->fff_resn |.ffunc_n math_atan; fld1; fpatan; jmp ->fff_resn | |.macro math_extern, func |.if SSE | .ffunc_nsse math_ .. func | .if not X64 | movsd FPARG1, xmm0 | .endif |.else | .ffunc_n math_ .. func | fstp FPARG1 |.endif | mov RB, BASE | call extern lj_vm_ .. func | mov BASE, RB | .if X64 | jmp ->fff_resxmm0 | .else | jmp ->fff_resn | .endif |.endmacro | | math_extern sinh | math_extern cosh | math_extern tanh | |->ff_math_deg: |.if SSE |.ffunc_nsse math_rad | mov CFUNC:RB, [BASE-8] | mulsd xmm0, qword CFUNC:RB->upvalue[0] | jmp ->fff_resxmm0 |.else |.ffunc_n math_rad | mov CFUNC:RB, [BASE-8] | fmul qword CFUNC:RB->upvalue[0] | jmp ->fff_resn |.endif | |.ffunc_nn math_atan2; fpatan; jmp ->fff_resn |.ffunc_nnr math_ldexp; fscale; fpop1; jmp ->fff_resn | |.ffunc_1 math_frexp | mov RB, [BASE+4] | cmp RB, LJ_TISNUM; jae ->fff_fallback | mov PC, [BASE-4] | mov RC, [BASE] | mov [BASE-4], RB; mov [BASE-8], RC | shl RB, 1; cmp RB, 0xffe00000; jae >3 | or RC, RB; jz >3 | mov RC, 1022 | cmp RB, 0x00200000; jb >4 |1: | shr RB, 21; sub RB, RC // Extract and unbias exponent. |.if SSE | cvtsi2sd xmm0, RB |.else | mov TMP1, RB; fild TMP1 |.endif | mov RB, [BASE-4] | and RB, 0x800fffff // Mask off exponent. | or RB, 0x3fe00000 // Put mantissa in range [0.5,1) or 0. | mov [BASE-4], RB |2: |.if SSE | movsd qword [BASE], xmm0 |.else | fstp qword [BASE] |.endif | mov RD, 1+2 | jmp ->fff_res |3: // Return +-0, +-Inf, NaN unmodified and an exponent of 0. |.if SSE | xorps xmm0, xmm0; jmp <2 |.else | fldz; jmp <2 |.endif |4: // Handle denormals by multiplying with 2^54 and adjusting the bias. |.if SSE | movsd xmm0, qword [BASE] | sseconst_hi xmm1, RBa, 43500000 // 2^54. | mulsd xmm0, xmm1 | movsd qword [BASE-8], xmm0 |.else | fld qword [BASE] | mov TMP1, 0x5a800000; fmul TMP1 // x = x*2^54 | fstp qword [BASE-8] |.endif | mov RB, [BASE-4]; mov RC, 1076; shl RB, 1; jmp <1 | |.if SSE |.ffunc_nsse math_modf |.else |.ffunc_n math_modf |.endif | mov RB, [BASE+4] | mov PC, [BASE-4] | shl RB, 1; cmp RB, 0xffe00000; je >4 // +-Inf? |.if SSE | movaps xmm4, xmm0 | call ->vm_trunc | subsd xmm4, xmm0 |1: | movsd qword [BASE-8], xmm0 | movsd qword [BASE], xmm4 |.else | fdup | call ->vm_trunc | fsub st1, st0 |1: | fstp qword [BASE-8] | fstp qword [BASE] |.endif | mov RC, [BASE-4]; mov RB, [BASE+4] | xor RC, RB; js >3 // Need to adjust sign? |2: | mov RD, 1+2 | jmp ->fff_res |3: | xor RB, 0x80000000; mov [BASE+4], RB // Flip sign of fraction. | jmp <2 |4: |.if SSE | xorps xmm4, xmm4; jmp <1 // Return +-Inf and +-0. |.else | fldz; fxch; jmp <1 // Return +-Inf and +-0. |.endif | |.ffunc_nnr math_fmod |1: ; fprem; fnstsw ax; and ax, 0x400; jnz <1 | fpop1 | jmp ->fff_resn | |.if SSE |.ffunc_nnsse math_pow; call ->vm_pow; jmp ->fff_resxmm0 |.else |.ffunc_nn math_pow; call ->vm_pow; jmp ->fff_resn |.endif | |.macro math_minmax, name, cmovop, fcmovop, sseop | .ffunc name | mov RA, 2 | cmp dword [BASE+4], LJ_TISNUM |.if DUALNUM | jne >4 | mov RB, dword [BASE] |1: // Handle integers. | cmp RA, RD; jae ->fff_resi | cmp dword [BASE+RA*8-4], LJ_TISNUM; jne >3 | cmp RB, dword [BASE+RA*8-8] | cmovop RB, dword [BASE+RA*8-8] | add RA, 1 | jmp <1 |3: | ja ->fff_fallback | // Convert intermediate result to number and continue below. |.if SSE | cvtsi2sd xmm0, RB |.else | mov TMP1, RB | fild TMP1 |.endif | jmp >6 |4: | ja ->fff_fallback |.else | jae ->fff_fallback |.endif | |.if SSE | movsd xmm0, qword [BASE] |5: // Handle numbers or integers. | cmp RA, RD; jae ->fff_resxmm0 | cmp dword [BASE+RA*8-4], LJ_TISNUM |.if DUALNUM | jb >6 | ja ->fff_fallback | cvtsi2sd xmm1, dword [BASE+RA*8-8] | jmp >7 |.else | jae ->fff_fallback |.endif |6: | movsd xmm1, qword [BASE+RA*8-8] |7: | sseop xmm0, xmm1 | add RA, 1 | jmp <5 |.else | fld qword [BASE] |5: // Handle numbers or integers. | cmp RA, RD; jae ->fff_resn | cmp dword [BASE+RA*8-4], LJ_TISNUM |.if DUALNUM | jb >6 | ja >9 | fild dword [BASE+RA*8-8] | jmp >7 |.else | jae >9 |.endif |6: | fld qword [BASE+RA*8-8] |7: | fucomi st1; fcmovop st1; fpop1 | add RA, 1 | jmp <5 |.endif |.endmacro | | math_minmax math_min, cmovg, fcmovnbe, minsd | math_minmax math_max, cmovl, fcmovbe, maxsd |.if not SSE |9: | fpop; jmp ->fff_fallback |.endif | |//-- String library ----------------------------------------------------- | |.ffunc_1 string_len | cmp dword [BASE+4], LJ_TSTR; jne ->fff_fallback | mov STR:RB, [BASE] |.if DUALNUM | mov RB, dword STR:RB->len; jmp ->fff_resi |.elif SSE | cvtsi2sd xmm0, dword STR:RB->len; jmp ->fff_resxmm0 |.else | fild dword STR:RB->len; jmp ->fff_resn |.endif | |.ffunc string_byte // Only handle the 1-arg case here. | cmp NARGS:RD, 1+1; jne ->fff_fallback | cmp dword [BASE+4], LJ_TSTR; jne ->fff_fallback | mov STR:RB, [BASE] | mov PC, [BASE-4] | cmp dword STR:RB->len, 1 | jb ->fff_res0 // Return no results for empty string. | movzx RB, byte STR:RB[1] |.if DUALNUM | jmp ->fff_resi |.elif SSE | cvtsi2sd xmm0, RB; jmp ->fff_resxmm0 |.else | mov TMP1, RB; fild TMP1; jmp ->fff_resn |.endif | |.ffunc string_char // Only handle the 1-arg case here. | ffgccheck | cmp NARGS:RD, 1+1; jne ->fff_fallback // *Exactly* 1 arg. | cmp dword [BASE+4], LJ_TISNUM |.if DUALNUM | jne ->fff_fallback | mov RB, dword [BASE] | cmp RB, 255; ja ->fff_fallback | mov TMP2, RB |.elif SSE | jae ->fff_fallback | cvttsd2si RB, qword [BASE] | cmp RB, 255; ja ->fff_fallback | mov TMP2, RB |.else | jae ->fff_fallback | fld qword [BASE] | fistp TMP2 | cmp TMP2, 255; ja ->fff_fallback |.endif |.if X64 | mov TMP3, 1 |.else | mov ARG3, 1 |.endif | lea RDa, TMP2 // Points to stack. Little-endian. |->fff_newstr: | mov L:RB, SAVE_L | mov L:RB->base, BASE |.if X64 | mov CARG3d, TMP3 // Zero-extended to size_t. | mov CARG2, RDa // May be 64 bit ptr to stack. | mov CARG1d, L:RB |.else | mov ARG2, RD | mov ARG1, L:RB |.endif | mov SAVE_PC, PC | call extern lj_str_new // (lua_State *L, char *str, size_t l) | // GCstr * returned in eax (RD). | mov BASE, L:RB->base | mov PC, [BASE-4] | mov dword [BASE-4], LJ_TSTR | mov [BASE-8], STR:RD | jmp ->fff_res1 | |.ffunc string_sub | ffgccheck | mov TMP2, -1 | cmp NARGS:RD, 1+2; jb ->fff_fallback | jna >1 | cmp dword [BASE+20], LJ_TISNUM |.if DUALNUM | jne ->fff_fallback | mov RB, dword [BASE+16] | mov TMP2, RB |.elif SSE | jae ->fff_fallback | cvttsd2si RB, qword [BASE+16] | mov TMP2, RB |.else | jae ->fff_fallback | fld qword [BASE+16] | fistp TMP2 |.endif |1: | cmp dword [BASE+4], LJ_TSTR; jne ->fff_fallback | cmp dword [BASE+12], LJ_TISNUM |.if DUALNUM | jne ->fff_fallback |.else | jae ->fff_fallback |.endif | mov STR:RB, [BASE] | mov TMP3, STR:RB | mov RB, STR:RB->len |.if DUALNUM | mov RA, dword [BASE+8] |.elif SSE | cvttsd2si RA, qword [BASE+8] |.else | fld qword [BASE+8] | fistp ARG3 | mov RA, ARG3 |.endif | mov RC, TMP2 | cmp RB, RC // len < end? (unsigned compare) | jb >5 |2: | test RA, RA // start <= 0? | jle >7 |3: | mov STR:RB, TMP3 | sub RC, RA // start > end? | jl ->fff_emptystr | lea RB, [STR:RB+RA+#STR-1] | add RC, 1 |4: |.if X64 | mov TMP3, RC |.else | mov ARG3, RC |.endif | mov RD, RB | jmp ->fff_newstr | |5: // Negative end or overflow. | jl >6 | lea RC, [RC+RB+1] // end = end+(len+1) | jmp <2 |6: // Overflow. | mov RC, RB // end = len | jmp <2 | |7: // Negative start or underflow. | je >8 | add RA, RB // start = start+(len+1) | add RA, 1 | jg <3 // start > 0? |8: // Underflow. | mov RA, 1 // start = 1 | jmp <3 | |->fff_emptystr: // Range underflow. | xor RC, RC // Zero length. Any ptr in RB is ok. | jmp <4 | |.ffunc string_rep // Only handle the 1-char case inline. | ffgccheck | cmp NARGS:RD, 2+1; jne ->fff_fallback // Exactly 2 arguments. | cmp dword [BASE+4], LJ_TSTR; jne ->fff_fallback | cmp dword [BASE+12], LJ_TISNUM | mov STR:RB, [BASE] |.if DUALNUM | jne ->fff_fallback | mov RC, dword [BASE+8] |.elif SSE | jae ->fff_fallback | cvttsd2si RC, qword [BASE+8] |.else | jae ->fff_fallback | fld qword [BASE+8] | fistp TMP2 | mov RC, TMP2 |.endif | test RC, RC | jle ->fff_emptystr // Count <= 0? (or non-int) | cmp dword STR:RB->len, 1 | jb ->fff_emptystr // Zero length string? | jne ->fff_fallback_2 // Fallback for > 1-char strings. | cmp [DISPATCH+DISPATCH_GL(tmpbuf.sz)], RC; jb ->fff_fallback_2 | movzx RA, byte STR:RB[1] | mov RB, [DISPATCH+DISPATCH_GL(tmpbuf.buf)] |.if X64 | mov TMP3, RC |.else | mov ARG3, RC |.endif |1: // Fill buffer with char. Yes, this is suboptimal code (do you care?). | mov [RB], RAL | add RB, 1 | sub RC, 1 | jnz <1 | mov RD, [DISPATCH+DISPATCH_GL(tmpbuf.buf)] | jmp ->fff_newstr | |.ffunc_1 string_reverse | ffgccheck | cmp dword [BASE+4], LJ_TSTR; jne ->fff_fallback | mov STR:RB, [BASE] | mov RC, STR:RB->len | test RC, RC | jz ->fff_emptystr // Zero length string? | cmp [DISPATCH+DISPATCH_GL(tmpbuf.sz)], RC; jb ->fff_fallback_1 | add RB, #STR | mov TMP2, PC // Need another temp register. |.if X64 | mov TMP3, RC |.else | mov ARG3, RC |.endif | mov PC, [DISPATCH+DISPATCH_GL(tmpbuf.buf)] |1: | movzx RA, byte [RB] | add RB, 1 | sub RC, 1 | mov [PC+RC], RAL | jnz <1 | mov RD, PC | mov PC, TMP2 | jmp ->fff_newstr | |.macro ffstring_case, name, lo, hi | .ffunc_1 name | ffgccheck | cmp dword [BASE+4], LJ_TSTR; jne ->fff_fallback | mov STR:RB, [BASE] | mov RC, STR:RB->len | cmp [DISPATCH+DISPATCH_GL(tmpbuf.sz)], RC; jb ->fff_fallback_1 | add RB, #STR | mov TMP2, PC // Need another temp register. |.if X64 | mov TMP3, RC |.else | mov ARG3, RC |.endif | mov PC, [DISPATCH+DISPATCH_GL(tmpbuf.buf)] | jmp >3 |1: // ASCII case conversion. Yes, this is suboptimal code (do you care?). | movzx RA, byte [RB+RC] | cmp RA, lo | jb >2 | cmp RA, hi | ja >2 | xor RA, 0x20 |2: | mov [PC+RC], RAL |3: | sub RC, 1 | jns <1 | mov RD, PC | mov PC, TMP2 | jmp ->fff_newstr |.endmacro | |ffstring_case string_lower, 0x41, 0x5a |ffstring_case string_upper, 0x61, 0x7a | |//-- Table library ------------------------------------------------------ | |.ffunc_1 table_getn | cmp dword [BASE+4], LJ_TTAB; jne ->fff_fallback | mov RB, BASE // Save BASE. | mov TAB:FCARG1, [BASE] | call extern lj_tab_len@4 // LJ_FASTCALL (GCtab *t) | // Length of table returned in eax (RD). | mov BASE, RB // Restore BASE. |.if DUALNUM | mov RB, RD; jmp ->fff_resi |.elif SSE | cvtsi2sd xmm0, RD; jmp ->fff_resxmm0 |.else | mov ARG1, RD; fild ARG1; jmp ->fff_resn |.endif | |//-- Bit library -------------------------------------------------------- | |.define TOBIT_BIAS, 0x59c00000 // 2^52 + 2^51 (float, not double!). | |.macro .ffunc_bit, name, kind, fdef | fdef name |.if kind == 2 |.if SSE | sseconst_tobit xmm1, RBa |.else | mov TMP1, TOBIT_BIAS |.endif |.endif | cmp dword [BASE+4], LJ_TISNUM |.if DUALNUM | jne >1 | mov RB, dword [BASE] |.if kind > 0 | jmp >2 |.else | jmp ->fff_resbit |.endif |1: | ja ->fff_fallback |.else | jae ->fff_fallback |.endif |.if SSE | movsd xmm0, qword [BASE] |.if kind < 2 | sseconst_tobit xmm1, RBa |.endif | addsd xmm0, xmm1 | movd RB, xmm0 |.else | fld qword [BASE] |.if kind < 2 | mov TMP1, TOBIT_BIAS |.endif | fadd TMP1 | fstp FPARG1 |.if kind > 0 | mov RB, ARG1 |.endif |.endif |2: |.endmacro | |.macro .ffunc_bit, name, kind | .ffunc_bit name, kind, .ffunc_1 |.endmacro | |.ffunc_bit bit_tobit, 0 |.if DUALNUM or SSE |.if not SSE | mov RB, ARG1 |.endif | jmp ->fff_resbit |.else | fild ARG1 | jmp ->fff_resn |.endif | |.macro .ffunc_bit_op, name, ins | .ffunc_bit name, 2 | mov TMP2, NARGS:RD // Save for fallback. | lea RD, [BASE+NARGS:RD*8-16] |1: | cmp RD, BASE | jbe ->fff_resbit | cmp dword [RD+4], LJ_TISNUM |.if DUALNUM | jne >2 | ins RB, dword [RD] | sub RD, 8 | jmp <1 |2: | ja ->fff_fallback_bit_op |.else | jae ->fff_fallback_bit_op |.endif |.if SSE | movsd xmm0, qword [RD] | addsd xmm0, xmm1 | movd RA, xmm0 | ins RB, RA |.else | fld qword [RD] | fadd TMP1 | fstp FPARG1 | ins RB, ARG1 |.endif | sub RD, 8 | jmp <1 |.endmacro | |.ffunc_bit_op bit_band, and |.ffunc_bit_op bit_bor, or |.ffunc_bit_op bit_bxor, xor | |.ffunc_bit bit_bswap, 1 | bswap RB | jmp ->fff_resbit | |.ffunc_bit bit_bnot, 1 | not RB |.if DUALNUM | jmp ->fff_resbit |.elif SSE |->fff_resbit: | cvtsi2sd xmm0, RB | jmp ->fff_resxmm0 |.else |->fff_resbit: | mov ARG1, RB | fild ARG1 | jmp ->fff_resn |.endif | |->fff_fallback_bit_op: | mov NARGS:RD, TMP2 // Restore for fallback | jmp ->fff_fallback | |.macro .ffunc_bit_sh, name, ins |.if DUALNUM | .ffunc_bit name, 1, .ffunc_2 | // Note: no inline conversion from number for 2nd argument! | cmp dword [BASE+12], LJ_TISNUM; jne ->fff_fallback | mov RA, dword [BASE+8] |.elif SSE | .ffunc_nnsse name | sseconst_tobit xmm2, RBa | addsd xmm0, xmm2 | addsd xmm1, xmm2 | movd RB, xmm0 | movd RA, xmm1 |.else | .ffunc_nn name | mov TMP1, TOBIT_BIAS | fadd TMP1 | fstp FPARG3 | fadd TMP1 | fstp FPARG1 | mov RA, ARG3 | mov RB, ARG1 |.endif | ins RB, cl // Assumes RA is ecx. | jmp ->fff_resbit |.endmacro | |.ffunc_bit_sh bit_lshift, shl |.ffunc_bit_sh bit_rshift, shr |.ffunc_bit_sh bit_arshift, sar |.ffunc_bit_sh bit_rol, rol |.ffunc_bit_sh bit_ror, ror | |//----------------------------------------------------------------------- | |->fff_fallback_2: | mov NARGS:RD, 1+2 // Other args are ignored, anyway. | jmp ->fff_fallback |->fff_fallback_1: | mov NARGS:RD, 1+1 // Other args are ignored, anyway. |->fff_fallback: // Call fast function fallback handler. | // BASE = new base, RD = nargs+1 | mov L:RB, SAVE_L | mov PC, [BASE-4] // Fallback may overwrite PC. | mov SAVE_PC, PC // Redundant (but a defined value). | mov L:RB->base, BASE | lea RD, [BASE+NARGS:RD*8-8] | lea RA, [RD+8*LUA_MINSTACK] // Ensure enough space for handler. | mov L:RB->top, RD | mov CFUNC:RD, [BASE-8] | cmp RA, L:RB->maxstack | ja >5 // Need to grow stack. |.if X64 | mov CARG1d, L:RB |.else | mov ARG1, L:RB |.endif | call aword CFUNC:RD->f // (lua_State *L) | mov BASE, L:RB->base | // Either throws an error, or recovers and returns -1, 0 or nresults+1. | test RD, RD; jg ->fff_res // Returned nresults+1? |1: | mov RA, L:RB->top | sub RA, BASE | shr RA, 3 | test RD, RD | lea NARGS:RD, [RA+1] | mov LFUNC:RB, [BASE-8] | jne ->vm_call_tail // Returned -1? | ins_callt // Returned 0: retry fast path. | |// Reconstruct previous base for vmeta_call during tailcall. |->vm_call_tail: | mov RA, BASE | test PC, FRAME_TYPE | jnz >3 | movzx RB, PC_RA | not RBa // Note: ~RB = -(RB+1) | lea BASE, [BASE+RB*8] // base = base - (RB+1)*8 | jmp ->vm_call_dispatch // Resolve again for tailcall. |3: | mov RB, PC | and RB, -8 | sub BASE, RB | jmp ->vm_call_dispatch // Resolve again for tailcall. | |5: // Grow stack for fallback handler. | mov FCARG2, LUA_MINSTACK | mov FCARG1, L:RB | call extern lj_state_growstack@8 // (lua_State *L, int n) | mov BASE, L:RB->base | xor RD, RD // Simulate a return 0. | jmp <1 // Dumb retry (goes through ff first). | |->fff_gcstep: // Call GC step function. | // BASE = new base, RD = nargs+1 | pop RBa // Must keep stack at same level. | mov TMPa, RBa // Save return address | mov L:RB, SAVE_L | mov SAVE_PC, PC // Redundant (but a defined value). | mov L:RB->base, BASE | lea RD, [BASE+NARGS:RD*8-8] | mov FCARG1, L:RB | mov L:RB->top, RD | call extern lj_gc_step@4 // (lua_State *L) | mov BASE, L:RB->base | mov RD, L:RB->top | sub RD, BASE | shr RD, 3 | add NARGS:RD, 1 | mov RBa, TMPa | push RBa // Restore return address. | ret | |//----------------------------------------------------------------------- |//-- Special dispatch targets ------------------------------------------- |//----------------------------------------------------------------------- | |->vm_record: // Dispatch target for recording phase. |.if JIT | movzx RD, byte [DISPATCH+DISPATCH_GL(hookmask)] | test RDL, HOOK_VMEVENT // No recording while in vmevent. | jnz >5 | // Decrement the hookcount for consistency, but always do the call. | test RDL, HOOK_ACTIVE | jnz >1 | test RDL, LUA_MASKLINE|LUA_MASKCOUNT | jz >1 | dec dword [DISPATCH+DISPATCH_GL(hookcount)] | jmp >1 |.endif | |->vm_rethook: // Dispatch target for return hooks. | movzx RD, byte [DISPATCH+DISPATCH_GL(hookmask)] | test RDL, HOOK_ACTIVE // Hook already active? | jnz >5 | jmp >1 | |->vm_inshook: // Dispatch target for instr/line hooks. | movzx RD, byte [DISPATCH+DISPATCH_GL(hookmask)] | test RDL, HOOK_ACTIVE // Hook already active? | jnz >5 | | test RDL, LUA_MASKLINE|LUA_MASKCOUNT | jz >5 | dec dword [DISPATCH+DISPATCH_GL(hookcount)] | jz >1 | test RDL, LUA_MASKLINE | jz >5 |1: | mov L:RB, SAVE_L | mov L:RB->base, BASE | mov FCARG2, PC // Caveat: FCARG2 == BASE | mov FCARG1, L:RB | // SAVE_PC must hold the _previous_ PC. The callee updates it with PC. | call extern lj_dispatch_ins@8 // (lua_State *L, BCIns *pc) |3: | mov BASE, L:RB->base |4: | movzx RA, PC_RA |5: | movzx OP, PC_OP | movzx RD, PC_RD |.if X64 | jmp aword [DISPATCH+OP*8+GG_DISP2STATIC] // Re-dispatch to static ins. |.else | jmp aword [DISPATCH+OP*4+GG_DISP2STATIC] // Re-dispatch to static ins. |.endif | |->cont_hook: // Continue from hook yield. | add PC, 4 | mov RA, [RB-24] | mov MULTRES, RA // Restore MULTRES for *M ins. | jmp <4 | |->vm_hotloop: // Hot loop counter underflow. |.if JIT | mov LFUNC:RB, [BASE-8] // Same as curr_topL(L). | mov RB, LFUNC:RB->pc | movzx RD, byte [RB+PC2PROTO(framesize)] | lea RD, [BASE+RD*8] | mov L:RB, SAVE_L | mov L:RB->base, BASE | mov L:RB->top, RD | mov FCARG2, PC | lea FCARG1, [DISPATCH+GG_DISP2J] | mov aword [DISPATCH+DISPATCH_J(L)], L:RBa | mov SAVE_PC, PC | call extern lj_trace_hot@8 // (jit_State *J, const BCIns *pc) | jmp <3 |.endif | |->vm_callhook: // Dispatch target for call hooks. | mov SAVE_PC, PC |.if JIT | jmp >1 |.endif | |->vm_hotcall: // Hot call counter underflow. |.if JIT | mov SAVE_PC, PC | or PC, 1 // Marker for hot call. |1: |.endif | lea RD, [BASE+NARGS:RD*8-8] | mov L:RB, SAVE_L | mov L:RB->base, BASE | mov L:RB->top, RD | mov FCARG2, PC | mov FCARG1, L:RB | call extern lj_dispatch_call@8 // (lua_State *L, const BCIns *pc) | // ASMFunction returned in eax/rax (RDa). | mov SAVE_PC, 0 // Invalidate for subsequent line hook. |.if JIT | and PC, -2 |.endif | mov BASE, L:RB->base | mov RAa, RDa | mov RD, L:RB->top | sub RD, BASE | mov RBa, RAa | movzx RA, PC_RA | shr RD, 3 | add NARGS:RD, 1 | jmp RBa | |//----------------------------------------------------------------------- |//-- Trace exit handler ------------------------------------------------- |//----------------------------------------------------------------------- | |// Called from an exit stub with the exit number on the stack. |// The 16 bit exit number is stored with two (sign-extended) push imm8. |->vm_exit_handler: |.if JIT |.if X64 | push r13; push r12 | push r11; push r10; push r9; push r8 | push rdi; push rsi; push rbp; lea rbp, [rsp+88]; push rbp | push rbx; push rdx; push rcx; push rax | movzx RC, byte [rbp-8] // Reconstruct exit number. | mov RCH, byte [rbp-16] | mov [rbp-8], r15; mov [rbp-16], r14 |.else | push ebp; lea ebp, [esp+12]; push ebp | push ebx; push edx; push ecx; push eax | movzx RC, byte [ebp-4] // Reconstruct exit number. | mov RCH, byte [ebp-8] | mov [ebp-4], edi; mov [ebp-8], esi |.endif | // Caveat: DISPATCH is ebx. | mov DISPATCH, [ebp] | mov RA, [DISPATCH+DISPATCH_GL(vmstate)] // Get trace number. | set_vmstate EXIT | mov [DISPATCH+DISPATCH_J(exitno)], RC | mov [DISPATCH+DISPATCH_J(parent)], RA |.if X64 |.if X64WIN | sub rsp, 16*8+4*8 // Room for SSE regs + save area. |.else | sub rsp, 16*8 // Room for SSE regs. |.endif | add rbp, -128 | movsd qword [rbp-8], xmm15; movsd qword [rbp-16], xmm14 | movsd qword [rbp-24], xmm13; movsd qword [rbp-32], xmm12 | movsd qword [rbp-40], xmm11; movsd qword [rbp-48], xmm10 | movsd qword [rbp-56], xmm9; movsd qword [rbp-64], xmm8 | movsd qword [rbp-72], xmm7; movsd qword [rbp-80], xmm6 | movsd qword [rbp-88], xmm5; movsd qword [rbp-96], xmm4 | movsd qword [rbp-104], xmm3; movsd qword [rbp-112], xmm2 | movsd qword [rbp-120], xmm1; movsd qword [rbp-128], xmm0 |.else | sub esp, 8*8+16 // Room for SSE regs + args. | movsd qword [ebp-40], xmm7; movsd qword [ebp-48], xmm6 | movsd qword [ebp-56], xmm5; movsd qword [ebp-64], xmm4 | movsd qword [ebp-72], xmm3; movsd qword [ebp-80], xmm2 | movsd qword [ebp-88], xmm1; movsd qword [ebp-96], xmm0 |.endif | // Caveat: RB is ebp. | mov L:RB, [DISPATCH+DISPATCH_GL(jit_L)] | mov BASE, [DISPATCH+DISPATCH_GL(jit_base)] | mov aword [DISPATCH+DISPATCH_J(L)], L:RBa | mov dword [DISPATCH+DISPATCH_GL(jit_L)], 0 | mov L:RB->base, BASE |.if X64WIN | lea CARG2, [rsp+4*8] |.elif X64 | mov CARG2, rsp |.else | lea FCARG2, [esp+16] |.endif | lea FCARG1, [DISPATCH+GG_DISP2J] | call extern lj_trace_exit@8 // (jit_State *J, ExitState *ex) | // MULTRES or negated error code returned in eax (RD). | mov RAa, L:RB->cframe | and RAa, CFRAME_RAWMASK |.if X64WIN | // Reposition stack later. |.elif X64 | mov rsp, RAa // Reposition stack to C frame. |.else | mov esp, RAa // Reposition stack to C frame. |.endif | mov [RAa+CFRAME_OFS_L], L:RB // Set SAVE_L (on-trace resume/yield). | mov BASE, L:RB->base | mov PC, [RAa+CFRAME_OFS_PC] // Get SAVE_PC. |.if X64 | jmp >1 |.endif |.endif |->vm_exit_interp: | // RD = MULTRES or negated error code, BASE, PC and DISPATCH set. |.if JIT |.if X64 | // Restore additional callee-save registers only used in compiled code. |.if X64WIN | lea RAa, [rsp+9*16+4*8] |1: | movdqa xmm15, [RAa-9*16] | movdqa xmm14, [RAa-8*16] | movdqa xmm13, [RAa-7*16] | movdqa xmm12, [RAa-6*16] | movdqa xmm11, [RAa-5*16] | movdqa xmm10, [RAa-4*16] | movdqa xmm9, [RAa-3*16] | movdqa xmm8, [RAa-2*16] | movdqa xmm7, [RAa-1*16] | mov rsp, RAa // Reposition stack to C frame. | movdqa xmm6, [RAa] | mov r15, CSAVE_3 | mov r14, CSAVE_4 |.else | add rsp, 16 // Reposition stack to C frame. |1: |.endif | mov r13, TMPa | mov r12, TMPQ |.endif | test RD, RD; js >3 // Check for error from exit. | mov MULTRES, RD | mov LFUNC:KBASE, [BASE-8] | mov KBASE, LFUNC:KBASE->pc | mov KBASE, [KBASE+PC2PROTO(k)] | mov dword [DISPATCH+DISPATCH_GL(jit_L)], 0 | set_vmstate INTERP | // Modified copy of ins_next which handles function header dispatch, too. | mov RC, [PC] | movzx RA, RCH | movzx OP, RCL | add PC, 4 | shr RC, 16 | cmp OP, BC_FUNCF // Function header? | jb >2 | mov RC, MULTRES // RC/RD holds nres+1. |2: |.if X64 | jmp aword [DISPATCH+OP*8] |.else | jmp aword [DISPATCH+OP*4] |.endif | |3: // Rethrow error from the right C frame. | neg RD | mov FCARG1, L:RB | mov FCARG2, RD | call extern lj_err_throw@8 // (lua_State *L, int errcode) |.endif | |//----------------------------------------------------------------------- |//-- Math helper functions ---------------------------------------------- |//----------------------------------------------------------------------- | |// FP value rounding. Called by math.floor/math.ceil fast functions |// and from JIT code. | |// x87 variant: Arg/ret on x87 stack. No int/xmm registers modified. |.macro vm_round_x87, mode1, mode2 | fnstcw word [esp+4] // Caveat: overwrites ARG1 and ARG2. | mov [esp+8], eax | mov ax, mode1 | or ax, [esp+4] |.if mode2 ~= 0xffff | and ax, mode2 |.endif | mov [esp+6], ax | fldcw word [esp+6] | frndint | fldcw word [esp+4] | mov eax, [esp+8] | ret |.endmacro | |// SSE variant: arg/ret is xmm0. xmm0-xmm3 and RD (eax) modified. |.macro vm_round_sse, mode | sseconst_abs xmm2, RDa | sseconst_2p52 xmm3, RDa | movaps xmm1, xmm0 | andpd xmm1, xmm2 // |x| | ucomisd xmm3, xmm1 // No truncation if 2^52 <= |x|. | jbe >1 | andnpd xmm2, xmm0 // Isolate sign bit. |.if mode == 2 // trunc(x)? | movaps xmm0, xmm1 | addsd xmm1, xmm3 // (|x| + 2^52) - 2^52 | subsd xmm1, xmm3 | sseconst_1 xmm3, RDa | cmpsd xmm0, xmm1, 1 // |x| < result? | andpd xmm0, xmm3 | subsd xmm1, xmm0 // If yes, subtract -1. | orpd xmm1, xmm2 // Merge sign bit back in. |.else | addsd xmm1, xmm3 // (|x| + 2^52) - 2^52 | subsd xmm1, xmm3 | orpd xmm1, xmm2 // Merge sign bit back in. | .if mode == 1 // ceil(x)? | sseconst_m1 xmm2, RDa // Must subtract -1 to preserve -0. | cmpsd xmm0, xmm1, 6 // x > result? | .else // floor(x)? | sseconst_1 xmm2, RDa | cmpsd xmm0, xmm1, 1 // x < result? | .endif | andpd xmm0, xmm2 | subsd xmm1, xmm0 // If yes, subtract +-1. |.endif | movaps xmm0, xmm1 |1: | ret |.endmacro | |.macro vm_round, name, ssemode, mode1, mode2 |->name: |.if not SSE | vm_round_x87 mode1, mode2 |.endif |->name .. _sse: | vm_round_sse ssemode |.endmacro | | vm_round vm_floor, 0, 0x0400, 0xf7ff | vm_round vm_ceil, 1, 0x0800, 0xfbff | vm_round vm_trunc, 2, 0x0c00, 0xffff | |// FP modulo x%y. Called by BC_MOD* and vm_arith. |->vm_mod: |.if SSE |// Args in xmm0/xmm1, return value in xmm0. |// Caveat: xmm0-xmm5 and RC (eax) modified! | movaps xmm5, xmm0 | divsd xmm0, xmm1 | sseconst_abs xmm2, RDa | sseconst_2p52 xmm3, RDa | movaps xmm4, xmm0 | andpd xmm4, xmm2 // |x/y| | ucomisd xmm3, xmm4 // No truncation if 2^52 <= |x/y|. | jbe >1 | andnpd xmm2, xmm0 // Isolate sign bit. | addsd xmm4, xmm3 // (|x/y| + 2^52) - 2^52 | subsd xmm4, xmm3 | orpd xmm4, xmm2 // Merge sign bit back in. | sseconst_1 xmm2, RDa | cmpsd xmm0, xmm4, 1 // x/y < result? | andpd xmm0, xmm2 | subsd xmm4, xmm0 // If yes, subtract 1.0. | movaps xmm0, xmm5 | mulsd xmm1, xmm4 | subsd xmm0, xmm1 | ret |1: | mulsd xmm1, xmm0 | movaps xmm0, xmm5 | subsd xmm0, xmm1 | ret |.else |// Args/ret on x87 stack (y on top). No xmm registers modified. |// Caveat: needs 3 slots on x87 stack! RC (eax) modified! | fld st1 | fdiv st1 | fnstcw word [esp+4] | mov ax, 0x0400 | or ax, [esp+4] | and ax, 0xf7ff | mov [esp+6], ax | fldcw word [esp+6] | frndint | fldcw word [esp+4] | fmulp st1 | fsubp st1 | ret |.endif | |// FP log2(x). Called by math.log(x, base). |->vm_log2: |.if X64WIN | movsd qword [rsp+8], xmm0 // Use scratch area. | fld1 | fld qword [rsp+8] | fyl2x | fstp qword [rsp+8] | movsd xmm0, qword [rsp+8] |.elif X64 | movsd qword [rsp-8], xmm0 // Use red zone. | fld1 | fld qword [rsp-8] | fyl2x | fstp qword [rsp-8] | movsd xmm0, qword [rsp-8] |.else | fld1 | fld qword [esp+4] | fyl2x |.endif | ret | |// FP exponentiation e^x and 2^x. Called by math.exp fast function and |// from JIT code. Arg/ret on x87 stack. No int/xmm regs modified. |// Caveat: needs 3 slots on x87 stack! |->vm_exp_x87: | fldl2e; fmulp st1 // e^x ==> 2^(x*log2(e)) |->vm_exp2_x87: | .if X64WIN | .define expscratch, dword [rsp+8] // Use scratch area. | .elif X64 | .define expscratch, dword [rsp-8] // Use red zone. | .else | .define expscratch, dword [esp+4] // Needs 4 byte scratch area. | .endif | fst expscratch // Caveat: overwrites ARG1. | cmp expscratch, 0x7f800000; je >1 // Special case: e^+Inf = +Inf | cmp expscratch, 0xff800000; je >2 // Special case: e^-Inf = 0 |->vm_exp2raw: // Entry point for vm_pow. Without +-Inf check. | fdup; frndint; fsub st1, st0; fxch // Split into frac/int part. | f2xm1; fld1; faddp st1; fscale; fpop1 // ==> (2^frac-1 +1) << int |1: | ret |2: | fpop; fldz; ret | |// Generic power function x^y. Called by BC_POW, math.pow fast function, |// and vm_arith. |// Args/ret on x87 stack (y on top). RC (eax) modified. |// Caveat: needs 3 slots on x87 stack! |->vm_pow: |.if not SSE | fist dword [esp+4] // Store/reload int before comparison. | fild dword [esp+4] // Integral exponent used in vm_powi. | fucomip st1 | jnz >8 // Branch for FP exponents. | jp >9 // Branch for NaN exponent. | fpop // Pop y and fallthrough to vm_powi. | |// FP/int power function x^i. Arg1/ret on x87 stack. |// Arg2 (int) on C stack. RC (eax) modified. |// Caveat: needs 2 slots on x87 stack! | mov eax, [esp+4] | cmp eax, 1; jle >6 // i<=1? | // Now 1 < (unsigned)i <= 0x80000000. |1: // Handle leading zeros. | test eax, 1; jnz >2 | fmul st0 | shr eax, 1 | jmp <1 |2: | shr eax, 1; jz >5 | fdup |3: // Handle trailing bits. | fmul st0 | shr eax, 1; jz >4 | jnc <3 | fmul st1, st0 | jmp <3 |4: | fmulp st1 |5: | ret |6: | je <5 // x^1 ==> x | jb >7 | fld1; fdivrp st1 | neg eax | cmp eax, 1; je <5 // x^-1 ==> 1/x | jmp <1 // x^-i ==> (1/x)^i |7: | fpop; fld1 // x^0 ==> 1 | ret | |8: // FP/FP power function x^y. | fst dword [esp+4] | fxch | fst dword [esp+8] | mov eax, [esp+4]; shl eax, 1 | cmp eax, 0xff000000; je >2 // x^+-Inf? | mov eax, [esp+8]; shl eax, 1; je >4 // +-0^y? | cmp eax, 0xff000000; je >4 // +-Inf^y? | fyl2x | jmp ->vm_exp2raw | |9: // Handle x^NaN. | fld1 | fucomip st2 | je >1 // 1^NaN ==> 1 | fxch // x^NaN ==> NaN |1: | fpop | ret | |2: // Handle x^+-Inf. | fabs | fld1 | fucomip st1 | je >3 // +-1^+-Inf ==> 1 | fpop; fabs; fldz; mov eax, 0; setc al | ror eax, 1; xor eax, [esp+4]; jns >3 // |x|<>1, x^+-Inf ==> +Inf/0 | fxch |3: | fpop1; fabs | ret | |4: // Handle +-0^y or +-Inf^y. | cmp dword [esp+4], 0; jge <3 // y >= 0, x^y ==> |x| | fpop; fpop | test eax, eax; jz >5 // y < 0, +-0^y ==> +Inf | fldz // y < 0, +-Inf^y ==> 0 | ret |5: | mov dword [esp+4], 0x7f800000 // Return +Inf. | fld dword [esp+4] | ret |.endif | |// Args in xmm0/xmm1. Ret in xmm0. xmm0-xmm2 and RC (eax) modified. |// Needs 16 byte scratch area for x86. Also called from JIT code. |->vm_pow_sse: | cvtsd2si eax, xmm1 | cvtsi2sd xmm2, eax | ucomisd xmm1, xmm2 | jnz >8 // Branch for FP exponents. | jp >9 // Branch for NaN exponent. | // Fallthrough to vm_powi_sse. | |// Args in xmm0/eax. Ret in xmm0. xmm0-xmm1 and eax modified. |->vm_powi_sse: | cmp eax, 1; jle >6 // i<=1? | // Now 1 < (unsigned)i <= 0x80000000. |1: // Handle leading zeros. | test eax, 1; jnz >2 | mulsd xmm0, xmm0 | shr eax, 1 | jmp <1 |2: | shr eax, 1; jz >5 | movaps xmm1, xmm0 |3: // Handle trailing bits. | mulsd xmm0, xmm0 | shr eax, 1; jz >4 | jnc <3 | mulsd xmm1, xmm0 | jmp <3 |4: | mulsd xmm0, xmm1 |5: | ret |6: | je <5 // x^1 ==> x | jb >7 // x^0 ==> 1 | neg eax | call <1 | sseconst_1 xmm1, RDa | divsd xmm1, xmm0 | movaps xmm0, xmm1 | ret |7: | sseconst_1 xmm0, RDa | ret | |8: // FP/FP power function x^y. |.if X64 | movd rax, xmm1; shl rax, 1 | rol rax, 12; cmp rax, 0xffe; je >2 // x^+-Inf? | movd rax, xmm0; shl rax, 1; je >4 // +-0^y? | rol rax, 12; cmp rax, 0xffe; je >5 // +-Inf^y? | .if X64WIN | movsd qword [rsp+16], xmm1 // Use scratch area. | movsd qword [rsp+8], xmm0 | fld qword [rsp+16] | fld qword [rsp+8] | .else | movsd qword [rsp-16], xmm1 // Use red zone. | movsd qword [rsp-8], xmm0 | fld qword [rsp-16] | fld qword [rsp-8] | .endif |.else | movsd qword [esp+12], xmm1 // Needs 16 byte scratch area. | movsd qword [esp+4], xmm0 | cmp dword [esp+12], 0; jne >1 | mov eax, [esp+16]; shl eax, 1 | cmp eax, 0xffe00000; je >2 // x^+-Inf? |1: | cmp dword [esp+4], 0; jne >1 | mov eax, [esp+8]; shl eax, 1; je >4 // +-0^y? | cmp eax, 0xffe00000; je >5 // +-Inf^y? |1: | fld qword [esp+12] | fld qword [esp+4] |.endif | fyl2x // y*log2(x) | fdup; frndint; fsub st1, st0; fxch // Split into frac/int part. | f2xm1; fld1; faddp st1; fscale; fpop1 // ==> (2^frac-1 +1) << int |.if X64WIN | fstp qword [rsp+8] // Use scratch area. | movsd xmm0, qword [rsp+8] |.elif X64 | fstp qword [rsp-8] // Use red zone. | movsd xmm0, qword [rsp-8] |.else | fstp qword [esp+4] // Needs 8 byte scratch area. | movsd xmm0, qword [esp+4] |.endif | ret | |9: // Handle x^NaN. | sseconst_1 xmm2, RDa | ucomisd xmm0, xmm2; je >1 // 1^NaN ==> 1 | movaps xmm0, xmm1 // x^NaN ==> NaN |1: | ret | |2: // Handle x^+-Inf. | sseconst_abs xmm2, RDa | andpd xmm0, xmm2 // |x| | sseconst_1 xmm2, RDa | ucomisd xmm0, xmm2; je <1 // +-1^+-Inf ==> 1 | movmskpd eax, xmm1 | xorps xmm0, xmm0 | mov ah, al; setc al; xor al, ah; jne <1 // |x|<>1, x^+-Inf ==> +Inf/0 |3: | sseconst_hi xmm0, RDa, 7ff00000 // +Inf | ret | |4: // Handle +-0^y. | movmskpd eax, xmm1; test eax, eax; jnz <3 // y < 0, +-0^y ==> +Inf | xorps xmm0, xmm0 // y >= 0, +-0^y ==> 0 | ret | |5: // Handle +-Inf^y. | movmskpd eax, xmm1; test eax, eax; jz <3 // y >= 0, +-Inf^y ==> +Inf | xorps xmm0, xmm0 // y < 0, +-Inf^y ==> 0 | ret | |// Callable from C: double lj_vm_foldfpm(double x, int fpm) |// Computes fpm(x) for extended math functions. ORDER FPM. |->vm_foldfpm: |.if JIT |.if X64 | .if X64WIN | .define fpmop, CARG2d | .else | .define fpmop, CARG1d | .endif | cmp fpmop, 1; jb ->vm_floor; je ->vm_ceil | cmp fpmop, 3; jb ->vm_trunc; ja >2 | sqrtsd xmm0, xmm0; ret |2: | .if X64WIN | movsd qword [rsp+8], xmm0 // Use scratch area. | fld qword [rsp+8] | .else | movsd qword [rsp-8], xmm0 // Use red zone. | fld qword [rsp-8] | .endif | cmp fpmop, 5; ja >2 | .if X64WIN; pop rax; .endif | je >1 | call ->vm_exp_x87 | .if X64WIN; push rax; .endif | jmp >7 |1: | call ->vm_exp2_x87 | .if X64WIN; push rax; .endif | jmp >7 |2: ; cmp fpmop, 7; je >1; ja >2 | fldln2; fxch; fyl2x; jmp >7 |1: ; fld1; fxch; fyl2x; jmp >7 |2: ; cmp fpmop, 9; je >1; ja >2 | fldlg2; fxch; fyl2x; jmp >7 |1: ; fsin; jmp >7 |2: ; cmp fpmop, 11; je >1; ja >9 | fcos; jmp >7 |1: ; fptan; fpop |7: | .if X64WIN | fstp qword [rsp+8] // Use scratch area. | movsd xmm0, qword [rsp+8] | .else | fstp qword [rsp-8] // Use red zone. | movsd xmm0, qword [rsp-8] | .endif | ret |.else // x86 calling convention. | .define fpmop, eax |.if SSE | mov fpmop, [esp+12] | movsd xmm0, qword [esp+4] | cmp fpmop, 1; je >1; ja >2 | call ->vm_floor; jmp >7 |1: ; call ->vm_ceil; jmp >7 |2: ; cmp fpmop, 3; je >1; ja >2 | call ->vm_trunc; jmp >7 |1: | sqrtsd xmm0, xmm0 |7: | movsd qword [esp+4], xmm0 // Overwrite callee-owned args. | fld qword [esp+4] | ret |2: ; fld qword [esp+4] | cmp fpmop, 5; jb ->vm_exp_x87; je ->vm_exp2_x87 |2: ; cmp fpmop, 7; je >1; ja >2 | fldln2; fxch; fyl2x; ret |1: ; fld1; fxch; fyl2x; ret |2: ; cmp fpmop, 9; je >1; ja >2 | fldlg2; fxch; fyl2x; ret |1: ; fsin; ret |2: ; cmp fpmop, 11; je >1; ja >9 | fcos; ret |1: ; fptan; fpop; ret |.else | mov fpmop, [esp+12] | fld qword [esp+4] | cmp fpmop, 1; jb ->vm_floor; je ->vm_ceil | cmp fpmop, 3; jb ->vm_trunc; ja >2 | fsqrt; ret |2: ; cmp fpmop, 5; jb ->vm_exp_x87; je ->vm_exp2_x87 | cmp fpmop, 7; je >1; ja >2 | fldln2; fxch; fyl2x; ret |1: ; fld1; fxch; fyl2x; ret |2: ; cmp fpmop, 9; je >1; ja >2 | fldlg2; fxch; fyl2x; ret |1: ; fsin; ret |2: ; cmp fpmop, 11; je >1; ja >9 | fcos; ret |1: ; fptan; fpop; ret |.endif |.endif |9: ; int3 // Bad fpm. |.endif | |// Callable from C: double lj_vm_foldarith(double x, double y, int op) |// Compute x op y for basic arithmetic operators (+ - * / % ^ and unary -) |// and basic math functions. ORDER ARITH |->vm_foldarith: |.if X64 | | .if X64WIN | .define foldop, CARG3d | .else | .define foldop, CARG1d | .endif | cmp foldop, 1; je >1; ja >2 | addsd xmm0, xmm1; ret |1: ; subsd xmm0, xmm1; ret |2: ; cmp foldop, 3; je >1; ja >2 | mulsd xmm0, xmm1; ret |1: ; divsd xmm0, xmm1; ret |2: ; cmp foldop, 5; jb ->vm_mod; je ->vm_pow | cmp foldop, 7; je >1; ja >2 | sseconst_sign xmm1, RDa; xorps xmm0, xmm1; ret |1: ; sseconst_abs xmm1, RDa; andps xmm0, xmm1; ret |2: ; cmp foldop, 9; ja >2 |.if X64WIN | movsd qword [rsp+8], xmm0 // Use scratch area. | movsd qword [rsp+16], xmm1 | fld qword [rsp+8] | fld qword [rsp+16] |.else | movsd qword [rsp-8], xmm0 // Use red zone. | movsd qword [rsp-16], xmm1 | fld qword [rsp-8] | fld qword [rsp-16] |.endif | je >1 | fpatan |7: |.if X64WIN | fstp qword [rsp+8] // Use scratch area. | movsd xmm0, qword [rsp+8] |.else | fstp qword [rsp-8] // Use red zone. | movsd xmm0, qword [rsp-8] |.endif | ret |1: ; fxch; fscale; fpop1; jmp <7 |2: ; cmp foldop, 11; je >1; ja >9 | minsd xmm0, xmm1; ret |1: ; maxsd xmm0, xmm1; ret |9: ; int3 // Bad op. | |.elif SSE // x86 calling convention with SSE ops. | | .define foldop, eax | mov foldop, [esp+20] | movsd xmm0, qword [esp+4] | movsd xmm1, qword [esp+12] | cmp foldop, 1; je >1; ja >2 | addsd xmm0, xmm1 |7: | movsd qword [esp+4], xmm0 // Overwrite callee-owned args. | fld qword [esp+4] | ret |1: ; subsd xmm0, xmm1; jmp <7 |2: ; cmp foldop, 3; je >1; ja >2 | mulsd xmm0, xmm1; jmp <7 |1: ; divsd xmm0, xmm1; jmp <7 |2: ; cmp foldop, 5 | je >1; ja >2 | call ->vm_mod; jmp <7 |1: ; pop edx; call ->vm_pow; push edx; jmp <7 // Writes to scratch area. |2: ; cmp foldop, 7; je >1; ja >2 | sseconst_sign xmm1, RDa; xorps xmm0, xmm1; jmp <7 |1: ; sseconst_abs xmm1, RDa; andps xmm0, xmm1; jmp <7 |2: ; cmp foldop, 9; ja >2 | fld qword [esp+4] // Reload from stack | fld qword [esp+12] | je >1 | fpatan; ret |1: ; fxch; fscale; fpop1; ret |2: ; cmp foldop, 11; je >1; ja >9 | minsd xmm0, xmm1; jmp <7 |1: ; maxsd xmm0, xmm1; jmp <7 |9: ; int3 // Bad op. | |.else // x86 calling convention with x87 ops. | | mov eax, [esp+20] | fld qword [esp+4] | fld qword [esp+12] | cmp eax, 1; je >1; ja >2 | faddp st1; ret |1: ; fsubp st1; ret |2: ; cmp eax, 3; je >1; ja >2 | fmulp st1; ret |1: ; fdivp st1; ret |2: ; cmp eax, 5; jb ->vm_mod; je ->vm_pow | cmp eax, 7; je >1; ja >2 | fpop; fchs; ret |1: ; fpop; fabs; ret |2: ; cmp eax, 9; je >1; ja >2 | fpatan; ret |1: ; fxch; fscale; fpop1; ret |2: ; cmp eax, 11; je >1; ja >9 | fucomi st1; fcmovnbe st1; fpop1; ret |1: ; fucomi st1; fcmovbe st1; fpop1; ret |9: ; int3 // Bad op. | |.endif | |//----------------------------------------------------------------------- |//-- Miscellaneous functions -------------------------------------------- |//----------------------------------------------------------------------- | |// int lj_vm_cpuid(uint32_t f, uint32_t res[4]) |->vm_cpuid: |.if X64 | mov eax, CARG1d | .if X64WIN; push rsi; mov rsi, CARG2; .endif | push rbx | cpuid | mov [rsi], eax | mov [rsi+4], ebx | mov [rsi+8], ecx | mov [rsi+12], edx | pop rbx | .if X64WIN; pop rsi; .endif | ret |.else | pushfd | pop edx | mov ecx, edx | xor edx, 0x00200000 // Toggle ID bit in flags. | push edx | popfd | pushfd | pop edx | xor eax, eax // Zero means no features supported. | cmp ecx, edx | jz >1 // No ID toggle means no CPUID support. | mov eax, [esp+4] // Argument 1 is function number. | push edi | push ebx | cpuid | mov edi, [esp+16] // Argument 2 is result area. | mov [edi], eax | mov [edi+4], ebx | mov [edi+8], ecx | mov [edi+12], edx | pop ebx | pop edi |1: | ret |.endif | |//----------------------------------------------------------------------- |//-- Assertions --------------------------------------------------------- |//----------------------------------------------------------------------- | |->assert_bad_for_arg_type: #ifdef LUA_USE_ASSERT | int3 #endif | int3 | |//----------------------------------------------------------------------- |//-- FFI helper functions ----------------------------------------------- |//----------------------------------------------------------------------- | |// Handler for callback functions. Callback slot number in ah/al. |->vm_ffi_callback: |.if FFI |.type CTSTATE, CTState, PC |.if not X64 | sub esp, 16 // Leave room for SAVE_ERRF etc. |.endif | saveregs_ // ebp/rbp already saved. ebp now holds global_State *. | lea DISPATCH, [ebp+GG_G2DISP] | mov CTSTATE, GL:ebp->ctype_state | movzx eax, ax | mov CTSTATE->cb.slot, eax |.if X64 | mov CTSTATE->cb.gpr[0], CARG1 | mov CTSTATE->cb.gpr[1], CARG2 | mov CTSTATE->cb.gpr[2], CARG3 | mov CTSTATE->cb.gpr[3], CARG4 | movsd qword CTSTATE->cb.fpr[0], xmm0 | movsd qword CTSTATE->cb.fpr[1], xmm1 | movsd qword CTSTATE->cb.fpr[2], xmm2 | movsd qword CTSTATE->cb.fpr[3], xmm3 |.if X64WIN | lea rax, [rsp+CFRAME_SIZE+4*8] |.else | lea rax, [rsp+CFRAME_SIZE] | mov CTSTATE->cb.gpr[4], CARG5 | mov CTSTATE->cb.gpr[5], CARG6 | movsd qword CTSTATE->cb.fpr[4], xmm4 | movsd qword CTSTATE->cb.fpr[5], xmm5 | movsd qword CTSTATE->cb.fpr[6], xmm6 | movsd qword CTSTATE->cb.fpr[7], xmm7 |.endif | mov CTSTATE->cb.stack, rax | mov CARG2, rsp |.else | lea eax, [esp+CFRAME_SIZE+16] | mov CTSTATE->cb.gpr[0], FCARG1 | mov CTSTATE->cb.gpr[1], FCARG2 | mov CTSTATE->cb.stack, eax | mov FCARG1, [esp+CFRAME_SIZE+12] // Move around misplaced retaddr/ebp. | mov FCARG2, [esp+CFRAME_SIZE+8] | mov SAVE_RET, FCARG1 | mov SAVE_R4, FCARG2 | mov FCARG2, esp |.endif | mov SAVE_PC, CTSTATE // Any value outside of bytecode is ok. | mov FCARG1, CTSTATE | call extern lj_ccallback_enter@8 // (CTState *cts, void *cf) | // lua_State * returned in eax (RD). | set_vmstate INTERP | mov BASE, L:RD->base | mov RD, L:RD->top | sub RD, BASE | mov LFUNC:RB, [BASE-8] | shr RD, 3 | add RD, 1 | ins_callt |.endif | |->cont_ffi_callback: // Return from FFI callback. |.if FFI | mov L:RA, SAVE_L | mov CTSTATE, [DISPATCH+DISPATCH_GL(ctype_state)] | mov aword CTSTATE->L, L:RAa | mov L:RA->base, BASE | mov L:RA->top, RB | mov FCARG1, CTSTATE | mov FCARG2, RC | call extern lj_ccallback_leave@8 // (CTState *cts, TValue *o) |.if X64 | mov rax, CTSTATE->cb.gpr[0] | movsd xmm0, qword CTSTATE->cb.fpr[0] | jmp ->vm_leave_unw |.else | mov L:RB, SAVE_L | mov eax, CTSTATE->cb.gpr[0] | mov edx, CTSTATE->cb.gpr[1] | cmp dword CTSTATE->cb.gpr[2], 1 | jb >7 | je >6 | fld qword CTSTATE->cb.fpr[0].d | jmp >7 |6: | fld dword CTSTATE->cb.fpr[0].f |7: | mov ecx, L:RB->top | movzx ecx, word [ecx+6] // Get stack adjustment and copy up. | mov SAVE_L, ecx // Must be one slot above SAVE_RET | restoreregs | pop ecx // Move return addr from SAVE_RET. | add esp, [esp] // Adjust stack. | add esp, 16 | push ecx | ret |.endif |.endif | |->vm_ffi_call@4: // Call C function via FFI. | // Caveat: needs special frame unwinding, see below. |.if FFI |.if X64 | .type CCSTATE, CCallState, rbx | push rbp; mov rbp, rsp; push rbx; mov CCSTATE, CARG1 |.else | .type CCSTATE, CCallState, ebx | push ebp; mov ebp, esp; push ebx; mov CCSTATE, FCARG1 |.endif | | // Readjust stack. |.if X64 | mov eax, CCSTATE->spadj | sub rsp, rax |.else | sub esp, CCSTATE->spadj |.if WIN | mov CCSTATE->spadj, esp |.endif |.endif | | // Copy stack slots. | movzx ecx, byte CCSTATE->nsp | sub ecx, 1 | js >2 |1: |.if X64 | mov rax, [CCSTATE+rcx*8+offsetof(CCallState, stack)] | mov [rsp+rcx*8+CCALL_SPS_EXTRA*8], rax |.else | mov eax, [CCSTATE+ecx*4+offsetof(CCallState, stack)] | mov [esp+ecx*4], eax |.endif | sub ecx, 1 | jns <1 |2: | |.if X64 | movzx eax, byte CCSTATE->nfpr | mov CARG1, CCSTATE->gpr[0] | mov CARG2, CCSTATE->gpr[1] | mov CARG3, CCSTATE->gpr[2] | mov CARG4, CCSTATE->gpr[3] |.if not X64WIN | mov CARG5, CCSTATE->gpr[4] | mov CARG6, CCSTATE->gpr[5] |.endif | test eax, eax; jz >5 | movaps xmm0, CCSTATE->fpr[0] | movaps xmm1, CCSTATE->fpr[1] | movaps xmm2, CCSTATE->fpr[2] | movaps xmm3, CCSTATE->fpr[3] |.if not X64WIN | cmp eax, 4; jbe >5 | movaps xmm4, CCSTATE->fpr[4] | movaps xmm5, CCSTATE->fpr[5] | movaps xmm6, CCSTATE->fpr[6] | movaps xmm7, CCSTATE->fpr[7] |.endif |5: |.else | mov FCARG1, CCSTATE->gpr[0] | mov FCARG2, CCSTATE->gpr[1] |.endif | | call aword CCSTATE->func | |.if X64 | mov CCSTATE->gpr[0], rax | movaps CCSTATE->fpr[0], xmm0 |.if not X64WIN | mov CCSTATE->gpr[1], rdx | movaps CCSTATE->fpr[1], xmm1 |.endif |.else | mov CCSTATE->gpr[0], eax | mov CCSTATE->gpr[1], edx | cmp byte CCSTATE->resx87, 1 | jb >7 | je >6 | fstp qword CCSTATE->fpr[0].d[0] | jmp >7 |6: | fstp dword CCSTATE->fpr[0].f[0] |7: |.if WIN | sub CCSTATE->spadj, esp |.endif |.endif | |.if X64 | mov rbx, [rbp-8]; leave; ret |.else | mov ebx, [ebp-4]; leave; ret |.endif |.endif |// Note: vm_ffi_call must be the last function in this object file! | |//----------------------------------------------------------------------- } /* Generate the code for a single instruction. */ static void build_ins(BuildCtx *ctx, BCOp op, int defop) { int vk = 0; |// Note: aligning all instructions does not pay off. |=>defop: switch (op) { /* -- Comparison ops ---------------------------------------------------- */ /* Remember: all ops branch for a true comparison, fall through otherwise. */ |.macro jmp_comp, lt, ge, le, gt, target ||switch (op) { ||case BC_ISLT: | lt target ||break; ||case BC_ISGE: | ge target ||break; ||case BC_ISLE: | le target ||break; ||case BC_ISGT: | gt target ||break; ||default: break; /* Shut up GCC. */ ||} |.endmacro case BC_ISLT: case BC_ISGE: case BC_ISLE: case BC_ISGT: | // RA = src1, RD = src2, JMP with RD = target | ins_AD |.if DUALNUM | checkint RA, >7 | checkint RD, >8 | mov RB, dword [BASE+RA*8] | add PC, 4 | cmp RB, dword [BASE+RD*8] | jmp_comp jge, jl, jg, jle, >9 |6: | movzx RD, PC_RD | branchPC RD |9: | ins_next | |7: // RA is not an integer. | ja ->vmeta_comp | // RA is a number. | cmp dword [BASE+RD*8+4], LJ_TISNUM; jb >1; jne ->vmeta_comp | // RA is a number, RD is an integer. |.if SSE | cvtsi2sd xmm0, dword [BASE+RD*8] | jmp >2 |.else | fld qword [BASE+RA*8] | fild dword [BASE+RD*8] | jmp >3 |.endif | |8: // RA is an integer, RD is not an integer. | ja ->vmeta_comp | // RA is an integer, RD is a number. |.if SSE | cvtsi2sd xmm1, dword [BASE+RA*8] | movsd xmm0, qword [BASE+RD*8] | add PC, 4 | ucomisd xmm0, xmm1 | jmp_comp jbe, ja, jb, jae, <9 | jmp <6 |.else | fild dword [BASE+RA*8] | jmp >2 |.endif |.else | checknum RA, ->vmeta_comp | checknum RD, ->vmeta_comp |.endif |.if SSE |1: | movsd xmm0, qword [BASE+RD*8] |2: | add PC, 4 | ucomisd xmm0, qword [BASE+RA*8] |3: |.else |1: | fld qword [BASE+RA*8] // Reverse order, i.e like cmp D, A. |2: | fld qword [BASE+RD*8] |3: | add PC, 4 | fcomparepp |.endif | // Unordered: all of ZF CF PF set, ordered: PF clear. | // To preserve NaN semantics GE/GT branch on unordered, but LT/LE don't. |.if DUALNUM | jmp_comp jbe, ja, jb, jae, <9 | jmp <6 |.else | jmp_comp jbe, ja, jb, jae, >1 | movzx RD, PC_RD | branchPC RD |1: | ins_next |.endif break; case BC_ISEQV: case BC_ISNEV: vk = op == BC_ISEQV; | ins_AD // RA = src1, RD = src2, JMP with RD = target | mov RB, [BASE+RD*8+4] | add PC, 4 |.if DUALNUM | cmp RB, LJ_TISNUM; jne >7 | checkint RA, >8 | mov RB, dword [BASE+RD*8] | cmp RB, dword [BASE+RA*8] if (vk) { | jne >9 } else { | je >9 } | movzx RD, PC_RD | branchPC RD |9: | ins_next | |7: // RD is not an integer. | ja >5 | // RD is a number. | cmp dword [BASE+RA*8+4], LJ_TISNUM; jb >1; jne >5 | // RD is a number, RA is an integer. |.if SSE | cvtsi2sd xmm0, dword [BASE+RA*8] |.else | fild dword [BASE+RA*8] |.endif | jmp >2 | |8: // RD is an integer, RA is not an integer. | ja >5 | // RD is an integer, RA is a number. |.if SSE | cvtsi2sd xmm0, dword [BASE+RD*8] | ucomisd xmm0, qword [BASE+RA*8] |.else | fild dword [BASE+RD*8] | fld qword [BASE+RA*8] |.endif | jmp >4 | |.else | cmp RB, LJ_TISNUM; jae >5 | checknum RA, >5 |.endif |.if SSE |1: | movsd xmm0, qword [BASE+RA*8] |2: | ucomisd xmm0, qword [BASE+RD*8] |4: |.else |1: | fld qword [BASE+RA*8] |2: | fld qword [BASE+RD*8] |4: | fcomparepp |.endif iseqne_fp: if (vk) { | jp >2 // Unordered means not equal. | jne >2 } else { | jp >2 // Unordered means not equal. | je >1 } iseqne_end: if (vk) { |1: // EQ: Branch to the target. | movzx RD, PC_RD | branchPC RD |2: // NE: Fallthrough to next instruction. |.if not FFI |3: |.endif } else { |.if not FFI |3: |.endif |2: // NE: Branch to the target. | movzx RD, PC_RD | branchPC RD |1: // EQ: Fallthrough to next instruction. } if (LJ_DUALNUM && (op == BC_ISEQV || op == BC_ISNEV || op == BC_ISEQN || op == BC_ISNEN)) { | jmp <9 } else { | ins_next } | if (op == BC_ISEQV || op == BC_ISNEV) { |5: // Either or both types are not numbers. |.if FFI | cmp RB, LJ_TCDATA; je ->vmeta_equal_cd | checktp RA, LJ_TCDATA; je ->vmeta_equal_cd |.endif | checktp RA, RB // Compare types. | jne <2 // Not the same type? | cmp RB, LJ_TISPRI | jae <1 // Same type and primitive type? | | // Same types and not a primitive type. Compare GCobj or pvalue. | mov RA, [BASE+RA*8] | mov RD, [BASE+RD*8] | cmp RA, RD | je <1 // Same GCobjs or pvalues? | cmp RB, LJ_TISTABUD | ja <2 // Different objects and not table/ud? |.if X64 | cmp RB, LJ_TUDATA // And not 64 bit lightuserdata. | jb <2 |.endif | | // Different tables or userdatas. Need to check __eq metamethod. | // Field metatable must be at same offset for GCtab and GCudata! | mov TAB:RB, TAB:RA->metatable | test TAB:RB, TAB:RB | jz <2 // No metatable? | test byte TAB:RB->nomm, 1<vmeta_equal // Handle __eq metamethod. } else { |.if FFI |3: | cmp RB, LJ_TCDATA if (LJ_DUALNUM && vk) { | jne <9 } else { | jne <2 } | jmp ->vmeta_equal_cd |.endif } break; case BC_ISEQS: case BC_ISNES: vk = op == BC_ISEQS; | ins_AND // RA = src, RD = str const, JMP with RD = target | mov RB, [BASE+RA*8+4] | add PC, 4 | cmp RB, LJ_TSTR; jne >3 | mov RA, [BASE+RA*8] | cmp RA, [KBASE+RD*4] iseqne_test: if (vk) { | jne >2 } else { | je >1 } goto iseqne_end; case BC_ISEQN: case BC_ISNEN: vk = op == BC_ISEQN; | ins_AD // RA = src, RD = num const, JMP with RD = target | mov RB, [BASE+RA*8+4] | add PC, 4 |.if DUALNUM | cmp RB, LJ_TISNUM; jne >7 | cmp dword [KBASE+RD*8+4], LJ_TISNUM; jne >8 | mov RB, dword [KBASE+RD*8] | cmp RB, dword [BASE+RA*8] if (vk) { | jne >9 } else { | je >9 } | movzx RD, PC_RD | branchPC RD |9: | ins_next | |7: // RA is not an integer. | ja >3 | // RA is a number. | cmp dword [KBASE+RD*8+4], LJ_TISNUM; jb >1 | // RA is a number, RD is an integer. |.if SSE | cvtsi2sd xmm0, dword [KBASE+RD*8] |.else | fild dword [KBASE+RD*8] |.endif | jmp >2 | |8: // RA is an integer, RD is a number. |.if SSE | cvtsi2sd xmm0, dword [BASE+RA*8] | ucomisd xmm0, qword [KBASE+RD*8] |.else | fild dword [BASE+RA*8] | fld qword [KBASE+RD*8] |.endif | jmp >4 |.else | cmp RB, LJ_TISNUM; jae >3 |.endif |.if SSE |1: | movsd xmm0, qword [KBASE+RD*8] |2: | ucomisd xmm0, qword [BASE+RA*8] |4: |.else |1: | fld qword [KBASE+RD*8] |2: | fld qword [BASE+RA*8] |4: | fcomparepp |.endif goto iseqne_fp; case BC_ISEQP: case BC_ISNEP: vk = op == BC_ISEQP; | ins_AND // RA = src, RD = primitive type (~), JMP with RD = target | mov RB, [BASE+RA*8+4] | add PC, 4 | cmp RB, RD if (!LJ_HASFFI) goto iseqne_test; if (vk) { | jne >3 | movzx RD, PC_RD | branchPC RD |2: | ins_next |3: | cmp RB, LJ_TCDATA; jne <2 | jmp ->vmeta_equal_cd } else { | je >2 | cmp RB, LJ_TCDATA; je ->vmeta_equal_cd | movzx RD, PC_RD | branchPC RD |2: | ins_next } break; /* -- Unary test and copy ops ------------------------------------------- */ case BC_ISTC: case BC_ISFC: case BC_IST: case BC_ISF: | ins_AD // RA = dst or unused, RD = src, JMP with RD = target | mov RB, [BASE+RD*8+4] | add PC, 4 | cmp RB, LJ_TISTRUECOND if (op == BC_IST || op == BC_ISTC) { | jae >1 } else { | jb >1 } if (op == BC_ISTC || op == BC_ISFC) { | mov [BASE+RA*8+4], RB | mov RB, [BASE+RD*8] | mov [BASE+RA*8], RB } | movzx RD, PC_RD | branchPC RD |1: // Fallthrough to the next instruction. | ins_next break; /* -- Unary ops --------------------------------------------------------- */ case BC_MOV: | ins_AD // RA = dst, RD = src |.if X64 | mov RBa, [BASE+RD*8] | mov [BASE+RA*8], RBa |.else | mov RB, [BASE+RD*8+4] | mov RD, [BASE+RD*8] | mov [BASE+RA*8+4], RB | mov [BASE+RA*8], RD |.endif | ins_next_ break; case BC_NOT: | ins_AD // RA = dst, RD = src | xor RB, RB | checktp RD, LJ_TISTRUECOND | adc RB, LJ_TTRUE | mov [BASE+RA*8+4], RB | ins_next break; case BC_UNM: | ins_AD // RA = dst, RD = src |.if DUALNUM | checkint RD, >5 | mov RB, [BASE+RD*8] | neg RB | jo >4 | mov dword [BASE+RA*8+4], LJ_TISNUM | mov dword [BASE+RA*8], RB |9: | ins_next |4: | mov dword [BASE+RA*8+4], 0x41e00000 // 2^31. | mov dword [BASE+RA*8], 0 | jmp <9 |5: | ja ->vmeta_unm |.else | checknum RD, ->vmeta_unm |.endif |.if SSE | movsd xmm0, qword [BASE+RD*8] | sseconst_sign xmm1, RDa | xorps xmm0, xmm1 | movsd qword [BASE+RA*8], xmm0 |.else | fld qword [BASE+RD*8] | fchs | fstp qword [BASE+RA*8] |.endif |.if DUALNUM | jmp <9 |.else | ins_next |.endif break; case BC_LEN: | ins_AD // RA = dst, RD = src | checkstr RD, >2 | mov STR:RD, [BASE+RD*8] |.if DUALNUM | mov RD, dword STR:RD->len |1: | mov dword [BASE+RA*8+4], LJ_TISNUM | mov dword [BASE+RA*8], RD |.elif SSE | xorps xmm0, xmm0 | cvtsi2sd xmm0, dword STR:RD->len |1: | movsd qword [BASE+RA*8], xmm0 |.else | fild dword STR:RD->len |1: | fstp qword [BASE+RA*8] |.endif | ins_next |2: | checktab RD, ->vmeta_len | mov TAB:FCARG1, [BASE+RD*8] #if LJ_52 | mov TAB:RB, TAB:FCARG1->metatable | cmp TAB:RB, 0 | jnz >9 |3: #endif |->BC_LEN_Z: | mov RB, BASE // Save BASE. | call extern lj_tab_len@4 // (GCtab *t) | // Length of table returned in eax (RD). |.if DUALNUM | // Nothing to do. |.elif SSE | cvtsi2sd xmm0, RD |.else | mov ARG1, RD | fild ARG1 |.endif | mov BASE, RB // Restore BASE. | movzx RA, PC_RA | jmp <1 #if LJ_52 |9: // Check for __len. | test byte TAB:RB->nomm, 1<vmeta_len // 'no __len' flag NOT set: check. #endif break; /* -- Binary ops -------------------------------------------------------- */ |.macro ins_arithpre, x87ins, sseins, ssereg | ins_ABC ||vk = ((int)op - BC_ADDVN) / (BC_ADDNV-BC_ADDVN); ||switch (vk) { ||case 0: | checknum RB, ->vmeta_arith_vn | .if DUALNUM | cmp dword [KBASE+RC*8+4], LJ_TISNUM; jae ->vmeta_arith_vn | .endif | .if SSE | movsd xmm0, qword [BASE+RB*8] | sseins ssereg, qword [KBASE+RC*8] | .else | fld qword [BASE+RB*8] | x87ins qword [KBASE+RC*8] | .endif || break; ||case 1: | checknum RB, ->vmeta_arith_nv | .if DUALNUM | cmp dword [KBASE+RC*8+4], LJ_TISNUM; jae ->vmeta_arith_nv | .endif | .if SSE | movsd xmm0, qword [KBASE+RC*8] | sseins ssereg, qword [BASE+RB*8] | .else | fld qword [KBASE+RC*8] | x87ins qword [BASE+RB*8] | .endif || break; ||default: | checknum RB, ->vmeta_arith_vv | checknum RC, ->vmeta_arith_vv | .if SSE | movsd xmm0, qword [BASE+RB*8] | sseins ssereg, qword [BASE+RC*8] | .else | fld qword [BASE+RB*8] | x87ins qword [BASE+RC*8] | .endif || break; ||} |.endmacro | |.macro ins_arithdn, intins | ins_ABC ||vk = ((int)op - BC_ADDVN) / (BC_ADDNV-BC_ADDVN); ||switch (vk) { ||case 0: | checkint RB, ->vmeta_arith_vn | cmp dword [KBASE+RC*8+4], LJ_TISNUM; jne ->vmeta_arith_vn | mov RB, [BASE+RB*8] | intins RB, [KBASE+RC*8]; jo ->vmeta_arith_vno || break; ||case 1: | checkint RB, ->vmeta_arith_nv | cmp dword [KBASE+RC*8+4], LJ_TISNUM; jne ->vmeta_arith_nv | mov RC, [KBASE+RC*8] | intins RC, [BASE+RB*8]; jo ->vmeta_arith_nvo || break; ||default: | checkint RB, ->vmeta_arith_vv | checkint RC, ->vmeta_arith_vv | mov RB, [BASE+RB*8] | intins RB, [BASE+RC*8]; jo ->vmeta_arith_vvo || break; ||} | mov dword [BASE+RA*8+4], LJ_TISNUM ||if (vk == 1) { | mov dword [BASE+RA*8], RC ||} else { | mov dword [BASE+RA*8], RB ||} | ins_next |.endmacro | |.macro ins_arithpost |.if SSE | movsd qword [BASE+RA*8], xmm0 |.else | fstp qword [BASE+RA*8] |.endif |.endmacro | |.macro ins_arith, x87ins, sseins | ins_arithpre x87ins, sseins, xmm0 | ins_arithpost | ins_next |.endmacro | |.macro ins_arith, intins, x87ins, sseins |.if DUALNUM | ins_arithdn intins |.else | ins_arith, x87ins, sseins |.endif |.endmacro | // RA = dst, RB = src1 or num const, RC = src2 or num const case BC_ADDVN: case BC_ADDNV: case BC_ADDVV: | ins_arith add, fadd, addsd break; case BC_SUBVN: case BC_SUBNV: case BC_SUBVV: | ins_arith sub, fsub, subsd break; case BC_MULVN: case BC_MULNV: case BC_MULVV: | ins_arith imul, fmul, mulsd break; case BC_DIVVN: case BC_DIVNV: case BC_DIVVV: | ins_arith fdiv, divsd break; case BC_MODVN: | ins_arithpre fld, movsd, xmm1 |->BC_MODVN_Z: | call ->vm_mod | ins_arithpost | ins_next break; case BC_MODNV: case BC_MODVV: | ins_arithpre fld, movsd, xmm1 | jmp ->BC_MODVN_Z // Avoid 3 copies. It's slow anyway. break; case BC_POW: | ins_arithpre fld, movsd, xmm1 | call ->vm_pow | ins_arithpost | ins_next break; case BC_CAT: | ins_ABC // RA = dst, RB = src_start, RC = src_end |.if X64 | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE | lea CARG2d, [BASE+RC*8] | mov CARG3d, RC | sub CARG3d, RB |->BC_CAT_Z: | mov L:RB, L:CARG1d |.else | lea RA, [BASE+RC*8] | sub RC, RB | mov ARG2, RA | mov ARG3, RC |->BC_CAT_Z: | mov L:RB, SAVE_L | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | call extern lj_meta_cat // (lua_State *L, TValue *top, int left) | // NULL (finished) or TValue * (metamethod) returned in eax (RC). | mov BASE, L:RB->base | test RC, RC | jnz ->vmeta_binop | movzx RB, PC_RB // Copy result to Stk[RA] from Stk[RB]. | movzx RA, PC_RA |.if X64 | mov RCa, [BASE+RB*8] | mov [BASE+RA*8], RCa |.else | mov RC, [BASE+RB*8+4] | mov RB, [BASE+RB*8] | mov [BASE+RA*8+4], RC | mov [BASE+RA*8], RB |.endif | ins_next break; /* -- Constant ops ------------------------------------------------------ */ case BC_KSTR: | ins_AND // RA = dst, RD = str const (~) | mov RD, [KBASE+RD*4] | mov dword [BASE+RA*8+4], LJ_TSTR | mov [BASE+RA*8], RD | ins_next break; case BC_KCDATA: |.if FFI | ins_AND // RA = dst, RD = cdata const (~) | mov RD, [KBASE+RD*4] | mov dword [BASE+RA*8+4], LJ_TCDATA | mov [BASE+RA*8], RD | ins_next |.endif break; case BC_KSHORT: | ins_AD // RA = dst, RD = signed int16 literal |.if DUALNUM | movsx RD, RDW | mov dword [BASE+RA*8+4], LJ_TISNUM | mov dword [BASE+RA*8], RD |.elif SSE | movsx RD, RDW // Sign-extend literal. | cvtsi2sd xmm0, RD | movsd qword [BASE+RA*8], xmm0 |.else | fild PC_RD // Refetch signed RD from instruction. | fstp qword [BASE+RA*8] |.endif | ins_next break; case BC_KNUM: | ins_AD // RA = dst, RD = num const |.if SSE | movsd xmm0, qword [KBASE+RD*8] | movsd qword [BASE+RA*8], xmm0 |.else | fld qword [KBASE+RD*8] | fstp qword [BASE+RA*8] |.endif | ins_next break; case BC_KPRI: | ins_AND // RA = dst, RD = primitive type (~) | mov [BASE+RA*8+4], RD | ins_next break; case BC_KNIL: | ins_AD // RA = dst_start, RD = dst_end | lea RA, [BASE+RA*8+12] | lea RD, [BASE+RD*8+4] | mov RB, LJ_TNIL | mov [RA-8], RB // Sets minimum 2 slots. |1: | mov [RA], RB | add RA, 8 | cmp RA, RD | jbe <1 | ins_next break; /* -- Upvalue and function ops ------------------------------------------ */ case BC_UGET: | ins_AD // RA = dst, RD = upvalue # | mov LFUNC:RB, [BASE-8] | mov UPVAL:RB, [LFUNC:RB+RD*4+offsetof(GCfuncL, uvptr)] | mov RB, UPVAL:RB->v |.if X64 | mov RDa, [RB] | mov [BASE+RA*8], RDa |.else | mov RD, [RB+4] | mov RB, [RB] | mov [BASE+RA*8+4], RD | mov [BASE+RA*8], RB |.endif | ins_next break; case BC_USETV: #define TV2MARKOFS \ ((int32_t)offsetof(GCupval, marked)-(int32_t)offsetof(GCupval, tv)) | ins_AD // RA = upvalue #, RD = src | mov LFUNC:RB, [BASE-8] | mov UPVAL:RB, [LFUNC:RB+RA*4+offsetof(GCfuncL, uvptr)] | cmp byte UPVAL:RB->closed, 0 | mov RB, UPVAL:RB->v | mov RA, [BASE+RD*8] | mov RD, [BASE+RD*8+4] | mov [RB], RA | mov [RB+4], RD | jz >1 | // Check barrier for closed upvalue. | test byte [RB+TV2MARKOFS], LJ_GC_BLACK // isblack(uv) | jnz >2 |1: | ins_next | |2: // Upvalue is black. Check if new value is collectable and white. | sub RD, LJ_TISGCV | cmp RD, LJ_TNUMX - LJ_TISGCV // tvisgcv(v) | jbe <1 | test byte GCOBJ:RA->gch.marked, LJ_GC_WHITES // iswhite(v) | jz <1 | // Crossed a write barrier. Move the barrier forward. |.if X64 and not X64WIN | mov FCARG2, RB | mov RB, BASE // Save BASE. |.else | xchg FCARG2, RB // Save BASE (FCARG2 == BASE). |.endif | lea GL:FCARG1, [DISPATCH+GG_DISP2G] | call extern lj_gc_barrieruv@8 // (global_State *g, TValue *tv) | mov BASE, RB // Restore BASE. | jmp <1 break; #undef TV2MARKOFS case BC_USETS: | ins_AND // RA = upvalue #, RD = str const (~) | mov LFUNC:RB, [BASE-8] | mov UPVAL:RB, [LFUNC:RB+RA*4+offsetof(GCfuncL, uvptr)] | mov GCOBJ:RA, [KBASE+RD*4] | mov RD, UPVAL:RB->v | mov [RD], GCOBJ:RA | mov dword [RD+4], LJ_TSTR | test byte UPVAL:RB->marked, LJ_GC_BLACK // isblack(uv) | jnz >2 |1: | ins_next | |2: // Check if string is white and ensure upvalue is closed. | test byte GCOBJ:RA->gch.marked, LJ_GC_WHITES // iswhite(str) | jz <1 | cmp byte UPVAL:RB->closed, 0 | jz <1 | // Crossed a write barrier. Move the barrier forward. | mov RB, BASE // Save BASE (FCARG2 == BASE). | mov FCARG2, RD | lea GL:FCARG1, [DISPATCH+GG_DISP2G] | call extern lj_gc_barrieruv@8 // (global_State *g, TValue *tv) | mov BASE, RB // Restore BASE. | jmp <1 break; case BC_USETN: | ins_AD // RA = upvalue #, RD = num const | mov LFUNC:RB, [BASE-8] |.if SSE | movsd xmm0, qword [KBASE+RD*8] |.else | fld qword [KBASE+RD*8] |.endif | mov UPVAL:RB, [LFUNC:RB+RA*4+offsetof(GCfuncL, uvptr)] | mov RA, UPVAL:RB->v |.if SSE | movsd qword [RA], xmm0 |.else | fstp qword [RA] |.endif | ins_next break; case BC_USETP: | ins_AND // RA = upvalue #, RD = primitive type (~) | mov LFUNC:RB, [BASE-8] | mov UPVAL:RB, [LFUNC:RB+RA*4+offsetof(GCfuncL, uvptr)] | mov RA, UPVAL:RB->v | mov [RA+4], RD | ins_next break; case BC_UCLO: | ins_AD // RA = level, RD = target | branchPC RD // Do this first to free RD. | mov L:RB, SAVE_L | cmp dword L:RB->openupval, 0 | je >1 | mov L:RB->base, BASE | lea FCARG2, [BASE+RA*8] // Caveat: FCARG2 == BASE | mov L:FCARG1, L:RB // Caveat: FCARG1 == RA | call extern lj_func_closeuv@8 // (lua_State *L, TValue *level) | mov BASE, L:RB->base |1: | ins_next break; case BC_FNEW: | ins_AND // RA = dst, RD = proto const (~) (holding function prototype) |.if X64 | mov L:RB, SAVE_L | mov L:RB->base, BASE // Caveat: CARG2d/CARG3d may be BASE. | mov CARG3d, [BASE-8] | mov CARG2d, [KBASE+RD*4] // Fetch GCproto *. | mov CARG1d, L:RB |.else | mov LFUNC:RA, [BASE-8] | mov PROTO:RD, [KBASE+RD*4] // Fetch GCproto *. | mov L:RB, SAVE_L | mov ARG3, LFUNC:RA | mov ARG2, PROTO:RD | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | // (lua_State *L, GCproto *pt, GCfuncL *parent) | call extern lj_func_newL_gc | // GCfuncL * returned in eax (RC). | mov BASE, L:RB->base | movzx RA, PC_RA | mov [BASE+RA*8], LFUNC:RC | mov dword [BASE+RA*8+4], LJ_TFUNC | ins_next break; /* -- Table ops --------------------------------------------------------- */ case BC_TNEW: | ins_AD // RA = dst, RD = hbits|asize | mov L:RB, SAVE_L | mov L:RB->base, BASE | mov RA, [DISPATCH+DISPATCH_GL(gc.total)] | cmp RA, [DISPATCH+DISPATCH_GL(gc.threshold)] | mov SAVE_PC, PC | jae >5 |1: |.if X64 | mov CARG3d, RD | and RD, 0x7ff | shr CARG3d, 11 |.else | mov RA, RD | and RD, 0x7ff | shr RA, 11 | mov ARG3, RA |.endif | cmp RD, 0x7ff | je >3 |2: |.if X64 | mov L:CARG1d, L:RB | mov CARG2d, RD |.else | mov ARG1, L:RB | mov ARG2, RD |.endif | call extern lj_tab_new // (lua_State *L, int32_t asize, uint32_t hbits) | // Table * returned in eax (RC). | mov BASE, L:RB->base | movzx RA, PC_RA | mov [BASE+RA*8], TAB:RC | mov dword [BASE+RA*8+4], LJ_TTAB | ins_next |3: // Turn 0x7ff into 0x801. | mov RD, 0x801 | jmp <2 |5: | mov L:FCARG1, L:RB | call extern lj_gc_step_fixtop@4 // (lua_State *L) | movzx RD, PC_RD | jmp <1 break; case BC_TDUP: | ins_AND // RA = dst, RD = table const (~) (holding template table) | mov L:RB, SAVE_L | mov RA, [DISPATCH+DISPATCH_GL(gc.total)] | mov SAVE_PC, PC | cmp RA, [DISPATCH+DISPATCH_GL(gc.threshold)] | mov L:RB->base, BASE | jae >3 |2: | mov TAB:FCARG2, [KBASE+RD*4] // Caveat: FCARG2 == BASE | mov L:FCARG1, L:RB // Caveat: FCARG1 == RA | call extern lj_tab_dup@8 // (lua_State *L, Table *kt) | // Table * returned in eax (RC). | mov BASE, L:RB->base | movzx RA, PC_RA | mov [BASE+RA*8], TAB:RC | mov dword [BASE+RA*8+4], LJ_TTAB | ins_next |3: | mov L:FCARG1, L:RB | call extern lj_gc_step_fixtop@4 // (lua_State *L) | movzx RD, PC_RD // Need to reload RD. | not RDa | jmp <2 break; case BC_GGET: | ins_AND // RA = dst, RD = str const (~) | mov LFUNC:RB, [BASE-8] | mov TAB:RB, LFUNC:RB->env | mov STR:RC, [KBASE+RD*4] | jmp ->BC_TGETS_Z break; case BC_GSET: | ins_AND // RA = src, RD = str const (~) | mov LFUNC:RB, [BASE-8] | mov TAB:RB, LFUNC:RB->env | mov STR:RC, [KBASE+RD*4] | jmp ->BC_TSETS_Z break; case BC_TGETV: | ins_ABC // RA = dst, RB = table, RC = key | checktab RB, ->vmeta_tgetv | mov TAB:RB, [BASE+RB*8] | | // Integer key? |.if DUALNUM | checkint RC, >5 | mov RC, dword [BASE+RC*8] |.else | // Convert number to int and back and compare. | checknum RC, >5 |.if SSE | movsd xmm0, qword [BASE+RC*8] | cvtsd2si RC, xmm0 | cvtsi2sd xmm1, RC | ucomisd xmm0, xmm1 |.else | fld qword [BASE+RC*8] | fist ARG1 | fild ARG1 | fcomparepp | mov RC, ARG1 |.endif | jne ->vmeta_tgetv // Generic numeric key? Use fallback. |.endif | cmp RC, TAB:RB->asize // Takes care of unordered, too. | jae ->vmeta_tgetv // Not in array part? Use fallback. | shl RC, 3 | add RC, TAB:RB->array | cmp dword [RC+4], LJ_TNIL // Avoid overwriting RB in fastpath. | je >2 | // Get array slot. |.if X64 | mov RBa, [RC] | mov [BASE+RA*8], RBa |.else | mov RB, [RC] | mov RC, [RC+4] | mov [BASE+RA*8], RB | mov [BASE+RA*8+4], RC |.endif |1: | ins_next | |2: // Check for __index if table value is nil. | cmp dword TAB:RB->metatable, 0 // Shouldn't overwrite RA for fastpath. | jz >3 | mov TAB:RA, TAB:RB->metatable | test byte TAB:RA->nomm, 1<vmeta_tgetv // 'no __index' flag NOT set: check. | movzx RA, PC_RA // Restore RA. |3: | mov dword [BASE+RA*8+4], LJ_TNIL | jmp <1 | |5: // String key? | checkstr RC, ->vmeta_tgetv | mov STR:RC, [BASE+RC*8] | jmp ->BC_TGETS_Z break; case BC_TGETS: | ins_ABC // RA = dst, RB = table, RC = str const (~) | not RCa | mov STR:RC, [KBASE+RC*4] | checktab RB, ->vmeta_tgets | mov TAB:RB, [BASE+RB*8] |->BC_TGETS_Z: // RB = GCtab *, RC = GCstr *, refetches PC_RA. | mov RA, TAB:RB->hmask | and RA, STR:RC->hash | imul RA, #NODE | add NODE:RA, TAB:RB->node |1: | cmp dword NODE:RA->key.it, LJ_TSTR | jne >4 | cmp dword NODE:RA->key.gcr, STR:RC | jne >4 | // Ok, key found. Assumes: offsetof(Node, val) == 0 | cmp dword [RA+4], LJ_TNIL // Avoid overwriting RB in fastpath. | je >5 // Key found, but nil value? | movzx RC, PC_RA | // Get node value. |.if X64 | mov RBa, [RA] | mov [BASE+RC*8], RBa |.else | mov RB, [RA] | mov RA, [RA+4] | mov [BASE+RC*8], RB | mov [BASE+RC*8+4], RA |.endif |2: | ins_next | |3: | movzx RC, PC_RA | mov dword [BASE+RC*8+4], LJ_TNIL | jmp <2 | |4: // Follow hash chain. | mov NODE:RA, NODE:RA->next | test NODE:RA, NODE:RA | jnz <1 | // End of hash chain: key not found, nil result. | |5: // Check for __index if table value is nil. | mov TAB:RA, TAB:RB->metatable | test TAB:RA, TAB:RA | jz <3 // No metatable: done. | test byte TAB:RA->nomm, 1<vmeta_tgets // Caveat: preserve STR:RC. break; case BC_TGETB: | ins_ABC // RA = dst, RB = table, RC = byte literal | checktab RB, ->vmeta_tgetb | mov TAB:RB, [BASE+RB*8] | cmp RC, TAB:RB->asize | jae ->vmeta_tgetb | shl RC, 3 | add RC, TAB:RB->array | cmp dword [RC+4], LJ_TNIL // Avoid overwriting RB in fastpath. | je >2 | // Get array slot. |.if X64 | mov RBa, [RC] | mov [BASE+RA*8], RBa |.else | mov RB, [RC] | mov RC, [RC+4] | mov [BASE+RA*8], RB | mov [BASE+RA*8+4], RC |.endif |1: | ins_next | |2: // Check for __index if table value is nil. | cmp dword TAB:RB->metatable, 0 // Shouldn't overwrite RA for fastpath. | jz >3 | mov TAB:RA, TAB:RB->metatable | test byte TAB:RA->nomm, 1<vmeta_tgetb // 'no __index' flag NOT set: check. | movzx RA, PC_RA // Restore RA. |3: | mov dword [BASE+RA*8+4], LJ_TNIL | jmp <1 break; case BC_TSETV: | ins_ABC // RA = src, RB = table, RC = key | checktab RB, ->vmeta_tsetv | mov TAB:RB, [BASE+RB*8] | | // Integer key? |.if DUALNUM | checkint RC, >5 | mov RC, dword [BASE+RC*8] |.else | // Convert number to int and back and compare. | checknum RC, >5 |.if SSE | movsd xmm0, qword [BASE+RC*8] | cvtsd2si RC, xmm0 | cvtsi2sd xmm1, RC | ucomisd xmm0, xmm1 |.else | fld qword [BASE+RC*8] | fist ARG1 | fild ARG1 | fcomparepp | mov RC, ARG1 |.endif | jne ->vmeta_tsetv // Generic numeric key? Use fallback. |.endif | cmp RC, TAB:RB->asize // Takes care of unordered, too. | jae ->vmeta_tsetv | shl RC, 3 | add RC, TAB:RB->array | cmp dword [RC+4], LJ_TNIL | je >3 // Previous value is nil? |1: | test byte TAB:RB->marked, LJ_GC_BLACK // isblack(table) | jnz >7 |2: // Set array slot. |.if X64 | mov RBa, [BASE+RA*8] | mov [RC], RBa |.else | mov RB, [BASE+RA*8+4] | mov RA, [BASE+RA*8] | mov [RC+4], RB | mov [RC], RA |.endif | ins_next | |3: // Check for __newindex if previous value is nil. | cmp dword TAB:RB->metatable, 0 // Shouldn't overwrite RA for fastpath. | jz <1 | mov TAB:RA, TAB:RB->metatable | test byte TAB:RA->nomm, 1<vmeta_tsetv // 'no __newindex' flag NOT set: check. | movzx RA, PC_RA // Restore RA. | jmp <1 | |5: // String key? | checkstr RC, ->vmeta_tsetv | mov STR:RC, [BASE+RC*8] | jmp ->BC_TSETS_Z | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, RA | movzx RA, PC_RA // Restore RA. | jmp <2 break; case BC_TSETS: | ins_ABC // RA = src, RB = table, RC = str const (~) | not RCa | mov STR:RC, [KBASE+RC*4] | checktab RB, ->vmeta_tsets | mov TAB:RB, [BASE+RB*8] |->BC_TSETS_Z: // RB = GCtab *, RC = GCstr *, refetches PC_RA. | mov RA, TAB:RB->hmask | and RA, STR:RC->hash | imul RA, #NODE | mov byte TAB:RB->nomm, 0 // Clear metamethod cache. | add NODE:RA, TAB:RB->node |1: | cmp dword NODE:RA->key.it, LJ_TSTR | jne >5 | cmp dword NODE:RA->key.gcr, STR:RC | jne >5 | // Ok, key found. Assumes: offsetof(Node, val) == 0 | cmp dword [RA+4], LJ_TNIL | je >4 // Previous value is nil? |2: | test byte TAB:RB->marked, LJ_GC_BLACK // isblack(table) | jnz >7 |3: // Set node value. | movzx RC, PC_RA |.if X64 | mov RBa, [BASE+RC*8] | mov [RA], RBa |.else | mov RB, [BASE+RC*8+4] | mov RC, [BASE+RC*8] | mov [RA+4], RB | mov [RA], RC |.endif | ins_next | |4: // Check for __newindex if previous value is nil. | cmp dword TAB:RB->metatable, 0 // Shouldn't overwrite RA for fastpath. | jz <2 | mov TMP1, RA // Save RA. | mov TAB:RA, TAB:RB->metatable | test byte TAB:RA->nomm, 1<vmeta_tsets // 'no __newindex' flag NOT set: check. | mov RA, TMP1 // Restore RA. | jmp <2 | |5: // Follow hash chain. | mov NODE:RA, NODE:RA->next | test NODE:RA, NODE:RA | jnz <1 | // End of hash chain: key not found, add a new one. | | // But check for __newindex first. | mov TAB:RA, TAB:RB->metatable | test TAB:RA, TAB:RA | jz >6 // No metatable: continue. | test byte TAB:RA->nomm, 1<vmeta_tsets // 'no __newindex' flag NOT set: check. |6: | mov TMP1, STR:RC | mov TMP2, LJ_TSTR | mov TMP3, TAB:RB // Save TAB:RB for us. |.if X64 | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE | lea CARG3, TMP1 | mov CARG2d, TAB:RB | mov L:RB, L:CARG1d |.else | lea RC, TMP1 // Store temp. TValue in TMP1/TMP2. | mov ARG2, TAB:RB | mov L:RB, SAVE_L | mov ARG3, RC | mov ARG1, L:RB | mov L:RB->base, BASE |.endif | mov SAVE_PC, PC | call extern lj_tab_newkey // (lua_State *L, GCtab *t, TValue *k) | // Handles write barrier for the new key. TValue * returned in eax (RC). | mov BASE, L:RB->base | mov TAB:RB, TMP3 // Need TAB:RB for barrier. | mov RA, eax | jmp <2 // Must check write barrier for value. | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, RC // Destroys STR:RC. | jmp <3 break; case BC_TSETB: | ins_ABC // RA = src, RB = table, RC = byte literal | checktab RB, ->vmeta_tsetb | mov TAB:RB, [BASE+RB*8] | cmp RC, TAB:RB->asize | jae ->vmeta_tsetb | shl RC, 3 | add RC, TAB:RB->array | cmp dword [RC+4], LJ_TNIL | je >3 // Previous value is nil? |1: | test byte TAB:RB->marked, LJ_GC_BLACK // isblack(table) | jnz >7 |2: // Set array slot. |.if X64 | mov RAa, [BASE+RA*8] | mov [RC], RAa |.else | mov RB, [BASE+RA*8+4] | mov RA, [BASE+RA*8] | mov [RC+4], RB | mov [RC], RA |.endif | ins_next | |3: // Check for __newindex if previous value is nil. | cmp dword TAB:RB->metatable, 0 // Shouldn't overwrite RA for fastpath. | jz <1 | mov TAB:RA, TAB:RB->metatable | test byte TAB:RA->nomm, 1<vmeta_tsetb // 'no __newindex' flag NOT set: check. | movzx RA, PC_RA // Restore RA. | jmp <1 | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, RA | movzx RA, PC_RA // Restore RA. | jmp <2 break; case BC_TSETM: | ins_AD // RA = base (table at base-1), RD = num const (start index) | mov TMP1, KBASE // Need one more free register. | mov KBASE, dword [KBASE+RD*8] // Integer constant is in lo-word. |1: | lea RA, [BASE+RA*8] | mov TAB:RB, [RA-8] // Guaranteed to be a table. | test byte TAB:RB->marked, LJ_GC_BLACK // isblack(table) | jnz >7 |2: | mov RD, MULTRES | sub RD, 1 | jz >4 // Nothing to copy? | add RD, KBASE // Compute needed size. | cmp RD, TAB:RB->asize | ja >5 // Doesn't fit into array part? | sub RD, KBASE | shl KBASE, 3 | add KBASE, TAB:RB->array |3: // Copy result slots to table. |.if X64 | mov RBa, [RA] | add RA, 8 | mov [KBASE], RBa |.else | mov RB, [RA] | mov [KBASE], RB | mov RB, [RA+4] | add RA, 8 | mov [KBASE+4], RB |.endif | add KBASE, 8 | sub RD, 1 | jnz <3 |4: | mov KBASE, TMP1 | ins_next | |5: // Need to resize array part. |.if X64 | mov L:CARG1d, SAVE_L | mov L:CARG1d->base, BASE // Caveat: CARG2d/CARG3d may be BASE. | mov CARG2d, TAB:RB | mov CARG3d, RD | mov L:RB, L:CARG1d |.else | mov ARG2, TAB:RB | mov L:RB, SAVE_L | mov L:RB->base, BASE | mov ARG3, RD | mov ARG1, L:RB |.endif | mov SAVE_PC, PC | call extern lj_tab_reasize // (lua_State *L, GCtab *t, int nasize) | mov BASE, L:RB->base | movzx RA, PC_RA // Restore RA. | jmp <1 // Retry. | |7: // Possible table write barrier for any value. Skip valiswhite check. | barrierback TAB:RB, RD | jmp <2 break; /* -- Calls and vararg handling ----------------------------------------- */ case BC_CALL: case BC_CALLM: | ins_A_C // RA = base, (RB = nresults+1,) RC = nargs+1 | extra_nargs if (op == BC_CALLM) { | add NARGS:RD, MULTRES } | cmp dword [BASE+RA*8+4], LJ_TFUNC | mov LFUNC:RB, [BASE+RA*8] | jne ->vmeta_call_ra | lea BASE, [BASE+RA*8+8] | ins_call break; case BC_CALLMT: | ins_AD // RA = base, RD = extra_nargs | add NARGS:RD, MULTRES | // Fall through. Assumes BC_CALLT follows and ins_AD is a no-op. break; case BC_CALLT: | ins_AD // RA = base, RD = nargs+1 | lea RA, [BASE+RA*8+8] | mov KBASE, BASE // Use KBASE for move + vmeta_call hint. | mov LFUNC:RB, [RA-8] | cmp dword [RA-4], LJ_TFUNC | jne ->vmeta_call |->BC_CALLT_Z: | mov PC, [BASE-4] | test PC, FRAME_TYPE | jnz >7 |1: | mov [BASE-8], LFUNC:RB // Copy function down, reloaded below. | mov MULTRES, NARGS:RD | sub NARGS:RD, 1 | jz >3 |2: // Move args down. |.if X64 | mov RBa, [RA] | add RA, 8 | mov [KBASE], RBa |.else | mov RB, [RA] | mov [KBASE], RB | mov RB, [RA+4] | add RA, 8 | mov [KBASE+4], RB |.endif | add KBASE, 8 | sub NARGS:RD, 1 | jnz <2 | | mov LFUNC:RB, [BASE-8] |3: | mov NARGS:RD, MULTRES | cmp byte LFUNC:RB->ffid, 1 // (> FF_C) Calling a fast function? | ja >5 |4: | ins_callt | |5: // Tailcall to a fast function. | test PC, FRAME_TYPE // Lua frame below? | jnz <4 | movzx RA, PC_RA | not RAa | mov LFUNC:KBASE, [BASE+RA*8-8] // Need to prepare KBASE. | mov KBASE, LFUNC:KBASE->pc | mov KBASE, [KBASE+PC2PROTO(k)] | jmp <4 | |7: // Tailcall from a vararg function. | sub PC, FRAME_VARG | test PC, FRAME_TYPEP | jnz >8 // Vararg frame below? | sub BASE, PC // Need to relocate BASE/KBASE down. | mov KBASE, BASE | mov PC, [BASE-4] | jmp <1 |8: | add PC, FRAME_VARG | jmp <1 break; case BC_ITERC: | ins_A // RA = base, (RB = nresults+1,) RC = nargs+1 (2+1) | lea RA, [BASE+RA*8+8] // fb = base+1 |.if X64 | mov RBa, [RA-24] // Copy state. fb[0] = fb[-3]. | mov RCa, [RA-16] // Copy control var. fb[1] = fb[-2]. | mov [RA], RBa | mov [RA+8], RCa |.else | mov RB, [RA-24] // Copy state. fb[0] = fb[-3]. | mov RC, [RA-20] | mov [RA], RB | mov [RA+4], RC | mov RB, [RA-16] // Copy control var. fb[1] = fb[-2]. | mov RC, [RA-12] | mov [RA+8], RB | mov [RA+12], RC |.endif | mov LFUNC:RB, [RA-32] // Copy callable. fb[-1] = fb[-4] | mov RC, [RA-28] | mov [RA-8], LFUNC:RB | mov [RA-4], RC | cmp RC, LJ_TFUNC // Handle like a regular 2-arg call. | mov NARGS:RD, 2+1 | jne ->vmeta_call | mov BASE, RA | ins_call break; case BC_ITERN: | ins_A // RA = base, (RB = nresults+1, RC = nargs+1 (2+1)) |.if JIT | // NYI: add hotloop, record BC_ITERN. |.endif | mov TMP1, KBASE // Need two more free registers. | mov TMP2, DISPATCH | mov TAB:RB, [BASE+RA*8-16] | mov RC, [BASE+RA*8-8] // Get index from control var. | mov DISPATCH, TAB:RB->asize | add PC, 4 | mov KBASE, TAB:RB->array |1: // Traverse array part. | cmp RC, DISPATCH; jae >5 // Index points after array part? | cmp dword [KBASE+RC*8+4], LJ_TNIL; je >4 |.if DUALNUM | mov dword [BASE+RA*8+4], LJ_TISNUM | mov dword [BASE+RA*8], RC |.elif SSE | cvtsi2sd xmm0, RC |.else | fild dword [BASE+RA*8-8] |.endif | // Copy array slot to returned value. |.if X64 | mov RBa, [KBASE+RC*8] | mov [BASE+RA*8+8], RBa |.else | mov RB, [KBASE+RC*8+4] | mov [BASE+RA*8+12], RB | mov RB, [KBASE+RC*8] | mov [BASE+RA*8+8], RB |.endif | add RC, 1 | // Return array index as a numeric key. |.if DUALNUM | // See above. |.elif SSE | movsd qword [BASE+RA*8], xmm0 |.else | fstp qword [BASE+RA*8] |.endif | mov [BASE+RA*8-8], RC // Update control var. |2: | movzx RD, PC_RD // Get target from ITERL. | branchPC RD |3: | mov DISPATCH, TMP2 | mov KBASE, TMP1 | ins_next | |4: // Skip holes in array part. | add RC, 1 |.if not (DUALNUM or SSE) | mov [BASE+RA*8-8], RC |.endif | jmp <1 | |5: // Traverse hash part. | sub RC, DISPATCH |6: | cmp RC, TAB:RB->hmask; ja <3 // End of iteration? Branch to ITERL+1. | imul KBASE, RC, #NODE | add NODE:KBASE, TAB:RB->node | cmp dword NODE:KBASE->val.it, LJ_TNIL; je >7 | lea DISPATCH, [RC+DISPATCH+1] | // Copy key and value from hash slot. |.if X64 | mov RBa, NODE:KBASE->key | mov RCa, NODE:KBASE->val | mov [BASE+RA*8], RBa | mov [BASE+RA*8+8], RCa |.else | mov RB, NODE:KBASE->key.gcr | mov RC, NODE:KBASE->key.it | mov [BASE+RA*8], RB | mov [BASE+RA*8+4], RC | mov RB, NODE:KBASE->val.gcr | mov RC, NODE:KBASE->val.it | mov [BASE+RA*8+8], RB | mov [BASE+RA*8+12], RC |.endif | mov [BASE+RA*8-8], DISPATCH | jmp <2 | |7: // Skip holes in hash part. | add RC, 1 | jmp <6 break; case BC_ISNEXT: | ins_AD // RA = base, RD = target (points to ITERN) | cmp dword [BASE+RA*8-20], LJ_TFUNC; jne >5 | mov CFUNC:RB, [BASE+RA*8-24] | cmp dword [BASE+RA*8-12], LJ_TTAB; jne >5 | cmp dword [BASE+RA*8-4], LJ_TNIL; jne >5 | cmp byte CFUNC:RB->ffid, FF_next_N; jne >5 | branchPC RD | mov dword [BASE+RA*8-8], 0 // Initialize control var. | mov dword [BASE+RA*8-4], 0xfffe7fff |1: | ins_next |5: // Despecialize bytecode if any of the checks fail. | mov PC_OP, BC_JMP | branchPC RD | mov byte [PC], BC_ITERC | jmp <1 break; case BC_VARG: | ins_ABC // RA = base, RB = nresults+1, RC = numparams | mov TMP1, KBASE // Need one more free register. | lea KBASE, [BASE+RC*8+(8+FRAME_VARG)] | lea RA, [BASE+RA*8] | sub KBASE, [BASE-4] | // Note: KBASE may now be even _above_ BASE if nargs was < numparams. | test RB, RB | jz >5 // Copy all varargs? | lea RB, [RA+RB*8-8] | cmp KBASE, BASE // No vararg slots? | jnb >2 |1: // Copy vararg slots to destination slots. |.if X64 | mov RCa, [KBASE-8] | add KBASE, 8 | mov [RA], RCa |.else | mov RC, [KBASE-8] | mov [RA], RC | mov RC, [KBASE-4] | add KBASE, 8 | mov [RA+4], RC |.endif | add RA, 8 | cmp RA, RB // All destination slots filled? | jnb >3 | cmp KBASE, BASE // No more vararg slots? | jb <1 |2: // Fill up remainder with nil. | mov dword [RA+4], LJ_TNIL | add RA, 8 | cmp RA, RB | jb <2 |3: | mov KBASE, TMP1 | ins_next | |5: // Copy all varargs. | mov MULTRES, 1 // MULTRES = 0+1 | mov RC, BASE | sub RC, KBASE | jbe <3 // No vararg slots? | mov RB, RC | shr RB, 3 | add RB, 1 | mov MULTRES, RB // MULTRES = #varargs+1 | mov L:RB, SAVE_L | add RC, RA | cmp RC, L:RB->maxstack | ja >7 // Need to grow stack? |6: // Copy all vararg slots. |.if X64 | mov RCa, [KBASE-8] | add KBASE, 8 | mov [RA], RCa |.else | mov RC, [KBASE-8] | mov [RA], RC | mov RC, [KBASE-4] | add KBASE, 8 | mov [RA+4], RC |.endif | add RA, 8 | cmp KBASE, BASE // No more vararg slots? | jb <6 | jmp <3 | |7: // Grow stack for varargs. | mov L:RB->base, BASE | mov L:RB->top, RA | mov SAVE_PC, PC | sub KBASE, BASE // Need delta, because BASE may change. | mov FCARG2, MULTRES | sub FCARG2, 1 | mov FCARG1, L:RB | call extern lj_state_growstack@8 // (lua_State *L, int n) | mov BASE, L:RB->base | mov RA, L:RB->top | add KBASE, BASE | jmp <6 break; /* -- Returns ----------------------------------------------------------- */ case BC_RETM: | ins_AD // RA = results, RD = extra_nresults | add RD, MULTRES // MULTRES >=1, so RD >=1. | // Fall through. Assumes BC_RET follows and ins_AD is a no-op. break; case BC_RET: case BC_RET0: case BC_RET1: | ins_AD // RA = results, RD = nresults+1 if (op != BC_RET0) { | shl RA, 3 } |1: | mov PC, [BASE-4] | mov MULTRES, RD // Save nresults+1. | test PC, FRAME_TYPE // Check frame type marker. | jnz >7 // Not returning to a fixarg Lua func? switch (op) { case BC_RET: |->BC_RET_Z: | mov KBASE, BASE // Use KBASE for result move. | sub RD, 1 | jz >3 |2: // Move results down. |.if X64 | mov RBa, [KBASE+RA] | mov [KBASE-8], RBa |.else | mov RB, [KBASE+RA] | mov [KBASE-8], RB | mov RB, [KBASE+RA+4] | mov [KBASE-4], RB |.endif | add KBASE, 8 | sub RD, 1 | jnz <2 |3: | mov RD, MULTRES // Note: MULTRES may be >255. | movzx RB, PC_RB // So cannot compare with RDL! |5: | cmp RB, RD // More results expected? | ja >6 break; case BC_RET1: |.if X64 | mov RBa, [BASE+RA] | mov [BASE-8], RBa |.else | mov RB, [BASE+RA+4] | mov [BASE-4], RB | mov RB, [BASE+RA] | mov [BASE-8], RB |.endif /* fallthrough */ case BC_RET0: |5: | cmp PC_RB, RDL // More results expected? | ja >6 default: break; } | movzx RA, PC_RA | not RAa // Note: ~RA = -(RA+1) | lea BASE, [BASE+RA*8] // base = base - (RA+1)*8 | mov LFUNC:KBASE, [BASE-8] | mov KBASE, LFUNC:KBASE->pc | mov KBASE, [KBASE+PC2PROTO(k)] | ins_next | |6: // Fill up results with nil. if (op == BC_RET) { | mov dword [KBASE-4], LJ_TNIL // Note: relies on shifted base. | add KBASE, 8 } else { | mov dword [BASE+RD*8-12], LJ_TNIL } | add RD, 1 | jmp <5 | |7: // Non-standard return case. | lea RB, [PC-FRAME_VARG] | test RB, FRAME_TYPEP | jnz ->vm_return | // Return from vararg function: relocate BASE down and RA up. | sub BASE, RB if (op != BC_RET0) { | add RA, RB } | jmp <1 break; /* -- Loops and branches ------------------------------------------------ */ |.define FOR_IDX, [RA]; .define FOR_TIDX, dword [RA+4] |.define FOR_STOP, [RA+8]; .define FOR_TSTOP, dword [RA+12] |.define FOR_STEP, [RA+16]; .define FOR_TSTEP, dword [RA+20] |.define FOR_EXT, [RA+24]; .define FOR_TEXT, dword [RA+28] case BC_FORL: |.if JIT | hotloop RB |.endif | // Fall through. Assumes BC_IFORL follows and ins_AJ is a no-op. break; case BC_JFORI: case BC_JFORL: #if !LJ_HASJIT break; #endif case BC_FORI: case BC_IFORL: vk = (op == BC_IFORL || op == BC_JFORL); | ins_AJ // RA = base, RD = target (after end of loop or start of loop) | lea RA, [BASE+RA*8] if (LJ_DUALNUM) { | cmp FOR_TIDX, LJ_TISNUM; jne >9 if (!vk) { | cmp FOR_TSTOP, LJ_TISNUM; jne ->vmeta_for | cmp FOR_TSTEP, LJ_TISNUM; jne ->vmeta_for | mov RB, dword FOR_IDX | cmp dword FOR_STEP, 0; jl >5 } else { #ifdef LUA_USE_ASSERT | cmp FOR_TSTOP, LJ_TISNUM; jne ->assert_bad_for_arg_type | cmp FOR_TSTEP, LJ_TISNUM; jne ->assert_bad_for_arg_type #endif | mov RB, dword FOR_STEP | test RB, RB; js >5 | add RB, dword FOR_IDX; jo >1 | mov dword FOR_IDX, RB } | cmp RB, dword FOR_STOP | mov FOR_TEXT, LJ_TISNUM | mov dword FOR_EXT, RB if (op == BC_FORI) { | jle >7 |1: |6: | branchPC RD } else if (op == BC_JFORI) { | branchPC RD | movzx RD, PC_RD | jle =>BC_JLOOP |1: |6: } else if (op == BC_IFORL) { | jg >7 |6: | branchPC RD |1: } else { | jle =>BC_JLOOP |1: |6: } |7: | ins_next | |5: // Invert check for negative step. if (vk) { | add RB, dword FOR_IDX; jo <1 | mov dword FOR_IDX, RB } | cmp RB, dword FOR_STOP | mov FOR_TEXT, LJ_TISNUM | mov dword FOR_EXT, RB if (op == BC_FORI) { | jge <7 } else if (op == BC_JFORI) { | branchPC RD | movzx RD, PC_RD | jge =>BC_JLOOP } else if (op == BC_IFORL) { | jl <7 } else { | jge =>BC_JLOOP } | jmp <6 |9: // Fallback to FP variant. } else if (!vk) { | cmp FOR_TIDX, LJ_TISNUM } if (!vk) { | jae ->vmeta_for | cmp FOR_TSTOP, LJ_TISNUM; jae ->vmeta_for } else { #ifdef LUA_USE_ASSERT | cmp FOR_TSTOP, LJ_TISNUM; jae ->assert_bad_for_arg_type | cmp FOR_TSTEP, LJ_TISNUM; jae ->assert_bad_for_arg_type #endif } | mov RB, FOR_TSTEP // Load type/hiword of for step. if (!vk) { | cmp RB, LJ_TISNUM; jae ->vmeta_for } |.if SSE | movsd xmm0, qword FOR_IDX | movsd xmm1, qword FOR_STOP if (vk) { | addsd xmm0, qword FOR_STEP | movsd qword FOR_IDX, xmm0 | test RB, RB; js >3 } else { | jl >3 } | ucomisd xmm1, xmm0 |1: | movsd qword FOR_EXT, xmm0 |.else | fld qword FOR_STOP | fld qword FOR_IDX if (vk) { | fadd qword FOR_STEP // nidx = idx + step | fst qword FOR_IDX | fst qword FOR_EXT | test RB, RB; js >1 } else { | fst qword FOR_EXT | jl >1 } | fxch // Swap lim/(n)idx if step non-negative. |1: | fcomparepp |.endif if (op == BC_FORI) { |.if DUALNUM | jnb <7 |.else | jnb >2 | branchPC RD |.endif } else if (op == BC_JFORI) { | branchPC RD | movzx RD, PC_RD | jnb =>BC_JLOOP } else if (op == BC_IFORL) { |.if DUALNUM | jb <7 |.else | jb >2 | branchPC RD |.endif } else { | jnb =>BC_JLOOP } |.if DUALNUM | jmp <6 |.else |2: | ins_next |.endif |.if SSE |3: // Invert comparison if step is negative. | ucomisd xmm0, xmm1 | jmp <1 |.endif break; case BC_ITERL: |.if JIT | hotloop RB |.endif | // Fall through. Assumes BC_IITERL follows and ins_AJ is a no-op. break; case BC_JITERL: #if !LJ_HASJIT break; #endif case BC_IITERL: | ins_AJ // RA = base, RD = target | lea RA, [BASE+RA*8] | mov RB, [RA+4] | cmp RB, LJ_TNIL; je >1 // Stop if iterator returned nil. if (op == BC_JITERL) { | mov [RA-4], RB | mov RB, [RA] | mov [RA-8], RB | jmp =>BC_JLOOP } else { | branchPC RD // Otherwise save control var + branch. | mov RD, [RA] | mov [RA-4], RB | mov [RA-8], RD } |1: | ins_next break; case BC_LOOP: | ins_A // RA = base, RD = target (loop extent) | // Note: RA/RD is only used by trace recorder to determine scope/extent | // This opcode does NOT jump, it's only purpose is to detect a hot loop. |.if JIT | hotloop RB |.endif | // Fall through. Assumes BC_ILOOP follows and ins_A is a no-op. break; case BC_ILOOP: | ins_A // RA = base, RD = target (loop extent) | ins_next break; case BC_JLOOP: |.if JIT | ins_AD // RA = base (ignored), RD = traceno | mov RA, [DISPATCH+DISPATCH_J(trace)] | mov TRACE:RD, [RA+RD*4] | mov RDa, TRACE:RD->mcode | mov L:RB, SAVE_L | mov [DISPATCH+DISPATCH_GL(jit_base)], BASE | mov [DISPATCH+DISPATCH_GL(jit_L)], L:RB | // Save additional callee-save registers only used in compiled code. |.if X64WIN | mov TMPQ, r12 | mov TMPa, r13 | mov CSAVE_4, r14 | mov CSAVE_3, r15 | mov RAa, rsp | sub rsp, 9*16+4*8 | movdqa [RAa], xmm6 | movdqa [RAa-1*16], xmm7 | movdqa [RAa-2*16], xmm8 | movdqa [RAa-3*16], xmm9 | movdqa [RAa-4*16], xmm10 | movdqa [RAa-5*16], xmm11 | movdqa [RAa-6*16], xmm12 | movdqa [RAa-7*16], xmm13 | movdqa [RAa-8*16], xmm14 | movdqa [RAa-9*16], xmm15 |.elif X64 | mov TMPQ, r12 | mov TMPa, r13 | sub rsp, 16 |.endif | jmp RDa |.endif break; case BC_JMP: | ins_AJ // RA = unused, RD = target | branchPC RD | ins_next break; /* -- Function headers -------------------------------------------------- */ /* ** Reminder: A function may be called with func/args above L->maxstack, ** i.e. occupying EXTRA_STACK slots. And vmeta_call may add one extra slot, ** too. This means all FUNC* ops (including fast functions) must check ** for stack overflow _before_ adding more slots! */ case BC_FUNCF: |.if JIT | hotcall RB |.endif case BC_FUNCV: /* NYI: compiled vararg functions. */ | // Fall through. Assumes BC_IFUNCF/BC_IFUNCV follow and ins_AD is a no-op. break; case BC_JFUNCF: #if !LJ_HASJIT break; #endif case BC_IFUNCF: | ins_AD // BASE = new base, RA = framesize, RD = nargs+1 | mov KBASE, [PC-4+PC2PROTO(k)] | mov L:RB, SAVE_L | lea RA, [BASE+RA*8] // Top of frame. | cmp RA, L:RB->maxstack | ja ->vm_growstack_f | movzx RA, byte [PC-4+PC2PROTO(numparams)] | cmp NARGS:RD, RA // Check for missing parameters. | jbe >3 |2: if (op == BC_JFUNCF) { | movzx RD, PC_RD | jmp =>BC_JLOOP } else { | ins_next } | |3: // Clear missing parameters. | mov dword [BASE+NARGS:RD*8-4], LJ_TNIL | add NARGS:RD, 1 | cmp NARGS:RD, RA | jbe <3 | jmp <2 break; case BC_JFUNCV: #if !LJ_HASJIT break; #endif | int3 // NYI: compiled vararg functions break; /* NYI: compiled vararg functions. */ case BC_IFUNCV: | ins_AD // BASE = new base, RA = framesize, RD = nargs+1 | lea RB, [NARGS:RD*8+FRAME_VARG] | lea RD, [BASE+NARGS:RD*8] | mov LFUNC:KBASE, [BASE-8] | mov [RD-4], RB // Store delta + FRAME_VARG. | mov [RD-8], LFUNC:KBASE // Store copy of LFUNC. | mov L:RB, SAVE_L | lea RA, [RD+RA*8] | cmp RA, L:RB->maxstack | ja ->vm_growstack_v // Need to grow stack. | mov RA, BASE | mov BASE, RD | movzx RB, byte [PC-4+PC2PROTO(numparams)] | test RB, RB | jz >2 |1: // Copy fixarg slots up to new frame. | add RA, 8 | cmp RA, BASE | jnb >3 // Less args than parameters? | mov KBASE, [RA-8] | mov [RD], KBASE | mov KBASE, [RA-4] | mov [RD+4], KBASE | add RD, 8 | mov dword [RA-4], LJ_TNIL // Clear old fixarg slot (help the GC). | sub RB, 1 | jnz <1 |2: if (op == BC_JFUNCV) { | movzx RD, PC_RD | jmp =>BC_JLOOP } else { | mov KBASE, [PC-4+PC2PROTO(k)] | ins_next } | |3: // Clear missing parameters. | mov dword [RD+4], LJ_TNIL | add RD, 8 | sub RB, 1 | jnz <3 | jmp <2 break; case BC_FUNCC: case BC_FUNCCW: | ins_AD // BASE = new base, RA = ins RA|RD (unused), RD = nargs+1 | mov CFUNC:RB, [BASE-8] | mov KBASEa, CFUNC:RB->f | mov L:RB, SAVE_L | lea RD, [BASE+NARGS:RD*8-8] | mov L:RB->base, BASE | lea RA, [RD+8*LUA_MINSTACK] | cmp RA, L:RB->maxstack | mov L:RB->top, RD if (op == BC_FUNCC) { |.if X64 | mov CARG1d, L:RB // Caveat: CARG1d may be RA. |.else | mov ARG1, L:RB |.endif } else { |.if X64 | mov CARG2, KBASEa | mov CARG1d, L:RB // Caveat: CARG1d may be RA. |.else | mov ARG2, KBASEa | mov ARG1, L:RB |.endif } | ja ->vm_growstack_c // Need to grow stack. | set_vmstate C if (op == BC_FUNCC) { | call KBASEa // (lua_State *L) } else { | // (lua_State *L, lua_CFunction f) | call aword [DISPATCH+DISPATCH_GL(wrapf)] } | set_vmstate INTERP | // nresults returned in eax (RD). | mov BASE, L:RB->base | lea RA, [BASE+RD*8] | neg RA | add RA, L:RB->top // RA = (L->top-(L->base+nresults))*8 | mov PC, [BASE-4] // Fetch PC of caller. | jmp ->vm_returnc break; /* ---------------------------------------------------------------------- */ default: fprintf(stderr, "Error: undefined opcode BC_%s\n", bc_names[op]); exit(2); break; } } static int build_backend(BuildCtx *ctx) { int op; dasm_growpc(Dst, BC__MAX); build_subroutines(ctx); |.code_op for (op = 0; op < BC__MAX; op++) build_ins(ctx, (BCOp)op, op); return BC__MAX; } /* Emit pseudo frame-info for all assembler functions. */ static void emit_asm_debug(BuildCtx *ctx) { int fcofs = (int)((uint8_t *)ctx->glob[GLOB_vm_ffi_call] - ctx->code); #if LJ_64 #define SZPTR "8" #define BSZPTR "3" #define REG_SP "0x7" #define REG_RA "0x10" #else #define SZPTR "4" #define BSZPTR "2" #define REG_SP "0x4" #define REG_RA "0x8" #endif switch (ctx->mode) { case BUILD_elfasm: fprintf(ctx->fp, "\t.section .debug_frame,\"\",@progbits\n"); fprintf(ctx->fp, ".Lframe0:\n" "\t.long .LECIE0-.LSCIE0\n" ".LSCIE0:\n" "\t.long 0xffffffff\n" "\t.byte 0x1\n" "\t.string \"\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -" SZPTR "\n" "\t.byte " REG_RA "\n" "\t.byte 0xc\n\t.uleb128 " REG_SP "\n\t.uleb128 " SZPTR "\n" "\t.byte 0x80+" REG_RA "\n\t.uleb128 0x1\n" "\t.align " SZPTR "\n" ".LECIE0:\n\n"); fprintf(ctx->fp, ".LSFDE0:\n" "\t.long .LEFDE0-.LASFDE0\n" ".LASFDE0:\n" "\t.long .Lframe0\n" #if LJ_64 "\t.quad .Lbegin\n" "\t.quad %d\n" "\t.byte 0xe\n\t.uleb128 %d\n" /* def_cfa_offset */ "\t.byte 0x86\n\t.uleb128 0x2\n" /* offset rbp */ "\t.byte 0x83\n\t.uleb128 0x3\n" /* offset rbx */ "\t.byte 0x8f\n\t.uleb128 0x4\n" /* offset r15 */ "\t.byte 0x8e\n\t.uleb128 0x5\n" /* offset r14 */ #if LJ_NO_UNWIND "\t.byte 0x8d\n\t.uleb128 0x6\n" /* offset r13 */ "\t.byte 0x8c\n\t.uleb128 0x7\n" /* offset r12 */ #endif #else "\t.long .Lbegin\n" "\t.long %d\n" "\t.byte 0xe\n\t.uleb128 %d\n" /* def_cfa_offset */ "\t.byte 0x85\n\t.uleb128 0x2\n" /* offset ebp */ "\t.byte 0x87\n\t.uleb128 0x3\n" /* offset edi */ "\t.byte 0x86\n\t.uleb128 0x4\n" /* offset esi */ "\t.byte 0x83\n\t.uleb128 0x5\n" /* offset ebx */ #endif "\t.align " SZPTR "\n" ".LEFDE0:\n\n", fcofs, CFRAME_SIZE); #if LJ_HASFFI fprintf(ctx->fp, ".LSFDE1:\n" "\t.long .LEFDE1-.LASFDE1\n" ".LASFDE1:\n" "\t.long .Lframe0\n" #if LJ_64 "\t.quad lj_vm_ffi_call\n" "\t.quad %d\n" "\t.byte 0xe\n\t.uleb128 16\n" /* def_cfa_offset */ "\t.byte 0x86\n\t.uleb128 0x2\n" /* offset rbp */ "\t.byte 0xd\n\t.uleb128 0x6\n" /* def_cfa_register rbp */ "\t.byte 0x83\n\t.uleb128 0x3\n" /* offset rbx */ #else "\t.long lj_vm_ffi_call\n" "\t.long %d\n" "\t.byte 0xe\n\t.uleb128 8\n" /* def_cfa_offset */ "\t.byte 0x85\n\t.uleb128 0x2\n" /* offset ebp */ "\t.byte 0xd\n\t.uleb128 0x5\n" /* def_cfa_register ebp */ "\t.byte 0x83\n\t.uleb128 0x3\n" /* offset ebx */ #endif "\t.align " SZPTR "\n" ".LEFDE1:\n\n", (int)ctx->codesz - fcofs); #endif #if !LJ_NO_UNWIND #if (defined(__sun__) && defined(__svr4__)) #if LJ_64 fprintf(ctx->fp, "\t.section .eh_frame,\"a\",@unwind\n"); #else fprintf(ctx->fp, "\t.section .eh_frame,\"aw\",@progbits\n"); #endif #else fprintf(ctx->fp, "\t.section .eh_frame,\"a\",@progbits\n"); #endif fprintf(ctx->fp, ".Lframe1:\n" "\t.long .LECIE1-.LSCIE1\n" ".LSCIE1:\n" "\t.long 0\n" "\t.byte 0x1\n" "\t.string \"zPR\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -" SZPTR "\n" "\t.byte " REG_RA "\n" "\t.uleb128 6\n" /* augmentation length */ "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.long lj_err_unwind_dwarf-.\n" "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.uleb128 " REG_SP "\n\t.uleb128 " SZPTR "\n" "\t.byte 0x80+" REG_RA "\n\t.uleb128 0x1\n" "\t.align " SZPTR "\n" ".LECIE1:\n\n"); fprintf(ctx->fp, ".LSFDE2:\n" "\t.long .LEFDE2-.LASFDE2\n" ".LASFDE2:\n" "\t.long .LASFDE2-.Lframe1\n" "\t.long .Lbegin-.\n" "\t.long %d\n" "\t.uleb128 0\n" /* augmentation length */ "\t.byte 0xe\n\t.uleb128 %d\n" /* def_cfa_offset */ #if LJ_64 "\t.byte 0x86\n\t.uleb128 0x2\n" /* offset rbp */ "\t.byte 0x83\n\t.uleb128 0x3\n" /* offset rbx */ "\t.byte 0x8f\n\t.uleb128 0x4\n" /* offset r15 */ "\t.byte 0x8e\n\t.uleb128 0x5\n" /* offset r14 */ #else "\t.byte 0x85\n\t.uleb128 0x2\n" /* offset ebp */ "\t.byte 0x87\n\t.uleb128 0x3\n" /* offset edi */ "\t.byte 0x86\n\t.uleb128 0x4\n" /* offset esi */ "\t.byte 0x83\n\t.uleb128 0x5\n" /* offset ebx */ #endif "\t.align " SZPTR "\n" ".LEFDE2:\n\n", fcofs, CFRAME_SIZE); #if LJ_HASFFI fprintf(ctx->fp, ".Lframe2:\n" "\t.long .LECIE2-.LSCIE2\n" ".LSCIE2:\n" "\t.long 0\n" "\t.byte 0x1\n" "\t.string \"zR\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -" SZPTR "\n" "\t.byte " REG_RA "\n" "\t.uleb128 1\n" /* augmentation length */ "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.uleb128 " REG_SP "\n\t.uleb128 " SZPTR "\n" "\t.byte 0x80+" REG_RA "\n\t.uleb128 0x1\n" "\t.align " SZPTR "\n" ".LECIE2:\n\n"); fprintf(ctx->fp, ".LSFDE3:\n" "\t.long .LEFDE3-.LASFDE3\n" ".LASFDE3:\n" "\t.long .LASFDE3-.Lframe2\n" "\t.long lj_vm_ffi_call-.\n" "\t.long %d\n" "\t.uleb128 0\n" /* augmentation length */ #if LJ_64 "\t.byte 0xe\n\t.uleb128 16\n" /* def_cfa_offset */ "\t.byte 0x86\n\t.uleb128 0x2\n" /* offset rbp */ "\t.byte 0xd\n\t.uleb128 0x6\n" /* def_cfa_register rbp */ "\t.byte 0x83\n\t.uleb128 0x3\n" /* offset rbx */ #else "\t.byte 0xe\n\t.uleb128 8\n" /* def_cfa_offset */ "\t.byte 0x85\n\t.uleb128 0x2\n" /* offset ebp */ "\t.byte 0xd\n\t.uleb128 0x5\n" /* def_cfa_register ebp */ "\t.byte 0x83\n\t.uleb128 0x3\n" /* offset ebx */ #endif "\t.align " SZPTR "\n" ".LEFDE3:\n\n", (int)ctx->codesz - fcofs); #endif #endif break; #if !LJ_NO_UNWIND /* Mental note: never let Apple design an assembler. ** Or a linker. Or a plastic case. But I digress. */ case BUILD_machasm: { #if LJ_HASFFI int fcsize = 0; #endif int i; fprintf(ctx->fp, "\t.section __TEXT,__eh_frame,coalesced,no_toc+strip_static_syms+live_support\n"); fprintf(ctx->fp, "EH_frame1:\n" "\t.set L$set$x,LECIEX-LSCIEX\n" "\t.long L$set$x\n" "LSCIEX:\n" "\t.long 0\n" "\t.byte 0x1\n" "\t.ascii \"zPR\\0\"\n" "\t.byte 0x1\n" "\t.byte 128-" SZPTR "\n" "\t.byte " REG_RA "\n" "\t.byte 6\n" /* augmentation length */ "\t.byte 0x9b\n" /* indirect|pcrel|sdata4 */ #if LJ_64 "\t.long _lj_err_unwind_dwarf+4@GOTPCREL\n" "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.byte " REG_SP "\n\t.byte " SZPTR "\n" #else "\t.long L_lj_err_unwind_dwarf$non_lazy_ptr-.\n" "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.byte 0x5\n\t.byte 0x4\n" /* esp=5 on 32 bit MACH-O. */ #endif "\t.byte 0x80+" REG_RA "\n\t.byte 0x1\n" "\t.align " BSZPTR "\n" "LECIEX:\n\n"); for (i = 0; i < ctx->nsym; i++) { const char *name = ctx->sym[i].name; int32_t size = ctx->sym[i+1].ofs - ctx->sym[i].ofs; if (size == 0) continue; #if LJ_HASFFI if (!strcmp(name, "_lj_vm_ffi_call")) { fcsize = size; continue; } #endif fprintf(ctx->fp, "%s.eh:\n" "LSFDE%d:\n" "\t.set L$set$%d,LEFDE%d-LASFDE%d\n" "\t.long L$set$%d\n" "LASFDE%d:\n" "\t.long LASFDE%d-EH_frame1\n" "\t.long %s-.\n" "\t.long %d\n" "\t.byte 0\n" /* augmentation length */ "\t.byte 0xe\n\t.byte %d\n" /* def_cfa_offset */ #if LJ_64 "\t.byte 0x86\n\t.byte 0x2\n" /* offset rbp */ "\t.byte 0x83\n\t.byte 0x3\n" /* offset rbx */ "\t.byte 0x8f\n\t.byte 0x4\n" /* offset r15 */ "\t.byte 0x8e\n\t.byte 0x5\n" /* offset r14 */ #else "\t.byte 0x84\n\t.byte 0x2\n" /* offset ebp (4 for MACH-O)*/ "\t.byte 0x87\n\t.byte 0x3\n" /* offset edi */ "\t.byte 0x86\n\t.byte 0x4\n" /* offset esi */ "\t.byte 0x83\n\t.byte 0x5\n" /* offset ebx */ #endif "\t.align " BSZPTR "\n" "LEFDE%d:\n\n", name, i, i, i, i, i, i, i, name, size, CFRAME_SIZE, i); } #if LJ_HASFFI if (fcsize) { fprintf(ctx->fp, "EH_frame2:\n" "\t.set L$set$y,LECIEY-LSCIEY\n" "\t.long L$set$y\n" "LSCIEY:\n" "\t.long 0\n" "\t.byte 0x1\n" "\t.ascii \"zR\\0\"\n" "\t.byte 0x1\n" "\t.byte 128-" SZPTR "\n" "\t.byte " REG_RA "\n" "\t.byte 1\n" /* augmentation length */ #if LJ_64 "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.byte " REG_SP "\n\t.byte " SZPTR "\n" #else "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.byte 0x5\n\t.byte 0x4\n" /* esp=5 on 32 bit MACH. */ #endif "\t.byte 0x80+" REG_RA "\n\t.byte 0x1\n" "\t.align " BSZPTR "\n" "LECIEY:\n\n"); fprintf(ctx->fp, "_lj_vm_ffi_call.eh:\n" "LSFDEY:\n" "\t.set L$set$yy,LEFDEY-LASFDEY\n" "\t.long L$set$yy\n" "LASFDEY:\n" "\t.long LASFDEY-EH_frame2\n" "\t.long _lj_vm_ffi_call-.\n" "\t.long %d\n" "\t.byte 0\n" /* augmentation length */ #if LJ_64 "\t.byte 0xe\n\t.byte 16\n" /* def_cfa_offset */ "\t.byte 0x86\n\t.byte 0x2\n" /* offset rbp */ "\t.byte 0xd\n\t.byte 0x6\n" /* def_cfa_register rbp */ "\t.byte 0x83\n\t.byte 0x3\n" /* offset rbx */ #else "\t.byte 0xe\n\t.byte 8\n" /* def_cfa_offset */ "\t.byte 0x84\n\t.byte 0x2\n" /* offset ebp (4 for MACH-O)*/ "\t.byte 0xd\n\t.byte 0x4\n" /* def_cfa_register ebp */ "\t.byte 0x83\n\t.byte 0x3\n" /* offset ebx */ #endif "\t.align " BSZPTR "\n" "LEFDEY:\n\n", fcsize); } #endif #if LJ_64 fprintf(ctx->fp, "\t.subsections_via_symbols\n"); #else fprintf(ctx->fp, "\t.non_lazy_symbol_pointer\n" "L_lj_err_unwind_dwarf$non_lazy_ptr:\n" ".indirect_symbol _lj_err_unwind_dwarf\n" ".long 0\n"); #endif } break; #endif default: /* Difficult for other modes. */ break; } } wcc-0.0.2/src/wsh/luajit-2.0/src/lib_jit.c0000644000175000017500000004236613122010155016464 0ustar philphil/* ** JIT library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lib_jit_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_arch.h" #include "lj_obj.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_bc.h" #if LJ_HASJIT #include "lj_ir.h" #include "lj_jit.h" #include "lj_ircall.h" #include "lj_iropt.h" #include "lj_target.h" #endif #include "lj_dispatch.h" #include "lj_vm.h" #include "lj_vmevent.h" #include "lj_lib.h" #include "luajit.h" /* -- jit.* functions ----------------------------------------------------- */ #define LJLIB_MODULE_jit static int setjitmode(lua_State *L, int mode) { int idx = 0; if (L->base == L->top || tvisnil(L->base)) { /* jit.on/off/flush([nil]) */ mode |= LUAJIT_MODE_ENGINE; } else { /* jit.on/off/flush(func|proto, nil|true|false) */ if (tvisfunc(L->base) || tvisproto(L->base)) idx = 1; else if (!tvistrue(L->base)) /* jit.on/off/flush(true, nil|true|false) */ goto err; if (L->base+1 < L->top && tvisbool(L->base+1)) mode |= boolV(L->base+1) ? LUAJIT_MODE_ALLFUNC : LUAJIT_MODE_ALLSUBFUNC; else mode |= LUAJIT_MODE_FUNC; } if (luaJIT_setmode(L, idx, mode) != 1) { if ((mode & LUAJIT_MODE_MASK) == LUAJIT_MODE_ENGINE) lj_err_caller(L, LJ_ERR_NOJIT); err: lj_err_argt(L, 1, LUA_TFUNCTION); } return 0; } LJLIB_CF(jit_on) { return setjitmode(L, LUAJIT_MODE_ON); } LJLIB_CF(jit_off) { return setjitmode(L, LUAJIT_MODE_OFF); } LJLIB_CF(jit_flush) { #if LJ_HASJIT if (L->base < L->top && tvisnumber(L->base)) { int traceno = lj_lib_checkint(L, 1); luaJIT_setmode(L, traceno, LUAJIT_MODE_FLUSH|LUAJIT_MODE_TRACE); return 0; } #endif return setjitmode(L, LUAJIT_MODE_FLUSH); } #if LJ_HASJIT /* Push a string for every flag bit that is set. */ static void flagbits_to_strings(lua_State *L, uint32_t flags, uint32_t base, const char *str) { for (; *str; base <<= 1, str += 1+*str) if (flags & base) setstrV(L, L->top++, lj_str_new(L, str+1, *(uint8_t *)str)); } #endif LJLIB_CF(jit_status) { #if LJ_HASJIT jit_State *J = L2J(L); L->top = L->base; setboolV(L->top++, (J->flags & JIT_F_ON) ? 1 : 0); flagbits_to_strings(L, J->flags, JIT_F_CPU_FIRST, JIT_F_CPUSTRING); flagbits_to_strings(L, J->flags, JIT_F_OPT_FIRST, JIT_F_OPTSTRING); return (int)(L->top - L->base); #else setboolV(L->top++, 0); return 1; #endif } LJLIB_CF(jit_attach) { #ifdef LUAJIT_DISABLE_VMEVENT luaL_error(L, "vmevent API disabled"); #else GCfunc *fn = lj_lib_checkfunc(L, 1); GCstr *s = lj_lib_optstr(L, 2); luaL_findtable(L, LUA_REGISTRYINDEX, LJ_VMEVENTS_REGKEY, LJ_VMEVENTS_HSIZE); if (s) { /* Attach to given event. */ const uint8_t *p = (const uint8_t *)strdata(s); uint32_t h = s->len; while (*p) h = h ^ (lj_rol(h, 6) + *p++); lua_pushvalue(L, 1); lua_rawseti(L, -2, VMEVENT_HASHIDX(h)); G(L)->vmevmask = VMEVENT_NOCACHE; /* Invalidate cache. */ } else { /* Detach if no event given. */ setnilV(L->top++); while (lua_next(L, -2)) { L->top--; if (tvisfunc(L->top) && funcV(L->top) == fn) { setnilV(lj_tab_set(L, tabV(L->top-2), L->top-1)); } } } #endif return 0; } LJLIB_PUSH(top-5) LJLIB_SET(os) LJLIB_PUSH(top-4) LJLIB_SET(arch) LJLIB_PUSH(top-3) LJLIB_SET(version_num) LJLIB_PUSH(top-2) LJLIB_SET(version) #include "lj_libdef.h" /* -- jit.util.* functions ------------------------------------------------ */ #define LJLIB_MODULE_jit_util /* -- Reflection API for Lua functions ------------------------------------ */ /* Return prototype of first argument (Lua function or prototype object) */ static GCproto *check_Lproto(lua_State *L, int nolua) { TValue *o = L->base; if (L->top > o) { if (tvisproto(o)) { return protoV(o); } else if (tvisfunc(o)) { if (isluafunc(funcV(o))) return funcproto(funcV(o)); else if (nolua) return NULL; } } lj_err_argt(L, 1, LUA_TFUNCTION); return NULL; /* unreachable */ } static void setintfield(lua_State *L, GCtab *t, const char *name, int32_t val) { setintV(lj_tab_setstr(L, t, lj_str_newz(L, name)), val); } /* local info = jit.util.funcinfo(func [,pc]) */ LJLIB_CF(jit_util_funcinfo) { GCproto *pt = check_Lproto(L, 1); if (pt) { BCPos pc = (BCPos)lj_lib_optint(L, 2, 0); GCtab *t; lua_createtable(L, 0, 16); /* Increment hash size if fields are added. */ t = tabV(L->top-1); setintfield(L, t, "linedefined", pt->firstline); setintfield(L, t, "lastlinedefined", pt->firstline + pt->numline); setintfield(L, t, "stackslots", pt->framesize); setintfield(L, t, "params", pt->numparams); setintfield(L, t, "bytecodes", (int32_t)pt->sizebc); setintfield(L, t, "gcconsts", (int32_t)pt->sizekgc); setintfield(L, t, "nconsts", (int32_t)pt->sizekn); setintfield(L, t, "upvalues", (int32_t)pt->sizeuv); if (pc < pt->sizebc) setintfield(L, t, "currentline", lj_debug_line(pt, pc)); lua_pushboolean(L, (pt->flags & PROTO_VARARG)); lua_setfield(L, -2, "isvararg"); lua_pushboolean(L, (pt->flags & PROTO_CHILD)); lua_setfield(L, -2, "children"); setstrV(L, L->top++, proto_chunkname(pt)); lua_setfield(L, -2, "source"); lj_debug_pushloc(L, pt, pc); lua_setfield(L, -2, "loc"); } else { GCfunc *fn = funcV(L->base); GCtab *t; lua_createtable(L, 0, 4); /* Increment hash size if fields are added. */ t = tabV(L->top-1); if (!iscfunc(fn)) setintfield(L, t, "ffid", fn->c.ffid); setintptrV(lj_tab_setstr(L, t, lj_str_newlit(L, "addr")), (intptr_t)(void *)fn->c.f); setintfield(L, t, "upvalues", fn->c.nupvalues); } return 1; } /* local ins, m = jit.util.funcbc(func, pc) */ LJLIB_CF(jit_util_funcbc) { GCproto *pt = check_Lproto(L, 0); BCPos pc = (BCPos)lj_lib_checkint(L, 2); if (pc < pt->sizebc) { BCIns ins = proto_bc(pt)[pc]; BCOp op = bc_op(ins); lua_assert(op < BC__MAX); setintV(L->top, ins); setintV(L->top+1, lj_bc_mode[op]); L->top += 2; return 2; } return 0; } /* local k = jit.util.funck(func, idx) */ LJLIB_CF(jit_util_funck) { GCproto *pt = check_Lproto(L, 0); ptrdiff_t idx = (ptrdiff_t)lj_lib_checkint(L, 2); if (idx >= 0) { if (idx < (ptrdiff_t)pt->sizekn) { copyTV(L, L->top-1, proto_knumtv(pt, idx)); return 1; } } else { if (~idx < (ptrdiff_t)pt->sizekgc) { GCobj *gc = proto_kgc(pt, idx); setgcV(L, L->top-1, gc, ~gc->gch.gct); return 1; } } return 0; } /* local name = jit.util.funcuvname(func, idx) */ LJLIB_CF(jit_util_funcuvname) { GCproto *pt = check_Lproto(L, 0); uint32_t idx = (uint32_t)lj_lib_checkint(L, 2); if (idx < pt->sizeuv) { setstrV(L, L->top-1, lj_str_newz(L, lj_debug_uvname(pt, idx))); return 1; } return 0; } /* -- Reflection API for traces ------------------------------------------- */ #if LJ_HASJIT /* Check trace argument. Must not throw for non-existent trace numbers. */ static GCtrace *jit_checktrace(lua_State *L) { TraceNo tr = (TraceNo)lj_lib_checkint(L, 1); jit_State *J = L2J(L); if (tr > 0 && tr < J->sizetrace) return traceref(J, tr); return NULL; } /* Names of link types. ORDER LJ_TRLINK */ static const char *const jit_trlinkname[] = { "none", "root", "loop", "tail-recursion", "up-recursion", "down-recursion", "interpreter", "return" }; /* local info = jit.util.traceinfo(tr) */ LJLIB_CF(jit_util_traceinfo) { GCtrace *T = jit_checktrace(L); if (T) { GCtab *t; lua_createtable(L, 0, 8); /* Increment hash size if fields are added. */ t = tabV(L->top-1); setintfield(L, t, "nins", (int32_t)T->nins - REF_BIAS - 1); setintfield(L, t, "nk", REF_BIAS - (int32_t)T->nk); setintfield(L, t, "link", T->link); setintfield(L, t, "nexit", T->nsnap); setstrV(L, L->top++, lj_str_newz(L, jit_trlinkname[T->linktype])); lua_setfield(L, -2, "linktype"); /* There are many more fields. Add them only when needed. */ return 1; } return 0; } /* local m, ot, op1, op2, prev = jit.util.traceir(tr, idx) */ LJLIB_CF(jit_util_traceir) { GCtrace *T = jit_checktrace(L); IRRef ref = (IRRef)lj_lib_checkint(L, 2) + REF_BIAS; if (T && ref >= REF_BIAS && ref < T->nins) { IRIns *ir = &T->ir[ref]; int32_t m = lj_ir_mode[ir->o]; setintV(L->top-2, m); setintV(L->top-1, ir->ot); setintV(L->top++, (int32_t)ir->op1 - (irm_op1(m)==IRMref ? REF_BIAS : 0)); setintV(L->top++, (int32_t)ir->op2 - (irm_op2(m)==IRMref ? REF_BIAS : 0)); setintV(L->top++, ir->prev); return 5; } return 0; } /* local k, t [, slot] = jit.util.tracek(tr, idx) */ LJLIB_CF(jit_util_tracek) { GCtrace *T = jit_checktrace(L); IRRef ref = (IRRef)lj_lib_checkint(L, 2) + REF_BIAS; if (T && ref >= T->nk && ref < REF_BIAS) { IRIns *ir = &T->ir[ref]; int32_t slot = -1; if (ir->o == IR_KSLOT) { slot = ir->op2; ir = &T->ir[ir->op1]; } lj_ir_kvalue(L, L->top-2, ir); setintV(L->top-1, (int32_t)irt_type(ir->t)); if (slot == -1) return 2; setintV(L->top++, slot); return 3; } return 0; } /* local snap = jit.util.tracesnap(tr, sn) */ LJLIB_CF(jit_util_tracesnap) { GCtrace *T = jit_checktrace(L); SnapNo sn = (SnapNo)lj_lib_checkint(L, 2); if (T && sn < T->nsnap) { SnapShot *snap = &T->snap[sn]; SnapEntry *map = &T->snapmap[snap->mapofs]; MSize n, nent = snap->nent; GCtab *t; lua_createtable(L, nent+2, 0); t = tabV(L->top-1); setintV(lj_tab_setint(L, t, 0), (int32_t)snap->ref - REF_BIAS); setintV(lj_tab_setint(L, t, 1), (int32_t)snap->nslots); for (n = 0; n < nent; n++) setintV(lj_tab_setint(L, t, (int32_t)(n+2)), (int32_t)map[n]); setintV(lj_tab_setint(L, t, (int32_t)(nent+2)), (int32_t)SNAP(255, 0, 0)); return 1; } return 0; } /* local mcode, addr, loop = jit.util.tracemc(tr) */ LJLIB_CF(jit_util_tracemc) { GCtrace *T = jit_checktrace(L); if (T && T->mcode != NULL) { setstrV(L, L->top-1, lj_str_new(L, (const char *)T->mcode, T->szmcode)); setintptrV(L->top++, (intptr_t)(void *)T->mcode); setintV(L->top++, T->mcloop); return 3; } return 0; } /* local addr = jit.util.traceexitstub([tr,] exitno) */ LJLIB_CF(jit_util_traceexitstub) { #ifdef EXITSTUBS_PER_GROUP ExitNo exitno = (ExitNo)lj_lib_checkint(L, 1); jit_State *J = L2J(L); if (exitno < EXITSTUBS_PER_GROUP*LJ_MAX_EXITSTUBGR) { setintptrV(L->top-1, (intptr_t)(void *)exitstub_addr(J, exitno)); return 1; } #else if (L->top > L->base+1) { /* Don't throw for one-argument variant. */ GCtrace *T = jit_checktrace(L); ExitNo exitno = (ExitNo)lj_lib_checkint(L, 2); ExitNo maxexit = T->root ? T->nsnap+1 : T->nsnap; if (T && T->mcode != NULL && exitno < maxexit) { setintptrV(L->top-1, (intptr_t)(void *)exitstub_trace_addr(T, exitno)); return 1; } } #endif return 0; } /* local addr = jit.util.ircalladdr(idx) */ LJLIB_CF(jit_util_ircalladdr) { uint32_t idx = (uint32_t)lj_lib_checkint(L, 1); if (idx < IRCALL__MAX) { setintptrV(L->top-1, (intptr_t)(void *)lj_ir_callinfo[idx].func); return 1; } return 0; } #endif #include "lj_libdef.h" /* -- jit.opt module ------------------------------------------------------ */ #if LJ_HASJIT #define LJLIB_MODULE_jit_opt /* Parse optimization level. */ static int jitopt_level(jit_State *J, const char *str) { if (str[0] >= '0' && str[0] <= '9' && str[1] == '\0') { uint32_t flags; if (str[0] == '0') flags = JIT_F_OPT_0; else if (str[0] == '1') flags = JIT_F_OPT_1; else if (str[0] == '2') flags = JIT_F_OPT_2; else flags = JIT_F_OPT_3; J->flags = (J->flags & ~JIT_F_OPT_MASK) | flags; return 1; /* Ok. */ } return 0; /* No match. */ } /* Parse optimization flag. */ static int jitopt_flag(jit_State *J, const char *str) { const char *lst = JIT_F_OPTSTRING; uint32_t opt; int set = 1; if (str[0] == '+') { str++; } else if (str[0] == '-') { str++; set = 0; } else if (str[0] == 'n' && str[1] == 'o') { str += str[2] == '-' ? 3 : 2; set = 0; } for (opt = JIT_F_OPT_FIRST; ; opt <<= 1) { size_t len = *(const uint8_t *)lst; if (len == 0) break; if (strncmp(str, lst+1, len) == 0 && str[len] == '\0') { if (set) J->flags |= opt; else J->flags &= ~opt; return 1; /* Ok. */ } lst += 1+len; } return 0; /* No match. */ } /* Parse optimization parameter. */ static int jitopt_param(jit_State *J, const char *str) { const char *lst = JIT_P_STRING; int i; for (i = 0; i < JIT_P__MAX; i++) { size_t len = *(const uint8_t *)lst; lua_assert(len != 0); if (strncmp(str, lst+1, len) == 0 && str[len] == '=') { int32_t n = 0; const char *p = &str[len+1]; while (*p >= '0' && *p <= '9') n = n*10 + (*p++ - '0'); if (*p) return 0; /* Malformed number. */ J->param[i] = n; if (i == JIT_P_hotloop) lj_dispatch_init_hotcount(J2G(J)); return 1; /* Ok. */ } lst += 1+len; } return 0; /* No match. */ } /* jit.opt.start(flags...) */ LJLIB_CF(jit_opt_start) { jit_State *J = L2J(L); int nargs = (int)(L->top - L->base); if (nargs == 0) { J->flags = (J->flags & ~JIT_F_OPT_MASK) | JIT_F_OPT_DEFAULT; } else { int i; for (i = 1; i <= nargs; i++) { const char *str = strdata(lj_lib_checkstr(L, i)); if (!jitopt_level(J, str) && !jitopt_flag(J, str) && !jitopt_param(J, str)) lj_err_callerv(L, LJ_ERR_JITOPT, str); } } return 0; } #include "lj_libdef.h" #endif /* -- JIT compiler initialization ----------------------------------------- */ #if LJ_HASJIT /* Default values for JIT parameters. */ static const int32_t jit_param_default[JIT_P__MAX+1] = { #define JIT_PARAMINIT(len, name, value) (value), JIT_PARAMDEF(JIT_PARAMINIT) #undef JIT_PARAMINIT 0 }; #endif #if LJ_TARGET_ARM && LJ_TARGET_LINUX #include #endif /* Arch-dependent CPU detection. */ static uint32_t jit_cpudetect(lua_State *L) { uint32_t flags = 0; #if LJ_TARGET_X86ORX64 uint32_t vendor[4]; uint32_t features[4]; if (lj_vm_cpuid(0, vendor) && lj_vm_cpuid(1, features)) { #if !LJ_HASJIT #define JIT_F_CMOV 1 #define JIT_F_SSE2 2 #endif flags |= ((features[3] >> 15)&1) * JIT_F_CMOV; flags |= ((features[3] >> 26)&1) * JIT_F_SSE2; #if LJ_HASJIT flags |= ((features[2] >> 0)&1) * JIT_F_SSE3; flags |= ((features[2] >> 19)&1) * JIT_F_SSE4_1; if (vendor[2] == 0x6c65746e) { /* Intel. */ if ((features[0] & 0x0ff00f00) == 0x00000f00) /* P4. */ flags |= JIT_F_P4; /* Currently unused. */ else if ((features[0] & 0x0fff0ff0) == 0x000106c0) /* Atom. */ flags |= JIT_F_LEA_AGU; } else if (vendor[2] == 0x444d4163) { /* AMD. */ uint32_t fam = (features[0] & 0x0ff00f00); if (fam == 0x00000f00) /* K8. */ flags |= JIT_F_SPLIT_XMM; if (fam >= 0x00000f00) /* K8, K10. */ flags |= JIT_F_PREFER_IMUL; } #endif } /* Check for required instruction set support on x86 (unnecessary on x64). */ #if LJ_TARGET_X86 #if !defined(LUAJIT_CPU_NOCMOV) if (!(flags & JIT_F_CMOV)) luaL_error(L, "CPU not supported"); #endif #if defined(LUAJIT_CPU_SSE2) if (!(flags & JIT_F_SSE2)) luaL_error(L, "CPU does not support SSE2 (recompile without -DLUAJIT_CPU_SSE2)"); #endif #endif #elif LJ_TARGET_ARM #if LJ_HASJIT int ver = LJ_ARCH_VERSION; /* Compile-time ARM CPU detection. */ #if LJ_TARGET_LINUX if (ver < 70) { /* Runtime ARM CPU detection. */ struct utsname ut; uname(&ut); if (strncmp(ut.machine, "armv", 4) == 0) { if (ut.machine[4] >= '7') ver = 70; else if (ut.machine[4] == '6') ver = 60; } } #endif flags |= ver >= 70 ? JIT_F_ARMV7 : ver >= 61 ? JIT_F_ARMV6T2_ : ver >= 60 ? JIT_F_ARMV6_ : 0; flags |= LJ_ARCH_HASFPU == 0 ? 0 : ver >= 70 ? JIT_F_VFPV3 : JIT_F_VFPV2; #endif #elif LJ_TARGET_PPC #if LJ_HASJIT #if LJ_ARCH_SQRT flags |= JIT_F_SQRT; #endif #if LJ_ARCH_ROUND flags |= JIT_F_ROUND; #endif #endif #elif LJ_TARGET_PPCSPE /* Nothing to do. */ #elif LJ_TARGET_MIPS #if LJ_HASJIT /* Compile-time MIPS CPU detection. */ #if LJ_ARCH_VERSION >= 20 flags |= JIT_F_MIPS32R2; #endif /* Runtime MIPS CPU detection. */ #if defined(__GNUC__) if (!(flags & JIT_F_MIPS32R2)) { int x; /* On MIPS32R1 rotr is treated as srl. rotr r2,r2,1 -> srl r2,r2,1. */ __asm__("li $2, 1\n\t.long 0x00221042\n\tmove %0, $2" : "=r"(x) : : "$2"); if (x) flags |= JIT_F_MIPS32R2; /* Either 0x80000000 (R2) or 0 (R1). */ } #endif #endif #else #error "Missing CPU detection for this architecture" #endif UNUSED(L); return flags; } /* Initialize JIT compiler. */ static void jit_init(lua_State *L) { uint32_t flags = jit_cpudetect(L); #if LJ_HASJIT jit_State *J = L2J(L); #if LJ_TARGET_X86 /* Silently turn off the JIT compiler on CPUs without SSE2. */ if ((flags & JIT_F_SSE2)) #endif J->flags = flags | JIT_F_ON | JIT_F_OPT_DEFAULT; memcpy(J->param, jit_param_default, sizeof(J->param)); lj_dispatch_update(G(L)); #else UNUSED(flags); #endif } LUALIB_API int luaopen_jit(lua_State *L) { lua_pushliteral(L, LJ_OS_NAME); lua_pushliteral(L, LJ_ARCH_NAME); lua_pushinteger(L, LUAJIT_VERSION_NUM); lua_pushliteral(L, LUAJIT_VERSION); LJ_LIB_REG(L, LUA_JITLIBNAME, jit); #ifndef LUAJIT_DISABLE_JITUTIL LJ_LIB_REG(L, "jit.util", jit_util); #endif #if LJ_HASJIT LJ_LIB_REG(L, "jit.opt", jit_opt); #endif L->top -= 2; jit_init(L); return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_clib.c0000644000175000017500000002414713122010155016443 0ustar philphil/* ** FFI C library loader. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_tab.h" #include "lj_str.h" #include "lj_udata.h" #include "lj_ctype.h" #include "lj_cconv.h" #include "lj_cdata.h" #include "lj_clib.h" /* -- OS-specific functions ----------------------------------------------- */ #if LJ_TARGET_DLOPEN #include #include #if defined(RTLD_DEFAULT) #define CLIB_DEFHANDLE RTLD_DEFAULT #elif LJ_TARGET_OSX || LJ_TARGET_BSD #define CLIB_DEFHANDLE ((void *)(intptr_t)-2) #else #define CLIB_DEFHANDLE NULL #endif LJ_NORET LJ_NOINLINE static void clib_error_(lua_State *L) { lj_err_callermsg(L, dlerror()); } #define clib_error(L, fmt, name) clib_error_(L) #if LJ_TARGET_CYGWIN #define CLIB_SOPREFIX "cyg" #else #define CLIB_SOPREFIX "lib" #endif #if LJ_TARGET_OSX #define CLIB_SOEXT "%s.dylib" #elif LJ_TARGET_CYGWIN #define CLIB_SOEXT "%s.dll" #else #define CLIB_SOEXT "%s.so" #endif static const char *clib_extname(lua_State *L, const char *name) { if (!strchr(name, '/') #if LJ_TARGET_CYGWIN && !strchr(name, '\\') #endif ) { if (!strchr(name, '.')) { name = lj_str_pushf(L, CLIB_SOEXT, name); L->top--; #if LJ_TARGET_CYGWIN } else { return name; #endif } if (!(name[0] == CLIB_SOPREFIX[0] && name[1] == CLIB_SOPREFIX[1] && name[2] == CLIB_SOPREFIX[2])) { name = lj_str_pushf(L, CLIB_SOPREFIX "%s", name); L->top--; } } return name; } /* Check for a recognized ld script line. */ static const char *clib_check_lds(lua_State *L, const char *buf) { char *p, *e; if ((!strncmp(buf, "GROUP", 5) || !strncmp(buf, "INPUT", 5)) && (p = strchr(buf, '('))) { while (*++p == ' ') ; for (e = p; *e && *e != ' ' && *e != ')'; e++) ; return strdata(lj_str_new(L, p, e-p)); } return NULL; } /* Quick and dirty solution to resolve shared library name from ld script. */ static const char *clib_resolve_lds(lua_State *L, const char *name) { FILE *fp = fopen(name, "r"); const char *p = NULL; if (fp) { char buf[256]; if (fgets(buf, sizeof(buf), fp)) { if (!strncmp(buf, "/* GNU ld script", 16)) { /* ld script magic? */ while (fgets(buf, sizeof(buf), fp)) { /* Check all lines. */ p = clib_check_lds(L, buf); if (p) break; } } else { /* Otherwise check only the first line. */ p = clib_check_lds(L, buf); } } fclose(fp); } return p; } static void *clib_loadlib(lua_State *L, const char *name, int global) { void *h = dlopen(clib_extname(L, name), RTLD_LAZY | (global?RTLD_GLOBAL:RTLD_LOCAL)); if (!h) { const char *e, *err = dlerror(); if (*err == '/' && (e = strchr(err, ':')) && (name = clib_resolve_lds(L, strdata(lj_str_new(L, err, e-err))))) { h = dlopen(name, RTLD_LAZY | (global?RTLD_GLOBAL:RTLD_LOCAL)); if (h) return h; err = dlerror(); } lj_err_callermsg(L, err); } return h; } static void clib_unloadlib(CLibrary *cl) { if (cl->handle && cl->handle != CLIB_DEFHANDLE) dlclose(cl->handle); } static void *clib_getsym(CLibrary *cl, const char *name) { void *p = dlsym(cl->handle, name); return p; } #elif LJ_TARGET_WINDOWS #define WIN32_LEAN_AND_MEAN #include #ifndef GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS #define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 4 #define GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT 2 BOOL WINAPI GetModuleHandleExA(DWORD, LPCSTR, HMODULE*); #endif #define CLIB_DEFHANDLE ((void *)-1) /* Default libraries. */ enum { CLIB_HANDLE_EXE, CLIB_HANDLE_DLL, CLIB_HANDLE_CRT, CLIB_HANDLE_KERNEL32, CLIB_HANDLE_USER32, CLIB_HANDLE_GDI32, CLIB_HANDLE_MAX }; static void *clib_def_handle[CLIB_HANDLE_MAX]; LJ_NORET LJ_NOINLINE static void clib_error(lua_State *L, const char *fmt, const char *name) { DWORD err = GetLastError(); char buf[128]; if (!FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS|FORMAT_MESSAGE_FROM_SYSTEM, NULL, err, 0, buf, sizeof(buf), NULL)) buf[0] = '\0'; lj_err_callermsg(L, lj_str_pushf(L, fmt, name, buf)); } static int clib_needext(const char *s) { while (*s) { if (*s == '/' || *s == '\\' || *s == '.') return 0; s++; } return 1; } static const char *clib_extname(lua_State *L, const char *name) { if (clib_needext(name)) { name = lj_str_pushf(L, "%s.dll", name); L->top--; } return name; } static void *clib_loadlib(lua_State *L, const char *name, int global) { DWORD oldwerr = GetLastError(); void *h = (void *)LoadLibraryA(clib_extname(L, name)); if (!h) clib_error(L, "cannot load module " LUA_QS ": %s", name); SetLastError(oldwerr); UNUSED(global); return h; } static void clib_unloadlib(CLibrary *cl) { if (cl->handle == CLIB_DEFHANDLE) { MSize i; for (i = CLIB_HANDLE_KERNEL32; i < CLIB_HANDLE_MAX; i++) { void *h = clib_def_handle[i]; if (h) { clib_def_handle[i] = NULL; FreeLibrary((HINSTANCE)h); } } } else if (cl->handle) { FreeLibrary((HINSTANCE)cl->handle); } } static void *clib_getsym(CLibrary *cl, const char *name) { void *p = NULL; if (cl->handle == CLIB_DEFHANDLE) { /* Search default libraries. */ MSize i; for (i = 0; i < CLIB_HANDLE_MAX; i++) { HINSTANCE h = (HINSTANCE)clib_def_handle[i]; if (!(void *)h) { /* Resolve default library handles (once). */ switch (i) { case CLIB_HANDLE_EXE: GetModuleHandleExA(GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT, NULL, &h); break; case CLIB_HANDLE_DLL: GetModuleHandleExA(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS|GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT, (const char *)clib_def_handle, &h); break; case CLIB_HANDLE_CRT: GetModuleHandleExA(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS|GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT, (const char *)&_fmode, &h); break; case CLIB_HANDLE_KERNEL32: h = LoadLibraryA("kernel32.dll"); break; case CLIB_HANDLE_USER32: h = LoadLibraryA("user32.dll"); break; case CLIB_HANDLE_GDI32: h = LoadLibraryA("gdi32.dll"); break; } if (!h) continue; clib_def_handle[i] = (void *)h; } p = (void *)GetProcAddress(h, name); if (p) break; } } else { p = (void *)GetProcAddress((HINSTANCE)cl->handle, name); } return p; } #else #define CLIB_DEFHANDLE NULL LJ_NORET LJ_NOINLINE static void clib_error(lua_State *L, const char *fmt, const char *name) { lj_err_callermsg(L, lj_str_pushf(L, fmt, name, "no support for this OS")); } static void *clib_loadlib(lua_State *L, const char *name, int global) { lj_err_callermsg(L, "no support for loading dynamic libraries for this OS"); UNUSED(name); UNUSED(global); return NULL; } static void clib_unloadlib(CLibrary *cl) { UNUSED(cl); } static void *clib_getsym(CLibrary *cl, const char *name) { UNUSED(cl); UNUSED(name); return NULL; } #endif /* -- C library indexing -------------------------------------------------- */ #if LJ_TARGET_X86 && LJ_ABI_WIN /* Compute argument size for fastcall/stdcall functions. */ static CTSize clib_func_argsize(CTState *cts, CType *ct) { CTSize n = 0; while (ct->sib) { CType *d; ct = ctype_get(cts, ct->sib); if (ctype_isfield(ct->info)) { d = ctype_rawchild(cts, ct); n += ((d->size + 3) & ~3); } } return n; } #endif /* Get redirected or mangled external symbol. */ static const char *clib_extsym(CTState *cts, CType *ct, GCstr *name) { if (ct->sib) { CType *ctf = ctype_get(cts, ct->sib); if (ctype_isxattrib(ctf->info, CTA_REDIR)) return strdata(gco2str(gcref(ctf->name))); } return strdata(name); } /* Index a C library by name. */ TValue *lj_clib_index(lua_State *L, CLibrary *cl, GCstr *name) { TValue *tv = lj_tab_setstr(L, cl->cache, name); if (LJ_UNLIKELY(tvisnil(tv))) { CTState *cts = ctype_cts(L); CType *ct; CTypeID id = lj_ctype_getname(cts, &ct, name, CLNS_INDEX); if (!id) lj_err_callerv(L, LJ_ERR_FFI_NODECL, strdata(name)); if (ctype_isconstval(ct->info)) { CType *ctt = ctype_child(cts, ct); lua_assert(ctype_isinteger(ctt->info) && ctt->size <= 4); if ((ctt->info & CTF_UNSIGNED) && (int32_t)ct->size < 0) setnumV(tv, (lua_Number)(uint32_t)ct->size); else setintV(tv, (int32_t)ct->size); } else { const char *sym = clib_extsym(cts, ct, name); #if LJ_TARGET_WINDOWS DWORD oldwerr = GetLastError(); #endif void *p = clib_getsym(cl, sym); GCcdata *cd; lua_assert(ctype_isfunc(ct->info) || ctype_isextern(ct->info)); #if LJ_TARGET_X86 && LJ_ABI_WIN /* Retry with decorated name for fastcall/stdcall functions. */ if (!p && ctype_isfunc(ct->info)) { CTInfo cconv = ctype_cconv(ct->info); if (cconv == CTCC_FASTCALL || cconv == CTCC_STDCALL) { CTSize sz = clib_func_argsize(cts, ct); const char *symd = lj_str_pushf(L, cconv == CTCC_FASTCALL ? "@%s@%d" : "_%s@%d", sym, sz); L->top--; p = clib_getsym(cl, symd); } } #endif if (!p) clib_error(L, "cannot resolve symbol " LUA_QS ": %s", sym); #if LJ_TARGET_WINDOWS SetLastError(oldwerr); #endif cd = lj_cdata_new(cts, id, CTSIZE_PTR); *(void **)cdataptr(cd) = p; setcdataV(L, tv, cd); } } return tv; } /* -- C library management ------------------------------------------------ */ /* Create a new CLibrary object and push it on the stack. */ static CLibrary *clib_new(lua_State *L, GCtab *mt) { GCtab *t = lj_tab_new(L, 0, 0); GCudata *ud = lj_udata_new(L, sizeof(CLibrary), t); CLibrary *cl = (CLibrary *)uddata(ud); cl->cache = t; ud->udtype = UDTYPE_FFI_CLIB; /* NOBARRIER: The GCudata is new (marked white). */ setgcref(ud->metatable, obj2gco(mt)); setudataV(L, L->top++, ud); return cl; } /* Load a C library. */ void lj_clib_load(lua_State *L, GCtab *mt, GCstr *name, int global) { void *handle = clib_loadlib(L, strdata(name), global); CLibrary *cl = clib_new(L, mt); cl->handle = handle; } /* Unload a C library. */ void lj_clib_unload(CLibrary *cl) { clib_unloadlib(cl); cl->handle = NULL; } /* Create the default C library object. */ void lj_clib_default(lua_State *L, GCtab *mt) { CLibrary *cl = clib_new(L, mt); cl->handle = CLIB_DEFHANDLE; } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/luaconf.h0000644000175000017500000001123213122010155016470 0ustar philphil/* ** Configuration header. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef luaconf_h #define luaconf_h #ifndef WINVER #define WINVER 0x0501 #endif #include #include /* Default path for loading Lua and C modules with require(). */ #if defined(_WIN32) /* ** In Windows, any exclamation mark ('!') in the path is replaced by the ** path of the directory of the executable file of the current process. */ #define LUA_LDIR "!\\lua\\" #define LUA_CDIR "!\\" #define LUA_PATH_DEFAULT \ ".\\?.lua;" LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" #define LUA_CPATH_DEFAULT \ ".\\?.dll;" LUA_CDIR"?.dll;" LUA_CDIR"loadall.dll" #else /* ** Note to distribution maintainers: do NOT patch the following lines! ** Please read ../doc/install.html#distro and pass PREFIX=/usr instead. */ #ifndef LUA_MULTILIB #define LUA_MULTILIB "lib" #endif #ifndef LUA_LMULTILIB #define LUA_LMULTILIB "lib" #endif #define LUA_LROOT "/usr/local" #define LUA_LUADIR "/lua/5.1/" #define LUA_LJDIR "/luajit-2.0.4/" #ifdef LUA_ROOT #define LUA_JROOT LUA_ROOT #define LUA_RLDIR LUA_ROOT "/share" LUA_LUADIR #define LUA_RCDIR LUA_ROOT "/" LUA_MULTILIB LUA_LUADIR #define LUA_RLPATH ";" LUA_RLDIR "?.lua;" LUA_RLDIR "?/init.lua" #define LUA_RCPATH ";" LUA_RCDIR "?.so" #else #define LUA_JROOT LUA_LROOT #define LUA_RLPATH #define LUA_RCPATH #endif #define LUA_JPATH ";" LUA_JROOT "/share" LUA_LJDIR "?.lua" #define LUA_LLDIR LUA_LROOT "/share" LUA_LUADIR #define LUA_LCDIR LUA_LROOT "/" LUA_LMULTILIB LUA_LUADIR #define LUA_LLPATH ";" LUA_LLDIR "?.lua;" LUA_LLDIR "?/init.lua" #define LUA_LCPATH1 ";" LUA_LCDIR "?.so" #define LUA_LCPATH2 ";" LUA_LCDIR "loadall.so" #define LUA_PATH_DEFAULT "./?.lua" LUA_JPATH LUA_LLPATH LUA_RLPATH #define LUA_CPATH_DEFAULT "./?.so" LUA_LCPATH1 LUA_RCPATH LUA_LCPATH2 #endif /* Environment variable names for path overrides and initialization code. */ #define LUA_PATH "LUA_PATH" #define LUA_CPATH "LUA_CPATH" #define LUA_INIT "LUA_INIT" /* Special file system characters. */ #if defined(_WIN32) #define LUA_DIRSEP "\\" #else #define LUA_DIRSEP "/" #endif #define LUA_PATHSEP ";" #define LUA_PATH_MARK "?" #define LUA_EXECDIR "!" #define LUA_IGMARK "-" #define LUA_PATH_CONFIG \ LUA_DIRSEP "\n" LUA_PATHSEP "\n" LUA_PATH_MARK "\n" \ LUA_EXECDIR "\n" LUA_IGMARK /* Quoting in error messages. */ #define LUA_QL(x) "'" x "'" #define LUA_QS LUA_QL("%s") /* Various tunables. */ #define LUAI_MAXSTACK 65500 /* Max. # of stack slots for a thread (<64K). */ #define LUAI_MAXCSTACK 8000 /* Max. # of stack slots for a C func (<10K). */ #define LUAI_GCPAUSE 200 /* Pause GC until memory is at 200%. */ #define LUAI_GCMUL 200 /* Run GC at 200% of allocation speed. */ #define LUA_MAXCAPTURES 32 /* Max. pattern captures. */ /* Compatibility with older library function names. */ #define LUA_COMPAT_MOD /* OLD: math.mod, NEW: math.fmod */ #define LUA_COMPAT_GFIND /* OLD: string.gfind, NEW: string.gmatch */ /* Configuration for the frontend (the luajit executable). */ #if defined(luajit_c) #define LUA_PROGNAME "luajit" /* Fallback frontend name. */ #define LUA_PROMPT "> " /* Interactive prompt. */ #define LUA_PROMPT2 ">> " /* Continuation prompt. */ #define LUA_MAXINPUT 512 /* Max. input line length. */ #endif /* Note: changing the following defines breaks the Lua 5.1 ABI. */ #define LUA_INTEGER ptrdiff_t #define LUA_IDSIZE 60 /* Size of lua_Debug.short_src. */ /* ** Size of lauxlib and io.* on-stack buffers. Weird workaround to avoid using ** unreasonable amounts of stack space, but still retain ABI compatibility. ** Blame Lua for depending on BUFSIZ in the ABI, blame **** for wrecking it. */ #define LUAL_BUFFERSIZE (BUFSIZ > 16384 ? 8192 : BUFSIZ) /* The following defines are here only for compatibility with luaconf.h ** from the standard Lua distribution. They must not be changed for LuaJIT. */ #define LUA_NUMBER_DOUBLE #define LUA_NUMBER double #define LUAI_UACNUMBER double #define LUA_NUMBER_SCAN "%lf" #define LUA_NUMBER_FMT "%.14g" #define lua_number2str(s, n) sprintf((s), LUA_NUMBER_FMT, (n)) #define LUAI_MAXNUMBER2STR 32 #define LUA_INTFRMLEN "l" #define LUA_INTFRM_T long /* Linkage of public API functions. */ #if defined(LUA_BUILD_AS_DLL) #if defined(LUA_CORE) || defined(LUA_LIB) #define LUA_API __declspec(dllexport) #else #define LUA_API __declspec(dllimport) #endif #else #define LUA_API extern #endif #define LUALIB_API LUA_API /* Support for internal assertions. */ #if defined(LUA_USE_ASSERT) || defined(LUA_USE_APICHECK) #include #endif #ifdef LUA_USE_ASSERT #define lua_assert(x) assert(x) #endif #ifdef LUA_USE_APICHECK #define luai_apicheck(L, o) { (void)L; assert(o); } #else #define luai_apicheck(L, o) { (void)L; } #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/vm_ppcspe.dasc0000644000175000017500000031357313122010155017535 0ustar philphil|// Low-level VM code for PowerPC/e500 CPUs. |// Bytecode interpreter, fast functions and helper functions. |// Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h | |.arch ppc |.section code_op, code_sub | |.actionlist build_actionlist |.globals GLOB_ |.globalnames globnames |.externnames extnames | |// Note: The ragged indentation of the instructions is intentional. |// The starting columns indicate data dependencies. | |//----------------------------------------------------------------------- | |// Fixed register assignments for the interpreter. |// Don't use: r1 = sp, r2 and r13 = reserved and/or small data area ptr | |// The following must be C callee-save (but BASE is often refetched). |.define BASE, r14 // Base of current Lua stack frame. |.define KBASE, r15 // Constants of current Lua function. |.define PC, r16 // Next PC. |.define DISPATCH, r17 // Opcode dispatch table. |.define LREG, r18 // Register holding lua_State (also in SAVE_L). |.define MULTRES, r19 // Size of multi-result: (nresults+1)*8. | |// Constants for vectorized type-comparisons (hi+low GPR). C callee-save. |.define TISNUM, r22 |.define TISSTR, r23 |.define TISTAB, r24 |.define TISFUNC, r25 |.define TISNIL, r26 |.define TOBIT, r27 |.define ZERO, TOBIT // Zero in lo word. | |// The following temporaries are not saved across C calls, except for RA. |.define RA, r20 // Callee-save. |.define RB, r10 |.define RC, r11 |.define RD, r12 |.define INS, r7 // Overlaps CARG5. | |.define TMP0, r0 |.define TMP1, r8 |.define TMP2, r9 |.define TMP3, r6 // Overlaps CARG4. | |// Saved temporaries. |.define SAVE0, r21 | |// Calling conventions. |.define CARG1, r3 |.define CARG2, r4 |.define CARG3, r5 |.define CARG4, r6 // Overlaps TMP3. |.define CARG5, r7 // Overlaps INS. | |.define CRET1, r3 |.define CRET2, r4 | |// Stack layout while in interpreter. Must match with lj_frame.h. |.define SAVE_LR, 188(sp) |.define CFRAME_SPACE, 184 // Delta for sp. |// Back chain for sp: 184(sp) <-- sp entering interpreter |.define SAVE_r31, 176(sp) // 64 bit register saves. |.define SAVE_r30, 168(sp) |.define SAVE_r29, 160(sp) |.define SAVE_r28, 152(sp) |.define SAVE_r27, 144(sp) |.define SAVE_r26, 136(sp) |.define SAVE_r25, 128(sp) |.define SAVE_r24, 120(sp) |.define SAVE_r23, 112(sp) |.define SAVE_r22, 104(sp) |.define SAVE_r21, 96(sp) |.define SAVE_r20, 88(sp) |.define SAVE_r19, 80(sp) |.define SAVE_r18, 72(sp) |.define SAVE_r17, 64(sp) |.define SAVE_r16, 56(sp) |.define SAVE_r15, 48(sp) |.define SAVE_r14, 40(sp) |.define SAVE_CR, 36(sp) |.define UNUSED1, 32(sp) |.define SAVE_ERRF, 28(sp) // 32 bit C frame info. |.define SAVE_NRES, 24(sp) |.define SAVE_CFRAME, 20(sp) |.define SAVE_L, 16(sp) |.define SAVE_PC, 12(sp) |.define SAVE_MULTRES, 8(sp) |// Next frame lr: 4(sp) |// Back chain for sp: 0(sp) <-- sp while in interpreter | |.macro save_, reg; evstdd reg, SAVE_..reg; .endmacro |.macro rest_, reg; evldd reg, SAVE_..reg; .endmacro | |.macro saveregs | stwu sp, -CFRAME_SPACE(sp) | save_ r14; save_ r15; save_ r16; save_ r17; save_ r18; save_ r19 | mflr r0; mfcr r12 | save_ r20; save_ r21; save_ r22; save_ r23; save_ r24; save_ r25 | stw r0, SAVE_LR; stw r12, SAVE_CR | save_ r26; save_ r27; save_ r28; save_ r29; save_ r30; save_ r31 |.endmacro | |.macro restoreregs | lwz r0, SAVE_LR; lwz r12, SAVE_CR | rest_ r14; rest_ r15; rest_ r16; rest_ r17; rest_ r18; rest_ r19 | mtlr r0; mtcrf 0x38, r12 | rest_ r20; rest_ r21; rest_ r22; rest_ r23; rest_ r24; rest_ r25 | rest_ r26; rest_ r27; rest_ r28; rest_ r29; rest_ r30; rest_ r31 | addi sp, sp, CFRAME_SPACE |.endmacro | |// Type definitions. Some of these are only used for documentation. |.type L, lua_State, LREG |.type GL, global_State |.type TVALUE, TValue |.type GCOBJ, GCobj |.type STR, GCstr |.type TAB, GCtab |.type LFUNC, GCfuncL |.type CFUNC, GCfuncC |.type PROTO, GCproto |.type UPVAL, GCupval |.type NODE, Node |.type NARGS8, int |.type TRACE, GCtrace | |//----------------------------------------------------------------------- | |// These basic macros should really be part of DynASM. |.macro srwi, rx, ry, n; rlwinm rx, ry, 32-n, n, 31; .endmacro |.macro slwi, rx, ry, n; rlwinm rx, ry, n, 0, 31-n; .endmacro |.macro rotlwi, rx, ry, n; rlwinm rx, ry, n, 0, 31; .endmacro |.macro rotlw, rx, ry, rn; rlwnm rx, ry, rn, 0, 31; .endmacro |.macro subi, rx, ry, i; addi rx, ry, -i; .endmacro | |// Trap for not-yet-implemented parts. |.macro NYI; tw 4, sp, sp; .endmacro | |//----------------------------------------------------------------------- | |// Access to frame relative to BASE. |.define FRAME_PC, -8 |.define FRAME_FUNC, -4 | |// Instruction decode. |.macro decode_OP4, dst, ins; rlwinm dst, ins, 2, 22, 29; .endmacro |.macro decode_RA8, dst, ins; rlwinm dst, ins, 27, 21, 28; .endmacro |.macro decode_RB8, dst, ins; rlwinm dst, ins, 11, 21, 28; .endmacro |.macro decode_RC8, dst, ins; rlwinm dst, ins, 19, 21, 28; .endmacro |.macro decode_RD8, dst, ins; rlwinm dst, ins, 19, 13, 28; .endmacro | |.macro decode_OP1, dst, ins; rlwinm dst, ins, 0, 24, 31; .endmacro |.macro decode_RD4, dst, ins; rlwinm dst, ins, 18, 14, 29; .endmacro | |// Instruction fetch. |.macro ins_NEXT1 | lwz INS, 0(PC) | addi PC, PC, 4 |.endmacro |// Instruction decode+dispatch. |.macro ins_NEXT2 | decode_OP4 TMP1, INS | decode_RB8 RB, INS | decode_RD8 RD, INS | lwzx TMP0, DISPATCH, TMP1 | decode_RA8 RA, INS | decode_RC8 RC, INS | mtctr TMP0 | bctr |.endmacro |.macro ins_NEXT | ins_NEXT1 | ins_NEXT2 |.endmacro | |// Instruction footer. |.if 1 | // Replicated dispatch. Less unpredictable branches, but higher I-Cache use. | .define ins_next, ins_NEXT | .define ins_next_, ins_NEXT | .define ins_next1, ins_NEXT1 | .define ins_next2, ins_NEXT2 |.else | // Common dispatch. Lower I-Cache use, only one (very) unpredictable branch. | // Affects only certain kinds of benchmarks (and only with -j off). | .macro ins_next | b ->ins_next | .endmacro | .macro ins_next1 | .endmacro | .macro ins_next2 | b ->ins_next | .endmacro | .macro ins_next_ | ->ins_next: | ins_NEXT | .endmacro |.endif | |// Call decode and dispatch. |.macro ins_callt | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | lwz PC, LFUNC:RB->pc | lwz INS, 0(PC) | addi PC, PC, 4 | decode_OP4 TMP1, INS | decode_RA8 RA, INS | lwzx TMP0, DISPATCH, TMP1 | add RA, RA, BASE | mtctr TMP0 | bctr |.endmacro | |.macro ins_call | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, PC = caller PC | stw PC, FRAME_PC(BASE) | ins_callt |.endmacro | |//----------------------------------------------------------------------- | |// Macros to test operand types. |.macro checknum, reg; evcmpltu reg, TISNUM; .endmacro |.macro checkstr, reg; evcmpeq reg, TISSTR; .endmacro |.macro checktab, reg; evcmpeq reg, TISTAB; .endmacro |.macro checkfunc, reg; evcmpeq reg, TISFUNC; .endmacro |.macro checknil, reg; evcmpeq reg, TISNIL; .endmacro |.macro checkok, label; blt label; .endmacro |.macro checkfail, label; bge label; .endmacro |.macro checkanyfail, label; bns label; .endmacro |.macro checkallok, label; bso label; .endmacro | |.macro branch_RD | srwi TMP0, RD, 1 | add PC, PC, TMP0 | addis PC, PC, -(BCBIAS_J*4 >> 16) |.endmacro | |// Assumes DISPATCH is relative to GL. #define DISPATCH_GL(field) (GG_DISP2G + (int)offsetof(global_State, field)) #define DISPATCH_J(field) (GG_DISP2J + (int)offsetof(jit_State, field)) | #define PC2PROTO(field) ((int)offsetof(GCproto, field)-(int)sizeof(GCproto)) | |.macro hotloop | NYI |.endmacro | |.macro hotcall | NYI |.endmacro | |// Set current VM state. Uses TMP0. |.macro li_vmstate, st; li TMP0, ~LJ_VMST_..st; .endmacro |.macro st_vmstate; stw TMP0, DISPATCH_GL(vmstate)(DISPATCH); .endmacro | |// Move table write barrier back. Overwrites mark and tmp. |.macro barrierback, tab, mark, tmp | lwz tmp, DISPATCH_GL(gc.grayagain)(DISPATCH) | // Assumes LJ_GC_BLACK is 0x04. | rlwinm mark, mark, 0, 30, 28 // black2gray(tab) | stw tab, DISPATCH_GL(gc.grayagain)(DISPATCH) | stb mark, tab->marked | stw tmp, tab->gclist |.endmacro | |//----------------------------------------------------------------------- /* Generate subroutines used by opcodes and other parts of the VM. */ /* The .code_sub section should be last to help static branch prediction. */ static void build_subroutines(BuildCtx *ctx) { |.code_sub | |//----------------------------------------------------------------------- |//-- Return handling ---------------------------------------------------- |//----------------------------------------------------------------------- | |->vm_returnp: | // See vm_return. Also: TMP2 = previous base. | andi. TMP0, PC, FRAME_P | evsplati TMP1, LJ_TTRUE | beq ->cont_dispatch | | // Return from pcall or xpcall fast func. | lwz PC, FRAME_PC(TMP2) // Fetch PC of previous frame. | mr BASE, TMP2 // Restore caller base. | // Prepending may overwrite the pcall frame, so do it at the end. | stwu TMP1, FRAME_PC(RA) // Prepend true to results. | |->vm_returnc: | addi RD, RD, 8 // RD = (nresults+1)*8. | andi. TMP0, PC, FRAME_TYPE | cmpwi cr1, RD, 0 | li CRET1, LUA_YIELD | beq cr1, ->vm_unwind_c_eh | mr MULTRES, RD | beq ->BC_RET_Z // Handle regular return to Lua. | |->vm_return: | // BASE = base, RA = resultptr, RD/MULTRES = (nresults+1)*8, PC = return | // TMP0 = PC & FRAME_TYPE | cmpwi TMP0, FRAME_C | rlwinm TMP2, PC, 0, 0, 28 | li_vmstate C | sub TMP2, BASE, TMP2 // TMP2 = previous base. | bne ->vm_returnp | | addic. TMP1, RD, -8 | stw TMP2, L->base | lwz TMP2, SAVE_NRES | subi BASE, BASE, 8 | st_vmstate | slwi TMP2, TMP2, 3 | beq >2 |1: | addic. TMP1, TMP1, -8 | evldd TMP0, 0(RA) | addi RA, RA, 8 | evstdd TMP0, 0(BASE) | addi BASE, BASE, 8 | bne <1 | |2: | cmpw TMP2, RD // More/less results wanted? | bne >6 |3: | stw BASE, L->top // Store new top. | |->vm_leave_cp: | lwz TMP0, SAVE_CFRAME // Restore previous C frame. | li CRET1, 0 // Ok return status for vm_pcall. | stw TMP0, L->cframe | |->vm_leave_unw: | restoreregs | blr | |6: | ble >7 // Less results wanted? | // More results wanted. Check stack size and fill up results with nil. | lwz TMP1, L->maxstack | cmplw BASE, TMP1 | bge >8 | evstdd TISNIL, 0(BASE) | addi RD, RD, 8 | addi BASE, BASE, 8 | b <2 | |7: // Less results wanted. | sub TMP0, RD, TMP2 | cmpwi TMP2, 0 // LUA_MULTRET+1 case? | sub TMP0, BASE, TMP0 // Subtract the difference. | iseleq BASE, BASE, TMP0 // Either keep top or shrink it. | b <3 | |8: // Corner case: need to grow stack for filling up results. | // This can happen if: | // - A C function grows the stack (a lot). | // - The GC shrinks the stack in between. | // - A return back from a lua_call() with (high) nresults adjustment. | stw BASE, L->top // Save current top held in BASE (yes). | mr SAVE0, RD | mr CARG2, TMP2 | mr CARG1, L | bl extern lj_state_growstack // (lua_State *L, int n) | lwz TMP2, SAVE_NRES | mr RD, SAVE0 | slwi TMP2, TMP2, 3 | lwz BASE, L->top // Need the (realloced) L->top in BASE. | b <2 | |->vm_unwind_c: // Unwind C stack, return from vm_pcall. | // (void *cframe, int errcode) | mr sp, CARG1 | mr CRET1, CARG2 |->vm_unwind_c_eh: // Landing pad for external unwinder. | lwz L, SAVE_L | li TMP0, ~LJ_VMST_C | lwz GL:TMP1, L->glref | stw TMP0, GL:TMP1->vmstate | b ->vm_leave_unw | |->vm_unwind_ff: // Unwind C stack, return from ff pcall. | // (void *cframe) | rlwinm sp, CARG1, 0, 0, 29 |->vm_unwind_ff_eh: // Landing pad for external unwinder. | lwz L, SAVE_L | evsplati TISNUM, LJ_TISNUM+1 // Setup type comparison constants. | evsplati TISFUNC, LJ_TFUNC | lus TOBIT, 0x4338 | evsplati TISTAB, LJ_TTAB | li TMP0, 0 | lwz BASE, L->base | evmergelo TOBIT, TOBIT, TMP0 | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | evsplati TISSTR, LJ_TSTR | li TMP1, LJ_TFALSE | evsplati TISNIL, LJ_TNIL | li_vmstate INTERP | lwz PC, FRAME_PC(BASE) // Fetch PC of previous frame. | la RA, -8(BASE) // Results start at BASE-8. | addi DISPATCH, DISPATCH, GG_G2DISP | stw TMP1, 0(RA) // Prepend false to error message. | li RD, 16 // 2 results: false + error message. | st_vmstate | b ->vm_returnc | |//----------------------------------------------------------------------- |//-- Grow stack for calls ----------------------------------------------- |//----------------------------------------------------------------------- | |->vm_growstack_c: // Grow stack for C function. | li CARG2, LUA_MINSTACK | b >2 | |->vm_growstack_l: // Grow stack for Lua function. | // BASE = new base, RA = BASE+framesize*8, RC = nargs*8, PC = first PC | add RC, BASE, RC | sub RA, RA, BASE | stw BASE, L->base | addi PC, PC, 4 // Must point after first instruction. | stw RC, L->top | srwi CARG2, RA, 3 |2: | // L->base = new base, L->top = top | stw PC, SAVE_PC | mr CARG1, L | bl extern lj_state_growstack // (lua_State *L, int n) | lwz BASE, L->base | lwz RC, L->top | lwz LFUNC:RB, FRAME_FUNC(BASE) | sub RC, RC, BASE | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | ins_callt // Just retry the call. | |//----------------------------------------------------------------------- |//-- Entry points into the assembler VM --------------------------------- |//----------------------------------------------------------------------- | |->vm_resume: // Setup C frame and resume thread. | // (lua_State *L, TValue *base, int nres1 = 0, ptrdiff_t ef = 0) | saveregs | mr L, CARG1 | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | mr BASE, CARG2 | lbz TMP1, L->status | stw L, SAVE_L | li PC, FRAME_CP | addi TMP0, sp, CFRAME_RESUME | addi DISPATCH, DISPATCH, GG_G2DISP | stw CARG3, SAVE_NRES | cmplwi TMP1, 0 | stw CARG3, SAVE_ERRF | stw TMP0, L->cframe | stw CARG3, SAVE_CFRAME | stw CARG1, SAVE_PC // Any value outside of bytecode is ok. | beq >3 | | // Resume after yield (like a return). | mr RA, BASE | lwz BASE, L->base | evsplati TISNUM, LJ_TISNUM+1 // Setup type comparison constants. | lwz TMP1, L->top | evsplati TISFUNC, LJ_TFUNC | lus TOBIT, 0x4338 | evsplati TISTAB, LJ_TTAB | lwz PC, FRAME_PC(BASE) | li TMP2, 0 | evsplati TISSTR, LJ_TSTR | sub RD, TMP1, BASE | evmergelo TOBIT, TOBIT, TMP2 | stb CARG3, L->status | andi. TMP0, PC, FRAME_TYPE | li_vmstate INTERP | addi RD, RD, 8 | evsplati TISNIL, LJ_TNIL | mr MULTRES, RD | st_vmstate | beq ->BC_RET_Z | b ->vm_return | |->vm_pcall: // Setup protected C frame and enter VM. | // (lua_State *L, TValue *base, int nres1, ptrdiff_t ef) | saveregs | li PC, FRAME_CP | stw CARG4, SAVE_ERRF | b >1 | |->vm_call: // Setup C frame and enter VM. | // (lua_State *L, TValue *base, int nres1) | saveregs | li PC, FRAME_C | |1: // Entry point for vm_pcall above (PC = ftype). | lwz TMP1, L:CARG1->cframe | stw CARG3, SAVE_NRES | mr L, CARG1 | stw CARG1, SAVE_L | mr BASE, CARG2 | stw sp, L->cframe // Add our C frame to cframe chain. | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | stw CARG1, SAVE_PC // Any value outside of bytecode is ok. | stw TMP1, SAVE_CFRAME | addi DISPATCH, DISPATCH, GG_G2DISP | |3: // Entry point for vm_cpcall/vm_resume (BASE = base, PC = ftype). | lwz TMP2, L->base // TMP2 = old base (used in vmeta_call). | evsplati TISNUM, LJ_TISNUM+1 // Setup type comparison constants. | lwz TMP1, L->top | evsplati TISFUNC, LJ_TFUNC | add PC, PC, BASE | evsplati TISTAB, LJ_TTAB | lus TOBIT, 0x4338 | li TMP0, 0 | sub PC, PC, TMP2 // PC = frame delta + frame type | evsplati TISSTR, LJ_TSTR | sub NARGS8:RC, TMP1, BASE | evmergelo TOBIT, TOBIT, TMP0 | li_vmstate INTERP | evsplati TISNIL, LJ_TNIL | st_vmstate | |->vm_call_dispatch: | // TMP2 = old base, BASE = new base, RC = nargs*8, PC = caller PC | li TMP0, -8 | evlddx LFUNC:RB, BASE, TMP0 | checkfunc LFUNC:RB | checkfail ->vmeta_call | |->vm_call_dispatch_f: | ins_call | // BASE = new base, RB = func, RC = nargs*8, PC = caller PC | |->vm_cpcall: // Setup protected C frame, call C. | // (lua_State *L, lua_CFunction func, void *ud, lua_CPFunction cp) | saveregs | mr L, CARG1 | lwz TMP0, L:CARG1->stack | stw CARG1, SAVE_L | lwz TMP1, L->top | stw CARG1, SAVE_PC // Any value outside of bytecode is ok. | sub TMP0, TMP0, TMP1 // Compute -savestack(L, L->top). | lwz TMP1, L->cframe | stw sp, L->cframe // Add our C frame to cframe chain. | li TMP2, 0 | stw TMP0, SAVE_NRES // Neg. delta means cframe w/o frame. | stw TMP2, SAVE_ERRF // No error function. | stw TMP1, SAVE_CFRAME | mtctr CARG4 | bctrl // (lua_State *L, lua_CFunction func, void *ud) | mr. BASE, CRET1 | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | li PC, FRAME_CP | addi DISPATCH, DISPATCH, GG_G2DISP | bne <3 // Else continue with the call. | b ->vm_leave_cp // No base? Just remove C frame. | |//----------------------------------------------------------------------- |//-- Metamethod handling ------------------------------------------------ |//----------------------------------------------------------------------- | |// The lj_meta_* functions (except for lj_meta_cat) don't reallocate the |// stack, so BASE doesn't need to be reloaded across these calls. | |//-- Continuation dispatch ---------------------------------------------- | |->cont_dispatch: | // BASE = meta base, RA = resultptr, RD = (nresults+1)*8 | lwz TMP0, -12(BASE) // Continuation. | mr RB, BASE | mr BASE, TMP2 // Restore caller BASE. | lwz LFUNC:TMP1, FRAME_FUNC(TMP2) | cmplwi TMP0, 0 | lwz PC, -16(RB) // Restore PC from [cont|PC]. | beq >1 | subi TMP2, RD, 8 | lwz TMP1, LFUNC:TMP1->pc | evstddx TISNIL, RA, TMP2 // Ensure one valid arg. | lwz KBASE, PC2PROTO(k)(TMP1) | // BASE = base, RA = resultptr, RB = meta base | mtctr TMP0 | bctr // Jump to continuation. | |1: // Tail call from C function. | subi TMP1, RB, 16 | sub RC, TMP1, BASE | b ->vm_call_tail | |->cont_cat: // RA = resultptr, RB = meta base | lwz INS, -4(PC) | subi CARG2, RB, 16 | decode_RB8 SAVE0, INS | evldd TMP0, 0(RA) | add TMP1, BASE, SAVE0 | stw BASE, L->base | cmplw TMP1, CARG2 | sub CARG3, CARG2, TMP1 | decode_RA8 RA, INS | evstdd TMP0, 0(CARG2) | bne ->BC_CAT_Z | evstddx TMP0, BASE, RA | b ->cont_nop | |//-- Table indexing metamethods ----------------------------------------- | |->vmeta_tgets1: | evmergelo STR:RC, TISSTR, STR:RC | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | decode_RB8 RB, INS | evstdd STR:RC, 0(CARG3) | add CARG2, BASE, RB | b >1 | |->vmeta_tgets: | evmergelo TAB:RB, TISTAB, TAB:RB | la CARG2, DISPATCH_GL(tmptv)(DISPATCH) | evmergelo STR:RC, TISSTR, STR:RC | evstdd TAB:RB, 0(CARG2) | la CARG3, DISPATCH_GL(tmptv2)(DISPATCH) | evstdd STR:RC, 0(CARG3) | b >1 | |->vmeta_tgetb: // TMP0 = index | efdcfsi TMP0, TMP0 | decode_RB8 RB, INS | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | add CARG2, BASE, RB | evstdd TMP0, 0(CARG3) | b >1 | |->vmeta_tgetv: | decode_RB8 RB, INS | decode_RC8 RC, INS | add CARG2, BASE, RB | add CARG3, BASE, RC |1: | stw BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_tget // (lua_State *L, TValue *o, TValue *k) | // Returns TValue * (finished) or NULL (metamethod). | cmplwi CRET1, 0 | beq >3 | evldd TMP0, 0(CRET1) | evstddx TMP0, BASE, RA | ins_next | |3: // Call __index metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k | subfic TMP1, BASE, FRAME_CONT | lwz BASE, L->top | stw PC, -16(BASE) // [cont|PC] | add PC, TMP1, BASE | lwz LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | li NARGS8:RC, 16 // 2 args for func(t, k). | b ->vm_call_dispatch_f | |//----------------------------------------------------------------------- | |->vmeta_tsets1: | evmergelo STR:RC, TISSTR, STR:RC | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | decode_RB8 RB, INS | evstdd STR:RC, 0(CARG3) | add CARG2, BASE, RB | b >1 | |->vmeta_tsets: | evmergelo TAB:RB, TISTAB, TAB:RB | la CARG2, DISPATCH_GL(tmptv)(DISPATCH) | evmergelo STR:RC, TISSTR, STR:RC | evstdd TAB:RB, 0(CARG2) | la CARG3, DISPATCH_GL(tmptv2)(DISPATCH) | evstdd STR:RC, 0(CARG3) | b >1 | |->vmeta_tsetb: // TMP0 = index | efdcfsi TMP0, TMP0 | decode_RB8 RB, INS | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | add CARG2, BASE, RB | evstdd TMP0, 0(CARG3) | b >1 | |->vmeta_tsetv: | decode_RB8 RB, INS | decode_RC8 RC, INS | add CARG2, BASE, RB | add CARG3, BASE, RC |1: | stw BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_tset // (lua_State *L, TValue *o, TValue *k) | // Returns TValue * (finished) or NULL (metamethod). | cmplwi CRET1, 0 | evlddx TMP0, BASE, RA | beq >3 | // NOBARRIER: lj_meta_tset ensures the table is not black. | evstdd TMP0, 0(CRET1) | ins_next | |3: // Call __newindex metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k/(v) | subfic TMP1, BASE, FRAME_CONT | lwz BASE, L->top | stw PC, -16(BASE) // [cont|PC] | add PC, TMP1, BASE | lwz LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | li NARGS8:RC, 24 // 3 args for func(t, k, v) | evstdd TMP0, 16(BASE) // Copy value to third argument. | b ->vm_call_dispatch_f | |//-- Comparison metamethods --------------------------------------------- | |->vmeta_comp: | mr CARG1, L | subi PC, PC, 4 | add CARG2, BASE, RA | stw PC, SAVE_PC | add CARG3, BASE, RD | stw BASE, L->base | decode_OP1 CARG4, INS | bl extern lj_meta_comp // (lua_State *L, TValue *o1, *o2, int op) | // Returns 0/1 or TValue * (metamethod). |3: | cmplwi CRET1, 1 | bgt ->vmeta_binop |4: | lwz INS, 0(PC) | addi PC, PC, 4 | decode_RD4 TMP2, INS | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | add TMP2, TMP2, TMP3 | isellt PC, PC, TMP2 |->cont_nop: | ins_next | |->cont_ra: // RA = resultptr | lwz INS, -4(PC) | evldd TMP0, 0(RA) | decode_RA8 TMP1, INS | evstddx TMP0, BASE, TMP1 | b ->cont_nop | |->cont_condt: // RA = resultptr | lwz TMP0, 0(RA) | li TMP1, LJ_TTRUE | cmplw TMP1, TMP0 // Branch if result is true. | b <4 | |->cont_condf: // RA = resultptr | lwz TMP0, 0(RA) | li TMP1, LJ_TFALSE | cmplw TMP0, TMP1 // Branch if result is false. | b <4 | |->vmeta_equal: | // CARG2, CARG3, CARG4 are already set by BC_ISEQV/BC_ISNEV. | subi PC, PC, 4 | stw BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_equal // (lua_State *L, GCobj *o1, *o2, int ne) | // Returns 0/1 or TValue * (metamethod). | b <3 | |//-- Arithmetic metamethods --------------------------------------------- | |->vmeta_arith_vn: | add CARG3, BASE, RB | add CARG4, KBASE, RC | b >1 | |->vmeta_arith_nv: | add CARG3, KBASE, RC | add CARG4, BASE, RB | b >1 | |->vmeta_unm: | add CARG3, BASE, RD | mr CARG4, CARG3 | b >1 | |->vmeta_arith_vv: | add CARG3, BASE, RB | add CARG4, BASE, RC |1: | add CARG2, BASE, RA | stw BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | decode_OP1 CARG5, INS // Caveat: CARG5 overlaps INS. | bl extern lj_meta_arith // (lua_State *L, TValue *ra,*rb,*rc, BCReg op) | // Returns NULL (finished) or TValue * (metamethod). | cmplwi CRET1, 0 | beq ->cont_nop | | // Call metamethod for binary op. |->vmeta_binop: | // BASE = old base, CRET1 = new base, stack = cont/func/o1/o2 | sub TMP1, CRET1, BASE | stw PC, -16(CRET1) // [cont|PC] | mr TMP2, BASE | addi PC, TMP1, FRAME_CONT | mr BASE, CRET1 | li NARGS8:RC, 16 // 2 args for func(o1, o2). | b ->vm_call_dispatch | |->vmeta_len: #if LJ_52 | mr SAVE0, CARG1 #endif | add CARG2, BASE, RD | stw BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_len // (lua_State *L, TValue *o) | // Returns NULL (retry) or TValue * (metamethod base). #if LJ_52 | cmplwi CRET1, 0 | bne ->vmeta_binop // Binop call for compatibility. | mr CARG1, SAVE0 | b ->BC_LEN_Z #else | b ->vmeta_binop // Binop call for compatibility. #endif | |//-- Call metamethod ---------------------------------------------------- | |->vmeta_call: // Resolve and call __call metamethod. | // TMP2 = old base, BASE = new base, RC = nargs*8 | mr CARG1, L | stw TMP2, L->base // This is the callers base! | subi CARG2, BASE, 8 | stw PC, SAVE_PC | add CARG3, BASE, RC | mr SAVE0, NARGS8:RC | bl extern lj_meta_call // (lua_State *L, TValue *func, TValue *top) | lwz LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | addi NARGS8:RC, SAVE0, 8 // Got one more argument now. | ins_call | |->vmeta_callt: // Resolve __call for BC_CALLT. | // BASE = old base, RA = new base, RC = nargs*8 | mr CARG1, L | stw BASE, L->base | subi CARG2, RA, 8 | stw PC, SAVE_PC | add CARG3, RA, RC | mr SAVE0, NARGS8:RC | bl extern lj_meta_call // (lua_State *L, TValue *func, TValue *top) | lwz TMP1, FRAME_PC(BASE) | addi NARGS8:RC, SAVE0, 8 // Got one more argument now. | lwz LFUNC:RB, FRAME_FUNC(RA) // Guaranteed to be a function here. | b ->BC_CALLT_Z | |//-- Argument coercion for 'for' statement ------------------------------ | |->vmeta_for: | mr CARG1, L | stw BASE, L->base | mr CARG2, RA | stw PC, SAVE_PC | mr SAVE0, INS | bl extern lj_meta_for // (lua_State *L, TValue *base) |.if JIT | decode_OP1 TMP0, SAVE0 |.endif | decode_RA8 RA, SAVE0 |.if JIT | cmpwi TMP0, BC_JFORI |.endif | decode_RD8 RD, SAVE0 |.if JIT | beq =>BC_JFORI |.endif | b =>BC_FORI | |//----------------------------------------------------------------------- |//-- Fast functions ----------------------------------------------------- |//----------------------------------------------------------------------- | |.macro .ffunc, name |->ff_ .. name: |.endmacro | |.macro .ffunc_1, name |->ff_ .. name: | cmplwi NARGS8:RC, 8 | evldd CARG1, 0(BASE) | blt ->fff_fallback |.endmacro | |.macro .ffunc_2, name |->ff_ .. name: | cmplwi NARGS8:RC, 16 | evldd CARG1, 0(BASE) | evldd CARG2, 8(BASE) | blt ->fff_fallback |.endmacro | |.macro .ffunc_n, name | .ffunc_1 name | checknum CARG1 | checkfail ->fff_fallback |.endmacro | |.macro .ffunc_nn, name | .ffunc_2 name | evmergehi TMP0, CARG1, CARG2 | checknum TMP0 | checkanyfail ->fff_fallback |.endmacro | |// Inlined GC threshold check. Caveat: uses TMP0 and TMP1. |.macro ffgccheck | lwz TMP0, DISPATCH_GL(gc.total)(DISPATCH) | lwz TMP1, DISPATCH_GL(gc.threshold)(DISPATCH) | cmplw TMP0, TMP1 | bgel ->fff_gcstep |.endmacro | |//-- Base library: checks ----------------------------------------------- | |.ffunc assert | cmplwi NARGS8:RC, 8 | evldd TMP0, 0(BASE) | blt ->fff_fallback | evaddw TMP1, TISNIL, TISNIL // Synthesize LJ_TFALSE. | la RA, -8(BASE) | evcmpltu cr1, TMP0, TMP1 | lwz PC, FRAME_PC(BASE) | bge cr1, ->fff_fallback | evstdd TMP0, 0(RA) | addi RD, NARGS8:RC, 8 // Compute (nresults+1)*8. | beq ->fff_res // Done if exactly 1 argument. | li TMP1, 8 | subi RC, RC, 8 |1: | cmplw TMP1, RC | evlddx TMP0, BASE, TMP1 | evstddx TMP0, RA, TMP1 | addi TMP1, TMP1, 8 | bne <1 | b ->fff_res | |.ffunc type | cmplwi NARGS8:RC, 8 | lwz CARG1, 0(BASE) | blt ->fff_fallback | li TMP2, ~LJ_TNUMX | cmplw CARG1, TISNUM | not TMP1, CARG1 | isellt TMP1, TMP2, TMP1 | slwi TMP1, TMP1, 3 | la TMP2, CFUNC:RB->upvalue | evlddx STR:CRET1, TMP2, TMP1 | b ->fff_restv | |//-- Base library: getters and setters --------------------------------- | |.ffunc_1 getmetatable | checktab CARG1 | evmergehi TMP1, CARG1, CARG1 | checkfail >6 |1: // Field metatable must be at same offset for GCtab and GCudata! | lwz TAB:RB, TAB:CARG1->metatable |2: | evmr CRET1, TISNIL | cmplwi TAB:RB, 0 | lwz STR:RC, DISPATCH_GL(gcroot[GCROOT_MMNAME+MM_metatable])(DISPATCH) | beq ->fff_restv | lwz TMP0, TAB:RB->hmask | evmergelo CRET1, TISTAB, TAB:RB // Use metatable as default result. | lwz TMP1, STR:RC->hash | lwz NODE:TMP2, TAB:RB->node | evmergelo STR:RC, TISSTR, STR:RC | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | slwi TMP0, TMP1, 5 | slwi TMP1, TMP1, 3 | sub TMP1, TMP0, TMP1 | add NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) |3: // Rearranged logic, because we expect _not_ to find the key. | evldd TMP0, NODE:TMP2->key | evldd TMP1, NODE:TMP2->val | evcmpeq TMP0, STR:RC | lwz NODE:TMP2, NODE:TMP2->next | checkallok >5 | cmplwi NODE:TMP2, 0 | beq ->fff_restv // Not found, keep default result. | b <3 |5: | checknil TMP1 | checkok ->fff_restv // Ditto for nil value. | evmr CRET1, TMP1 // Return value of mt.__metatable. | b ->fff_restv | |6: | cmpwi TMP1, LJ_TUDATA | not TMP1, TMP1 | beq <1 | checknum CARG1 | slwi TMP1, TMP1, 2 | li TMP2, 4*~LJ_TNUMX | isellt TMP1, TMP2, TMP1 | la TMP2, DISPATCH_GL(gcroot[GCROOT_BASEMT])(DISPATCH) | lwzx TAB:RB, TMP2, TMP1 | b <2 | |.ffunc_2 setmetatable | // Fast path: no mt for table yet and not clearing the mt. | evmergehi TMP0, TAB:CARG1, TAB:CARG2 | checktab TMP0 | checkanyfail ->fff_fallback | lwz TAB:TMP1, TAB:CARG1->metatable | cmplwi TAB:TMP1, 0 | lbz TMP3, TAB:CARG1->marked | bne ->fff_fallback | andi. TMP0, TMP3, LJ_GC_BLACK // isblack(table) | stw TAB:CARG2, TAB:CARG1->metatable | beq ->fff_restv | barrierback TAB:CARG1, TMP3, TMP0 | b ->fff_restv | |.ffunc rawget | cmplwi NARGS8:RC, 16 | evldd CARG2, 0(BASE) | blt ->fff_fallback | checktab CARG2 | la CARG3, 8(BASE) | checkfail ->fff_fallback | mr CARG1, L | bl extern lj_tab_get // (lua_State *L, GCtab *t, cTValue *key) | // Returns cTValue *. | evldd CRET1, 0(CRET1) | b ->fff_restv | |//-- Base library: conversions ------------------------------------------ | |.ffunc tonumber | // Only handles the number case inline (without a base argument). | cmplwi NARGS8:RC, 8 | evldd CARG1, 0(BASE) | bne ->fff_fallback // Exactly one argument. | checknum CARG1 | checkok ->fff_restv | b ->fff_fallback | |.ffunc_1 tostring | // Only handles the string or number case inline. | checkstr CARG1 | // A __tostring method in the string base metatable is ignored. | checkok ->fff_restv // String key? | // Handle numbers inline, unless a number base metatable is present. | lwz TMP0, DISPATCH_GL(gcroot[GCROOT_BASEMT_NUM])(DISPATCH) | checknum CARG1 | cmplwi cr1, TMP0, 0 | stw BASE, L->base // Add frame since C call can throw. | crand 4*cr0+eq, 4*cr0+lt, 4*cr1+eq | stw PC, SAVE_PC // Redundant (but a defined value). | bne ->fff_fallback | ffgccheck | mr CARG1, L | mr CARG2, BASE | bl extern lj_str_fromnum // (lua_State *L, lua_Number *np) | // Returns GCstr *. | evmergelo STR:CRET1, TISSTR, STR:CRET1 | b ->fff_restv | |//-- Base library: iterators ------------------------------------------- | |.ffunc next | cmplwi NARGS8:RC, 8 | evldd CARG2, 0(BASE) | blt ->fff_fallback | evstddx TISNIL, BASE, NARGS8:RC // Set missing 2nd arg to nil. | checktab TAB:CARG2 | lwz PC, FRAME_PC(BASE) | checkfail ->fff_fallback | stw BASE, L->base // Add frame since C call can throw. | mr CARG1, L | stw BASE, L->top // Dummy frame length is ok. | la CARG3, 8(BASE) | stw PC, SAVE_PC | bl extern lj_tab_next // (lua_State *L, GCtab *t, TValue *key) | // Returns 0 at end of traversal. | cmplwi CRET1, 0 | evmr CRET1, TISNIL | beq ->fff_restv // End of traversal: return nil. | evldd TMP0, 8(BASE) // Copy key and value to results. | la RA, -8(BASE) | evldd TMP1, 16(BASE) | evstdd TMP0, 0(RA) | li RD, (2+1)*8 | evstdd TMP1, 8(RA) | b ->fff_res | |.ffunc_1 pairs | checktab TAB:CARG1 | lwz PC, FRAME_PC(BASE) | checkfail ->fff_fallback #if LJ_52 | lwz TAB:TMP2, TAB:CARG1->metatable | evldd CFUNC:TMP0, CFUNC:RB->upvalue[0] | cmplwi TAB:TMP2, 0 | la RA, -8(BASE) | bne ->fff_fallback #else | evldd CFUNC:TMP0, CFUNC:RB->upvalue[0] | la RA, -8(BASE) #endif | evstdd TISNIL, 8(BASE) | li RD, (3+1)*8 | evstdd CFUNC:TMP0, 0(RA) | b ->fff_res | |.ffunc_2 ipairs_aux | checktab TAB:CARG1 | lwz PC, FRAME_PC(BASE) | checkfail ->fff_fallback | checknum CARG2 | lus TMP3, 0x3ff0 | checkfail ->fff_fallback | efdctsi TMP2, CARG2 | lwz TMP0, TAB:CARG1->asize | evmergelo TMP3, TMP3, ZERO | lwz TMP1, TAB:CARG1->array | efdadd CARG2, CARG2, TMP3 | addi TMP2, TMP2, 1 | la RA, -8(BASE) | cmplw TMP0, TMP2 | slwi TMP3, TMP2, 3 | evstdd CARG2, 0(RA) | ble >2 // Not in array part? | evlddx TMP1, TMP1, TMP3 |1: | checknil TMP1 | li RD, (0+1)*8 | checkok ->fff_res // End of iteration, return 0 results. | li RD, (2+1)*8 | evstdd TMP1, 8(RA) | b ->fff_res |2: // Check for empty hash part first. Otherwise call C function. | lwz TMP0, TAB:CARG1->hmask | cmplwi TMP0, 0 | li RD, (0+1)*8 | beq ->fff_res | mr CARG2, TMP2 | bl extern lj_tab_getinth // (GCtab *t, int32_t key) | // Returns cTValue * or NULL. | cmplwi CRET1, 0 | li RD, (0+1)*8 | beq ->fff_res | evldd TMP1, 0(CRET1) | b <1 | |.ffunc_1 ipairs | checktab TAB:CARG1 | lwz PC, FRAME_PC(BASE) | checkfail ->fff_fallback #if LJ_52 | lwz TAB:TMP2, TAB:CARG1->metatable | evldd CFUNC:TMP0, CFUNC:RB->upvalue[0] | cmplwi TAB:TMP2, 0 | la RA, -8(BASE) | bne ->fff_fallback #else | evldd CFUNC:TMP0, CFUNC:RB->upvalue[0] | la RA, -8(BASE) #endif | evsplati TMP1, 0 | li RD, (3+1)*8 | evstdd TMP1, 8(BASE) | evstdd CFUNC:TMP0, 0(RA) | b ->fff_res | |//-- Base library: catch errors ---------------------------------------- | |.ffunc pcall | cmplwi NARGS8:RC, 8 | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | blt ->fff_fallback | mr TMP2, BASE | la BASE, 8(BASE) | // Remember active hook before pcall. | rlwinm TMP3, TMP3, 32-HOOK_ACTIVE_SHIFT, 31, 31 | subi NARGS8:RC, NARGS8:RC, 8 | addi PC, TMP3, 8+FRAME_PCALL | b ->vm_call_dispatch | |.ffunc_2 xpcall | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | mr TMP2, BASE | checkfunc CARG2 // Traceback must be a function. | checkfail ->fff_fallback | la BASE, 16(BASE) | // Remember active hook before pcall. | rlwinm TMP3, TMP3, 32-HOOK_ACTIVE_SHIFT, 31, 31 | evstdd CARG2, 0(TMP2) // Swap function and traceback. | subi NARGS8:RC, NARGS8:RC, 16 | evstdd CARG1, 8(TMP2) | addi PC, TMP3, 16+FRAME_PCALL | b ->vm_call_dispatch | |//-- Coroutine library -------------------------------------------------- | |.macro coroutine_resume_wrap, resume |.if resume |.ffunc_1 coroutine_resume | evmergehi TMP0, L:CARG1, L:CARG1 |.else |.ffunc coroutine_wrap_aux | lwz L:CARG1, CFUNC:RB->upvalue[0].gcr |.endif |.if resume | cmpwi TMP0, LJ_TTHREAD | bne ->fff_fallback |.endif | lbz TMP0, L:CARG1->status | lwz TMP1, L:CARG1->cframe | lwz CARG2, L:CARG1->top | cmplwi cr0, TMP0, LUA_YIELD | lwz TMP2, L:CARG1->base | cmplwi cr1, TMP1, 0 | lwz TMP0, L:CARG1->maxstack | cmplw cr7, CARG2, TMP2 | lwz PC, FRAME_PC(BASE) | crorc 4*cr6+lt, 4*cr0+gt, 4*cr1+eq // st>LUA_YIELD || cframe!=0 | add TMP2, CARG2, NARGS8:RC | crandc 4*cr6+gt, 4*cr7+eq, 4*cr0+eq // base==top && st!=LUA_YIELD | cmplw cr1, TMP2, TMP0 | cror 4*cr6+lt, 4*cr6+lt, 4*cr6+gt | stw PC, SAVE_PC | cror 4*cr6+lt, 4*cr6+lt, 4*cr1+gt // cond1 || cond2 || stackov | stw BASE, L->base | blt cr6, ->fff_fallback |1: |.if resume | addi BASE, BASE, 8 // Keep resumed thread in stack for GC. | subi NARGS8:RC, NARGS8:RC, 8 | subi TMP2, TMP2, 8 |.endif | stw TMP2, L:CARG1->top | li TMP1, 0 | stw BASE, L->top |2: // Move args to coroutine. | cmpw TMP1, NARGS8:RC | evlddx TMP0, BASE, TMP1 | beq >3 | evstddx TMP0, CARG2, TMP1 | addi TMP1, TMP1, 8 | b <2 |3: | li CARG3, 0 | mr L:SAVE0, L:CARG1 | li CARG4, 0 | bl ->vm_resume // (lua_State *L, TValue *base, 0, 0) | // Returns thread status. |4: | lwz TMP2, L:SAVE0->base | cmplwi CRET1, LUA_YIELD | lwz TMP3, L:SAVE0->top | li_vmstate INTERP | lwz BASE, L->base | st_vmstate | bgt >8 | sub RD, TMP3, TMP2 | lwz TMP0, L->maxstack | cmplwi RD, 0 | add TMP1, BASE, RD | beq >6 // No results? | cmplw TMP1, TMP0 | li TMP1, 0 | bgt >9 // Need to grow stack? | | subi TMP3, RD, 8 | stw TMP2, L:SAVE0->top // Clear coroutine stack. |5: // Move results from coroutine. | cmplw TMP1, TMP3 | evlddx TMP0, TMP2, TMP1 | evstddx TMP0, BASE, TMP1 | addi TMP1, TMP1, 8 | bne <5 |6: | andi. TMP0, PC, FRAME_TYPE |.if resume | li TMP1, LJ_TTRUE | la RA, -8(BASE) | stw TMP1, -8(BASE) // Prepend true to results. | addi RD, RD, 16 |.else | mr RA, BASE | addi RD, RD, 8 |.endif |7: | stw PC, SAVE_PC | mr MULTRES, RD | beq ->BC_RET_Z | b ->vm_return | |8: // Coroutine returned with error (at co->top-1). |.if resume | andi. TMP0, PC, FRAME_TYPE | la TMP3, -8(TMP3) | li TMP1, LJ_TFALSE | evldd TMP0, 0(TMP3) | stw TMP3, L:SAVE0->top // Remove error from coroutine stack. | li RD, (2+1)*8 | stw TMP1, -8(BASE) // Prepend false to results. | la RA, -8(BASE) | evstdd TMP0, 0(BASE) // Copy error message. | b <7 |.else | mr CARG1, L | mr CARG2, L:SAVE0 | bl extern lj_ffh_coroutine_wrap_err // (lua_State *L, lua_State *co) |.endif | |9: // Handle stack expansion on return from yield. | mr CARG1, L | srwi CARG2, RD, 3 | bl extern lj_state_growstack // (lua_State *L, int n) | li CRET1, 0 | b <4 |.endmacro | | coroutine_resume_wrap 1 // coroutine.resume | coroutine_resume_wrap 0 // coroutine.wrap | |.ffunc coroutine_yield | lwz TMP0, L->cframe | add TMP1, BASE, NARGS8:RC | stw BASE, L->base | andi. TMP0, TMP0, CFRAME_RESUME | stw TMP1, L->top | li CRET1, LUA_YIELD | beq ->fff_fallback | stw ZERO, L->cframe | stb CRET1, L->status | b ->vm_leave_unw | |//-- Math library ------------------------------------------------------- | |.ffunc_n math_abs | efdabs CRET1, CARG1 | // Fallthrough. | |->fff_restv: | // CRET1 = TValue result. | lwz PC, FRAME_PC(BASE) | la RA, -8(BASE) | evstdd CRET1, 0(RA) |->fff_res1: | // RA = results, PC = return. | li RD, (1+1)*8 |->fff_res: | // RA = results, RD = (nresults+1)*8, PC = return. | andi. TMP0, PC, FRAME_TYPE | mr MULTRES, RD | bne ->vm_return | lwz INS, -4(PC) | decode_RB8 RB, INS |5: | cmplw RB, RD // More results expected? | decode_RA8 TMP0, INS | bgt >6 | ins_next1 | // Adjust BASE. KBASE is assumed to be set for the calling frame. | sub BASE, RA, TMP0 | ins_next2 | |6: // Fill up results with nil. | subi TMP1, RD, 8 | addi RD, RD, 8 | evstddx TISNIL, RA, TMP1 | b <5 | |.macro math_extern, func | .ffunc math_ .. func | cmplwi NARGS8:RC, 8 | evldd CARG2, 0(BASE) | blt ->fff_fallback | checknum CARG2 | evmergehi CARG1, CARG2, CARG2 | checkfail ->fff_fallback | bl extern func@plt | evmergelo CRET1, CRET1, CRET2 | b ->fff_restv |.endmacro | |.macro math_extern2, func | .ffunc math_ .. func | cmplwi NARGS8:RC, 16 | evldd CARG2, 0(BASE) | evldd CARG4, 8(BASE) | blt ->fff_fallback | evmergehi CARG1, CARG4, CARG2 | checknum CARG1 | evmergehi CARG3, CARG4, CARG4 | checkanyfail ->fff_fallback | bl extern func@plt | evmergelo CRET1, CRET1, CRET2 | b ->fff_restv |.endmacro | |.macro math_round, func | .ffunc math_ .. func | cmplwi NARGS8:RC, 8 | evldd CARG2, 0(BASE) | blt ->fff_fallback | checknum CARG2 | evmergehi CARG1, CARG2, CARG2 | checkfail ->fff_fallback | lwz PC, FRAME_PC(BASE) | bl ->vm_..func.._hilo; | la RA, -8(BASE) | evstdd CRET2, 0(RA) | b ->fff_res1 |.endmacro | | math_round floor | math_round ceil | | math_extern sqrt | |.ffunc math_log | cmplwi NARGS8:RC, 8 | evldd CARG2, 0(BASE) | bne ->fff_fallback // Need exactly 1 argument. | checknum CARG2 | evmergehi CARG1, CARG2, CARG2 | checkfail ->fff_fallback | bl extern log@plt | evmergelo CRET1, CRET1, CRET2 | b ->fff_restv | | math_extern log10 | math_extern exp | math_extern sin | math_extern cos | math_extern tan | math_extern asin | math_extern acos | math_extern atan | math_extern sinh | math_extern cosh | math_extern tanh | math_extern2 pow | math_extern2 atan2 | math_extern2 fmod | |->ff_math_deg: |.ffunc_n math_rad | evldd CARG2, CFUNC:RB->upvalue[0] | efdmul CRET1, CARG1, CARG2 | b ->fff_restv | |.ffunc math_ldexp | cmplwi NARGS8:RC, 16 | evldd CARG2, 0(BASE) | evldd CARG4, 8(BASE) | blt ->fff_fallback | evmergehi CARG1, CARG4, CARG2 | checknum CARG1 | checkanyfail ->fff_fallback | efdctsi CARG3, CARG4 | bl extern ldexp@plt | evmergelo CRET1, CRET1, CRET2 | b ->fff_restv | |.ffunc math_frexp | cmplwi NARGS8:RC, 8 | evldd CARG2, 0(BASE) | blt ->fff_fallback | checknum CARG2 | evmergehi CARG1, CARG2, CARG2 | checkfail ->fff_fallback | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | lwz PC, FRAME_PC(BASE) | bl extern frexp@plt | lwz TMP1, DISPATCH_GL(tmptv)(DISPATCH) | evmergelo CRET1, CRET1, CRET2 | efdcfsi CRET2, TMP1 | la RA, -8(BASE) | evstdd CRET1, 0(RA) | li RD, (2+1)*8 | evstdd CRET2, 8(RA) | b ->fff_res | |.ffunc math_modf | cmplwi NARGS8:RC, 8 | evldd CARG2, 0(BASE) | blt ->fff_fallback | checknum CARG2 | evmergehi CARG1, CARG2, CARG2 | checkfail ->fff_fallback | la CARG3, -8(BASE) | lwz PC, FRAME_PC(BASE) | bl extern modf@plt | evmergelo CRET1, CRET1, CRET2 | la RA, -8(BASE) | evstdd CRET1, 0(BASE) | li RD, (2+1)*8 | b ->fff_res | |.macro math_minmax, name, cmpop | .ffunc_1 name | checknum CARG1 | li TMP1, 8 | checkfail ->fff_fallback |1: | evlddx CARG2, BASE, TMP1 | cmplw cr1, TMP1, NARGS8:RC | checknum CARG2 | bge cr1, ->fff_restv // Ok, since CRET1 = CARG1. | checkfail ->fff_fallback | cmpop CARG2, CARG1 | addi TMP1, TMP1, 8 | crmove 4*cr0+lt, 4*cr0+gt | evsel CARG1, CARG2, CARG1 | b <1 |.endmacro | | math_minmax math_min, efdtstlt | math_minmax math_max, efdtstgt | |//-- String library ----------------------------------------------------- | |.ffunc_1 string_len | checkstr STR:CARG1 | checkfail ->fff_fallback | lwz TMP0, STR:CARG1->len | efdcfsi CRET1, TMP0 | b ->fff_restv | |.ffunc string_byte // Only handle the 1-arg case here. | cmplwi NARGS8:RC, 8 | evldd STR:CARG1, 0(BASE) | bne ->fff_fallback // Need exactly 1 argument. | checkstr STR:CARG1 | la RA, -8(BASE) | checkfail ->fff_fallback | lwz TMP0, STR:CARG1->len | li RD, (0+1)*8 | lbz TMP1, STR:CARG1[1] // Access is always ok (NUL at end). | li TMP2, (1+1)*8 | cmplwi TMP0, 0 | lwz PC, FRAME_PC(BASE) | efdcfsi CRET1, TMP1 | iseleq RD, RD, TMP2 | evstdd CRET1, 0(RA) | b ->fff_res | |.ffunc string_char // Only handle the 1-arg case here. | ffgccheck | cmplwi NARGS8:RC, 8 | evldd CARG1, 0(BASE) | bne ->fff_fallback // Exactly 1 argument. | checknum CARG1 | la CARG2, DISPATCH_GL(tmptv)(DISPATCH) | checkfail ->fff_fallback | efdctsiz TMP0, CARG1 | li CARG3, 1 | cmplwi TMP0, 255 | stb TMP0, 0(CARG2) | bgt ->fff_fallback |->fff_newstr: | mr CARG1, L | stw BASE, L->base | stw PC, SAVE_PC | bl extern lj_str_new // (lua_State *L, char *str, size_t l) | // Returns GCstr *. | lwz BASE, L->base | evmergelo STR:CRET1, TISSTR, STR:CRET1 | b ->fff_restv | |.ffunc string_sub | ffgccheck | cmplwi NARGS8:RC, 16 | evldd CARG3, 16(BASE) | evldd STR:CARG1, 0(BASE) | blt ->fff_fallback | evldd CARG2, 8(BASE) | li TMP2, -1 | beq >1 | checknum CARG3 | checkfail ->fff_fallback | efdctsiz TMP2, CARG3 |1: | checknum CARG2 | checkfail ->fff_fallback | checkstr STR:CARG1 | efdctsiz TMP1, CARG2 | checkfail ->fff_fallback | lwz TMP0, STR:CARG1->len | cmplw TMP0, TMP2 // len < end? (unsigned compare) | add TMP3, TMP2, TMP0 | blt >5 |2: | cmpwi TMP1, 0 // start <= 0? | add TMP3, TMP1, TMP0 | ble >7 |3: | sub. CARG3, TMP2, TMP1 | addi CARG2, STR:CARG1, #STR-1 | addi CARG3, CARG3, 1 | add CARG2, CARG2, TMP1 | isellt CARG3, r0, CARG3 | b ->fff_newstr | |5: // Negative end or overflow. | cmpw TMP0, TMP2 | addi TMP3, TMP3, 1 | iselgt TMP2, TMP3, TMP0 // end = end > len ? len : end+len+1 | b <2 | |7: // Negative start or underflow. | cmpwi cr1, TMP3, 0 | iseleq TMP1, r0, TMP3 | isel TMP1, r0, TMP1, 4*cr1+lt | addi TMP1, TMP1, 1 // start = 1 + (start ? start+len : 0) | b <3 | |.ffunc string_rep // Only handle the 1-char case inline. | ffgccheck | cmplwi NARGS8:RC, 16 | evldd CARG1, 0(BASE) | evldd CARG2, 8(BASE) | bne ->fff_fallback // Exactly 2 arguments. | checknum CARG2 | checkfail ->fff_fallback | checkstr STR:CARG1 | efdctsiz CARG3, CARG2 | checkfail ->fff_fallback | lwz TMP0, STR:CARG1->len | cmpwi CARG3, 0 | lwz TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | ble >2 // Count <= 0? (or non-int) | cmplwi TMP0, 1 | subi TMP2, CARG3, 1 | blt >2 // Zero length string? | cmplw cr1, TMP1, CARG3 | bne ->fff_fallback // Fallback for > 1-char strings. | lbz TMP0, STR:CARG1[1] | lwz CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | blt cr1, ->fff_fallback |1: // Fill buffer with char. Yes, this is suboptimal code (do you care?). | cmplwi TMP2, 0 | stbx TMP0, CARG2, TMP2 | subi TMP2, TMP2, 1 | bne <1 | b ->fff_newstr |2: // Return empty string. | la STR:CRET1, DISPATCH_GL(strempty)(DISPATCH) | evmergelo CRET1, TISSTR, STR:CRET1 | b ->fff_restv | |.ffunc string_reverse | ffgccheck | cmplwi NARGS8:RC, 8 | evldd CARG1, 0(BASE) | blt ->fff_fallback | checkstr STR:CARG1 | lwz TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | checkfail ->fff_fallback | lwz CARG3, STR:CARG1->len | la CARG1, #STR(STR:CARG1) | lwz CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | li TMP2, 0 | cmplw TMP1, CARG3 | subi TMP3, CARG3, 1 | blt ->fff_fallback |1: // Reverse string copy. | cmpwi TMP3, 0 | lbzx TMP1, CARG1, TMP2 | blt ->fff_newstr | stbx TMP1, CARG2, TMP3 | subi TMP3, TMP3, 1 | addi TMP2, TMP2, 1 | b <1 | |.macro ffstring_case, name, lo | .ffunc name | ffgccheck | cmplwi NARGS8:RC, 8 | evldd CARG1, 0(BASE) | blt ->fff_fallback | checkstr STR:CARG1 | lwz TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | checkfail ->fff_fallback | lwz CARG3, STR:CARG1->len | la CARG1, #STR(STR:CARG1) | lwz CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | cmplw TMP1, CARG3 | li TMP2, 0 | blt ->fff_fallback |1: // ASCII case conversion. | cmplw TMP2, CARG3 | lbzx TMP1, CARG1, TMP2 | bge ->fff_newstr | subi TMP0, TMP1, lo | xori TMP3, TMP1, 0x20 | cmplwi TMP0, 26 | isellt TMP1, TMP3, TMP1 | stbx TMP1, CARG2, TMP2 | addi TMP2, TMP2, 1 | b <1 |.endmacro | |ffstring_case string_lower, 65 |ffstring_case string_upper, 97 | |//-- Table library ------------------------------------------------------ | |.ffunc_1 table_getn | checktab CARG1 | checkfail ->fff_fallback | bl extern lj_tab_len // (GCtab *t) | // Returns uint32_t (but less than 2^31). | efdcfsi CRET1, CRET1 | b ->fff_restv | |//-- Bit library -------------------------------------------------------- | |.macro .ffunc_bit, name | .ffunc_n bit_..name | efdadd CARG1, CARG1, TOBIT |.endmacro | |.ffunc_bit tobit |->fff_resbit: | efdcfsi CRET1, CARG1 | b ->fff_restv | |.macro .ffunc_bit_op, name, ins | .ffunc_bit name | li TMP1, 8 |1: | evlddx CARG2, BASE, TMP1 | cmplw cr1, TMP1, NARGS8:RC | checknum CARG2 | bge cr1, ->fff_resbit | checkfail ->fff_fallback | efdadd CARG2, CARG2, TOBIT | ins CARG1, CARG1, CARG2 | addi TMP1, TMP1, 8 | b <1 |.endmacro | |.ffunc_bit_op band, and |.ffunc_bit_op bor, or |.ffunc_bit_op bxor, xor | |.ffunc_bit bswap | rotlwi TMP0, CARG1, 8 | rlwimi TMP0, CARG1, 24, 0, 7 | rlwimi TMP0, CARG1, 24, 16, 23 | efdcfsi CRET1, TMP0 | b ->fff_restv | |.ffunc_bit bnot | not TMP0, CARG1 | efdcfsi CRET1, TMP0 | b ->fff_restv | |.macro .ffunc_bit_sh, name, ins, shmod | .ffunc_nn bit_..name | efdadd CARG2, CARG2, TOBIT | efdadd CARG1, CARG1, TOBIT |.if shmod == 1 | rlwinm CARG2, CARG2, 0, 27, 31 |.elif shmod == 2 | neg CARG2, CARG2 |.endif | ins TMP0, CARG1, CARG2 | efdcfsi CRET1, TMP0 | b ->fff_restv |.endmacro | |.ffunc_bit_sh lshift, slw, 1 |.ffunc_bit_sh rshift, srw, 1 |.ffunc_bit_sh arshift, sraw, 1 |.ffunc_bit_sh rol, rotlw, 0 |.ffunc_bit_sh ror, rotlw, 2 | |//----------------------------------------------------------------------- | |->fff_fallback: // Call fast function fallback handler. | // BASE = new base, RB = CFUNC, RC = nargs*8 | lwz TMP3, CFUNC:RB->f | add TMP1, BASE, NARGS8:RC | lwz PC, FRAME_PC(BASE) // Fallback may overwrite PC. | addi TMP0, TMP1, 8*LUA_MINSTACK | lwz TMP2, L->maxstack | stw PC, SAVE_PC // Redundant (but a defined value). | cmplw TMP0, TMP2 | stw BASE, L->base | stw TMP1, L->top | mr CARG1, L | bgt >5 // Need to grow stack. | mtctr TMP3 | bctrl // (lua_State *L) | // Either throws an error, or recovers and returns -1, 0 or nresults+1. | lwz BASE, L->base | cmpwi CRET1, 0 | slwi RD, CRET1, 3 | la RA, -8(BASE) | bgt ->fff_res // Returned nresults+1? |1: // Returned 0 or -1: retry fast path. | lwz TMP0, L->top | lwz LFUNC:RB, FRAME_FUNC(BASE) | sub NARGS8:RC, TMP0, BASE | bne ->vm_call_tail // Returned -1? | ins_callt // Returned 0: retry fast path. | |// Reconstruct previous base for vmeta_call during tailcall. |->vm_call_tail: | andi. TMP0, PC, FRAME_TYPE | rlwinm TMP1, PC, 0, 0, 28 | bne >3 | lwz INS, -4(PC) | decode_RA8 TMP1, INS | addi TMP1, TMP1, 8 |3: | sub TMP2, BASE, TMP1 | b ->vm_call_dispatch // Resolve again for tailcall. | |5: // Grow stack for fallback handler. | li CARG2, LUA_MINSTACK | bl extern lj_state_growstack // (lua_State *L, int n) | lwz BASE, L->base | cmpw TMP0, TMP0 // Set 4*cr0+eq to force retry. | b <1 | |->fff_gcstep: // Call GC step function. | // BASE = new base, RC = nargs*8 | mflr SAVE0 | stw BASE, L->base | add TMP0, BASE, NARGS8:RC | stw PC, SAVE_PC // Redundant (but a defined value). | stw TMP0, L->top | mr CARG1, L | bl extern lj_gc_step // (lua_State *L) | lwz BASE, L->base | mtlr SAVE0 | lwz TMP0, L->top | sub NARGS8:RC, TMP0, BASE | lwz CFUNC:RB, FRAME_FUNC(BASE) | blr | |//----------------------------------------------------------------------- |//-- Special dispatch targets ------------------------------------------- |//----------------------------------------------------------------------- | |->vm_record: // Dispatch target for recording phase. |.if JIT | NYI |.endif | |->vm_rethook: // Dispatch target for return hooks. | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | andi. TMP0, TMP3, HOOK_ACTIVE // Hook already active? | beq >1 |5: // Re-dispatch to static ins. | addi TMP1, TMP1, GG_DISP2STATIC // Assumes decode_OP4 TMP1, INS. | lwzx TMP0, DISPATCH, TMP1 | mtctr TMP0 | bctr | |->vm_inshook: // Dispatch target for instr/line hooks. | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | lwz TMP2, DISPATCH_GL(hookcount)(DISPATCH) | andi. TMP0, TMP3, HOOK_ACTIVE // Hook already active? | rlwinm TMP0, TMP3, 31-LUA_HOOKLINE, 31, 0 | bne <5 | | cmpwi cr1, TMP0, 0 | addic. TMP2, TMP2, -1 | beq cr1, <5 | stw TMP2, DISPATCH_GL(hookcount)(DISPATCH) | beq >1 | bge cr1, <5 |1: | mr CARG1, L | stw MULTRES, SAVE_MULTRES | mr CARG2, PC | stw BASE, L->base | // SAVE_PC must hold the _previous_ PC. The callee updates it with PC. | bl extern lj_dispatch_ins // (lua_State *L, const BCIns *pc) |3: | lwz BASE, L->base |4: // Re-dispatch to static ins. | lwz INS, -4(PC) | decode_OP4 TMP1, INS | decode_RB8 RB, INS | addi TMP1, TMP1, GG_DISP2STATIC | decode_RD8 RD, INS | lwzx TMP0, DISPATCH, TMP1 | decode_RA8 RA, INS | decode_RC8 RC, INS | mtctr TMP0 | bctr | |->cont_hook: // Continue from hook yield. | addi PC, PC, 4 | lwz MULTRES, -20(RB) // Restore MULTRES for *M ins. | b <4 | |->vm_hotloop: // Hot loop counter underflow. |.if JIT | NYI |.endif | |->vm_callhook: // Dispatch target for call hooks. | mr CARG2, PC |.if JIT | b >1 |.endif | |->vm_hotcall: // Hot call counter underflow. |.if JIT | ori CARG2, PC, 1 |1: |.endif | add TMP0, BASE, RC | stw PC, SAVE_PC | mr CARG1, L | stw BASE, L->base | sub RA, RA, BASE | stw TMP0, L->top | bl extern lj_dispatch_call // (lua_State *L, const BCIns *pc) | // Returns ASMFunction. | lwz BASE, L->base | lwz TMP0, L->top | stw ZERO, SAVE_PC // Invalidate for subsequent line hook. | sub NARGS8:RC, TMP0, BASE | add RA, BASE, RA | lwz LFUNC:RB, FRAME_FUNC(BASE) | mtctr CRET1 | bctr | |//----------------------------------------------------------------------- |//-- Trace exit handler ------------------------------------------------- |//----------------------------------------------------------------------- | |->vm_exit_handler: |.if JIT | NYI |.endif |->vm_exit_interp: |.if JIT | NYI |.endif | |//----------------------------------------------------------------------- |//-- Math helper functions ---------------------------------------------- |//----------------------------------------------------------------------- | |// FP value rounding. Called by math.floor/math.ceil fast functions |// and from JIT code. |// |// This can be inlined if the CPU has the frin/friz/frip/frim instructions. |// The alternative hard-float approaches have a deep dependency chain. |// The resulting latency is at least 3x-7x the double-precision FP latency |// (e500v2: 6cy, e600: 5cy, Cell: 10cy) or around 20-70 cycles. |// |// The soft-float approach is tedious, but much faster (e500v2: ~11cy/~6cy). |// However it relies on a fast way to transfer the FP value to GPRs |// (e500v2: 0cy for lo-word, 1cy for hi-word). |// |.macro vm_round, name, mode | // Used temporaries: TMP0, TMP1, TMP2, TMP3. |->name.._efd: // Input: CARG2, output: CRET2 | evmergehi CARG1, CARG2, CARG2 |->name.._hilo: | // Input: CARG1 (hi), CARG2 (hi, lo), output: CRET2 | rlwinm TMP2, CARG1, 12, 21, 31 | addic. TMP2, TMP2, -1023 // exp = exponent(x) - 1023 | li TMP1, -1 | cmplwi cr1, TMP2, 51 // 0 <= exp <= 51? | subfic TMP0, TMP2, 52 | bgt cr1, >1 | lus TMP3, 0xfff0 | slw TMP0, TMP1, TMP0 // lomask = -1 << (52-exp) | sraw TMP1, TMP3, TMP2 // himask = (int32_t)0xfff00000 >> exp |.if mode == 2 // trunc(x): | evmergelo TMP0, TMP1, TMP0 | evand CRET2, CARG2, TMP0 // hi &= himask, lo &= lomask |.else | andc TMP2, CARG2, TMP0 | andc TMP3, CARG1, TMP1 | or TMP2, TMP2, TMP3 // ztest = (hi&~himask) | (lo&~lomask) | srawi TMP3, CARG1, 31 // signmask = (int32_t)hi >> 31 |.if mode == 0 // floor(x): | and. TMP2, TMP2, TMP3 // iszero = ((ztest & signmask) == 0) |.else // ceil(x): | andc. TMP2, TMP2, TMP3 // iszero = ((ztest & ~signmask) == 0) |.endif | and CARG2, CARG2, TMP0 // lo &= lomask | and CARG1, CARG1, TMP1 // hi &= himask | subc TMP0, CARG2, TMP0 | iseleq TMP0, CARG2, TMP0 // lo = iszero ? lo : lo-lomask | sube TMP1, CARG1, TMP1 | iseleq TMP1, CARG1, TMP1 // hi = iszero ? hi : hi-himask+carry | evmergelo CRET2, TMP1, TMP0 |.endif | blr |1: | bgtlr // Already done if >=2^52, +-inf or nan. |.if mode == 2 // trunc(x): | rlwinm TMP1, CARG1, 0, 0, 0 // hi = sign(x) | li TMP0, 0 | evmergelo CRET2, TMP1, TMP0 |.else | rlwinm TMP2, CARG1, 0, 1, 31 | srawi TMP0, CARG1, 31 // signmask = (int32_t)hi >> 31 | or TMP2, TMP2, CARG2 // ztest = abs(hi) | lo | lus TMP1, 0x3ff0 |.if mode == 0 // floor(x): | and. TMP2, TMP2, TMP0 // iszero = ((ztest & signmask) == 0) |.else // ceil(x): | andc. TMP2, TMP2, TMP0 // iszero = ((ztest & ~signmask) == 0) |.endif | li TMP0, 0 | iseleq TMP1, r0, TMP1 | rlwimi CARG1, TMP1, 0, 1, 31 // hi = sign(x) | (iszero ? 0.0 : 1.0) | evmergelo CRET2, CARG1, TMP0 |.endif | blr |.endmacro | |->vm_floor: | mflr CARG3 | evmergelo CARG2, CARG1, CARG2 | bl ->vm_floor_hilo | mtlr CARG3 | evmergehi CRET1, CRET2, CRET2 | blr | | vm_round vm_floor, 0 | vm_round vm_ceil, 1 |.if JIT | vm_round vm_trunc, 2 |.else |->vm_trunc_efd: |->vm_trunc_hilo: |.endif | |//----------------------------------------------------------------------- |//-- Miscellaneous functions -------------------------------------------- |//----------------------------------------------------------------------- | |//----------------------------------------------------------------------- |//-- FFI helper functions ----------------------------------------------- |//----------------------------------------------------------------------- | |->vm_ffi_call: |.if FFI | NYI |.endif | |//----------------------------------------------------------------------- } /* Generate the code for a single instruction. */ static void build_ins(BuildCtx *ctx, BCOp op, int defop) { int vk = 0; |=>defop: switch (op) { /* -- Comparison ops ---------------------------------------------------- */ /* Remember: all ops branch for a true comparison, fall through otherwise. */ case BC_ISLT: case BC_ISGE: case BC_ISLE: case BC_ISGT: | // RA = src1*8, RD = src2*8, JMP with RD = target | evlddx TMP0, BASE, RA | addi PC, PC, 4 | evlddx TMP1, BASE, RD | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | lwz TMP2, -4(PC) | evmergehi RB, TMP0, TMP1 | decode_RD4 TMP2, TMP2 | checknum RB | add TMP2, TMP2, TMP3 | checkanyfail ->vmeta_comp | efdcmplt TMP0, TMP1 if (op == BC_ISLE || op == BC_ISGT) { | efdcmpeq cr1, TMP0, TMP1 | cror 4*cr0+gt, 4*cr0+gt, 4*cr1+gt } if (op == BC_ISLT || op == BC_ISLE) { | iselgt PC, TMP2, PC } else { | iselgt PC, PC, TMP2 } | ins_next break; case BC_ISEQV: case BC_ISNEV: vk = op == BC_ISEQV; | // RA = src1*8, RD = src2*8, JMP with RD = target | evlddx CARG2, BASE, RA | addi PC, PC, 4 | evlddx CARG3, BASE, RD | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | lwz TMP2, -4(PC) | evmergehi RB, CARG2, CARG3 | decode_RD4 TMP2, TMP2 | checknum RB | add TMP2, TMP2, TMP3 | checkanyfail >5 | efdcmpeq CARG2, CARG3 if (vk) { | iselgt PC, TMP2, PC } else { | iselgt PC, PC, TMP2 } |1: | ins_next | |5: // Either or both types are not numbers. | evcmpeq CARG2, CARG3 | not TMP3, RB | cmplwi cr1, TMP3, ~LJ_TISPRI // Primitive? | crorc 4*cr7+lt, 4*cr0+so, 4*cr0+lt // 1: Same tv or different type. | cmplwi cr6, TMP3, ~LJ_TISTABUD // Table or userdata? | crandc 4*cr7+gt, 4*cr0+lt, 4*cr1+gt // 2: Same type and primitive. | mr SAVE0, PC if (vk) { | isel PC, TMP2, PC, 4*cr7+gt } else { | isel TMP2, PC, TMP2, 4*cr7+gt } | cror 4*cr7+lt, 4*cr7+lt, 4*cr7+gt // 1 or 2. if (vk) { | isel PC, TMP2, PC, 4*cr0+so } else { | isel PC, PC, TMP2, 4*cr0+so } | blt cr7, <1 // Done if 1 or 2. | blt cr6, <1 // Done if not tab/ud. | | // Different tables or userdatas. Need to check __eq metamethod. | // Field metatable must be at same offset for GCtab and GCudata! | lwz TAB:TMP2, TAB:CARG2->metatable | li CARG4, 1-vk // ne = 0 or 1. | cmplwi TAB:TMP2, 0 | beq <1 // No metatable? | lbz TMP2, TAB:TMP2->nomm | andi. TMP2, TMP2, 1<vmeta_equal // Handle __eq metamethod. break; case BC_ISEQS: case BC_ISNES: vk = op == BC_ISEQS; | // RA = src*8, RD = str_const*8 (~), JMP with RD = target | evlddx TMP0, BASE, RA | srwi RD, RD, 1 | lwz INS, 0(PC) | subfic RD, RD, -4 | addi PC, PC, 4 | lwzx STR:TMP1, KBASE, RD // KBASE-4-str_const*4 | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | decode_RD4 TMP2, INS | evmergelo STR:TMP1, TISSTR, STR:TMP1 | add TMP2, TMP2, TMP3 | evcmpeq TMP0, STR:TMP1 if (vk) { | isel PC, TMP2, PC, 4*cr0+so } else { | isel PC, PC, TMP2, 4*cr0+so } | ins_next break; case BC_ISEQN: case BC_ISNEN: vk = op == BC_ISEQN; | // RA = src*8, RD = num_const*8, JMP with RD = target | evlddx TMP0, BASE, RA | addi PC, PC, 4 | evlddx TMP1, KBASE, RD | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | lwz INS, -4(PC) | checknum TMP0 | checkfail >5 | efdcmpeq TMP0, TMP1 |1: | decode_RD4 TMP2, INS | add TMP2, TMP2, TMP3 if (vk) { | iselgt PC, TMP2, PC |5: } else { | iselgt PC, PC, TMP2 } |3: | ins_next if (!vk) { |5: | decode_RD4 TMP2, INS | add PC, TMP2, TMP3 | b <3 } break; case BC_ISEQP: case BC_ISNEP: vk = op == BC_ISEQP; | // RA = src*8, RD = primitive_type*8 (~), JMP with RD = target | lwzx TMP0, BASE, RA | srwi TMP1, RD, 3 | lwz INS, 0(PC) | addi PC, PC, 4 | not TMP1, TMP1 | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | cmplw TMP0, TMP1 | decode_RD4 TMP2, INS | add TMP2, TMP2, TMP3 if (vk) { | iseleq PC, TMP2, PC } else { | iseleq PC, PC, TMP2 } | ins_next break; /* -- Unary test and copy ops ------------------------------------------- */ case BC_ISTC: case BC_ISFC: case BC_IST: case BC_ISF: | // RA = dst*8 or unused, RD = src*8, JMP with RD = target | evlddx TMP0, BASE, RD | evaddw TMP1, TISNIL, TISNIL // Synthesize LJ_TFALSE. | lwz INS, 0(PC) | evcmpltu TMP0, TMP1 | addi PC, PC, 4 if (op == BC_IST || op == BC_ISF) { | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | decode_RD4 TMP2, INS | add TMP2, TMP2, TMP3 if (op == BC_IST) { | isellt PC, TMP2, PC } else { | isellt PC, PC, TMP2 } } else { if (op == BC_ISTC) { | checkfail >1 } else { | checkok >1 } | addis PC, PC, -(BCBIAS_J*4 >> 16) | decode_RD4 TMP2, INS | evstddx TMP0, BASE, RA | add PC, PC, TMP2 |1: } | ins_next break; /* -- Unary ops --------------------------------------------------------- */ case BC_MOV: | // RA = dst*8, RD = src*8 | ins_next1 | evlddx TMP0, BASE, RD | evstddx TMP0, BASE, RA | ins_next2 break; case BC_NOT: | // RA = dst*8, RD = src*8 | ins_next1 | lwzx TMP0, BASE, RD | subfic TMP1, TMP0, LJ_TTRUE | adde TMP0, TMP0, TMP1 | stwx TMP0, BASE, RA | ins_next2 break; case BC_UNM: | // RA = dst*8, RD = src*8 | evlddx TMP0, BASE, RD | checknum TMP0 | checkfail ->vmeta_unm | efdneg TMP0, TMP0 | ins_next1 | evstddx TMP0, BASE, RA | ins_next2 break; case BC_LEN: | // RA = dst*8, RD = src*8 | evlddx CARG1, BASE, RD | checkstr CARG1 | checkfail >2 | lwz CRET1, STR:CARG1->len |1: | ins_next1 | efdcfsi TMP0, CRET1 | evstddx TMP0, BASE, RA | ins_next2 |2: | checktab CARG1 | checkfail ->vmeta_len #if LJ_52 | lwz TAB:TMP2, TAB:CARG1->metatable | cmplwi TAB:TMP2, 0 | bne >9 |3: #endif |->BC_LEN_Z: | bl extern lj_tab_len // (GCtab *t) | // Returns uint32_t (but less than 2^31). | b <1 #if LJ_52 |9: | lbz TMP0, TAB:TMP2->nomm | andi. TMP0, TMP0, 1<vmeta_len #endif break; /* -- Binary ops -------------------------------------------------------- */ |.macro ins_arithpre, t0, t1 | // RA = dst*8, RB = src1*8, RC = src2*8 | num_const*8 ||vk = ((int)op - BC_ADDVN) / (BC_ADDNV-BC_ADDVN); ||switch (vk) { ||case 0: | evlddx t0, BASE, RB | checknum t0 | evlddx t1, KBASE, RC | checkfail ->vmeta_arith_vn || break; ||case 1: | evlddx t1, BASE, RB | checknum t1 | evlddx t0, KBASE, RC | checkfail ->vmeta_arith_nv || break; ||default: | evlddx t0, BASE, RB | evlddx t1, BASE, RC | evmergehi TMP2, t0, t1 | checknum TMP2 | checkanyfail ->vmeta_arith_vv || break; ||} |.endmacro | |.macro ins_arith, ins | ins_arithpre TMP0, TMP1 | ins_next1 | ins TMP0, TMP0, TMP1 | evstddx TMP0, BASE, RA | ins_next2 |.endmacro case BC_ADDVN: case BC_ADDNV: case BC_ADDVV: | ins_arith efdadd break; case BC_SUBVN: case BC_SUBNV: case BC_SUBVV: | ins_arith efdsub break; case BC_MULVN: case BC_MULNV: case BC_MULVV: | ins_arith efdmul break; case BC_DIVVN: case BC_DIVNV: case BC_DIVVV: | ins_arith efddiv break; case BC_MODVN: | ins_arithpre RD, SAVE0 |->BC_MODVN_Z: | efddiv CARG2, RD, SAVE0 | bl ->vm_floor_efd // floor(b/c) | efdmul TMP0, CRET2, SAVE0 | ins_next1 | efdsub TMP0, RD, TMP0 // b - floor(b/c)*c | evstddx TMP0, BASE, RA | ins_next2 break; case BC_MODNV: case BC_MODVV: | ins_arithpre RD, SAVE0 | b ->BC_MODVN_Z // Avoid 3 copies. It's slow anyway. break; case BC_POW: | evlddx CARG2, BASE, RB | evlddx CARG4, BASE, RC | evmergehi CARG1, CARG4, CARG2 | checknum CARG1 | evmergehi CARG3, CARG4, CARG4 | checkanyfail ->vmeta_arith_vv | bl extern pow@plt | evmergelo CRET2, CRET1, CRET2 | evstddx CRET2, BASE, RA | ins_next break; case BC_CAT: | // RA = dst*8, RB = src_start*8, RC = src_end*8 | sub CARG3, RC, RB | stw BASE, L->base | add CARG2, BASE, RC | mr SAVE0, RB |->BC_CAT_Z: | stw PC, SAVE_PC | mr CARG1, L | srwi CARG3, CARG3, 3 | bl extern lj_meta_cat // (lua_State *L, TValue *top, int left) | // Returns NULL (finished) or TValue * (metamethod). | cmplwi CRET1, 0 | lwz BASE, L->base | bne ->vmeta_binop | evlddx TMP0, BASE, SAVE0 // Copy result from RB to RA. | evstddx TMP0, BASE, RA | ins_next break; /* -- Constant ops ------------------------------------------------------ */ case BC_KSTR: | // RA = dst*8, RD = str_const*8 (~) | ins_next1 | srwi TMP1, RD, 1 | subfic TMP1, TMP1, -4 | lwzx TMP0, KBASE, TMP1 // KBASE-4-str_const*4 | evmergelo TMP0, TISSTR, TMP0 | evstddx TMP0, BASE, RA | ins_next2 break; case BC_KCDATA: |.if FFI | // RA = dst*8, RD = cdata_const*8 (~) | ins_next1 | srwi TMP1, RD, 1 | subfic TMP1, TMP1, -4 | lwzx TMP0, KBASE, TMP1 // KBASE-4-cdata_const*4 | li TMP2, LJ_TCDATA | evmergelo TMP0, TMP2, TMP0 | evstddx TMP0, BASE, RA | ins_next2 |.endif break; case BC_KSHORT: | // RA = dst*8, RD = int16_literal*8 | srwi TMP1, RD, 3 | extsh TMP1, TMP1 | ins_next1 | efdcfsi TMP0, TMP1 | evstddx TMP0, BASE, RA | ins_next2 break; case BC_KNUM: | // RA = dst*8, RD = num_const*8 | evlddx TMP0, KBASE, RD | ins_next1 | evstddx TMP0, BASE, RA | ins_next2 break; case BC_KPRI: | // RA = dst*8, RD = primitive_type*8 (~) | srwi TMP1, RD, 3 | not TMP0, TMP1 | ins_next1 | stwx TMP0, BASE, RA | ins_next2 break; case BC_KNIL: | // RA = base*8, RD = end*8 | evstddx TISNIL, BASE, RA | addi RA, RA, 8 |1: | evstddx TISNIL, BASE, RA | cmpw RA, RD | addi RA, RA, 8 | blt <1 | ins_next_ break; /* -- Upvalue and function ops ------------------------------------------ */ case BC_UGET: | // RA = dst*8, RD = uvnum*8 | ins_next1 | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RD, RD, 1 | addi RD, RD, offsetof(GCfuncL, uvptr) | lwzx UPVAL:RB, LFUNC:RB, RD | lwz TMP1, UPVAL:RB->v | evldd TMP0, 0(TMP1) | evstddx TMP0, BASE, RA | ins_next2 break; case BC_USETV: | // RA = uvnum*8, RD = src*8 | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RA, RA, 1 | addi RA, RA, offsetof(GCfuncL, uvptr) | evlddx TMP1, BASE, RD | lwzx UPVAL:RB, LFUNC:RB, RA | lbz TMP3, UPVAL:RB->marked | lwz CARG2, UPVAL:RB->v | andi. TMP3, TMP3, LJ_GC_BLACK // isblack(uv) | lbz TMP0, UPVAL:RB->closed | evmergehi TMP2, TMP1, TMP1 | evstdd TMP1, 0(CARG2) | cmplwi cr1, TMP0, 0 | cror 4*cr0+eq, 4*cr0+eq, 4*cr1+eq | subi TMP2, TMP2, (LJ_TISNUM+1) | bne >2 // Upvalue is closed and black? |1: | ins_next | |2: // Check if new value is collectable. | cmplwi TMP2, LJ_TISGCV - (LJ_TISNUM+1) | bge <1 // tvisgcv(v) | lbz TMP3, GCOBJ:TMP1->gch.marked | andi. TMP3, TMP3, LJ_GC_WHITES // iswhite(v) | la CARG1, GG_DISP2G(DISPATCH) | // Crossed a write barrier. Move the barrier forward. | beq <1 | bl extern lj_gc_barrieruv // (global_State *g, TValue *tv) | b <1 break; case BC_USETS: | // RA = uvnum*8, RD = str_const*8 (~) | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi TMP1, RD, 1 | srwi RA, RA, 1 | subfic TMP1, TMP1, -4 | addi RA, RA, offsetof(GCfuncL, uvptr) | lwzx STR:TMP1, KBASE, TMP1 // KBASE-4-str_const*4 | lwzx UPVAL:RB, LFUNC:RB, RA | evmergelo STR:TMP1, TISSTR, STR:TMP1 | lbz TMP3, UPVAL:RB->marked | lwz CARG2, UPVAL:RB->v | andi. TMP3, TMP3, LJ_GC_BLACK // isblack(uv) | lbz TMP3, STR:TMP1->marked | lbz TMP2, UPVAL:RB->closed | evstdd STR:TMP1, 0(CARG2) | bne >2 |1: | ins_next | |2: // Check if string is white and ensure upvalue is closed. | andi. TMP3, TMP3, LJ_GC_WHITES // iswhite(str) | cmplwi cr1, TMP2, 0 | cror 4*cr0+eq, 4*cr0+eq, 4*cr1+eq | la CARG1, GG_DISP2G(DISPATCH) | // Crossed a write barrier. Move the barrier forward. | beq <1 | bl extern lj_gc_barrieruv // (global_State *g, TValue *tv) | b <1 break; case BC_USETN: | // RA = uvnum*8, RD = num_const*8 | ins_next1 | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RA, RA, 1 | addi RA, RA, offsetof(GCfuncL, uvptr) | evlddx TMP0, KBASE, RD | lwzx UPVAL:RB, LFUNC:RB, RA | lwz TMP1, UPVAL:RB->v | evstdd TMP0, 0(TMP1) | ins_next2 break; case BC_USETP: | // RA = uvnum*8, RD = primitive_type*8 (~) | ins_next1 | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RA, RA, 1 | addi RA, RA, offsetof(GCfuncL, uvptr) | srwi TMP0, RD, 3 | lwzx UPVAL:RB, LFUNC:RB, RA | not TMP0, TMP0 | lwz TMP1, UPVAL:RB->v | stw TMP0, 0(TMP1) | ins_next2 break; case BC_UCLO: | // RA = level*8, RD = target | lwz TMP1, L->openupval | branch_RD // Do this first since RD is not saved. | stw BASE, L->base | cmplwi TMP1, 0 | mr CARG1, L | beq >1 | add CARG2, BASE, RA | bl extern lj_func_closeuv // (lua_State *L, TValue *level) | lwz BASE, L->base |1: | ins_next break; case BC_FNEW: | // RA = dst*8, RD = proto_const*8 (~) (holding function prototype) | srwi TMP1, RD, 1 | stw BASE, L->base | subfic TMP1, TMP1, -4 | stw PC, SAVE_PC | lwzx CARG2, KBASE, TMP1 // KBASE-4-tab_const*4 | mr CARG1, L | lwz CARG3, FRAME_FUNC(BASE) | // (lua_State *L, GCproto *pt, GCfuncL *parent) | bl extern lj_func_newL_gc | // Returns GCfuncL *. | lwz BASE, L->base | evmergelo LFUNC:CRET1, TISFUNC, LFUNC:CRET1 | evstddx LFUNC:CRET1, BASE, RA | ins_next break; /* -- Table ops --------------------------------------------------------- */ case BC_TNEW: case BC_TDUP: | // RA = dst*8, RD = (hbits|asize)*8 | tab_const*8 (~) | lwz TMP0, DISPATCH_GL(gc.total)(DISPATCH) | mr CARG1, L | lwz TMP1, DISPATCH_GL(gc.threshold)(DISPATCH) | stw BASE, L->base | cmplw TMP0, TMP1 | stw PC, SAVE_PC | bge >5 |1: if (op == BC_TNEW) { | rlwinm CARG2, RD, 29, 21, 31 | rlwinm CARG3, RD, 18, 27, 31 | cmpwi CARG2, 0x7ff | li TMP1, 0x801 | iseleq CARG2, TMP1, CARG2 | bl extern lj_tab_new // (lua_State *L, int32_t asize, uint32_t hbits) | // Returns Table *. } else { | srwi TMP1, RD, 1 | subfic TMP1, TMP1, -4 | lwzx CARG2, KBASE, TMP1 // KBASE-4-tab_const*4 | bl extern lj_tab_dup // (lua_State *L, Table *kt) | // Returns Table *. } | lwz BASE, L->base | evmergelo TAB:CRET1, TISTAB, TAB:CRET1 | evstddx TAB:CRET1, BASE, RA | ins_next |5: | mr SAVE0, RD | bl extern lj_gc_step_fixtop // (lua_State *L) | mr RD, SAVE0 | mr CARG1, L | b <1 break; case BC_GGET: | // RA = dst*8, RD = str_const*8 (~) case BC_GSET: | // RA = src*8, RD = str_const*8 (~) | lwz LFUNC:TMP2, FRAME_FUNC(BASE) | srwi TMP1, RD, 1 | lwz TAB:RB, LFUNC:TMP2->env | subfic TMP1, TMP1, -4 | lwzx STR:RC, KBASE, TMP1 // KBASE-4-str_const*4 if (op == BC_GGET) { | b ->BC_TGETS_Z } else { | b ->BC_TSETS_Z } break; case BC_TGETV: | // RA = dst*8, RB = table*8, RC = key*8 | evlddx TAB:RB, BASE, RB | evlddx RC, BASE, RC | checktab TAB:RB | checkfail ->vmeta_tgetv | checknum RC | checkfail >5 | // Convert number key to integer | efdctsi TMP2, RC | lwz TMP0, TAB:RB->asize | efdcfsi TMP1, TMP2 | cmplw cr0, TMP0, TMP2 | efdcmpeq cr1, RC, TMP1 | lwz TMP1, TAB:RB->array | crand 4*cr0+gt, 4*cr0+gt, 4*cr1+gt | slwi TMP2, TMP2, 3 | ble ->vmeta_tgetv // Integer key and in array part? | evlddx TMP1, TMP1, TMP2 | checknil TMP1 | checkok >2 |1: | evstddx TMP1, BASE, RA | ins_next | |2: // Check for __index if table value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <1 // No metatable: done. | lbz TMP0, TAB:TMP2->nomm | andi. TMP0, TMP0, 1<vmeta_tgetv | |5: | checkstr STR:RC // String key? | checkok ->BC_TGETS_Z | b ->vmeta_tgetv break; case BC_TGETS: | // RA = dst*8, RB = table*8, RC = str_const*8 (~) | evlddx TAB:RB, BASE, RB | srwi TMP1, RC, 1 | checktab TAB:RB | subfic TMP1, TMP1, -4 | lwzx STR:RC, KBASE, TMP1 // KBASE-4-str_const*4 | checkfail ->vmeta_tgets1 |->BC_TGETS_Z: | // TAB:RB = GCtab *, STR:RC = GCstr *, RA = dst*8 | lwz TMP0, TAB:RB->hmask | lwz TMP1, STR:RC->hash | lwz NODE:TMP2, TAB:RB->node | evmergelo STR:RC, TISSTR, STR:RC | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | slwi TMP0, TMP1, 5 | slwi TMP1, TMP1, 3 | sub TMP1, TMP0, TMP1 | add NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) |1: | evldd TMP0, NODE:TMP2->key | evldd TMP1, NODE:TMP2->val | evcmpeq TMP0, STR:RC | checkanyfail >4 | checknil TMP1 | checkok >5 // Key found, but nil value? |3: | evstddx TMP1, BASE, RA | ins_next | |4: // Follow hash chain. | lwz NODE:TMP2, NODE:TMP2->next | cmplwi NODE:TMP2, 0 | bne <1 | // End of hash chain: key not found, nil result. | evmr TMP1, TISNIL | |5: // Check for __index if table value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <3 // No metatable: done. | lbz TMP0, TAB:TMP2->nomm | andi. TMP0, TMP0, 1<vmeta_tgets break; case BC_TGETB: | // RA = dst*8, RB = table*8, RC = index*8 | evlddx TAB:RB, BASE, RB | srwi TMP0, RC, 3 | checktab TAB:RB | checkfail ->vmeta_tgetb | lwz TMP1, TAB:RB->asize | lwz TMP2, TAB:RB->array | cmplw TMP0, TMP1 | bge ->vmeta_tgetb | evlddx TMP1, TMP2, RC | checknil TMP1 | checkok >5 |1: | ins_next1 | evstddx TMP1, BASE, RA | ins_next2 | |5: // Check for __index if table value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <1 // No metatable: done. | lbz TMP2, TAB:TMP2->nomm | andi. TMP2, TMP2, 1<vmeta_tgetb // Caveat: preserve TMP0! break; case BC_TSETV: | // RA = src*8, RB = table*8, RC = key*8 | evlddx TAB:RB, BASE, RB | evlddx RC, BASE, RC | checktab TAB:RB | checkfail ->vmeta_tsetv | checknum RC | checkfail >5 | // Convert number key to integer | efdctsi TMP2, RC | evlddx SAVE0, BASE, RA | lwz TMP0, TAB:RB->asize | efdcfsi TMP1, TMP2 | cmplw cr0, TMP0, TMP2 | efdcmpeq cr1, RC, TMP1 | lwz TMP1, TAB:RB->array | crand 4*cr0+gt, 4*cr0+gt, 4*cr1+gt | slwi TMP0, TMP2, 3 | ble ->vmeta_tsetv // Integer key and in array part? | lbz TMP3, TAB:RB->marked | evlddx TMP2, TMP1, TMP0 | checknil TMP2 | checkok >3 |1: | andi. TMP2, TMP3, LJ_GC_BLACK // isblack(table) | evstddx SAVE0, TMP1, TMP0 | bne >7 |2: | ins_next | |3: // Check for __newindex if previous value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <1 // No metatable: done. | lbz TMP2, TAB:TMP2->nomm | andi. TMP2, TMP2, 1<vmeta_tsetv | |5: | checkstr STR:RC // String key? | checkok ->BC_TSETS_Z | b ->vmeta_tsetv | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0 | b <2 break; case BC_TSETS: | // RA = src*8, RB = table*8, RC = str_const*8 (~) | evlddx TAB:RB, BASE, RB | srwi TMP1, RC, 1 | checktab TAB:RB | subfic TMP1, TMP1, -4 | lwzx STR:RC, KBASE, TMP1 // KBASE-4-str_const*4 | checkfail ->vmeta_tsets1 |->BC_TSETS_Z: | // TAB:RB = GCtab *, STR:RC = GCstr *, RA = src*8 | lwz TMP0, TAB:RB->hmask | lwz TMP1, STR:RC->hash | lwz NODE:TMP2, TAB:RB->node | evmergelo STR:RC, TISSTR, STR:RC | stb ZERO, TAB:RB->nomm // Clear metamethod cache. | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | evlddx SAVE0, BASE, RA | slwi TMP0, TMP1, 5 | slwi TMP1, TMP1, 3 | sub TMP1, TMP0, TMP1 | lbz TMP3, TAB:RB->marked | add NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) |1: | evldd TMP0, NODE:TMP2->key | evldd TMP1, NODE:TMP2->val | evcmpeq TMP0, STR:RC | checkanyfail >5 | checknil TMP1 | checkok >4 // Key found, but nil value? |2: | andi. TMP0, TMP3, LJ_GC_BLACK // isblack(table) | evstdd SAVE0, NODE:TMP2->val | bne >7 |3: | ins_next | |4: // Check for __newindex if previous value is nil. | lwz TAB:TMP1, TAB:RB->metatable | cmplwi TAB:TMP1, 0 | beq <2 // No metatable: done. | lbz TMP0, TAB:TMP1->nomm | andi. TMP0, TMP0, 1<vmeta_tsets | |5: // Follow hash chain. | lwz NODE:TMP2, NODE:TMP2->next | cmplwi NODE:TMP2, 0 | bne <1 | // End of hash chain: key not found, add a new one. | | // But check for __newindex first. | lwz TAB:TMP1, TAB:RB->metatable | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | stw PC, SAVE_PC | mr CARG1, L | cmplwi TAB:TMP1, 0 | stw BASE, L->base | beq >6 // No metatable: continue. | lbz TMP0, TAB:TMP1->nomm | andi. TMP0, TMP0, 1<vmeta_tsets // 'no __newindex' flag NOT set: check. |6: | mr CARG2, TAB:RB | evstdd STR:RC, 0(CARG3) | bl extern lj_tab_newkey // (lua_State *L, GCtab *t, TValue *k) | // Returns TValue *. | lwz BASE, L->base | evstdd SAVE0, 0(CRET1) | b <3 // No 2nd write barrier needed. | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0 | b <3 break; case BC_TSETB: | // RA = src*8, RB = table*8, RC = index*8 | evlddx TAB:RB, BASE, RB | srwi TMP0, RC, 3 | checktab TAB:RB | checkfail ->vmeta_tsetb | lwz TMP1, TAB:RB->asize | lwz TMP2, TAB:RB->array | lbz TMP3, TAB:RB->marked | cmplw TMP0, TMP1 | evlddx SAVE0, BASE, RA | bge ->vmeta_tsetb | evlddx TMP1, TMP2, RC | checknil TMP1 | checkok >5 |1: | andi. TMP0, TMP3, LJ_GC_BLACK // isblack(table) | evstddx SAVE0, TMP2, RC | bne >7 |2: | ins_next | |5: // Check for __newindex if previous value is nil. | lwz TAB:TMP1, TAB:RB->metatable | cmplwi TAB:TMP1, 0 | beq <1 // No metatable: done. | lbz TMP1, TAB:TMP1->nomm | andi. TMP1, TMP1, 1<vmeta_tsetb // Caveat: preserve TMP0! | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0 | b <2 break; case BC_TSETM: | // RA = base*8 (table at base-1), RD = num_const*8 (start index) | add RA, BASE, RA |1: | add TMP3, KBASE, RD | lwz TAB:CARG2, -4(RA) // Guaranteed to be a table. | addic. TMP0, MULTRES, -8 | lwz TMP3, 4(TMP3) // Integer constant is in lo-word. | srwi CARG3, TMP0, 3 | beq >4 // Nothing to copy? | add CARG3, CARG3, TMP3 | lwz TMP2, TAB:CARG2->asize | slwi TMP1, TMP3, 3 | lbz TMP3, TAB:CARG2->marked | cmplw CARG3, TMP2 | add TMP2, RA, TMP0 | lwz TMP0, TAB:CARG2->array | bgt >5 | add TMP1, TMP1, TMP0 | andi. TMP0, TMP3, LJ_GC_BLACK // isblack(table) |3: // Copy result slots to table. | evldd TMP0, 0(RA) | addi RA, RA, 8 | cmpw cr1, RA, TMP2 | evstdd TMP0, 0(TMP1) | addi TMP1, TMP1, 8 | blt cr1, <3 | bne >7 |4: | ins_next | |5: // Need to resize array part. | stw BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | mr SAVE0, RD | bl extern lj_tab_reasize // (lua_State *L, GCtab *t, int nasize) | // Must not reallocate the stack. | mr RD, SAVE0 | b <1 | |7: // Possible table write barrier for any value. Skip valiswhite check. | barrierback TAB:CARG2, TMP3, TMP0 | b <4 break; /* -- Calls and vararg handling ----------------------------------------- */ case BC_CALLM: | // RA = base*8, (RB = (nresults+1)*8,) RC = extra_nargs*8 | add NARGS8:RC, NARGS8:RC, MULTRES | // Fall through. Assumes BC_CALL follows. break; case BC_CALL: | // RA = base*8, (RB = (nresults+1)*8,) RC = (nargs+1)*8 | evlddx LFUNC:RB, BASE, RA | mr TMP2, BASE | add BASE, BASE, RA | subi NARGS8:RC, NARGS8:RC, 8 | checkfunc LFUNC:RB | addi BASE, BASE, 8 | checkfail ->vmeta_call | ins_call break; case BC_CALLMT: | // RA = base*8, (RB = 0,) RC = extra_nargs*8 | add NARGS8:RC, NARGS8:RC, MULTRES | // Fall through. Assumes BC_CALLT follows. break; case BC_CALLT: | // RA = base*8, (RB = 0,) RC = (nargs+1)*8 | evlddx LFUNC:RB, BASE, RA | add RA, BASE, RA | lwz TMP1, FRAME_PC(BASE) | subi NARGS8:RC, NARGS8:RC, 8 | checkfunc LFUNC:RB | addi RA, RA, 8 | checkfail ->vmeta_callt |->BC_CALLT_Z: | andi. TMP0, TMP1, FRAME_TYPE // Caveat: preserve cr0 until the crand. | lbz TMP3, LFUNC:RB->ffid | xori TMP2, TMP1, FRAME_VARG | cmplwi cr1, NARGS8:RC, 0 | bne >7 |1: | stw LFUNC:RB, FRAME_FUNC(BASE) // Copy function down, but keep PC. | li TMP2, 0 | cmplwi cr7, TMP3, 1 // (> FF_C) Calling a fast function? | beq cr1, >3 |2: | addi TMP3, TMP2, 8 | evlddx TMP0, RA, TMP2 | cmplw cr1, TMP3, NARGS8:RC | evstddx TMP0, BASE, TMP2 | mr TMP2, TMP3 | bne cr1, <2 |3: | crand 4*cr0+eq, 4*cr0+eq, 4*cr7+gt | beq >5 |4: | ins_callt | |5: // Tailcall to a fast function with a Lua frame below. | lwz INS, -4(TMP1) | decode_RA8 RA, INS | sub TMP1, BASE, RA | lwz LFUNC:TMP1, FRAME_FUNC-8(TMP1) | lwz TMP1, LFUNC:TMP1->pc | lwz KBASE, PC2PROTO(k)(TMP1) // Need to prepare KBASE. | b <4 | |7: // Tailcall from a vararg function. | andi. TMP0, TMP2, FRAME_TYPEP | bne <1 // Vararg frame below? | sub BASE, BASE, TMP2 // Relocate BASE down. | lwz TMP1, FRAME_PC(BASE) | andi. TMP0, TMP1, FRAME_TYPE | b <1 break; case BC_ITERC: | // RA = base*8, (RB = (nresults+1)*8, RC = (nargs+1)*8 ((2+1)*8)) | subi RA, RA, 24 // evldd doesn't support neg. offsets. | mr TMP2, BASE | evlddx LFUNC:RB, BASE, RA | add BASE, BASE, RA | evldd TMP0, 8(BASE) | evldd TMP1, 16(BASE) | evstdd LFUNC:RB, 24(BASE) // Copy callable. | checkfunc LFUNC:RB | evstdd TMP0, 32(BASE) // Copy state. | li NARGS8:RC, 16 // Iterators get 2 arguments. | evstdd TMP1, 40(BASE) // Copy control var. | addi BASE, BASE, 32 | checkfail ->vmeta_call | ins_call break; case BC_ITERN: | // RA = base*8, (RB = (nresults+1)*8, RC = (nargs+1)*8 (2+1)*8) |.if JIT | // NYI: add hotloop, record BC_ITERN. |.endif | add RA, BASE, RA | lwz TAB:RB, -12(RA) | lwz RC, -4(RA) // Get index from control var. | lwz TMP0, TAB:RB->asize | lwz TMP1, TAB:RB->array | addi PC, PC, 4 |1: // Traverse array part. | cmplw RC, TMP0 | slwi TMP3, RC, 3 | bge >5 // Index points after array part? | evlddx TMP2, TMP1, TMP3 | checknil TMP2 | lwz INS, -4(PC) | checkok >4 | efdcfsi TMP0, RC | addi RC, RC, 1 | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | evstdd TMP2, 8(RA) | decode_RD4 TMP1, INS | stw RC, -4(RA) // Update control var. | add PC, TMP1, TMP3 | evstdd TMP0, 0(RA) |3: | ins_next | |4: // Skip holes in array part. | addi RC, RC, 1 | b <1 | |5: // Traverse hash part. | lwz TMP1, TAB:RB->hmask | sub RC, RC, TMP0 | lwz TMP2, TAB:RB->node |6: | cmplw RC, TMP1 // End of iteration? Branch to ITERL+1. | slwi TMP3, RC, 5 | bgt <3 | slwi RB, RC, 3 | sub TMP3, TMP3, RB | evlddx RB, TMP2, TMP3 | add NODE:TMP3, TMP2, TMP3 | checknil RB | lwz INS, -4(PC) | checkok >7 | evldd TMP3, NODE:TMP3->key | addis TMP2, PC, -(BCBIAS_J*4 >> 16) | evstdd RB, 8(RA) | add RC, RC, TMP0 | decode_RD4 TMP1, INS | evstdd TMP3, 0(RA) | addi RC, RC, 1 | add PC, TMP1, TMP2 | stw RC, -4(RA) // Update control var. | b <3 | |7: // Skip holes in hash part. | addi RC, RC, 1 | b <6 break; case BC_ISNEXT: | // RA = base*8, RD = target (points to ITERN) | add RA, BASE, RA | li TMP2, -24 | evlddx CFUNC:TMP1, RA, TMP2 | lwz TMP2, -16(RA) | lwz TMP3, -8(RA) | evmergehi TMP0, CFUNC:TMP1, CFUNC:TMP1 | cmpwi cr0, TMP2, LJ_TTAB | cmpwi cr1, TMP0, LJ_TFUNC | cmpwi cr6, TMP3, LJ_TNIL | bne cr1, >5 | lbz TMP1, CFUNC:TMP1->ffid | crand 4*cr0+eq, 4*cr0+eq, 4*cr6+eq | cmpwi cr7, TMP1, FF_next_N | srwi TMP0, RD, 1 | crand 4*cr0+eq, 4*cr0+eq, 4*cr7+eq | add TMP3, PC, TMP0 | bne cr0, >5 | lus TMP1, 0xfffe | ori TMP1, TMP1, 0x7fff | stw ZERO, -4(RA) // Initialize control var. | stw TMP1, -8(RA) | addis PC, TMP3, -(BCBIAS_J*4 >> 16) |1: | ins_next |5: // Despecialize bytecode if any of the checks fail. | li TMP0, BC_JMP | li TMP1, BC_ITERC | stb TMP0, -1(PC) | addis PC, TMP3, -(BCBIAS_J*4 >> 16) | stb TMP1, 3(PC) | b <1 break; case BC_VARG: | // RA = base*8, RB = (nresults+1)*8, RC = numparams*8 | lwz TMP0, FRAME_PC(BASE) | add RC, BASE, RC | add RA, BASE, RA | addi RC, RC, FRAME_VARG | add TMP2, RA, RB | subi TMP3, BASE, 8 // TMP3 = vtop | sub RC, RC, TMP0 // RC = vbase | // Note: RC may now be even _above_ BASE if nargs was < numparams. | cmplwi cr1, RB, 0 | sub. TMP1, TMP3, RC | beq cr1, >5 // Copy all varargs? | subi TMP2, TMP2, 16 | ble >2 // No vararg slots? |1: // Copy vararg slots to destination slots. | evldd TMP0, 0(RC) | addi RC, RC, 8 | evstdd TMP0, 0(RA) | cmplw RA, TMP2 | cmplw cr1, RC, TMP3 | bge >3 // All destination slots filled? | addi RA, RA, 8 | blt cr1, <1 // More vararg slots? |2: // Fill up remainder with nil. | evstdd TISNIL, 0(RA) | cmplw RA, TMP2 | addi RA, RA, 8 | blt <2 |3: | ins_next | |5: // Copy all varargs. | lwz TMP0, L->maxstack | li MULTRES, 8 // MULTRES = (0+1)*8 | ble <3 // No vararg slots? | add TMP2, RA, TMP1 | cmplw TMP2, TMP0 | addi MULTRES, TMP1, 8 | bgt >7 |6: | evldd TMP0, 0(RC) | addi RC, RC, 8 | evstdd TMP0, 0(RA) | cmplw RC, TMP3 | addi RA, RA, 8 | blt <6 // More vararg slots? | b <3 | |7: // Grow stack for varargs. | mr CARG1, L | stw RA, L->top | sub SAVE0, RC, BASE // Need delta, because BASE may change. | stw BASE, L->base | sub RA, RA, BASE | stw PC, SAVE_PC | srwi CARG2, TMP1, 3 | bl extern lj_state_growstack // (lua_State *L, int n) | lwz BASE, L->base | add RA, BASE, RA | add RC, BASE, SAVE0 | subi TMP3, BASE, 8 | b <6 break; /* -- Returns ----------------------------------------------------------- */ case BC_RETM: | // RA = results*8, RD = extra_nresults*8 | add RD, RD, MULTRES // MULTRES >= 8, so RD >= 8. | // Fall through. Assumes BC_RET follows. break; case BC_RET: | // RA = results*8, RD = (nresults+1)*8 | lwz PC, FRAME_PC(BASE) | add RA, BASE, RA | mr MULTRES, RD |1: | andi. TMP0, PC, FRAME_TYPE | xori TMP1, PC, FRAME_VARG | bne ->BC_RETV_Z | |->BC_RET_Z: | // BASE = base, RA = resultptr, RD = (nresults+1)*8, PC = return | lwz INS, -4(PC) | cmpwi RD, 8 | subi TMP2, BASE, 8 | subi RC, RD, 8 | decode_RB8 RB, INS | beq >3 | li TMP1, 0 |2: | addi TMP3, TMP1, 8 | evlddx TMP0, RA, TMP1 | cmpw TMP3, RC | evstddx TMP0, TMP2, TMP1 | beq >3 | addi TMP1, TMP3, 8 | evlddx TMP0, RA, TMP3 | cmpw TMP1, RC | evstddx TMP0, TMP2, TMP3 | bne <2 |3: |5: | cmplw RB, RD | decode_RA8 RA, INS | bgt >6 | sub BASE, TMP2, RA | lwz LFUNC:TMP1, FRAME_FUNC(BASE) | ins_next1 | lwz TMP1, LFUNC:TMP1->pc | lwz KBASE, PC2PROTO(k)(TMP1) | ins_next2 | |6: // Fill up results with nil. | subi TMP1, RD, 8 | addi RD, RD, 8 | evstddx TISNIL, TMP2, TMP1 | b <5 | |->BC_RETV_Z: // Non-standard return case. | andi. TMP2, TMP1, FRAME_TYPEP | bne ->vm_return | // Return from vararg function: relocate BASE down. | sub BASE, BASE, TMP1 | lwz PC, FRAME_PC(BASE) | b <1 break; case BC_RET0: case BC_RET1: | // RA = results*8, RD = (nresults+1)*8 | lwz PC, FRAME_PC(BASE) | add RA, BASE, RA | mr MULTRES, RD | andi. TMP0, PC, FRAME_TYPE | xori TMP1, PC, FRAME_VARG | bne ->BC_RETV_Z | | lwz INS, -4(PC) | subi TMP2, BASE, 8 | decode_RB8 RB, INS if (op == BC_RET1) { | evldd TMP0, 0(RA) | evstdd TMP0, 0(TMP2) } |5: | cmplw RB, RD | decode_RA8 RA, INS | bgt >6 | sub BASE, TMP2, RA | lwz LFUNC:TMP1, FRAME_FUNC(BASE) | ins_next1 | lwz TMP1, LFUNC:TMP1->pc | lwz KBASE, PC2PROTO(k)(TMP1) | ins_next2 | |6: // Fill up results with nil. | subi TMP1, RD, 8 | addi RD, RD, 8 | evstddx TISNIL, TMP2, TMP1 | b <5 break; /* -- Loops and branches ------------------------------------------------ */ case BC_FORL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IFORL follows. break; case BC_JFORI: case BC_JFORL: #if !LJ_HASJIT break; #endif case BC_FORI: case BC_IFORL: | // RA = base*8, RD = target (after end of loop or start of loop) vk = (op == BC_IFORL || op == BC_JFORL); | add RA, BASE, RA | evldd TMP1, FORL_IDX*8(RA) | evldd TMP3, FORL_STEP*8(RA) | evldd TMP2, FORL_STOP*8(RA) if (!vk) { | evcmpgtu cr0, TMP1, TISNUM | evcmpgtu cr7, TMP3, TISNUM | evcmpgtu cr1, TMP2, TISNUM | cror 4*cr0+lt, 4*cr0+lt, 4*cr7+lt | cror 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | blt ->vmeta_for } if (vk) { | efdadd TMP1, TMP1, TMP3 | evstdd TMP1, FORL_IDX*8(RA) } | evcmpgts TMP3, TISNIL | evstdd TMP1, FORL_EXT*8(RA) | bge >2 | efdcmpgt TMP1, TMP2 |1: if (op != BC_JFORL) { | srwi RD, RD, 1 | add RD, PC, RD if (op == BC_JFORI) { | addis PC, RD, -(BCBIAS_J*4 >> 16) } else { | addis RD, RD, -(BCBIAS_J*4 >> 16) } } if (op == BC_FORI) { | iselgt PC, RD, PC } else if (op == BC_IFORL) { | iselgt PC, PC, RD } else { | ble =>BC_JLOOP } | ins_next |2: | efdcmpgt TMP2, TMP1 | b <1 break; case BC_ITERL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IITERL follows. break; case BC_JITERL: #if !LJ_HASJIT break; #endif case BC_IITERL: | // RA = base*8, RD = target | evlddx TMP1, BASE, RA | subi RA, RA, 8 | checknil TMP1 | checkok >1 // Stop if iterator returned nil. if (op == BC_JITERL) { | NYI } else { | branch_RD // Otherwise save control var + branch. | evstddx TMP1, BASE, RA } |1: | ins_next break; case BC_LOOP: | // RA = base*8, RD = target (loop extent) | // Note: RA/RD is only used by trace recorder to determine scope/extent | // This opcode does NOT jump, it's only purpose is to detect a hot loop. |.if JIT | hotloop |.endif | // Fall through. Assumes BC_ILOOP follows. break; case BC_ILOOP: | // RA = base*8, RD = target (loop extent) | ins_next break; case BC_JLOOP: |.if JIT | NYI |.endif break; case BC_JMP: | // RA = base*8 (only used by trace recorder), RD = target | branch_RD | ins_next break; /* -- Function headers -------------------------------------------------- */ case BC_FUNCF: |.if JIT | hotcall |.endif case BC_FUNCV: /* NYI: compiled vararg functions. */ | // Fall through. Assumes BC_IFUNCF/BC_IFUNCV follow. break; case BC_JFUNCF: #if !LJ_HASJIT break; #endif case BC_IFUNCF: | // BASE = new base, RA = BASE+framesize*8, RB = LFUNC, RC = nargs*8 | lwz TMP2, L->maxstack | lbz TMP1, -4+PC2PROTO(numparams)(PC) | lwz KBASE, -4+PC2PROTO(k)(PC) | cmplw RA, TMP2 | slwi TMP1, TMP1, 3 | bgt ->vm_growstack_l | ins_next1 |2: | cmplw NARGS8:RC, TMP1 // Check for missing parameters. | ble >3 if (op == BC_JFUNCF) { | NYI } else { | ins_next2 } | |3: // Clear missing parameters. | evstddx TISNIL, BASE, NARGS8:RC | addi NARGS8:RC, NARGS8:RC, 8 | b <2 break; case BC_JFUNCV: #if !LJ_HASJIT break; #endif | NYI // NYI: compiled vararg functions break; /* NYI: compiled vararg functions. */ case BC_IFUNCV: | // BASE = new base, RA = BASE+framesize*8, RB = LFUNC, RC = nargs*8 | lwz TMP2, L->maxstack | add TMP1, BASE, RC | add TMP0, RA, RC | stw LFUNC:RB, 4(TMP1) // Store copy of LFUNC. | addi TMP3, RC, 8+FRAME_VARG | lwz KBASE, -4+PC2PROTO(k)(PC) | cmplw TMP0, TMP2 | stw TMP3, 0(TMP1) // Store delta + FRAME_VARG. | bge ->vm_growstack_l | lbz TMP2, -4+PC2PROTO(numparams)(PC) | mr RA, BASE | mr RC, TMP1 | ins_next1 | cmpwi TMP2, 0 | addi BASE, TMP1, 8 | beq >3 |1: | cmplw RA, RC // Less args than parameters? | evldd TMP0, 0(RA) | bge >4 | evstdd TISNIL, 0(RA) // Clear old fixarg slot (help the GC). | addi RA, RA, 8 |2: | addic. TMP2, TMP2, -1 | evstdd TMP0, 8(TMP1) | addi TMP1, TMP1, 8 | bne <1 |3: | ins_next2 | |4: // Clear missing parameters. | evmr TMP0, TISNIL | b <2 break; case BC_FUNCC: case BC_FUNCCW: | // BASE = new base, RA = BASE+framesize*8, RB = CFUNC, RC = nargs*8 if (op == BC_FUNCC) { | lwz TMP3, CFUNC:RB->f } else { | lwz TMP3, DISPATCH_GL(wrapf)(DISPATCH) } | add TMP1, RA, NARGS8:RC | lwz TMP2, L->maxstack | add RC, BASE, NARGS8:RC | stw BASE, L->base | cmplw TMP1, TMP2 | stw RC, L->top | li_vmstate C | mtctr TMP3 if (op == BC_FUNCCW) { | lwz CARG2, CFUNC:RB->f } | mr CARG1, L | bgt ->vm_growstack_c // Need to grow stack. | st_vmstate | bctrl // (lua_State *L [, lua_CFunction f]) | // Returns nresults. | lwz TMP1, L->top | slwi RD, CRET1, 3 | lwz BASE, L->base | li_vmstate INTERP | lwz PC, FRAME_PC(BASE) // Fetch PC of caller. | sub RA, TMP1, RD // RA = L->top - nresults*8 | st_vmstate | b ->vm_returnc break; /* ---------------------------------------------------------------------- */ default: fprintf(stderr, "Error: undefined opcode BC_%s\n", bc_names[op]); exit(2); break; } } static int build_backend(BuildCtx *ctx) { int op; dasm_growpc(Dst, BC__MAX); build_subroutines(ctx); |.code_op for (op = 0; op < BC__MAX; op++) build_ins(ctx, (BCOp)op, op); return BC__MAX; } /* Emit pseudo frame-info for all assembler functions. */ static void emit_asm_debug(BuildCtx *ctx) { int i; switch (ctx->mode) { case BUILD_elfasm: fprintf(ctx->fp, "\t.section .debug_frame,\"\",@progbits\n"); fprintf(ctx->fp, ".Lframe0:\n" "\t.long .LECIE0-.LSCIE0\n" ".LSCIE0:\n" "\t.long 0xffffffff\n" "\t.byte 0x1\n" "\t.string \"\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 65\n" "\t.byte 0xc\n\t.uleb128 1\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE0:\n\n"); fprintf(ctx->fp, ".LSFDE0:\n" "\t.long .LEFDE0-.LASFDE0\n" ".LASFDE0:\n" "\t.long .Lframe0\n" "\t.long .Lbegin\n" "\t.long %d\n" "\t.byte 0xe\n\t.uleb128 %d\n" "\t.byte 0x11\n\t.uleb128 65\n\t.sleb128 -1\n" "\t.byte 0x5\n\t.uleb128 70\n\t.sleb128 37\n", (int)ctx->codesz, CFRAME_SIZE); for (i = 14; i <= 31; i++) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n" "\t.byte 5\n\t.uleb128 %d\n\t.uleb128 %d\n", 0x80+i, 1+2*(31-i), 1200+i, 2+2*(31-i)); fprintf(ctx->fp, "\t.align 2\n" ".LEFDE0:\n\n"); fprintf(ctx->fp, "\t.section .eh_frame,\"a\",@progbits\n"); fprintf(ctx->fp, ".Lframe1:\n" "\t.long .LECIE1-.LSCIE1\n" ".LSCIE1:\n" "\t.long 0\n" "\t.byte 0x1\n" "\t.string \"zPR\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 65\n" "\t.uleb128 6\n" /* augmentation length */ "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.long lj_err_unwind_dwarf-.\n" "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.uleb128 1\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE1:\n\n"); fprintf(ctx->fp, ".LSFDE1:\n" "\t.long .LEFDE1-.LASFDE1\n" ".LASFDE1:\n" "\t.long .LASFDE1-.Lframe1\n" "\t.long .Lbegin-.\n" "\t.long %d\n" "\t.uleb128 0\n" /* augmentation length */ "\t.byte 0xe\n\t.uleb128 %d\n" "\t.byte 0x11\n\t.uleb128 65\n\t.sleb128 -1\n" "\t.byte 0x5\n\t.uleb128 70\n\t.sleb128 37\n", (int)ctx->codesz, CFRAME_SIZE); for (i = 14; i <= 31; i++) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n" "\t.byte 5\n\t.uleb128 %d\n\t.uleb128 %d\n", 0x80+i, 1+2*(31-i), 1200+i, 2+2*(31-i)); fprintf(ctx->fp, "\t.align 2\n" ".LEFDE1:\n\n"); break; default: break; } } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_mcode.h0000644000175000017500000000126313122010155016620 0ustar philphil/* ** Machine code management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_MCODE_H #define _LJ_MCODE_H #include "lj_obj.h" #if LJ_HASJIT || LJ_HASFFI LJ_FUNC void lj_mcode_sync(void *start, void *end); #endif #if LJ_HASJIT #include "lj_jit.h" LJ_FUNC void lj_mcode_free(jit_State *J); LJ_FUNC MCode *lj_mcode_reserve(jit_State *J, MCode **lim); LJ_FUNC void lj_mcode_commit(jit_State *J, MCode *m); LJ_FUNC void lj_mcode_abort(jit_State *J); LJ_FUNC MCode *lj_mcode_patch(jit_State *J, MCode *ptr, int finish); LJ_FUNC_NORET void lj_mcode_limiterr(jit_State *J, size_t need); #define lj_mcode_commitbot(J, m) (J->mcbot = (m)) #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_dispatch.h0000644000175000017500000001037713122010155017336 0ustar philphil/* ** Instruction dispatch handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_DISPATCH_H #define _LJ_DISPATCH_H #include "lj_obj.h" #include "lj_bc.h" #if LJ_HASJIT #include "lj_jit.h" #endif #if LJ_TARGET_MIPS /* Need our own global offset table for the dreaded MIPS calling conventions. */ #if LJ_HASJIT #define JITGOTDEF(_) _(lj_trace_exit) _(lj_trace_hot) #else #define JITGOTDEF(_) #endif #if LJ_HASFFI #define FFIGOTDEF(_) \ _(lj_meta_equal_cd) _(lj_ccallback_enter) _(lj_ccallback_leave) #else #define FFIGOTDEF(_) #endif #define GOTDEF(_) \ _(floor) _(ceil) _(trunc) _(log) _(log10) _(exp) _(sin) _(cos) _(tan) \ _(asin) _(acos) _(atan) _(sinh) _(cosh) _(tanh) _(frexp) _(modf) _(atan2) \ _(pow) _(fmod) _(ldexp) \ _(lj_dispatch_call) _(lj_dispatch_ins) _(lj_err_throw) \ _(lj_ffh_coroutine_wrap_err) _(lj_func_closeuv) _(lj_func_newL_gc) \ _(lj_gc_barrieruv) _(lj_gc_step) _(lj_gc_step_fixtop) _(lj_meta_arith) \ _(lj_meta_call) _(lj_meta_cat) _(lj_meta_comp) _(lj_meta_equal) \ _(lj_meta_for) _(lj_meta_len) _(lj_meta_tget) _(lj_meta_tset) \ _(lj_state_growstack) _(lj_str_fromnum) _(lj_str_fromnumber) _(lj_str_new) \ _(lj_tab_dup) _(lj_tab_get) _(lj_tab_getinth) _(lj_tab_len) _(lj_tab_new) \ _(lj_tab_newkey) _(lj_tab_next) _(lj_tab_reasize) \ JITGOTDEF(_) FFIGOTDEF(_) enum { #define GOTENUM(name) LJ_GOT_##name, GOTDEF(GOTENUM) #undef GOTENUM LJ_GOT__MAX }; #endif /* Type of hot counter. Must match the code in the assembler VM. */ /* 16 bits are sufficient. Only 0.0015% overhead with maximum slot penalty. */ typedef uint16_t HotCount; /* Number of hot counter hash table entries (must be a power of two). */ #define HOTCOUNT_SIZE 64 #define HOTCOUNT_PCMASK ((HOTCOUNT_SIZE-1)*sizeof(HotCount)) /* Hotcount decrements. */ #define HOTCOUNT_LOOP 2 #define HOTCOUNT_CALL 1 /* This solves a circular dependency problem -- bump as needed. Sigh. */ #define GG_NUM_ASMFF 62 #define GG_LEN_DDISP (BC__MAX + GG_NUM_ASMFF) #define GG_LEN_SDISP BC_FUNCF #define GG_LEN_DISP (GG_LEN_DDISP + GG_LEN_SDISP) /* Global state, main thread and extra fields are allocated together. */ typedef struct GG_State { lua_State L; /* Main thread. */ global_State g; /* Global state. */ #if LJ_TARGET_MIPS ASMFunction got[LJ_GOT__MAX]; /* Global offset table. */ #endif #if LJ_HASJIT jit_State J; /* JIT state. */ HotCount hotcount[HOTCOUNT_SIZE]; /* Hot counters. */ #endif ASMFunction dispatch[GG_LEN_DISP]; /* Instruction dispatch tables. */ BCIns bcff[GG_NUM_ASMFF]; /* Bytecode for ASM fast functions. */ } GG_State; #define GG_OFS(field) ((int)offsetof(GG_State, field)) #define G2GG(gl) ((GG_State *)((char *)(gl) - GG_OFS(g))) #define J2GG(j) ((GG_State *)((char *)(j) - GG_OFS(J))) #define L2GG(L) (G2GG(G(L))) #define J2G(J) (&J2GG(J)->g) #define G2J(gl) (&G2GG(gl)->J) #define L2J(L) (&L2GG(L)->J) #define GG_G2DISP (GG_OFS(dispatch) - GG_OFS(g)) #define GG_DISP2G (GG_OFS(g) - GG_OFS(dispatch)) #define GG_DISP2J (GG_OFS(J) - GG_OFS(dispatch)) #define GG_DISP2HOT (GG_OFS(hotcount) - GG_OFS(dispatch)) #define GG_DISP2STATIC (GG_LEN_DDISP*(int)sizeof(ASMFunction)) #define hotcount_get(gg, pc) \ (gg)->hotcount[(u32ptr(pc)>>2) & (HOTCOUNT_SIZE-1)] #define hotcount_set(gg, pc, val) \ (hotcount_get((gg), (pc)) = (HotCount)(val)) /* Dispatch table management. */ LJ_FUNC void lj_dispatch_init(GG_State *GG); #if LJ_HASJIT LJ_FUNC void lj_dispatch_init_hotcount(global_State *g); #endif LJ_FUNC void lj_dispatch_update(global_State *g); /* Instruction dispatch callback for hooks or when recording. */ LJ_FUNCA void LJ_FASTCALL lj_dispatch_ins(lua_State *L, const BCIns *pc); LJ_FUNCA ASMFunction LJ_FASTCALL lj_dispatch_call(lua_State *L, const BCIns*pc); LJ_FUNCA void LJ_FASTCALL lj_dispatch_return(lua_State *L, const BCIns *pc); #if LJ_HASFFI && !defined(_BUILDVM_H) /* Save/restore errno and GetLastError() around hooks, exits and recording. */ #include #if LJ_TARGET_WINDOWS #define WIN32_LEAN_AND_MEAN #include #define ERRNO_SAVE int olderr = errno; DWORD oldwerr = GetLastError(); #define ERRNO_RESTORE errno = olderr; SetLastError(oldwerr); #else #define ERRNO_SAVE int olderr = errno; #define ERRNO_RESTORE errno = olderr; #endif #else #define ERRNO_SAVE #define ERRNO_RESTORE #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_emit_x86.h0000644000175000017500000002720113122010155017174 0ustar philphil/* ** x86/x64 instruction emitter. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Emit basic instructions --------------------------------------------- */ #define MODRM(mode, r1, r2) ((MCode)((mode)+(((r1)&7)<<3)+((r2)&7))) #if LJ_64 #define REXRB(p, rr, rb) \ { MCode rex = 0x40 + (((rr)>>1)&4) + (((rb)>>3)&1); \ if (rex != 0x40) *--(p) = rex; } #define FORCE_REX 0x200 #define REX_64 (FORCE_REX|0x080000) #else #define REXRB(p, rr, rb) ((void)0) #define FORCE_REX 0 #define REX_64 0 #endif #define emit_i8(as, i) (*--as->mcp = (MCode)(i)) #define emit_i32(as, i) (*(int32_t *)(as->mcp-4) = (i), as->mcp -= 4) #define emit_u32(as, u) (*(uint32_t *)(as->mcp-4) = (u), as->mcp -= 4) #define emit_x87op(as, xo) \ (*(uint16_t *)(as->mcp-2) = (uint16_t)(xo), as->mcp -= 2) /* op */ static LJ_AINLINE MCode *emit_op(x86Op xo, Reg rr, Reg rb, Reg rx, MCode *p, int delta) { int n = (int8_t)xo; #if defined(__GNUC__) if (__builtin_constant_p(xo) && n == -2) p[delta-2] = (MCode)(xo >> 24); else if (__builtin_constant_p(xo) && n == -3) *(uint16_t *)(p+delta-3) = (uint16_t)(xo >> 16); else #endif *(uint32_t *)(p+delta-5) = (uint32_t)xo; p += n + delta; #if LJ_64 { uint32_t rex = 0x40 + ((rr>>1)&(4+(FORCE_REX>>1)))+((rx>>2)&2)+((rb>>3)&1); if (rex != 0x40) { rex |= (rr >> 16); if (n == -4) { *p = (MCode)rex; rex = (MCode)(xo >> 8); } else if ((xo & 0xffffff) == 0x6600fd) { *p = (MCode)rex; rex = 0x66; } *--p = (MCode)rex; } } #else UNUSED(rr); UNUSED(rb); UNUSED(rx); #endif return p; } /* op + modrm */ #define emit_opm(xo, mode, rr, rb, p, delta) \ (p[(delta)-1] = MODRM((mode), (rr), (rb)), \ emit_op((xo), (rr), (rb), 0, (p), (delta))) /* op + modrm + sib */ #define emit_opmx(xo, mode, scale, rr, rb, rx, p) \ (p[-1] = MODRM((scale), (rx), (rb)), \ p[-2] = MODRM((mode), (rr), RID_ESP), \ emit_op((xo), (rr), (rb), (rx), (p), -1)) /* op r1, r2 */ static void emit_rr(ASMState *as, x86Op xo, Reg r1, Reg r2) { MCode *p = as->mcp; as->mcp = emit_opm(xo, XM_REG, r1, r2, p, 0); } #if LJ_64 && defined(LUA_USE_ASSERT) /* [addr] is sign-extended in x64 and must be in lower 2G (not 4G). */ static int32_t ptr2addr(const void *p) { lua_assert((uintptr_t)p < (uintptr_t)0x80000000); return i32ptr(p); } #else #define ptr2addr(p) (i32ptr((p))) #endif /* op r, [addr] */ static void emit_rma(ASMState *as, x86Op xo, Reg rr, const void *addr) { MCode *p = as->mcp; *(int32_t *)(p-4) = ptr2addr(addr); #if LJ_64 p[-5] = MODRM(XM_SCALE1, RID_ESP, RID_EBP); as->mcp = emit_opm(xo, XM_OFS0, rr, RID_ESP, p, -5); #else as->mcp = emit_opm(xo, XM_OFS0, rr, RID_EBP, p, -4); #endif } /* op r, [base+ofs] */ static void emit_rmro(ASMState *as, x86Op xo, Reg rr, Reg rb, int32_t ofs) { MCode *p = as->mcp; x86Mode mode; if (ra_hasreg(rb)) { if (ofs == 0 && (rb&7) != RID_EBP) { mode = XM_OFS0; } else if (checki8(ofs)) { *--p = (MCode)ofs; mode = XM_OFS8; } else { p -= 4; *(int32_t *)p = ofs; mode = XM_OFS32; } if ((rb&7) == RID_ESP) *--p = MODRM(XM_SCALE1, RID_ESP, RID_ESP); } else { *(int32_t *)(p-4) = ofs; #if LJ_64 p[-5] = MODRM(XM_SCALE1, RID_ESP, RID_EBP); p -= 5; rb = RID_ESP; #else p -= 4; rb = RID_EBP; #endif mode = XM_OFS0; } as->mcp = emit_opm(xo, mode, rr, rb, p, 0); } /* op r, [base+idx*scale+ofs] */ static void emit_rmrxo(ASMState *as, x86Op xo, Reg rr, Reg rb, Reg rx, x86Mode scale, int32_t ofs) { MCode *p = as->mcp; x86Mode mode; if (ofs == 0 && (rb&7) != RID_EBP) { mode = XM_OFS0; } else if (checki8(ofs)) { mode = XM_OFS8; *--p = (MCode)ofs; } else { mode = XM_OFS32; p -= 4; *(int32_t *)p = ofs; } as->mcp = emit_opmx(xo, mode, scale, rr, rb, rx, p); } /* op r, i */ static void emit_gri(ASMState *as, x86Group xg, Reg rb, int32_t i) { MCode *p = as->mcp; x86Op xo; if (checki8(i)) { *--p = (MCode)i; xo = XG_TOXOi8(xg); } else { p -= 4; *(int32_t *)p = i; xo = XG_TOXOi(xg); } as->mcp = emit_opm(xo, XM_REG, (Reg)(xg & 7) | (rb & REX_64), rb, p, 0); } /* op [base+ofs], i */ static void emit_gmroi(ASMState *as, x86Group xg, Reg rb, int32_t ofs, int32_t i) { x86Op xo; if (checki8(i)) { emit_i8(as, i); xo = XG_TOXOi8(xg); } else { emit_i32(as, i); xo = XG_TOXOi(xg); } emit_rmro(as, xo, (Reg)(xg & 7), rb, ofs); } #define emit_shifti(as, xg, r, i) \ (emit_i8(as, (i)), emit_rr(as, XO_SHIFTi, (Reg)(xg), (r))) /* op r, rm/mrm */ static void emit_mrm(ASMState *as, x86Op xo, Reg rr, Reg rb) { MCode *p = as->mcp; x86Mode mode = XM_REG; if (rb == RID_MRM) { rb = as->mrm.base; if (rb == RID_NONE) { rb = RID_EBP; mode = XM_OFS0; p -= 4; *(int32_t *)p = as->mrm.ofs; if (as->mrm.idx != RID_NONE) goto mrmidx; #if LJ_64 *--p = MODRM(XM_SCALE1, RID_ESP, RID_EBP); rb = RID_ESP; #endif } else { if (as->mrm.ofs == 0 && (rb&7) != RID_EBP) { mode = XM_OFS0; } else if (checki8(as->mrm.ofs)) { *--p = (MCode)as->mrm.ofs; mode = XM_OFS8; } else { p -= 4; *(int32_t *)p = as->mrm.ofs; mode = XM_OFS32; } if (as->mrm.idx != RID_NONE) { mrmidx: as->mcp = emit_opmx(xo, mode, as->mrm.scale, rr, rb, as->mrm.idx, p); return; } if ((rb&7) == RID_ESP) *--p = MODRM(XM_SCALE1, RID_ESP, RID_ESP); } } as->mcp = emit_opm(xo, mode, rr, rb, p, 0); } /* op rm/mrm, i */ static void emit_gmrmi(ASMState *as, x86Group xg, Reg rb, int32_t i) { x86Op xo; if (checki8(i)) { emit_i8(as, i); xo = XG_TOXOi8(xg); } else { emit_i32(as, i); xo = XG_TOXOi(xg); } emit_mrm(as, xo, (Reg)(xg & 7) | (rb & REX_64), (rb & ~REX_64)); } /* -- Emit loads/stores --------------------------------------------------- */ /* Instruction selection for XMM moves. */ #define XMM_MOVRR(as) ((as->flags & JIT_F_SPLIT_XMM) ? XO_MOVSD : XO_MOVAPS) #define XMM_MOVRM(as) ((as->flags & JIT_F_SPLIT_XMM) ? XO_MOVLPD : XO_MOVSD) /* mov [base+ofs], i */ static void emit_movmroi(ASMState *as, Reg base, int32_t ofs, int32_t i) { emit_i32(as, i); emit_rmro(as, XO_MOVmi, 0, base, ofs); } /* mov [base+ofs], r */ #define emit_movtomro(as, r, base, ofs) \ emit_rmro(as, XO_MOVto, (r), (base), (ofs)) /* Get/set global_State fields. */ #define emit_opgl(as, xo, r, field) \ emit_rma(as, (xo), (r), (void *)&J2G(as->J)->field) #define emit_getgl(as, r, field) emit_opgl(as, XO_MOV, (r), field) #define emit_setgl(as, r, field) emit_opgl(as, XO_MOVto, (r), field) #define emit_setvmstate(as, i) \ (emit_i32(as, i), emit_opgl(as, XO_MOVmi, 0, vmstate)) /* mov r, i / xor r, r */ static void emit_loadi(ASMState *as, Reg r, int32_t i) { /* XOR r,r is shorter, but modifies the flags. This is bad for HIOP. */ if (i == 0 && !(LJ_32 && (IR(as->curins)->o == IR_HIOP || (as->curins+1 < as->T->nins && IR(as->curins+1)->o == IR_HIOP)))) { emit_rr(as, XO_ARITH(XOg_XOR), r, r); } else { MCode *p = as->mcp; *(int32_t *)(p-4) = i; p[-5] = (MCode)(XI_MOVri+(r&7)); p -= 5; REXRB(p, 0, r); as->mcp = p; } } /* mov r, addr */ #define emit_loada(as, r, addr) \ emit_loadi(as, (r), ptr2addr((addr))) #if LJ_64 /* mov r, imm64 or shorter 32 bit extended load. */ static void emit_loadu64(ASMState *as, Reg r, uint64_t u64) { if (checku32(u64)) { /* 32 bit load clears upper 32 bits. */ emit_loadi(as, r, (int32_t)u64); } else if (checki32((int64_t)u64)) { /* Sign-extended 32 bit load. */ MCode *p = as->mcp; *(int32_t *)(p-4) = (int32_t)u64; as->mcp = emit_opm(XO_MOVmi, XM_REG, REX_64, r, p, -4); } else { /* Full-size 64 bit load. */ MCode *p = as->mcp; *(uint64_t *)(p-8) = u64; p[-9] = (MCode)(XI_MOVri+(r&7)); p[-10] = 0x48 + ((r>>3)&1); p -= 10; as->mcp = p; } } #endif /* movsd r, [&tv->n] / xorps r, r */ static void emit_loadn(ASMState *as, Reg r, cTValue *tv) { if (tvispzero(tv)) /* Use xor only for +0. */ emit_rr(as, XO_XORPS, r, r); else emit_rma(as, XMM_MOVRM(as), r, &tv->n); } /* -- Emit control-flow instructions -------------------------------------- */ /* Label for short jumps. */ typedef MCode *MCLabel; #if LJ_32 && LJ_HASFFI /* jmp short target */ static void emit_sjmp(ASMState *as, MCLabel target) { MCode *p = as->mcp; ptrdiff_t delta = target - p; lua_assert(delta == (int8_t)delta); p[-1] = (MCode)(int8_t)delta; p[-2] = XI_JMPs; as->mcp = p - 2; } #endif /* jcc short target */ static void emit_sjcc(ASMState *as, int cc, MCLabel target) { MCode *p = as->mcp; ptrdiff_t delta = target - p; lua_assert(delta == (int8_t)delta); p[-1] = (MCode)(int8_t)delta; p[-2] = (MCode)(XI_JCCs+(cc&15)); as->mcp = p - 2; } /* jcc short (pending target) */ static MCLabel emit_sjcc_label(ASMState *as, int cc) { MCode *p = as->mcp; p[-1] = 0; p[-2] = (MCode)(XI_JCCs+(cc&15)); as->mcp = p - 2; return p; } /* Fixup jcc short target. */ static void emit_sfixup(ASMState *as, MCLabel source) { source[-1] = (MCode)(as->mcp-source); } /* Return label pointing to current PC. */ #define emit_label(as) ((as)->mcp) /* Compute relative 32 bit offset for jump and call instructions. */ static LJ_AINLINE int32_t jmprel(MCode *p, MCode *target) { ptrdiff_t delta = target - p; lua_assert(delta == (int32_t)delta); return (int32_t)delta; } /* jcc target */ static void emit_jcc(ASMState *as, int cc, MCode *target) { MCode *p = as->mcp; *(int32_t *)(p-4) = jmprel(p, target); p[-5] = (MCode)(XI_JCCn+(cc&15)); p[-6] = 0x0f; as->mcp = p - 6; } /* jmp target */ static void emit_jmp(ASMState *as, MCode *target) { MCode *p = as->mcp; *(int32_t *)(p-4) = jmprel(p, target); p[-5] = XI_JMP; as->mcp = p - 5; } /* call target */ static void emit_call_(ASMState *as, MCode *target) { MCode *p = as->mcp; #if LJ_64 if (target-p != (int32_t)(target-p)) { /* Assumes RID_RET is never an argument to calls and always clobbered. */ emit_rr(as, XO_GROUP5, XOg_CALL, RID_RET); emit_loadu64(as, RID_RET, (uint64_t)target); return; } #endif *(int32_t *)(p-4) = jmprel(p, target); p[-5] = XI_CALL; as->mcp = p - 5; } #define emit_call(as, f) emit_call_(as, (MCode *)(void *)(f)) /* -- Emit generic operations --------------------------------------------- */ /* Use 64 bit operations to handle 64 bit IR types. */ #if LJ_64 #define REX_64IR(ir, r) ((r) + (irt_is64((ir)->t) ? REX_64 : 0)) #else #define REX_64IR(ir, r) (r) #endif /* Generic move between two regs. */ static void emit_movrr(ASMState *as, IRIns *ir, Reg dst, Reg src) { UNUSED(ir); if (dst < RID_MAX_GPR) emit_rr(as, XO_MOV, REX_64IR(ir, dst), src); else emit_rr(as, XMM_MOVRR(as), dst, src); } /* Generic load of register from stack slot. */ static void emit_spload(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { if (r < RID_MAX_GPR) emit_rmro(as, XO_MOV, REX_64IR(ir, r), RID_ESP, ofs); else emit_rmro(as, irt_isnum(ir->t) ? XMM_MOVRM(as) : XO_MOVSS, r, RID_ESP, ofs); } /* Generic store of register to stack slot. */ static void emit_spstore(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { if (r < RID_MAX_GPR) emit_rmro(as, XO_MOVto, REX_64IR(ir, r), RID_ESP, ofs); else emit_rmro(as, irt_isnum(ir->t) ? XO_MOVSDto : XO_MOVSSto, r, RID_ESP, ofs); } /* Add offset to pointer. */ static void emit_addptr(ASMState *as, Reg r, int32_t ofs) { if (ofs) { if ((as->flags & JIT_F_LEA_AGU)) emit_rmro(as, XO_LEA, r, r, ofs); else emit_gri(as, XG_ARITHi(XOg_ADD), r, ofs); } } #define emit_spsub(as, ofs) emit_addptr(as, RID_ESP|REX_64, -(ofs)) /* Prefer rematerialization of BASE/L from global_State over spills. */ #define emit_canremat(ref) ((ref) <= REF_BASE) wcc-0.0.2/src/wsh/luajit-2.0/src/lj_record.c0000644000175000017500000022254413122010155017011 0ustar philphil/* ** Trace recorder (bytecode -> SSA IR). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_record_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_meta.h" #include "lj_frame.h" #if LJ_HASFFI #include "lj_ctype.h" #endif #include "lj_bc.h" #include "lj_ff.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_ircall.h" #include "lj_iropt.h" #include "lj_trace.h" #include "lj_record.h" #include "lj_ffrecord.h" #include "lj_snap.h" #include "lj_dispatch.h" #include "lj_vm.h" /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) /* Emit raw IR without passing through optimizations. */ #define emitir_raw(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_ir_emit(J)) /* -- Sanity checks ------------------------------------------------------- */ #ifdef LUA_USE_ASSERT /* Sanity check the whole IR -- sloooow. */ static void rec_check_ir(jit_State *J) { IRRef i, nins = J->cur.nins, nk = J->cur.nk; lua_assert(nk <= REF_BIAS && nins >= REF_BIAS && nins < 65536); for (i = nins-1; i >= nk; i--) { IRIns *ir = IR(i); uint32_t mode = lj_ir_mode[ir->o]; IRRef op1 = ir->op1; IRRef op2 = ir->op2; switch (irm_op1(mode)) { case IRMnone: lua_assert(op1 == 0); break; case IRMref: lua_assert(op1 >= nk); lua_assert(i >= REF_BIAS ? op1 < i : op1 > i); break; case IRMlit: break; case IRMcst: lua_assert(i < REF_BIAS); continue; } switch (irm_op2(mode)) { case IRMnone: lua_assert(op2 == 0); break; case IRMref: lua_assert(op2 >= nk); lua_assert(i >= REF_BIAS ? op2 < i : op2 > i); break; case IRMlit: break; case IRMcst: lua_assert(0); break; } if (ir->prev) { lua_assert(ir->prev >= nk); lua_assert(i >= REF_BIAS ? ir->prev < i : ir->prev > i); lua_assert(ir->o == IR_NOP || IR(ir->prev)->o == ir->o); } } } /* Compare stack slots and frames of the recorder and the VM. */ static void rec_check_slots(jit_State *J) { BCReg s, nslots = J->baseslot + J->maxslot; int32_t depth = 0; cTValue *base = J->L->base - J->baseslot; lua_assert(J->baseslot >= 1 && J->baseslot < LJ_MAX_JSLOTS); lua_assert(J->baseslot == 1 || (J->slot[J->baseslot-1] & TREF_FRAME)); lua_assert(nslots < LJ_MAX_JSLOTS); for (s = 0; s < nslots; s++) { TRef tr = J->slot[s]; if (tr) { cTValue *tv = &base[s]; IRRef ref = tref_ref(tr); IRIns *ir; lua_assert(ref >= J->cur.nk && ref < J->cur.nins); ir = IR(ref); lua_assert(irt_t(ir->t) == tref_t(tr)); if (s == 0) { lua_assert(tref_isfunc(tr)); } else if ((tr & TREF_FRAME)) { GCfunc *fn = gco2func(frame_gc(tv)); BCReg delta = (BCReg)(tv - frame_prev(tv)); lua_assert(tref_isfunc(tr)); if (tref_isk(tr)) lua_assert(fn == ir_kfunc(ir)); lua_assert(s > delta ? (J->slot[s-delta] & TREF_FRAME) : (s == delta)); depth++; } else if ((tr & TREF_CONT)) { lua_assert(ir_kptr(ir) == gcrefp(tv->gcr, void)); lua_assert((J->slot[s+1] & TREF_FRAME)); depth++; } else { if (tvisnumber(tv)) lua_assert(tref_isnumber(tr)); /* Could be IRT_INT etc., too. */ else lua_assert(itype2irt(tv) == tref_type(tr)); if (tref_isk(tr)) { /* Compare constants. */ TValue tvk; lj_ir_kvalue(J->L, &tvk, ir); if (!(tvisnum(&tvk) && tvisnan(&tvk))) lua_assert(lj_obj_equal(tv, &tvk)); else lua_assert(tvisnum(tv) && tvisnan(tv)); } } } } lua_assert(J->framedepth == depth); } #endif /* -- Type handling and specialization ------------------------------------ */ /* Note: these functions return tagged references (TRef). */ /* Specialize a slot to a specific type. Note: slot can be negative! */ static TRef sloadt(jit_State *J, int32_t slot, IRType t, int mode) { /* Caller may set IRT_GUARD in t. */ TRef ref = emitir_raw(IRT(IR_SLOAD, t), (int32_t)J->baseslot+slot, mode); J->base[slot] = ref; return ref; } /* Specialize a slot to the runtime type. Note: slot can be negative! */ static TRef sload(jit_State *J, int32_t slot) { IRType t = itype2irt(&J->L->base[slot]); TRef ref = emitir_raw(IRTG(IR_SLOAD, t), (int32_t)J->baseslot+slot, IRSLOAD_TYPECHECK); if (irtype_ispri(t)) ref = TREF_PRI(t); /* Canonicalize primitive refs. */ J->base[slot] = ref; return ref; } /* Get TRef from slot. Load slot and specialize if not done already. */ #define getslot(J, s) (J->base[(s)] ? J->base[(s)] : sload(J, (int32_t)(s))) /* Get TRef for current function. */ static TRef getcurrf(jit_State *J) { if (J->base[-1]) return J->base[-1]; lua_assert(J->baseslot == 1); return sloadt(J, -1, IRT_FUNC, IRSLOAD_READONLY); } /* Compare for raw object equality. ** Returns 0 if the objects are the same. ** Returns 1 if they are different, but the same type. ** Returns 2 for two different types. ** Comparisons between primitives always return 1 -- no caller cares about it. */ int lj_record_objcmp(jit_State *J, TRef a, TRef b, cTValue *av, cTValue *bv) { int diff = !lj_obj_equal(av, bv); if (!tref_isk2(a, b)) { /* Shortcut, also handles primitives. */ IRType ta = tref_isinteger(a) ? IRT_INT : tref_type(a); IRType tb = tref_isinteger(b) ? IRT_INT : tref_type(b); if (ta != tb) { /* Widen mixed number/int comparisons to number/number comparison. */ if (ta == IRT_INT && tb == IRT_NUM) { a = emitir(IRTN(IR_CONV), a, IRCONV_NUM_INT); ta = IRT_NUM; } else if (ta == IRT_NUM && tb == IRT_INT) { b = emitir(IRTN(IR_CONV), b, IRCONV_NUM_INT); } else { return 2; /* Two different types are never equal. */ } } emitir(IRTG(diff ? IR_NE : IR_EQ, ta), a, b); } return diff; } /* Constify a value. Returns 0 for non-representable object types. */ TRef lj_record_constify(jit_State *J, cTValue *o) { if (tvisgcv(o)) return lj_ir_kgc(J, gcV(o), itype2irt(o)); else if (tvisint(o)) return lj_ir_kint(J, intV(o)); else if (tvisnum(o)) return lj_ir_knumint(J, numV(o)); else if (tvisbool(o)) return TREF_PRI(itype2irt(o)); else return 0; /* Can't represent lightuserdata (pointless). */ } /* -- Record loop ops ----------------------------------------------------- */ /* Loop event. */ typedef enum { LOOPEV_LEAVE, /* Loop is left or not entered. */ LOOPEV_ENTERLO, /* Loop is entered with a low iteration count left. */ LOOPEV_ENTER /* Loop is entered. */ } LoopEvent; /* Canonicalize slots: convert integers to numbers. */ static void canonicalize_slots(jit_State *J) { BCReg s; if (LJ_DUALNUM) return; for (s = J->baseslot+J->maxslot-1; s >= 1; s--) { TRef tr = J->slot[s]; if (tref_isinteger(tr)) { IRIns *ir = IR(tref_ref(tr)); if (!(ir->o == IR_SLOAD && (ir->op2 & IRSLOAD_READONLY))) J->slot[s] = emitir(IRTN(IR_CONV), tr, IRCONV_NUM_INT); } } } /* Stop recording. */ static void rec_stop(jit_State *J, TraceLink linktype, TraceNo lnk) { lj_trace_end(J); J->cur.linktype = (uint8_t)linktype; J->cur.link = (uint16_t)lnk; /* Looping back at the same stack level? */ if (lnk == J->cur.traceno && J->framedepth + J->retdepth == 0) { if ((J->flags & JIT_F_OPT_LOOP)) /* Shall we try to create a loop? */ goto nocanon; /* Do not canonicalize or we lose the narrowing. */ if (J->cur.root) /* Otherwise ensure we always link to the root trace. */ J->cur.link = J->cur.root; } canonicalize_slots(J); nocanon: /* Note: all loop ops must set J->pc to the following instruction! */ lj_snap_add(J); /* Add loop snapshot. */ J->needsnap = 0; J->mergesnap = 1; /* In case recording continues. */ } /* Search bytecode backwards for a int/num constant slot initializer. */ static TRef find_kinit(jit_State *J, const BCIns *endpc, BCReg slot, IRType t) { /* This algorithm is rather simplistic and assumes quite a bit about ** how the bytecode is generated. It works fine for FORI initializers, ** but it won't necessarily work in other cases (e.g. iterator arguments). ** It doesn't do anything fancy, either (like backpropagating MOVs). */ const BCIns *pc, *startpc = proto_bc(J->pt); for (pc = endpc-1; pc > startpc; pc--) { BCIns ins = *pc; BCOp op = bc_op(ins); /* First try to find the last instruction that stores to this slot. */ if (bcmode_a(op) == BCMbase && bc_a(ins) <= slot) { return 0; /* Multiple results, e.g. from a CALL or KNIL. */ } else if (bcmode_a(op) == BCMdst && bc_a(ins) == slot) { if (op == BC_KSHORT || op == BC_KNUM) { /* Found const. initializer. */ /* Now try to verify there's no forward jump across it. */ const BCIns *kpc = pc; for (; pc > startpc; pc--) if (bc_op(*pc) == BC_JMP) { const BCIns *target = pc+bc_j(*pc)+1; if (target > kpc && target <= endpc) return 0; /* Conditional assignment. */ } if (op == BC_KSHORT) { int32_t k = (int32_t)(int16_t)bc_d(ins); return t == IRT_INT ? lj_ir_kint(J, k) : lj_ir_knum(J, (lua_Number)k); } else { cTValue *tv = proto_knumtv(J->pt, bc_d(ins)); if (t == IRT_INT) { int32_t k = numberVint(tv); if (tvisint(tv) || numV(tv) == (lua_Number)k) /* -0 is ok here. */ return lj_ir_kint(J, k); return 0; /* Type mismatch. */ } else { return lj_ir_knum(J, numberVnum(tv)); } } } return 0; /* Non-constant initializer. */ } } return 0; /* No assignment to this slot found? */ } /* Load and optionally convert a FORI argument from a slot. */ static TRef fori_load(jit_State *J, BCReg slot, IRType t, int mode) { int conv = (tvisint(&J->L->base[slot]) != (t==IRT_INT)) ? IRSLOAD_CONVERT : 0; return sloadt(J, (int32_t)slot, t + (((mode & IRSLOAD_TYPECHECK) || (conv && t == IRT_INT && !(mode >> 16))) ? IRT_GUARD : 0), mode + conv); } /* Peek before FORI to find a const initializer. Otherwise load from slot. */ static TRef fori_arg(jit_State *J, const BCIns *fori, BCReg slot, IRType t, int mode) { TRef tr = J->base[slot]; if (!tr) { tr = find_kinit(J, fori, slot, t); if (!tr) tr = fori_load(J, slot, t, mode); } return tr; } /* Return the direction of the FOR loop iterator. ** It's important to exactly reproduce the semantics of the interpreter. */ static int rec_for_direction(cTValue *o) { return (tvisint(o) ? intV(o) : (int32_t)o->u32.hi) >= 0; } /* Simulate the runtime behavior of the FOR loop iterator. */ static LoopEvent rec_for_iter(IROp *op, cTValue *o, int isforl) { lua_Number stopv = numberVnum(&o[FORL_STOP]); lua_Number idxv = numberVnum(&o[FORL_IDX]); lua_Number stepv = numberVnum(&o[FORL_STEP]); if (isforl) idxv += stepv; if (rec_for_direction(&o[FORL_STEP])) { if (idxv <= stopv) { *op = IR_LE; return idxv + 2*stepv > stopv ? LOOPEV_ENTERLO : LOOPEV_ENTER; } *op = IR_GT; return LOOPEV_LEAVE; } else { if (stopv <= idxv) { *op = IR_GE; return idxv + 2*stepv < stopv ? LOOPEV_ENTERLO : LOOPEV_ENTER; } *op = IR_LT; return LOOPEV_LEAVE; } } /* Record checks for FOR loop overflow and step direction. */ static void rec_for_check(jit_State *J, IRType t, int dir, TRef stop, TRef step, int init) { if (!tref_isk(step)) { /* Non-constant step: need a guard for the direction. */ TRef zero = (t == IRT_INT) ? lj_ir_kint(J, 0) : lj_ir_knum_zero(J); emitir(IRTG(dir ? IR_GE : IR_LT, t), step, zero); /* Add hoistable overflow checks for a narrowed FORL index. */ if (init && t == IRT_INT) { if (tref_isk(stop)) { /* Constant stop: optimize check away or to a range check for step. */ int32_t k = IR(tref_ref(stop))->i; if (dir) { if (k > 0) emitir(IRTGI(IR_LE), step, lj_ir_kint(J, (int32_t)0x7fffffff-k)); } else { if (k < 0) emitir(IRTGI(IR_GE), step, lj_ir_kint(J, (int32_t)0x80000000-k)); } } else { /* Stop+step variable: need full overflow check. */ TRef tr = emitir(IRTGI(IR_ADDOV), step, stop); emitir(IRTI(IR_USE), tr, 0); /* ADDOV is weak. Avoid dead result. */ } } } else if (init && t == IRT_INT && !tref_isk(stop)) { /* Constant step: optimize overflow check to a range check for stop. */ int32_t k = IR(tref_ref(step))->i; k = (int32_t)(dir ? 0x7fffffff : 0x80000000) - k; emitir(IRTGI(dir ? IR_LE : IR_GE), stop, lj_ir_kint(J, k)); } } /* Record a FORL instruction. */ static void rec_for_loop(jit_State *J, const BCIns *fori, ScEvEntry *scev, int init) { BCReg ra = bc_a(*fori); cTValue *tv = &J->L->base[ra]; TRef idx = J->base[ra+FORL_IDX]; IRType t = idx ? tref_type(idx) : (init || LJ_DUALNUM) ? lj_opt_narrow_forl(J, tv) : IRT_NUM; int mode = IRSLOAD_INHERIT + ((!LJ_DUALNUM || tvisint(tv) == (t == IRT_INT)) ? IRSLOAD_READONLY : 0); TRef stop = fori_arg(J, fori, ra+FORL_STOP, t, mode); TRef step = fori_arg(J, fori, ra+FORL_STEP, t, mode); int tc, dir = rec_for_direction(&tv[FORL_STEP]); lua_assert(bc_op(*fori) == BC_FORI || bc_op(*fori) == BC_JFORI); scev->t.irt = t; scev->dir = dir; scev->stop = tref_ref(stop); scev->step = tref_ref(step); rec_for_check(J, t, dir, stop, step, init); scev->start = tref_ref(find_kinit(J, fori, ra+FORL_IDX, IRT_INT)); tc = (LJ_DUALNUM && !(scev->start && irref_isk(scev->stop) && irref_isk(scev->step) && tvisint(&tv[FORL_IDX]) == (t == IRT_INT))) ? IRSLOAD_TYPECHECK : 0; if (tc) { J->base[ra+FORL_STOP] = stop; J->base[ra+FORL_STEP] = step; } if (!idx) idx = fori_load(J, ra+FORL_IDX, t, IRSLOAD_INHERIT + tc + (J->scev.start << 16)); if (!init) J->base[ra+FORL_IDX] = idx = emitir(IRT(IR_ADD, t), idx, step); J->base[ra+FORL_EXT] = idx; scev->idx = tref_ref(idx); setmref(scev->pc, fori); J->maxslot = ra+FORL_EXT+1; } /* Record FORL/JFORL or FORI/JFORI. */ static LoopEvent rec_for(jit_State *J, const BCIns *fori, int isforl) { BCReg ra = bc_a(*fori); TValue *tv = &J->L->base[ra]; TRef *tr = &J->base[ra]; IROp op; LoopEvent ev; TRef stop; IRType t; if (isforl) { /* Handle FORL/JFORL opcodes. */ TRef idx = tr[FORL_IDX]; if (mref(J->scev.pc, const BCIns) == fori && tref_ref(idx) == J->scev.idx) { t = J->scev.t.irt; stop = J->scev.stop; idx = emitir(IRT(IR_ADD, t), idx, J->scev.step); tr[FORL_EXT] = tr[FORL_IDX] = idx; } else { ScEvEntry scev; rec_for_loop(J, fori, &scev, 0); t = scev.t.irt; stop = scev.stop; } } else { /* Handle FORI/JFORI opcodes. */ BCReg i; lj_meta_for(J->L, tv); t = (LJ_DUALNUM || tref_isint(tr[FORL_IDX])) ? lj_opt_narrow_forl(J, tv) : IRT_NUM; for (i = FORL_IDX; i <= FORL_STEP; i++) { if (!tr[i]) sload(J, ra+i); lua_assert(tref_isnumber_str(tr[i])); if (tref_isstr(tr[i])) tr[i] = emitir(IRTG(IR_STRTO, IRT_NUM), tr[i], 0); if (t == IRT_INT) { if (!tref_isinteger(tr[i])) tr[i] = emitir(IRTGI(IR_CONV), tr[i], IRCONV_INT_NUM|IRCONV_CHECK); } else { if (!tref_isnum(tr[i])) tr[i] = emitir(IRTN(IR_CONV), tr[i], IRCONV_NUM_INT); } } tr[FORL_EXT] = tr[FORL_IDX]; stop = tr[FORL_STOP]; rec_for_check(J, t, rec_for_direction(&tv[FORL_STEP]), stop, tr[FORL_STEP], 1); } ev = rec_for_iter(&op, tv, isforl); if (ev == LOOPEV_LEAVE) { J->maxslot = ra+FORL_EXT+1; J->pc = fori+1; } else { J->maxslot = ra; J->pc = fori+bc_j(*fori)+1; } lj_snap_add(J); emitir(IRTG(op, t), tr[FORL_IDX], stop); if (ev == LOOPEV_LEAVE) { J->maxslot = ra; J->pc = fori+bc_j(*fori)+1; } else { J->maxslot = ra+FORL_EXT+1; J->pc = fori+1; } J->needsnap = 1; return ev; } /* Record ITERL/JITERL. */ static LoopEvent rec_iterl(jit_State *J, const BCIns iterins) { BCReg ra = bc_a(iterins); lua_assert(J->base[ra] != 0); if (!tref_isnil(J->base[ra])) { /* Looping back? */ J->base[ra-1] = J->base[ra]; /* Copy result of ITERC to control var. */ J->maxslot = ra-1+bc_b(J->pc[-1]); J->pc += bc_j(iterins)+1; return LOOPEV_ENTER; } else { J->maxslot = ra-3; J->pc++; return LOOPEV_LEAVE; } } /* Record LOOP/JLOOP. Now, that was easy. */ static LoopEvent rec_loop(jit_State *J, BCReg ra) { if (ra < J->maxslot) J->maxslot = ra; J->pc++; return LOOPEV_ENTER; } /* Check if a loop repeatedly failed to trace because it didn't loop back. */ static int innerloopleft(jit_State *J, const BCIns *pc) { ptrdiff_t i; for (i = 0; i < PENALTY_SLOTS; i++) if (mref(J->penalty[i].pc, const BCIns) == pc) { if ((J->penalty[i].reason == LJ_TRERR_LLEAVE || J->penalty[i].reason == LJ_TRERR_LINNER) && J->penalty[i].val >= 2*PENALTY_MIN) return 1; break; } return 0; } /* Handle the case when an interpreted loop op is hit. */ static void rec_loop_interp(jit_State *J, const BCIns *pc, LoopEvent ev) { if (J->parent == 0) { if (pc == J->startpc && J->framedepth + J->retdepth == 0) { /* Same loop? */ if (ev == LOOPEV_LEAVE) /* Must loop back to form a root trace. */ lj_trace_err(J, LJ_TRERR_LLEAVE); rec_stop(J, LJ_TRLINK_LOOP, J->cur.traceno); /* Looping root trace. */ } else if (ev != LOOPEV_LEAVE) { /* Entering inner loop? */ /* It's usually better to abort here and wait until the inner loop ** is traced. But if the inner loop repeatedly didn't loop back, ** this indicates a low trip count. In this case try unrolling ** an inner loop even in a root trace. But it's better to be a bit ** more conservative here and only do it for very short loops. */ if (bc_j(*pc) != -1 && !innerloopleft(J, pc)) lj_trace_err(J, LJ_TRERR_LINNER); /* Root trace hit an inner loop. */ if ((ev != LOOPEV_ENTERLO && J->loopref && J->cur.nins - J->loopref > 24) || --J->loopunroll < 0) lj_trace_err(J, LJ_TRERR_LUNROLL); /* Limit loop unrolling. */ J->loopref = J->cur.nins; } } else if (ev != LOOPEV_LEAVE) { /* Side trace enters an inner loop. */ J->loopref = J->cur.nins; if (--J->loopunroll < 0) lj_trace_err(J, LJ_TRERR_LUNROLL); /* Limit loop unrolling. */ } /* Side trace continues across a loop that's left or not entered. */ } /* Handle the case when an already compiled loop op is hit. */ static void rec_loop_jit(jit_State *J, TraceNo lnk, LoopEvent ev) { if (J->parent == 0) { /* Root trace hit an inner loop. */ /* Better let the inner loop spawn a side trace back here. */ lj_trace_err(J, LJ_TRERR_LINNER); } else if (ev != LOOPEV_LEAVE) { /* Side trace enters a compiled loop. */ J->instunroll = 0; /* Cannot continue across a compiled loop op. */ if (J->pc == J->startpc && J->framedepth + J->retdepth == 0) rec_stop(J, LJ_TRLINK_LOOP, J->cur.traceno); /* Form an extra loop. */ else rec_stop(J, LJ_TRLINK_ROOT, lnk); /* Link to the loop. */ } /* Side trace continues across a loop that's left or not entered. */ } /* -- Record calls and returns -------------------------------------------- */ /* Specialize to the runtime value of the called function or its prototype. */ static TRef rec_call_specialize(jit_State *J, GCfunc *fn, TRef tr) { TRef kfunc; if (isluafunc(fn)) { GCproto *pt = funcproto(fn); /* Too many closures created? Probably not a monomorphic function. */ if (pt->flags >= PROTO_CLC_POLY) { /* Specialize to prototype instead. */ TRef trpt = emitir(IRT(IR_FLOAD, IRT_P32), tr, IRFL_FUNC_PC); emitir(IRTG(IR_EQ, IRT_P32), trpt, lj_ir_kptr(J, proto_bc(pt))); (void)lj_ir_kgc(J, obj2gco(pt), IRT_PROTO); /* Prevent GC of proto. */ return tr; } } /* Otherwise specialize to the function (closure) value itself. */ kfunc = lj_ir_kfunc(J, fn); emitir(IRTG(IR_EQ, IRT_FUNC), tr, kfunc); return kfunc; } /* Record call setup. */ static void rec_call_setup(jit_State *J, BCReg func, ptrdiff_t nargs) { RecordIndex ix; TValue *functv = &J->L->base[func]; TRef *fbase = &J->base[func]; ptrdiff_t i; for (i = 0; i <= nargs; i++) (void)getslot(J, func+i); /* Ensure func and all args have a reference. */ if (!tref_isfunc(fbase[0])) { /* Resolve __call metamethod. */ ix.tab = fbase[0]; copyTV(J->L, &ix.tabv, functv); if (!lj_record_mm_lookup(J, &ix, MM_call) || !tref_isfunc(ix.mobj)) lj_trace_err(J, LJ_TRERR_NOMM); for (i = ++nargs; i > 0; i--) /* Shift arguments up. */ fbase[i] = fbase[i-1]; fbase[0] = ix.mobj; /* Replace function. */ functv = &ix.mobjv; } fbase[0] = TREF_FRAME | rec_call_specialize(J, funcV(functv), fbase[0]); J->maxslot = (BCReg)nargs; } /* Record call. */ void lj_record_call(jit_State *J, BCReg func, ptrdiff_t nargs) { rec_call_setup(J, func, nargs); /* Bump frame. */ J->framedepth++; J->base += func+1; J->baseslot += func+1; } /* Record tail call. */ void lj_record_tailcall(jit_State *J, BCReg func, ptrdiff_t nargs) { rec_call_setup(J, func, nargs); if (frame_isvarg(J->L->base - 1)) { BCReg cbase = (BCReg)frame_delta(J->L->base - 1); if (--J->framedepth < 0) lj_trace_err(J, LJ_TRERR_NYIRETL); J->baseslot -= (BCReg)cbase; J->base -= cbase; func += cbase; } /* Move func + args down. */ memmove(&J->base[-1], &J->base[func], sizeof(TRef)*(J->maxslot+1)); /* Note: the new TREF_FRAME is now at J->base[-1] (even for slot #0). */ /* Tailcalls can form a loop, so count towards the loop unroll limit. */ if (++J->tailcalled > J->loopunroll) lj_trace_err(J, LJ_TRERR_LUNROLL); } /* Check unroll limits for down-recursion. */ static int check_downrec_unroll(jit_State *J, GCproto *pt) { IRRef ptref; for (ptref = J->chain[IR_KGC]; ptref; ptref = IR(ptref)->prev) if (ir_kgc(IR(ptref)) == obj2gco(pt)) { int count = 0; IRRef ref; for (ref = J->chain[IR_RETF]; ref; ref = IR(ref)->prev) if (IR(ref)->op1 == ptref) count++; if (count) { if (J->pc == J->startpc) { if (count + J->tailcalled > J->param[JIT_P_recunroll]) return 1; } else { lj_trace_err(J, LJ_TRERR_DOWNREC); } } } return 0; } /* Record return. */ void lj_record_ret(jit_State *J, BCReg rbase, ptrdiff_t gotresults) { TValue *frame = J->L->base - 1; ptrdiff_t i; for (i = 0; i < gotresults; i++) (void)getslot(J, rbase+i); /* Ensure all results have a reference. */ while (frame_ispcall(frame)) { /* Immediately resolve pcall() returns. */ BCReg cbase = (BCReg)frame_delta(frame); if (--J->framedepth <= 0) lj_trace_err(J, LJ_TRERR_NYIRETL); lua_assert(J->baseslot > 1); gotresults++; rbase += cbase; J->baseslot -= (BCReg)cbase; J->base -= cbase; J->base[--rbase] = TREF_TRUE; /* Prepend true to results. */ frame = frame_prevd(frame); } /* Return to lower frame via interpreter for unhandled cases. */ if (J->framedepth == 0 && J->pt && bc_isret(bc_op(*J->pc)) && (!frame_islua(frame) || (J->parent == 0 && !bc_isret(bc_op(J->cur.startins))))) { /* NYI: specialize to frame type and return directly, not via RET*. */ for (i = 0; i < (ptrdiff_t)rbase; i++) J->base[i] = 0; /* Purge dead slots. */ J->maxslot = rbase + (BCReg)gotresults; rec_stop(J, LJ_TRLINK_RETURN, 0); /* Return to interpreter. */ return; } if (frame_isvarg(frame)) { BCReg cbase = (BCReg)frame_delta(frame); if (--J->framedepth < 0) /* NYI: return of vararg func to lower frame. */ lj_trace_err(J, LJ_TRERR_NYIRETL); lua_assert(J->baseslot > 1); rbase += cbase; J->baseslot -= (BCReg)cbase; J->base -= cbase; frame = frame_prevd(frame); } if (frame_islua(frame)) { /* Return to Lua frame. */ BCIns callins = *(frame_pc(frame)-1); ptrdiff_t nresults = bc_b(callins) ? (ptrdiff_t)bc_b(callins)-1 :gotresults; BCReg cbase = bc_a(callins); GCproto *pt = funcproto(frame_func(frame - (cbase+1))); if ((pt->flags & PROTO_NOJIT)) lj_trace_err(J, LJ_TRERR_CJITOFF); if (J->framedepth == 0 && J->pt && frame == J->L->base - 1) { if (check_downrec_unroll(J, pt)) { J->maxslot = (BCReg)(rbase + gotresults); lj_snap_purge(J); rec_stop(J, LJ_TRLINK_DOWNREC, J->cur.traceno); /* Down-recursion. */ return; } lj_snap_add(J); } for (i = 0; i < nresults; i++) /* Adjust results. */ J->base[i-1] = i < gotresults ? J->base[rbase+i] : TREF_NIL; J->maxslot = cbase+(BCReg)nresults; if (J->framedepth > 0) { /* Return to a frame that is part of the trace. */ J->framedepth--; lua_assert(J->baseslot > cbase+1); J->baseslot -= cbase+1; J->base -= cbase+1; } else if (J->parent == 0 && !bc_isret(bc_op(J->cur.startins))) { /* Return to lower frame would leave the loop in a root trace. */ lj_trace_err(J, LJ_TRERR_LLEAVE); } else if (J->needsnap) { /* Tailcalled to ff with side-effects. */ lj_trace_err(J, LJ_TRERR_NYIRETL); /* No way to insert snapshot here. */ } else { /* Return to lower frame. Guard for the target we return to. */ TRef trpt = lj_ir_kgc(J, obj2gco(pt), IRT_PROTO); TRef trpc = lj_ir_kptr(J, (void *)frame_pc(frame)); emitir(IRTG(IR_RETF, IRT_P32), trpt, trpc); J->retdepth++; J->needsnap = 1; lua_assert(J->baseslot == 1); /* Shift result slots up and clear the slots of the new frame below. */ memmove(J->base + cbase, J->base-1, sizeof(TRef)*nresults); memset(J->base-1, 0, sizeof(TRef)*(cbase+1)); } } else if (frame_iscont(frame)) { /* Return to continuation frame. */ ASMFunction cont = frame_contf(frame); BCReg cbase = (BCReg)frame_delta(frame); if ((J->framedepth -= 2) < 0) lj_trace_err(J, LJ_TRERR_NYIRETL); J->baseslot -= (BCReg)cbase; J->base -= cbase; J->maxslot = cbase-2; if (cont == lj_cont_ra) { /* Copy result to destination slot. */ BCReg dst = bc_a(*(frame_contpc(frame)-1)); J->base[dst] = gotresults ? J->base[cbase+rbase] : TREF_NIL; if (dst >= J->maxslot) J->maxslot = dst+1; } else if (cont == lj_cont_nop) { /* Nothing to do here. */ } else if (cont == lj_cont_cat) { lua_assert(0); } else { /* Result type already specialized. */ lua_assert(cont == lj_cont_condf || cont == lj_cont_condt); } } else { lj_trace_err(J, LJ_TRERR_NYIRETL); /* NYI: handle return to C frame. */ } lua_assert(J->baseslot >= 1); } /* -- Metamethod handling ------------------------------------------------- */ /* Prepare to record call to metamethod. */ static BCReg rec_mm_prep(jit_State *J, ASMFunction cont) { BCReg s, top = curr_proto(J->L)->framesize; TRef trcont; setcont(&J->L->base[top], cont); #if LJ_64 trcont = lj_ir_kptr(J, (void *)((int64_t)cont - (int64_t)lj_vm_asm_begin)); #else trcont = lj_ir_kptr(J, (void *)cont); #endif J->base[top] = trcont | TREF_CONT; J->framedepth++; for (s = J->maxslot; s < top; s++) J->base[s] = 0; /* Clear frame gap to avoid resurrecting previous refs. */ return top+1; } /* Record metamethod lookup. */ int lj_record_mm_lookup(jit_State *J, RecordIndex *ix, MMS mm) { RecordIndex mix; GCtab *mt; if (tref_istab(ix->tab)) { mt = tabref(tabV(&ix->tabv)->metatable); mix.tab = emitir(IRT(IR_FLOAD, IRT_TAB), ix->tab, IRFL_TAB_META); } else if (tref_isudata(ix->tab)) { int udtype = udataV(&ix->tabv)->udtype; mt = tabref(udataV(&ix->tabv)->metatable); /* The metatables of special userdata objects are treated as immutable. */ if (udtype != UDTYPE_USERDATA) { cTValue *mo; if (LJ_HASFFI && udtype == UDTYPE_FFI_CLIB) { /* Specialize to the C library namespace object. */ emitir(IRTG(IR_EQ, IRT_P32), ix->tab, lj_ir_kptr(J, udataV(&ix->tabv))); } else { /* Specialize to the type of userdata. */ TRef tr = emitir(IRT(IR_FLOAD, IRT_U8), ix->tab, IRFL_UDATA_UDTYPE); emitir(IRTGI(IR_EQ), tr, lj_ir_kint(J, udtype)); } immutable_mt: mo = lj_tab_getstr(mt, mmname_str(J2G(J), mm)); if (!mo || tvisnil(mo)) return 0; /* No metamethod. */ /* Treat metamethod or index table as immutable, too. */ if (!(tvisfunc(mo) || tvistab(mo))) lj_trace_err(J, LJ_TRERR_BADTYPE); copyTV(J->L, &ix->mobjv, mo); ix->mobj = lj_ir_kgc(J, gcV(mo), tvisfunc(mo) ? IRT_FUNC : IRT_TAB); ix->mtv = mt; ix->mt = TREF_NIL; /* Dummy value for comparison semantics. */ return 1; /* Got metamethod or index table. */ } mix.tab = emitir(IRT(IR_FLOAD, IRT_TAB), ix->tab, IRFL_UDATA_META); } else { /* Specialize to base metatable. Must flush mcode in lua_setmetatable(). */ mt = tabref(basemt_obj(J2G(J), &ix->tabv)); if (mt == NULL) { ix->mt = TREF_NIL; return 0; /* No metamethod. */ } /* The cdata metatable is treated as immutable. */ if (LJ_HASFFI && tref_iscdata(ix->tab)) goto immutable_mt; ix->mt = mix.tab = lj_ir_ktab(J, mt); goto nocheck; } ix->mt = mt ? mix.tab : TREF_NIL; emitir(IRTG(mt ? IR_NE : IR_EQ, IRT_TAB), mix.tab, lj_ir_knull(J, IRT_TAB)); nocheck: if (mt) { GCstr *mmstr = mmname_str(J2G(J), mm); cTValue *mo = lj_tab_getstr(mt, mmstr); if (mo && !tvisnil(mo)) copyTV(J->L, &ix->mobjv, mo); ix->mtv = mt; settabV(J->L, &mix.tabv, mt); setstrV(J->L, &mix.keyv, mmstr); mix.key = lj_ir_kstr(J, mmstr); mix.val = 0; mix.idxchain = 0; ix->mobj = lj_record_idx(J, &mix); return !tref_isnil(ix->mobj); /* 1 if metamethod found, 0 if not. */ } return 0; /* No metamethod. */ } /* Record call to arithmetic metamethod. */ static TRef rec_mm_arith(jit_State *J, RecordIndex *ix, MMS mm) { /* Set up metamethod call first to save ix->tab and ix->tabv. */ BCReg func = rec_mm_prep(J, lj_cont_ra); TRef *base = J->base + func; TValue *basev = J->L->base + func; base[1] = ix->tab; base[2] = ix->key; copyTV(J->L, basev+1, &ix->tabv); copyTV(J->L, basev+2, &ix->keyv); if (!lj_record_mm_lookup(J, ix, mm)) { /* Lookup mm on 1st operand. */ if (mm != MM_unm) { ix->tab = ix->key; copyTV(J->L, &ix->tabv, &ix->keyv); if (lj_record_mm_lookup(J, ix, mm)) /* Lookup mm on 2nd operand. */ goto ok; } lj_trace_err(J, LJ_TRERR_NOMM); } ok: base[0] = ix->mobj; copyTV(J->L, basev+0, &ix->mobjv); lj_record_call(J, func, 2); return 0; /* No result yet. */ } /* Record call to __len metamethod. */ static TRef rec_mm_len(jit_State *J, TRef tr, TValue *tv) { RecordIndex ix; ix.tab = tr; copyTV(J->L, &ix.tabv, tv); if (lj_record_mm_lookup(J, &ix, MM_len)) { BCReg func = rec_mm_prep(J, lj_cont_ra); TRef *base = J->base + func; TValue *basev = J->L->base + func; base[0] = ix.mobj; copyTV(J->L, basev+0, &ix.mobjv); base[1] = tr; copyTV(J->L, basev+1, tv); #if LJ_52 base[2] = tr; copyTV(J->L, basev+2, tv); #else base[2] = TREF_NIL; setnilV(basev+2); #endif lj_record_call(J, func, 2); } else { if (LJ_52 && tref_istab(tr)) return lj_ir_call(J, IRCALL_lj_tab_len, tr); lj_trace_err(J, LJ_TRERR_NOMM); } return 0; /* No result yet. */ } /* Call a comparison metamethod. */ static void rec_mm_callcomp(jit_State *J, RecordIndex *ix, int op) { BCReg func = rec_mm_prep(J, (op&1) ? lj_cont_condf : lj_cont_condt); TRef *base = J->base + func; TValue *tv = J->L->base + func; base[0] = ix->mobj; base[1] = ix->val; base[2] = ix->key; copyTV(J->L, tv+0, &ix->mobjv); copyTV(J->L, tv+1, &ix->valv); copyTV(J->L, tv+2, &ix->keyv); lj_record_call(J, func, 2); } /* Record call to equality comparison metamethod (for tab and udata only). */ static void rec_mm_equal(jit_State *J, RecordIndex *ix, int op) { ix->tab = ix->val; copyTV(J->L, &ix->tabv, &ix->valv); if (lj_record_mm_lookup(J, ix, MM_eq)) { /* Lookup mm on 1st operand. */ cTValue *bv; TRef mo1 = ix->mobj; TValue mo1v; copyTV(J->L, &mo1v, &ix->mobjv); /* Avoid the 2nd lookup and the objcmp if the metatables are equal. */ bv = &ix->keyv; if (tvistab(bv) && tabref(tabV(bv)->metatable) == ix->mtv) { TRef mt2 = emitir(IRT(IR_FLOAD, IRT_TAB), ix->key, IRFL_TAB_META); emitir(IRTG(IR_EQ, IRT_TAB), mt2, ix->mt); } else if (tvisudata(bv) && tabref(udataV(bv)->metatable) == ix->mtv) { TRef mt2 = emitir(IRT(IR_FLOAD, IRT_TAB), ix->key, IRFL_UDATA_META); emitir(IRTG(IR_EQ, IRT_TAB), mt2, ix->mt); } else { /* Lookup metamethod on 2nd operand and compare both. */ ix->tab = ix->key; copyTV(J->L, &ix->tabv, bv); if (!lj_record_mm_lookup(J, ix, MM_eq) || lj_record_objcmp(J, mo1, ix->mobj, &mo1v, &ix->mobjv)) return; } rec_mm_callcomp(J, ix, op); } } /* Record call to ordered comparison metamethods (for arbitrary objects). */ static void rec_mm_comp(jit_State *J, RecordIndex *ix, int op) { ix->tab = ix->val; copyTV(J->L, &ix->tabv, &ix->valv); while (1) { MMS mm = (op & 2) ? MM_le : MM_lt; /* Try __le + __lt or only __lt. */ #if LJ_52 if (!lj_record_mm_lookup(J, ix, mm)) { /* Lookup mm on 1st operand. */ ix->tab = ix->key; copyTV(J->L, &ix->tabv, &ix->keyv); if (!lj_record_mm_lookup(J, ix, mm)) /* Lookup mm on 2nd operand. */ goto nomatch; } rec_mm_callcomp(J, ix, op); return; #else if (lj_record_mm_lookup(J, ix, mm)) { /* Lookup mm on 1st operand. */ cTValue *bv; TRef mo1 = ix->mobj; TValue mo1v; copyTV(J->L, &mo1v, &ix->mobjv); /* Avoid the 2nd lookup and the objcmp if the metatables are equal. */ bv = &ix->keyv; if (tvistab(bv) && tabref(tabV(bv)->metatable) == ix->mtv) { TRef mt2 = emitir(IRT(IR_FLOAD, IRT_TAB), ix->key, IRFL_TAB_META); emitir(IRTG(IR_EQ, IRT_TAB), mt2, ix->mt); } else if (tvisudata(bv) && tabref(udataV(bv)->metatable) == ix->mtv) { TRef mt2 = emitir(IRT(IR_FLOAD, IRT_TAB), ix->key, IRFL_UDATA_META); emitir(IRTG(IR_EQ, IRT_TAB), mt2, ix->mt); } else { /* Lookup metamethod on 2nd operand and compare both. */ ix->tab = ix->key; copyTV(J->L, &ix->tabv, bv); if (!lj_record_mm_lookup(J, ix, mm) || lj_record_objcmp(J, mo1, ix->mobj, &mo1v, &ix->mobjv)) goto nomatch; } rec_mm_callcomp(J, ix, op); return; } #endif nomatch: /* Lookup failed. Retry with __lt and swapped operands. */ if (!(op & 2)) break; /* Already at __lt. Interpreter will throw. */ ix->tab = ix->key; ix->key = ix->val; ix->val = ix->tab; copyTV(J->L, &ix->tabv, &ix->keyv); copyTV(J->L, &ix->keyv, &ix->valv); copyTV(J->L, &ix->valv, &ix->tabv); op ^= 3; } } #if LJ_HASFFI /* Setup call to cdata comparison metamethod. */ static void rec_mm_comp_cdata(jit_State *J, RecordIndex *ix, int op, MMS mm) { lj_snap_add(J); if (tref_iscdata(ix->val)) { ix->tab = ix->val; copyTV(J->L, &ix->tabv, &ix->valv); } else { lua_assert(tref_iscdata(ix->key)); ix->tab = ix->key; copyTV(J->L, &ix->tabv, &ix->keyv); } lj_record_mm_lookup(J, ix, mm); rec_mm_callcomp(J, ix, op); } #endif /* -- Indexed access ------------------------------------------------------ */ /* Record bounds-check. */ static void rec_idx_abc(jit_State *J, TRef asizeref, TRef ikey, uint32_t asize) { /* Try to emit invariant bounds checks. */ if ((J->flags & (JIT_F_OPT_LOOP|JIT_F_OPT_ABC)) == (JIT_F_OPT_LOOP|JIT_F_OPT_ABC)) { IRRef ref = tref_ref(ikey); IRIns *ir = IR(ref); int32_t ofs = 0; IRRef ofsref = 0; /* Handle constant offsets. */ if (ir->o == IR_ADD && irref_isk(ir->op2)) { ofsref = ir->op2; ofs = IR(ofsref)->i; ref = ir->op1; ir = IR(ref); } /* Got scalar evolution analysis results for this reference? */ if (ref == J->scev.idx) { int32_t stop; lua_assert(irt_isint(J->scev.t) && ir->o == IR_SLOAD); stop = numberVint(&(J->L->base - J->baseslot)[ir->op1 + FORL_STOP]); /* Runtime value for stop of loop is within bounds? */ if ((uint64_t)stop + ofs < (uint64_t)asize) { /* Emit invariant bounds check for stop. */ emitir(IRTG(IR_ABC, IRT_P32), asizeref, ofs == 0 ? J->scev.stop : emitir(IRTI(IR_ADD), J->scev.stop, ofsref)); /* Emit invariant bounds check for start, if not const or negative. */ if (!(J->scev.dir && J->scev.start && (int64_t)IR(J->scev.start)->i + ofs >= 0)) emitir(IRTG(IR_ABC, IRT_P32), asizeref, ikey); return; } } } emitir(IRTGI(IR_ABC), asizeref, ikey); /* Emit regular bounds check. */ } /* Record indexed key lookup. */ static TRef rec_idx_key(jit_State *J, RecordIndex *ix) { TRef key; GCtab *t = tabV(&ix->tabv); ix->oldv = lj_tab_get(J->L, t, &ix->keyv); /* Lookup previous value. */ /* Integer keys are looked up in the array part first. */ key = ix->key; if (tref_isnumber(key)) { int32_t k = numberVint(&ix->keyv); if (!tvisint(&ix->keyv) && numV(&ix->keyv) != (lua_Number)k) k = LJ_MAX_ASIZE; if ((MSize)k < LJ_MAX_ASIZE) { /* Potential array key? */ TRef ikey = lj_opt_narrow_index(J, key); TRef asizeref = emitir(IRTI(IR_FLOAD), ix->tab, IRFL_TAB_ASIZE); if ((MSize)k < t->asize) { /* Currently an array key? */ TRef arrayref; rec_idx_abc(J, asizeref, ikey, t->asize); arrayref = emitir(IRT(IR_FLOAD, IRT_P32), ix->tab, IRFL_TAB_ARRAY); return emitir(IRT(IR_AREF, IRT_P32), arrayref, ikey); } else { /* Currently not in array (may be an array extension)? */ emitir(IRTGI(IR_ULE), asizeref, ikey); /* Inv. bounds check. */ if (k == 0 && tref_isk(key)) key = lj_ir_knum_zero(J); /* Canonicalize 0 or +-0.0 to +0.0. */ /* And continue with the hash lookup. */ } } else if (!tref_isk(key)) { /* We can rule out const numbers which failed the integerness test ** above. But all other numbers are potential array keys. */ if (t->asize == 0) { /* True sparse tables have an empty array part. */ /* Guard that the array part stays empty. */ TRef tmp = emitir(IRTI(IR_FLOAD), ix->tab, IRFL_TAB_ASIZE); emitir(IRTGI(IR_EQ), tmp, lj_ir_kint(J, 0)); } else { lj_trace_err(J, LJ_TRERR_NYITMIX); } } } /* Otherwise the key is located in the hash part. */ if (t->hmask == 0) { /* Shortcut for empty hash part. */ /* Guard that the hash part stays empty. */ TRef tmp = emitir(IRTI(IR_FLOAD), ix->tab, IRFL_TAB_HMASK); emitir(IRTGI(IR_EQ), tmp, lj_ir_kint(J, 0)); return lj_ir_kkptr(J, niltvg(J2G(J))); } if (tref_isinteger(key)) /* Hash keys are based on numbers, not ints. */ key = emitir(IRTN(IR_CONV), key, IRCONV_NUM_INT); if (tref_isk(key)) { /* Optimize lookup of constant hash keys. */ MSize hslot = (MSize)((char *)ix->oldv - (char *)&noderef(t->node)[0].val); if (t->hmask > 0 && hslot <= t->hmask*(MSize)sizeof(Node) && hslot <= 65535*(MSize)sizeof(Node)) { TRef node, kslot; TRef hm = emitir(IRTI(IR_FLOAD), ix->tab, IRFL_TAB_HMASK); emitir(IRTGI(IR_EQ), hm, lj_ir_kint(J, (int32_t)t->hmask)); node = emitir(IRT(IR_FLOAD, IRT_P32), ix->tab, IRFL_TAB_NODE); kslot = lj_ir_kslot(J, key, hslot / sizeof(Node)); return emitir(IRTG(IR_HREFK, IRT_P32), node, kslot); } } /* Fall back to a regular hash lookup. */ return emitir(IRT(IR_HREF, IRT_P32), ix->tab, key); } /* Determine whether a key is NOT one of the fast metamethod names. */ static int nommstr(jit_State *J, TRef key) { if (tref_isstr(key)) { if (tref_isk(key)) { GCstr *str = ir_kstr(IR(tref_ref(key))); uint32_t mm; for (mm = 0; mm <= MM_FAST; mm++) if (mmname_str(J2G(J), mm) == str) return 0; /* MUST be one the fast metamethod names. */ } else { return 0; /* Variable string key MAY be a metamethod name. */ } } return 1; /* CANNOT be a metamethod name. */ } /* Record indexed load/store. */ TRef lj_record_idx(jit_State *J, RecordIndex *ix) { TRef xref; IROp xrefop, loadop; cTValue *oldv; while (!tref_istab(ix->tab)) { /* Handle non-table lookup. */ /* Never call raw lj_record_idx() on non-table. */ lua_assert(ix->idxchain != 0); if (!lj_record_mm_lookup(J, ix, ix->val ? MM_newindex : MM_index)) lj_trace_err(J, LJ_TRERR_NOMM); handlemm: if (tref_isfunc(ix->mobj)) { /* Handle metamethod call. */ BCReg func = rec_mm_prep(J, ix->val ? lj_cont_nop : lj_cont_ra); TRef *base = J->base + func; TValue *tv = J->L->base + func; base[0] = ix->mobj; base[1] = ix->tab; base[2] = ix->key; setfuncV(J->L, tv+0, funcV(&ix->mobjv)); copyTV(J->L, tv+1, &ix->tabv); copyTV(J->L, tv+2, &ix->keyv); if (ix->val) { base[3] = ix->val; copyTV(J->L, tv+3, &ix->valv); lj_record_call(J, func, 3); /* mobj(tab, key, val) */ return 0; } else { lj_record_call(J, func, 2); /* res = mobj(tab, key) */ return 0; /* No result yet. */ } } /* Otherwise retry lookup with metaobject. */ ix->tab = ix->mobj; copyTV(J->L, &ix->tabv, &ix->mobjv); if (--ix->idxchain == 0) lj_trace_err(J, LJ_TRERR_IDXLOOP); } /* First catch nil and NaN keys for tables. */ if (tvisnil(&ix->keyv) || (tvisnum(&ix->keyv) && tvisnan(&ix->keyv))) { if (ix->val) /* Better fail early. */ lj_trace_err(J, LJ_TRERR_STORENN); if (tref_isk(ix->key)) { if (ix->idxchain && lj_record_mm_lookup(J, ix, MM_index)) goto handlemm; return TREF_NIL; } } /* Record the key lookup. */ xref = rec_idx_key(J, ix); xrefop = IR(tref_ref(xref))->o; loadop = xrefop == IR_AREF ? IR_ALOAD : IR_HLOAD; /* The lj_meta_tset() inconsistency is gone, but better play safe. */ oldv = xrefop == IR_KKPTR ? (cTValue *)ir_kptr(IR(tref_ref(xref))) : ix->oldv; if (ix->val == 0) { /* Indexed load */ IRType t = itype2irt(oldv); TRef res; if (oldv == niltvg(J2G(J))) { emitir(IRTG(IR_EQ, IRT_P32), xref, lj_ir_kkptr(J, niltvg(J2G(J)))); res = TREF_NIL; } else { res = emitir(IRTG(loadop, t), xref, 0); } if (t == IRT_NIL && ix->idxchain && lj_record_mm_lookup(J, ix, MM_index)) goto handlemm; if (irtype_ispri(t)) res = TREF_PRI(t); /* Canonicalize primitives. */ return res; } else { /* Indexed store. */ GCtab *mt = tabref(tabV(&ix->tabv)->metatable); int keybarrier = tref_isgcv(ix->key) && !tref_isnil(ix->val); if (tvisnil(oldv)) { /* Previous value was nil? */ /* Need to duplicate the hasmm check for the early guards. */ int hasmm = 0; if (ix->idxchain && mt) { cTValue *mo = lj_tab_getstr(mt, mmname_str(J2G(J), MM_newindex)); hasmm = mo && !tvisnil(mo); } if (hasmm) emitir(IRTG(loadop, IRT_NIL), xref, 0); /* Guard for nil value. */ else if (xrefop == IR_HREF) emitir(IRTG(oldv == niltvg(J2G(J)) ? IR_EQ : IR_NE, IRT_P32), xref, lj_ir_kkptr(J, niltvg(J2G(J)))); if (ix->idxchain && lj_record_mm_lookup(J, ix, MM_newindex)) { lua_assert(hasmm); goto handlemm; } lua_assert(!hasmm); if (oldv == niltvg(J2G(J))) { /* Need to insert a new key. */ TRef key = ix->key; if (tref_isinteger(key)) /* NEWREF needs a TValue as a key. */ key = emitir(IRTN(IR_CONV), key, IRCONV_NUM_INT); xref = emitir(IRT(IR_NEWREF, IRT_P32), ix->tab, key); keybarrier = 0; /* NEWREF already takes care of the key barrier. */ } } else if (!lj_opt_fwd_wasnonnil(J, loadop, tref_ref(xref))) { /* Cannot derive that the previous value was non-nil, must do checks. */ if (xrefop == IR_HREF) /* Guard against store to niltv. */ emitir(IRTG(IR_NE, IRT_P32), xref, lj_ir_kkptr(J, niltvg(J2G(J)))); if (ix->idxchain) { /* Metamethod lookup required? */ /* A check for NULL metatable is cheaper (hoistable) than a load. */ if (!mt) { TRef mtref = emitir(IRT(IR_FLOAD, IRT_TAB), ix->tab, IRFL_TAB_META); emitir(IRTG(IR_EQ, IRT_TAB), mtref, lj_ir_knull(J, IRT_TAB)); } else { IRType t = itype2irt(oldv); emitir(IRTG(loadop, t), xref, 0); /* Guard for non-nil value. */ } } } else { keybarrier = 0; /* Previous non-nil value kept the key alive. */ } /* Convert int to number before storing. */ if (!LJ_DUALNUM && tref_isinteger(ix->val)) ix->val = emitir(IRTN(IR_CONV), ix->val, IRCONV_NUM_INT); emitir(IRT(loadop+IRDELTA_L2S, tref_type(ix->val)), xref, ix->val); if (keybarrier || tref_isgcv(ix->val)) emitir(IRT(IR_TBAR, IRT_NIL), ix->tab, 0); /* Invalidate neg. metamethod cache for stores with certain string keys. */ if (!nommstr(J, ix->key)) { TRef fref = emitir(IRT(IR_FREF, IRT_P32), ix->tab, IRFL_TAB_NOMM); emitir(IRT(IR_FSTORE, IRT_U8), fref, lj_ir_kint(J, 0)); } J->needsnap = 1; return 0; } } /* -- Upvalue access ------------------------------------------------------ */ /* Check whether upvalue is immutable and ok to constify. */ static int rec_upvalue_constify(jit_State *J, GCupval *uvp) { if (uvp->immutable) { cTValue *o = uvval(uvp); /* Don't constify objects that may retain large amounts of memory. */ #if LJ_HASFFI if (tviscdata(o)) { GCcdata *cd = cdataV(o); if (!cdataisv(cd) && !(cd->marked & LJ_GC_CDATA_FIN)) { CType *ct = ctype_raw(ctype_ctsG(J2G(J)), cd->ctypeid); if (!ctype_hassize(ct->info) || ct->size <= 16) return 1; } return 0; } #else UNUSED(J); #endif if (!(tvistab(o) || tvisudata(o) || tvisthread(o))) return 1; } return 0; } /* Record upvalue load/store. */ static TRef rec_upvalue(jit_State *J, uint32_t uv, TRef val) { GCupval *uvp = &gcref(J->fn->l.uvptr[uv])->uv; TRef fn = getcurrf(J); IRRef uref; int needbarrier = 0; if (rec_upvalue_constify(J, uvp)) { /* Try to constify immutable upvalue. */ TRef tr, kfunc; lua_assert(val == 0); if (!tref_isk(fn)) { /* Late specialization of current function. */ if (J->pt->flags >= PROTO_CLC_POLY) goto noconstify; kfunc = lj_ir_kfunc(J, J->fn); emitir(IRTG(IR_EQ, IRT_FUNC), fn, kfunc); J->base[-1] = TREF_FRAME | kfunc; fn = kfunc; } tr = lj_record_constify(J, uvval(uvp)); if (tr) return tr; } noconstify: /* Note: this effectively limits LJ_MAX_UPVAL to 127. */ uv = (uv << 8) | (hashrot(uvp->dhash, uvp->dhash + HASH_BIAS) & 0xff); if (!uvp->closed) { uref = tref_ref(emitir(IRTG(IR_UREFO, IRT_P32), fn, uv)); /* In current stack? */ if (uvval(uvp) >= tvref(J->L->stack) && uvval(uvp) < tvref(J->L->maxstack)) { int32_t slot = (int32_t)(uvval(uvp) - (J->L->base - J->baseslot)); if (slot >= 0) { /* Aliases an SSA slot? */ emitir(IRTG(IR_EQ, IRT_P32), REF_BASE, emitir(IRT(IR_ADD, IRT_P32), uref, lj_ir_kint(J, (slot - 1) * -8))); slot -= (int32_t)J->baseslot; /* Note: slot number may be negative! */ if (val == 0) { return getslot(J, slot); } else { J->base[slot] = val; if (slot >= (int32_t)J->maxslot) J->maxslot = (BCReg)(slot+1); return 0; } } } emitir(IRTG(IR_UGT, IRT_P32), emitir(IRT(IR_SUB, IRT_P32), uref, REF_BASE), lj_ir_kint(J, (J->baseslot + J->maxslot) * 8)); } else { needbarrier = 1; uref = tref_ref(emitir(IRTG(IR_UREFC, IRT_P32), fn, uv)); } if (val == 0) { /* Upvalue load */ IRType t = itype2irt(uvval(uvp)); TRef res = emitir(IRTG(IR_ULOAD, t), uref, 0); if (irtype_ispri(t)) res = TREF_PRI(t); /* Canonicalize primitive refs. */ return res; } else { /* Upvalue store. */ /* Convert int to number before storing. */ if (!LJ_DUALNUM && tref_isinteger(val)) val = emitir(IRTN(IR_CONV), val, IRCONV_NUM_INT); emitir(IRT(IR_USTORE, tref_type(val)), uref, val); if (needbarrier && tref_isgcv(val)) emitir(IRT(IR_OBAR, IRT_NIL), uref, val); J->needsnap = 1; return 0; } } /* -- Record calls to Lua functions --------------------------------------- */ /* Check unroll limits for calls. */ static void check_call_unroll(jit_State *J, TraceNo lnk) { cTValue *frame = J->L->base - 1; void *pc = mref(frame_func(frame)->l.pc, void); int32_t depth = J->framedepth; int32_t count = 0; if ((J->pt->flags & PROTO_VARARG)) depth--; /* Vararg frame still missing. */ for (; depth > 0; depth--) { /* Count frames with same prototype. */ if (frame_iscont(frame)) depth--; frame = frame_prev(frame); if (mref(frame_func(frame)->l.pc, void) == pc) count++; } if (J->pc == J->startpc) { if (count + J->tailcalled > J->param[JIT_P_recunroll]) { J->pc++; if (J->framedepth + J->retdepth == 0) rec_stop(J, LJ_TRLINK_TAILREC, J->cur.traceno); /* Tail-recursion. */ else rec_stop(J, LJ_TRLINK_UPREC, J->cur.traceno); /* Up-recursion. */ } } else { if (count > J->param[JIT_P_callunroll]) { if (lnk) { /* Possible tail- or up-recursion. */ lj_trace_flush(J, lnk); /* Flush trace that only returns. */ /* Set a small, pseudo-random hotcount for a quick retry of JFUNC*. */ hotcount_set(J2GG(J), J->pc+1, LJ_PRNG_BITS(J, 4)); } lj_trace_err(J, LJ_TRERR_CUNROLL); } } } /* Record Lua function setup. */ static void rec_func_setup(jit_State *J) { GCproto *pt = J->pt; BCReg s, numparams = pt->numparams; if ((pt->flags & PROTO_NOJIT)) lj_trace_err(J, LJ_TRERR_CJITOFF); if (J->baseslot + pt->framesize >= LJ_MAX_JSLOTS) lj_trace_err(J, LJ_TRERR_STACKOV); /* Fill up missing parameters with nil. */ for (s = J->maxslot; s < numparams; s++) J->base[s] = TREF_NIL; /* The remaining slots should never be read before they are written. */ J->maxslot = numparams; } /* Record Lua vararg function setup. */ static void rec_func_vararg(jit_State *J) { GCproto *pt = J->pt; BCReg s, fixargs, vframe = J->maxslot+1; lua_assert((pt->flags & PROTO_VARARG)); if (J->baseslot + vframe + pt->framesize >= LJ_MAX_JSLOTS) lj_trace_err(J, LJ_TRERR_STACKOV); J->base[vframe-1] = J->base[-1]; /* Copy function up. */ /* Copy fixarg slots up and set their original slots to nil. */ fixargs = pt->numparams < J->maxslot ? pt->numparams : J->maxslot; for (s = 0; s < fixargs; s++) { J->base[vframe+s] = J->base[s]; J->base[s] = TREF_NIL; } J->maxslot = fixargs; J->framedepth++; J->base += vframe; J->baseslot += vframe; } /* Record entry to a Lua function. */ static void rec_func_lua(jit_State *J) { rec_func_setup(J); check_call_unroll(J, 0); } /* Record entry to an already compiled function. */ static void rec_func_jit(jit_State *J, TraceNo lnk) { GCtrace *T; rec_func_setup(J); T = traceref(J, lnk); if (T->linktype == LJ_TRLINK_RETURN) { /* Trace returns to interpreter? */ check_call_unroll(J, lnk); /* Temporarily unpatch JFUNC* to continue recording across function. */ J->patchins = *J->pc; J->patchpc = (BCIns *)J->pc; *J->patchpc = T->startins; return; } J->instunroll = 0; /* Cannot continue across a compiled function. */ if (J->pc == J->startpc && J->framedepth + J->retdepth == 0) rec_stop(J, LJ_TRLINK_TAILREC, J->cur.traceno); /* Extra tail-recursion. */ else rec_stop(J, LJ_TRLINK_ROOT, lnk); /* Link to the function. */ } /* -- Vararg handling ----------------------------------------------------- */ /* Detect y = select(x, ...) idiom. */ static int select_detect(jit_State *J) { BCIns ins = J->pc[1]; if (bc_op(ins) == BC_CALLM && bc_b(ins) == 2 && bc_c(ins) == 1) { cTValue *func = &J->L->base[bc_a(ins)]; if (tvisfunc(func) && funcV(func)->c.ffid == FF_select) { TRef kfunc = lj_ir_kfunc(J, funcV(func)); emitir(IRTG(IR_EQ, IRT_FUNC), getslot(J, bc_a(ins)), kfunc); return 1; } } return 0; } /* Record vararg instruction. */ static void rec_varg(jit_State *J, BCReg dst, ptrdiff_t nresults) { int32_t numparams = J->pt->numparams; ptrdiff_t nvararg = frame_delta(J->L->base-1) - numparams - 1; lua_assert(frame_isvarg(J->L->base-1)); if (J->framedepth > 0) { /* Simple case: varargs defined on-trace. */ ptrdiff_t i; if (nvararg < 0) nvararg = 0; if (nresults == -1) { nresults = nvararg; J->maxslot = dst + (BCReg)nvararg; } else if (dst + nresults > J->maxslot) { J->maxslot = dst + (BCReg)nresults; } for (i = 0; i < nresults; i++) J->base[dst+i] = i < nvararg ? getslot(J, i - nvararg - 1) : TREF_NIL; } else { /* Unknown number of varargs passed to trace. */ TRef fr = emitir(IRTI(IR_SLOAD), 0, IRSLOAD_READONLY|IRSLOAD_FRAME); int32_t frofs = 8*(1+numparams)+FRAME_VARG; if (nresults >= 0) { /* Known fixed number of results. */ ptrdiff_t i; if (nvararg > 0) { ptrdiff_t nload = nvararg >= nresults ? nresults : nvararg; TRef vbase; if (nvararg >= nresults) emitir(IRTGI(IR_GE), fr, lj_ir_kint(J, frofs+8*(int32_t)nresults)); else emitir(IRTGI(IR_EQ), fr, lj_ir_kint(J, frame_ftsz(J->L->base-1))); vbase = emitir(IRTI(IR_SUB), REF_BASE, fr); vbase = emitir(IRT(IR_ADD, IRT_P32), vbase, lj_ir_kint(J, frofs-8)); for (i = 0; i < nload; i++) { IRType t = itype2irt(&J->L->base[i-1-nvararg]); TRef aref = emitir(IRT(IR_AREF, IRT_P32), vbase, lj_ir_kint(J, (int32_t)i)); TRef tr = emitir(IRTG(IR_VLOAD, t), aref, 0); if (irtype_ispri(t)) tr = TREF_PRI(t); /* Canonicalize primitives. */ J->base[dst+i] = tr; } } else { emitir(IRTGI(IR_LE), fr, lj_ir_kint(J, frofs)); nvararg = 0; } for (i = nvararg; i < nresults; i++) J->base[dst+i] = TREF_NIL; if (dst + (BCReg)nresults > J->maxslot) J->maxslot = dst + (BCReg)nresults; } else if (select_detect(J)) { /* y = select(x, ...) */ TRef tridx = J->base[dst-1]; TRef tr = TREF_NIL; ptrdiff_t idx = lj_ffrecord_select_mode(J, tridx, &J->L->base[dst-1]); if (idx < 0) goto nyivarg; if (idx != 0 && !tref_isinteger(tridx)) tridx = emitir(IRTGI(IR_CONV), tridx, IRCONV_INT_NUM|IRCONV_INDEX); if (idx != 0 && tref_isk(tridx)) { emitir(IRTGI(idx <= nvararg ? IR_GE : IR_LT), fr, lj_ir_kint(J, frofs+8*(int32_t)idx)); frofs -= 8; /* Bias for 1-based index. */ } else if (idx <= nvararg) { /* Compute size. */ TRef tmp = emitir(IRTI(IR_ADD), fr, lj_ir_kint(J, -frofs)); if (numparams) emitir(IRTGI(IR_GE), tmp, lj_ir_kint(J, 0)); tr = emitir(IRTI(IR_BSHR), tmp, lj_ir_kint(J, 3)); if (idx != 0) { tridx = emitir(IRTI(IR_ADD), tridx, lj_ir_kint(J, -1)); rec_idx_abc(J, tr, tridx, (uint32_t)nvararg); } } else { TRef tmp = lj_ir_kint(J, frofs); if (idx != 0) { TRef tmp2 = emitir(IRTI(IR_BSHL), tridx, lj_ir_kint(J, 3)); tmp = emitir(IRTI(IR_ADD), tmp2, tmp); } else { tr = lj_ir_kint(J, 0); } emitir(IRTGI(IR_LT), fr, tmp); } if (idx != 0 && idx <= nvararg) { IRType t; TRef aref, vbase = emitir(IRTI(IR_SUB), REF_BASE, fr); vbase = emitir(IRT(IR_ADD, IRT_P32), vbase, lj_ir_kint(J, frofs-8)); t = itype2irt(&J->L->base[idx-2-nvararg]); aref = emitir(IRT(IR_AREF, IRT_P32), vbase, tridx); tr = emitir(IRTG(IR_VLOAD, t), aref, 0); if (irtype_ispri(t)) tr = TREF_PRI(t); /* Canonicalize primitives. */ } J->base[dst-2] = tr; J->maxslot = dst-1; J->bcskip = 2; /* Skip CALLM + select. */ } else { nyivarg: setintV(&J->errinfo, BC_VARG); lj_trace_err_info(J, LJ_TRERR_NYIBC); } } } /* -- Record allocations -------------------------------------------------- */ static TRef rec_tnew(jit_State *J, uint32_t ah) { uint32_t asize = ah & 0x7ff; uint32_t hbits = ah >> 11; if (asize == 0x7ff) asize = 0x801; return emitir(IRTG(IR_TNEW, IRT_TAB), asize, hbits); } /* -- Record bytecode ops ------------------------------------------------- */ /* Prepare for comparison. */ static void rec_comp_prep(jit_State *J) { /* Prevent merging with snapshot #0 (GC exit) since we fixup the PC. */ if (J->cur.nsnap == 1 && J->cur.snap[0].ref == J->cur.nins) emitir_raw(IRT(IR_NOP, IRT_NIL), 0, 0); lj_snap_add(J); } /* Fixup comparison. */ static void rec_comp_fixup(jit_State *J, const BCIns *pc, int cond) { BCIns jmpins = pc[1]; const BCIns *npc = pc + 2 + (cond ? bc_j(jmpins) : 0); SnapShot *snap = &J->cur.snap[J->cur.nsnap-1]; /* Set PC to opposite target to avoid re-recording the comp. in side trace. */ J->cur.snapmap[snap->mapofs + snap->nent] = SNAP_MKPC(npc); J->needsnap = 1; if (bc_a(jmpins) < J->maxslot) J->maxslot = bc_a(jmpins); lj_snap_shrink(J); /* Shrink last snapshot if possible. */ } /* Record the next bytecode instruction (_before_ it's executed). */ void lj_record_ins(jit_State *J) { cTValue *lbase; RecordIndex ix; const BCIns *pc; BCIns ins; BCOp op; TRef ra, rb, rc; /* Perform post-processing action before recording the next instruction. */ if (LJ_UNLIKELY(J->postproc != LJ_POST_NONE)) { switch (J->postproc) { case LJ_POST_FIXCOMP: /* Fixup comparison. */ pc = frame_pc(&J2G(J)->tmptv); rec_comp_fixup(J, pc, (!tvistruecond(&J2G(J)->tmptv2) ^ (bc_op(*pc)&1))); /* fallthrough */ case LJ_POST_FIXGUARD: /* Fixup and emit pending guard. */ case LJ_POST_FIXGUARDSNAP: /* Fixup and emit pending guard and snapshot. */ if (!tvistruecond(&J2G(J)->tmptv2)) { J->fold.ins.o ^= 1; /* Flip guard to opposite. */ if (J->postproc == LJ_POST_FIXGUARDSNAP) { SnapShot *snap = &J->cur.snap[J->cur.nsnap-1]; J->cur.snapmap[snap->mapofs+snap->nent-1]--; /* False -> true. */ } } lj_opt_fold(J); /* Emit pending guard. */ /* fallthrough */ case LJ_POST_FIXBOOL: if (!tvistruecond(&J2G(J)->tmptv2)) { BCReg s; TValue *tv = J->L->base; for (s = 0; s < J->maxslot; s++) /* Fixup stack slot (if any). */ if (J->base[s] == TREF_TRUE && tvisfalse(&tv[s])) { J->base[s] = TREF_FALSE; break; } } break; case LJ_POST_FIXCONST: { BCReg s; TValue *tv = J->L->base; for (s = 0; s < J->maxslot; s++) /* Constify stack slots (if any). */ if (J->base[s] == TREF_NIL && !tvisnil(&tv[s])) J->base[s] = lj_record_constify(J, &tv[s]); } break; case LJ_POST_FFRETRY: /* Suppress recording of retried fast function. */ if (bc_op(*J->pc) >= BC__MAX) return; break; default: lua_assert(0); break; } J->postproc = LJ_POST_NONE; } /* Need snapshot before recording next bytecode (e.g. after a store). */ if (J->needsnap) { J->needsnap = 0; lj_snap_purge(J); lj_snap_add(J); J->mergesnap = 1; } /* Skip some bytecodes. */ if (LJ_UNLIKELY(J->bcskip > 0)) { J->bcskip--; return; } /* Record only closed loops for root traces. */ pc = J->pc; if (J->framedepth == 0 && (MSize)((char *)pc - (char *)J->bc_min) >= J->bc_extent) lj_trace_err(J, LJ_TRERR_LLEAVE); #ifdef LUA_USE_ASSERT rec_check_slots(J); rec_check_ir(J); #endif /* Keep a copy of the runtime values of var/num/str operands. */ #define rav (&ix.valv) #define rbv (&ix.tabv) #define rcv (&ix.keyv) lbase = J->L->base; ins = *pc; op = bc_op(ins); ra = bc_a(ins); ix.val = 0; switch (bcmode_a(op)) { case BCMvar: copyTV(J->L, rav, &lbase[ra]); ix.val = ra = getslot(J, ra); break; default: break; /* Handled later. */ } rb = bc_b(ins); rc = bc_c(ins); switch (bcmode_b(op)) { case BCMnone: rb = 0; rc = bc_d(ins); break; /* Upgrade rc to 'rd'. */ case BCMvar: copyTV(J->L, rbv, &lbase[rb]); ix.tab = rb = getslot(J, rb); break; default: break; /* Handled later. */ } switch (bcmode_c(op)) { case BCMvar: copyTV(J->L, rcv, &lbase[rc]); ix.key = rc = getslot(J, rc); break; case BCMpri: setitype(rcv, ~rc); ix.key = rc = TREF_PRI(IRT_NIL+rc); break; case BCMnum: { cTValue *tv = proto_knumtv(J->pt, rc); copyTV(J->L, rcv, tv); ix.key = rc = tvisint(tv) ? lj_ir_kint(J, intV(tv)) : lj_ir_knumint(J, numV(tv)); } break; case BCMstr: { GCstr *s = gco2str(proto_kgc(J->pt, ~(ptrdiff_t)rc)); setstrV(J->L, rcv, s); ix.key = rc = lj_ir_kstr(J, s); } break; default: break; /* Handled later. */ } switch (op) { /* -- Comparison ops ---------------------------------------------------- */ case BC_ISLT: case BC_ISGE: case BC_ISLE: case BC_ISGT: #if LJ_HASFFI if (tref_iscdata(ra) || tref_iscdata(rc)) { rec_mm_comp_cdata(J, &ix, op, ((int)op & 2) ? MM_le : MM_lt); break; } #endif /* Emit nothing for two numeric or string consts. */ if (!(tref_isk2(ra,rc) && tref_isnumber_str(ra) && tref_isnumber_str(rc))) { IRType ta = tref_isinteger(ra) ? IRT_INT : tref_type(ra); IRType tc = tref_isinteger(rc) ? IRT_INT : tref_type(rc); int irop; if (ta != tc) { /* Widen mixed number/int comparisons to number/number comparison. */ if (ta == IRT_INT && tc == IRT_NUM) { ra = emitir(IRTN(IR_CONV), ra, IRCONV_NUM_INT); ta = IRT_NUM; } else if (ta == IRT_NUM && tc == IRT_INT) { rc = emitir(IRTN(IR_CONV), rc, IRCONV_NUM_INT); } else if (LJ_52) { ta = IRT_NIL; /* Force metamethod for different types. */ } else if (!((ta == IRT_FALSE || ta == IRT_TRUE) && (tc == IRT_FALSE || tc == IRT_TRUE))) { break; /* Interpreter will throw for two different types. */ } } rec_comp_prep(J); irop = (int)op - (int)BC_ISLT + (int)IR_LT; if (ta == IRT_NUM) { if ((irop & 1)) irop ^= 4; /* ISGE/ISGT are unordered. */ if (!lj_ir_numcmp(numberVnum(rav), numberVnum(rcv), (IROp)irop)) irop ^= 5; } else if (ta == IRT_INT) { if (!lj_ir_numcmp(numberVnum(rav), numberVnum(rcv), (IROp)irop)) irop ^= 1; } else if (ta == IRT_STR) { if (!lj_ir_strcmp(strV(rav), strV(rcv), (IROp)irop)) irop ^= 1; ra = lj_ir_call(J, IRCALL_lj_str_cmp, ra, rc); rc = lj_ir_kint(J, 0); ta = IRT_INT; } else { rec_mm_comp(J, &ix, (int)op); break; } emitir(IRTG(irop, ta), ra, rc); rec_comp_fixup(J, J->pc, ((int)op ^ irop) & 1); } break; case BC_ISEQV: case BC_ISNEV: case BC_ISEQS: case BC_ISNES: case BC_ISEQN: case BC_ISNEN: case BC_ISEQP: case BC_ISNEP: #if LJ_HASFFI if (tref_iscdata(ra) || tref_iscdata(rc)) { rec_mm_comp_cdata(J, &ix, op, MM_eq); break; } #endif /* Emit nothing for two non-table, non-udata consts. */ if (!(tref_isk2(ra, rc) && !(tref_istab(ra) || tref_isudata(ra)))) { int diff; rec_comp_prep(J); diff = lj_record_objcmp(J, ra, rc, rav, rcv); if (diff == 2 || !(tref_istab(ra) || tref_isudata(ra))) rec_comp_fixup(J, J->pc, ((int)op & 1) == !diff); else if (diff == 1) /* Only check __eq if different, but same type. */ rec_mm_equal(J, &ix, (int)op); } break; /* -- Unary test and copy ops ------------------------------------------- */ case BC_ISTC: case BC_ISFC: if ((op & 1) == tref_istruecond(rc)) rc = 0; /* Don't store if condition is not true. */ /* fallthrough */ case BC_IST: case BC_ISF: /* Type specialization suffices. */ if (bc_a(pc[1]) < J->maxslot) J->maxslot = bc_a(pc[1]); /* Shrink used slots. */ break; /* -- Unary ops --------------------------------------------------------- */ case BC_NOT: /* Type specialization already forces const result. */ rc = tref_istruecond(rc) ? TREF_FALSE : TREF_TRUE; break; case BC_LEN: if (tref_isstr(rc)) rc = emitir(IRTI(IR_FLOAD), rc, IRFL_STR_LEN); else if (!LJ_52 && tref_istab(rc)) rc = lj_ir_call(J, IRCALL_lj_tab_len, rc); else rc = rec_mm_len(J, rc, rcv); break; /* -- Arithmetic ops ---------------------------------------------------- */ case BC_UNM: if (tref_isnumber_str(rc)) { rc = lj_opt_narrow_unm(J, rc, rcv); } else { ix.tab = rc; copyTV(J->L, &ix.tabv, rcv); rc = rec_mm_arith(J, &ix, MM_unm); } break; case BC_ADDNV: case BC_SUBNV: case BC_MULNV: case BC_DIVNV: case BC_MODNV: /* Swap rb/rc and rbv/rcv. rav is temp. */ ix.tab = rc; ix.key = rc = rb; rb = ix.tab; copyTV(J->L, rav, rbv); copyTV(J->L, rbv, rcv); copyTV(J->L, rcv, rav); if (op == BC_MODNV) goto recmod; /* fallthrough */ case BC_ADDVN: case BC_SUBVN: case BC_MULVN: case BC_DIVVN: case BC_ADDVV: case BC_SUBVV: case BC_MULVV: case BC_DIVVV: { MMS mm = bcmode_mm(op); if (tref_isnumber_str(rb) && tref_isnumber_str(rc)) rc = lj_opt_narrow_arith(J, rb, rc, rbv, rcv, (int)mm - (int)MM_add + (int)IR_ADD); else rc = rec_mm_arith(J, &ix, mm); break; } case BC_MODVN: case BC_MODVV: recmod: if (tref_isnumber_str(rb) && tref_isnumber_str(rc)) rc = lj_opt_narrow_mod(J, rb, rc, rbv, rcv); else rc = rec_mm_arith(J, &ix, MM_mod); break; case BC_POW: if (tref_isnumber_str(rb) && tref_isnumber_str(rc)) rc = lj_opt_narrow_pow(J, rb, rc, rbv, rcv); else rc = rec_mm_arith(J, &ix, MM_pow); break; /* -- Constant and move ops --------------------------------------------- */ case BC_MOV: /* Clear gap of method call to avoid resurrecting previous refs. */ if (ra > J->maxslot) J->base[ra-1] = 0; break; case BC_KSTR: case BC_KNUM: case BC_KPRI: break; case BC_KSHORT: rc = lj_ir_kint(J, (int32_t)(int16_t)rc); break; case BC_KNIL: while (ra <= rc) J->base[ra++] = TREF_NIL; if (rc >= J->maxslot) J->maxslot = rc+1; break; #if LJ_HASFFI case BC_KCDATA: rc = lj_ir_kgc(J, proto_kgc(J->pt, ~(ptrdiff_t)rc), IRT_CDATA); break; #endif /* -- Upvalue and function ops ------------------------------------------ */ case BC_UGET: rc = rec_upvalue(J, rc, 0); break; case BC_USETV: case BC_USETS: case BC_USETN: case BC_USETP: rec_upvalue(J, ra, rc); break; /* -- Table ops --------------------------------------------------------- */ case BC_GGET: case BC_GSET: settabV(J->L, &ix.tabv, tabref(J->fn->l.env)); ix.tab = emitir(IRT(IR_FLOAD, IRT_TAB), getcurrf(J), IRFL_FUNC_ENV); ix.idxchain = LJ_MAX_IDXCHAIN; rc = lj_record_idx(J, &ix); break; case BC_TGETB: case BC_TSETB: setintV(&ix.keyv, (int32_t)rc); ix.key = lj_ir_kint(J, (int32_t)rc); /* fallthrough */ case BC_TGETV: case BC_TGETS: case BC_TSETV: case BC_TSETS: ix.idxchain = LJ_MAX_IDXCHAIN; rc = lj_record_idx(J, &ix); break; case BC_TNEW: rc = rec_tnew(J, rc); break; case BC_TDUP: rc = emitir(IRTG(IR_TDUP, IRT_TAB), lj_ir_ktab(J, gco2tab(proto_kgc(J->pt, ~(ptrdiff_t)rc))), 0); break; /* -- Calls and vararg handling ----------------------------------------- */ case BC_ITERC: J->base[ra] = getslot(J, ra-3); J->base[ra+1] = getslot(J, ra-2); J->base[ra+2] = getslot(J, ra-1); { /* Do the actual copy now because lj_record_call needs the values. */ TValue *b = &J->L->base[ra]; copyTV(J->L, b, b-3); copyTV(J->L, b+1, b-2); copyTV(J->L, b+2, b-1); } lj_record_call(J, ra, (ptrdiff_t)rc-1); break; /* L->top is set to L->base+ra+rc+NARGS-1+1. See lj_dispatch_ins(). */ case BC_CALLM: rc = (BCReg)(J->L->top - J->L->base) - ra; /* fallthrough */ case BC_CALL: lj_record_call(J, ra, (ptrdiff_t)rc-1); break; case BC_CALLMT: rc = (BCReg)(J->L->top - J->L->base) - ra; /* fallthrough */ case BC_CALLT: lj_record_tailcall(J, ra, (ptrdiff_t)rc-1); break; case BC_VARG: rec_varg(J, ra, (ptrdiff_t)rb-1); break; /* -- Returns ----------------------------------------------------------- */ case BC_RETM: /* L->top is set to L->base+ra+rc+NRESULTS-1, see lj_dispatch_ins(). */ rc = (BCReg)(J->L->top - J->L->base) - ra + 1; /* fallthrough */ case BC_RET: case BC_RET0: case BC_RET1: lj_record_ret(J, ra, (ptrdiff_t)rc-1); break; /* -- Loops and branches ------------------------------------------------ */ case BC_FORI: if (rec_for(J, pc, 0) != LOOPEV_LEAVE) J->loopref = J->cur.nins; break; case BC_JFORI: lua_assert(bc_op(pc[(ptrdiff_t)rc-BCBIAS_J]) == BC_JFORL); if (rec_for(J, pc, 0) != LOOPEV_LEAVE) /* Link to existing loop. */ rec_stop(J, LJ_TRLINK_ROOT, bc_d(pc[(ptrdiff_t)rc-BCBIAS_J])); /* Continue tracing if the loop is not entered. */ break; case BC_FORL: rec_loop_interp(J, pc, rec_for(J, pc+((ptrdiff_t)rc-BCBIAS_J), 1)); break; case BC_ITERL: rec_loop_interp(J, pc, rec_iterl(J, *pc)); break; case BC_LOOP: rec_loop_interp(J, pc, rec_loop(J, ra)); break; case BC_JFORL: rec_loop_jit(J, rc, rec_for(J, pc+bc_j(traceref(J, rc)->startins), 1)); break; case BC_JITERL: rec_loop_jit(J, rc, rec_iterl(J, traceref(J, rc)->startins)); break; case BC_JLOOP: rec_loop_jit(J, rc, rec_loop(J, ra)); break; case BC_IFORL: case BC_IITERL: case BC_ILOOP: case BC_IFUNCF: case BC_IFUNCV: lj_trace_err(J, LJ_TRERR_BLACKL); break; case BC_JMP: if (ra < J->maxslot) J->maxslot = ra; /* Shrink used slots. */ break; /* -- Function headers -------------------------------------------------- */ case BC_FUNCF: rec_func_lua(J); break; case BC_JFUNCF: rec_func_jit(J, rc); break; case BC_FUNCV: rec_func_vararg(J); rec_func_lua(J); break; case BC_JFUNCV: lua_assert(0); /* Cannot happen. No hotcall counting for varag funcs. */ break; case BC_FUNCC: case BC_FUNCCW: lj_ffrecord_func(J); break; default: if (op >= BC__MAX) { lj_ffrecord_func(J); break; } /* fallthrough */ case BC_ITERN: case BC_ISNEXT: case BC_CAT: case BC_UCLO: case BC_FNEW: case BC_TSETM: setintV(&J->errinfo, (int32_t)op); lj_trace_err_info(J, LJ_TRERR_NYIBC); break; } /* rc == 0 if we have no result yet, e.g. pending __index metamethod call. */ if (bcmode_a(op) == BCMdst && rc) { J->base[ra] = rc; if (ra >= J->maxslot) J->maxslot = ra+1; } #undef rav #undef rbv #undef rcv /* Limit the number of recorded IR instructions. */ if (J->cur.nins > REF_FIRST+(IRRef)J->param[JIT_P_maxrecord]) lj_trace_err(J, LJ_TRERR_TRACEOV); } /* -- Recording setup ----------------------------------------------------- */ /* Setup recording for a root trace started by a hot loop. */ static const BCIns *rec_setup_root(jit_State *J) { /* Determine the next PC and the bytecode range for the loop. */ const BCIns *pcj, *pc = J->pc; BCIns ins = *pc; BCReg ra = bc_a(ins); switch (bc_op(ins)) { case BC_FORL: J->bc_extent = (MSize)(-bc_j(ins))*sizeof(BCIns); pc += 1+bc_j(ins); J->bc_min = pc; break; case BC_ITERL: lua_assert(bc_op(pc[-1]) == BC_ITERC); J->maxslot = ra + bc_b(pc[-1]) - 1; J->bc_extent = (MSize)(-bc_j(ins))*sizeof(BCIns); pc += 1+bc_j(ins); lua_assert(bc_op(pc[-1]) == BC_JMP); J->bc_min = pc; break; case BC_LOOP: /* Only check BC range for real loops, but not for "repeat until true". */ pcj = pc + bc_j(ins); ins = *pcj; if (bc_op(ins) == BC_JMP && bc_j(ins) < 0) { J->bc_min = pcj+1 + bc_j(ins); J->bc_extent = (MSize)(-bc_j(ins))*sizeof(BCIns); } J->maxslot = ra; pc++; break; case BC_RET: case BC_RET0: case BC_RET1: /* No bytecode range check for down-recursive root traces. */ J->maxslot = ra + bc_d(ins) - 1; break; case BC_FUNCF: /* No bytecode range check for root traces started by a hot call. */ J->maxslot = J->pt->numparams; pc++; break; default: lua_assert(0); break; } return pc; } /* Setup for recording a new trace. */ void lj_record_setup(jit_State *J) { uint32_t i; /* Initialize state related to current trace. */ memset(J->slot, 0, sizeof(J->slot)); memset(J->chain, 0, sizeof(J->chain)); memset(J->bpropcache, 0, sizeof(J->bpropcache)); J->scev.idx = REF_NIL; setmref(J->scev.pc, NULL); J->baseslot = 1; /* Invoking function is at base[-1]. */ J->base = J->slot + J->baseslot; J->maxslot = 0; J->framedepth = 0; J->retdepth = 0; J->instunroll = J->param[JIT_P_instunroll]; J->loopunroll = J->param[JIT_P_loopunroll]; J->tailcalled = 0; J->loopref = 0; J->bc_min = NULL; /* Means no limit. */ J->bc_extent = ~(MSize)0; /* Emit instructions for fixed references. Also triggers initial IR alloc. */ emitir_raw(IRT(IR_BASE, IRT_P32), J->parent, J->exitno); for (i = 0; i <= 2; i++) { IRIns *ir = IR(REF_NIL-i); ir->i = 0; ir->t.irt = (uint8_t)(IRT_NIL+i); ir->o = IR_KPRI; ir->prev = 0; } J->cur.nk = REF_TRUE; J->startpc = J->pc; setmref(J->cur.startpc, J->pc); if (J->parent) { /* Side trace. */ GCtrace *T = traceref(J, J->parent); TraceNo root = T->root ? T->root : J->parent; J->cur.root = (uint16_t)root; J->cur.startins = BCINS_AD(BC_JMP, 0, 0); /* Check whether we could at least potentially form an extra loop. */ if (J->exitno == 0 && T->snap[0].nent == 0) { /* We can narrow a FORL for some side traces, too. */ if (J->pc > proto_bc(J->pt) && bc_op(J->pc[-1]) == BC_JFORI && bc_d(J->pc[bc_j(J->pc[-1])-1]) == root) { lj_snap_add(J); rec_for_loop(J, J->pc-1, &J->scev, 1); goto sidecheck; } } else { J->startpc = NULL; /* Prevent forming an extra loop. */ } lj_snap_replay(J, T); sidecheck: if (traceref(J, J->cur.root)->nchild >= J->param[JIT_P_maxside] || T->snap[J->exitno].count >= J->param[JIT_P_hotexit] + J->param[JIT_P_tryside]) { rec_stop(J, LJ_TRLINK_INTERP, 0); } } else { /* Root trace. */ J->cur.root = 0; J->cur.startins = *J->pc; J->pc = rec_setup_root(J); /* Note: the loop instruction itself is recorded at the end and not ** at the start! So snapshot #0 needs to point to the *next* instruction. */ lj_snap_add(J); if (bc_op(J->cur.startins) == BC_FORL) rec_for_loop(J, J->pc-1, &J->scev, 1); if (1 + J->pt->framesize >= LJ_MAX_JSLOTS) lj_trace_err(J, LJ_TRERR_STACKOV); } #ifdef LUAJIT_ENABLE_CHECKHOOK /* Regularly check for instruction/line hooks from compiled code and ** exit to the interpreter if the hooks are set. ** ** This is a compile-time option and disabled by default, since the ** hook checks may be quite expensive in tight loops. ** ** Note this is only useful if hooks are *not* set most of the time. ** Use this only if you want to *asynchronously* interrupt the execution. ** ** You can set the instruction hook via lua_sethook() with a count of 1 ** from a signal handler or another native thread. Please have a look ** at the first few functions in luajit.c for an example (Ctrl-C handler). */ { TRef tr = emitir(IRT(IR_XLOAD, IRT_U8), lj_ir_kptr(J, &J2G(J)->hookmask), IRXLOAD_VOLATILE); tr = emitir(IRTI(IR_BAND), tr, lj_ir_kint(J, (LUA_MASKLINE|LUA_MASKCOUNT))); emitir(IRTGI(IR_EQ), tr, lj_ir_kint(J, 0)); } #endif } #undef IR #undef emitir_raw #undef emitir #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_parse.h0000644000175000017500000000064113122010155016642 0ustar philphil/* ** Lua parser (source code -> bytecode). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_PARSE_H #define _LJ_PARSE_H #include "lj_obj.h" #include "lj_lex.h" LJ_FUNC GCproto *lj_parse(LexState *ls); LJ_FUNC GCstr *lj_parse_keepstr(LexState *ls, const char *str, size_t l); #if LJ_HASFFI LJ_FUNC void lj_parse_keepcdata(LexState *ls, TValue *tv, GCcdata *cd); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/psvitabuild.bat0000644000175000017500000000604413122010155017713 0ustar philphil@rem Script to build LuaJIT with the PS Vita SDK. @rem Donated to the public domain. @rem @rem Open a "Visual Studio .NET Command Prompt" (32 bit host compiler) @rem Then cd to this directory and run this script. @if not defined INCLUDE goto :FAIL @if not defined SCE_PSP2_SDK_DIR goto :FAIL @setlocal @rem ---- Host compiler ---- @set LJCOMPILE=cl /nologo /c /MD /O2 /W3 /D_CRT_SECURE_NO_DEPRECATE @set LJLINK=link /nologo @set LJMT=mt /nologo @set DASMDIR=..\dynasm @set DASM=%DASMDIR%\dynasm.lua @set ALL_LIB=lib_base.c lib_math.c lib_bit.c lib_string.c lib_table.c lib_io.c lib_os.c lib_package.c lib_debug.c lib_jit.c lib_ffi.c %LJCOMPILE% host\minilua.c @if errorlevel 1 goto :BAD %LJLINK% /out:minilua.exe minilua.obj @if errorlevel 1 goto :BAD if exist minilua.exe.manifest^ %LJMT% -manifest minilua.exe.manifest -outputresource:minilua.exe @rem Check for 32 bit host compiler. @minilua @if errorlevel 8 goto :FAIL @set DASMFLAGS=-D FPU -D HFABI minilua %DASM% -LN %DASMFLAGS% -o host\buildvm_arch.h vm_arm.dasc @if errorlevel 1 goto :BAD %LJCOMPILE% /I "." /I %DASMDIR% -DLUAJIT_TARGET=LUAJIT_ARCH_ARM -DLUAJIT_OS=LUAJIT_OS_OTHER -DLUAJIT_DISABLE_JIT -DLUAJIT_DISABLE_FFI -DLJ_TARGET_PSVITA=1 host\buildvm*.c @if errorlevel 1 goto :BAD %LJLINK% /out:buildvm.exe buildvm*.obj @if errorlevel 1 goto :BAD if exist buildvm.exe.manifest^ %LJMT% -manifest buildvm.exe.manifest -outputresource:buildvm.exe buildvm -m elfasm -o lj_vm.s @if errorlevel 1 goto :BAD buildvm -m bcdef -o lj_bcdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m ffdef -o lj_ffdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m libdef -o lj_libdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m recdef -o lj_recdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m vmdef -o jit\vmdef.lua %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m folddef -o lj_folddef.h lj_opt_fold.c @if errorlevel 1 goto :BAD @rem ---- Cross compiler ---- @set LJCOMPILE="%SCE_PSP2_SDK_DIR%\host_tools\build\bin\psp2snc" -c -w -DLUAJIT_DISABLE_FFI -DLUAJIT_USE_SYSMALLOC @set LJLIB="%SCE_PSP2_SDK_DIR%\host_tools\build\bin\psp2ld32" -r --output= @set INCLUDE="" "%SCE_PSP2_SDK_DIR%\host_tools\build\bin\psp2as" -o lj_vm.o lj_vm.s @if "%1" neq "debug" goto :NODEBUG @shift @set LJCOMPILE=%LJCOMPILE% -g -O0 @set TARGETLIB=libluajitD.a goto :BUILD :NODEBUG @set LJCOMPILE=%LJCOMPILE% -O2 @set TARGETLIB=libluajit.a :BUILD del %TARGETLIB% %LJCOMPILE% ljamalg.c @if errorlevel 1 goto :BAD %LJLIB%%TARGETLIB% ljamalg.o lj_vm.o @if errorlevel 1 goto :BAD @del *.o *.obj *.manifest minilua.exe buildvm.exe @echo. @echo === Successfully built LuaJIT for PS Vita === @goto :END :BAD @echo. @echo ******************************************************* @echo *** Build FAILED -- Please check the error messages *** @echo ******************************************************* @goto :END :FAIL @echo To run this script you must open a "Visual Studio .NET Command Prompt" @echo (32 bit host compiler). The PS Vita SDK must be installed, too. :END wcc-0.0.2/src/wsh/luajit-2.0/src/lj_opt_mem.c0000644000175000017500000007400113122010155017164 0ustar philphil/* ** Memory access optimizations. ** AA: Alias Analysis using high-level semantic disambiguation. ** FWD: Load Forwarding (L2L) + Store Forwarding (S2L). ** DSE: Dead-Store Elimination. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_opt_mem_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_tab.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) #define fins (&J->fold.ins) #define fleft (&J->fold.left) #define fright (&J->fold.right) /* ** Caveat #1: return value is not always a TRef -- only use with tref_ref(). ** Caveat #2: FWD relies on active CSE for xREF operands -- see lj_opt_fold(). */ /* Return values from alias analysis. */ typedef enum { ALIAS_NO, /* The two refs CANNOT alias (exact). */ ALIAS_MAY, /* The two refs MAY alias (inexact). */ ALIAS_MUST /* The two refs MUST alias (exact). */ } AliasRet; /* -- ALOAD/HLOAD forwarding and ASTORE/HSTORE elimination ---------------- */ /* Simplified escape analysis: check for intervening stores. */ static AliasRet aa_escape(jit_State *J, IRIns *ir, IRIns *stop) { IRRef ref = (IRRef)(ir - J->cur.ir); /* The ref that might be stored. */ for (ir++; ir < stop; ir++) if (ir->op2 == ref && (ir->o == IR_ASTORE || ir->o == IR_HSTORE || ir->o == IR_USTORE || ir->o == IR_FSTORE)) return ALIAS_MAY; /* Reference was stored and might alias. */ return ALIAS_NO; /* Reference was not stored. */ } /* Alias analysis for two different table references. */ static AliasRet aa_table(jit_State *J, IRRef ta, IRRef tb) { IRIns *taba = IR(ta), *tabb = IR(tb); int newa, newb; lua_assert(ta != tb); lua_assert(irt_istab(taba->t) && irt_istab(tabb->t)); /* Disambiguate new allocations. */ newa = (taba->o == IR_TNEW || taba->o == IR_TDUP); newb = (tabb->o == IR_TNEW || tabb->o == IR_TDUP); if (newa && newb) return ALIAS_NO; /* Two different allocations never alias. */ if (newb) { /* At least one allocation? */ IRIns *tmp = taba; taba = tabb; tabb = tmp; } else if (!newa) { return ALIAS_MAY; /* Anything else: we just don't know. */ } return aa_escape(J, taba, tabb); } /* Alias analysis for array and hash access using key-based disambiguation. */ static AliasRet aa_ahref(jit_State *J, IRIns *refa, IRIns *refb) { IRRef ka = refa->op2; IRRef kb = refb->op2; IRIns *keya, *keyb; IRRef ta, tb; if (refa == refb) return ALIAS_MUST; /* Shortcut for same refs. */ keya = IR(ka); if (keya->o == IR_KSLOT) { ka = keya->op1; keya = IR(ka); } keyb = IR(kb); if (keyb->o == IR_KSLOT) { kb = keyb->op1; keyb = IR(kb); } ta = (refa->o==IR_HREFK || refa->o==IR_AREF) ? IR(refa->op1)->op1 : refa->op1; tb = (refb->o==IR_HREFK || refb->o==IR_AREF) ? IR(refb->op1)->op1 : refb->op1; if (ka == kb) { /* Same key. Check for same table with different ref (NEWREF vs. HREF). */ if (ta == tb) return ALIAS_MUST; /* Same key, same table. */ else return aa_table(J, ta, tb); /* Same key, possibly different table. */ } if (irref_isk(ka) && irref_isk(kb)) return ALIAS_NO; /* Different constant keys. */ if (refa->o == IR_AREF) { /* Disambiguate array references based on index arithmetic. */ int32_t ofsa = 0, ofsb = 0; IRRef basea = ka, baseb = kb; lua_assert(refb->o == IR_AREF); /* Gather base and offset from t[base] or t[base+-ofs]. */ if (keya->o == IR_ADD && irref_isk(keya->op2)) { basea = keya->op1; ofsa = IR(keya->op2)->i; if (basea == kb && ofsa != 0) return ALIAS_NO; /* t[base+-ofs] vs. t[base]. */ } if (keyb->o == IR_ADD && irref_isk(keyb->op2)) { baseb = keyb->op1; ofsb = IR(keyb->op2)->i; if (ka == baseb && ofsb != 0) return ALIAS_NO; /* t[base] vs. t[base+-ofs]. */ } if (basea == baseb && ofsa != ofsb) return ALIAS_NO; /* t[base+-o1] vs. t[base+-o2] and o1 != o2. */ } else { /* Disambiguate hash references based on the type of their keys. */ lua_assert((refa->o==IR_HREF || refa->o==IR_HREFK || refa->o==IR_NEWREF) && (refb->o==IR_HREF || refb->o==IR_HREFK || refb->o==IR_NEWREF)); if (!irt_sametype(keya->t, keyb->t)) return ALIAS_NO; /* Different key types. */ } if (ta == tb) return ALIAS_MAY; /* Same table, cannot disambiguate keys. */ else return aa_table(J, ta, tb); /* Try to disambiguate tables. */ } /* Array and hash load forwarding. */ static TRef fwd_ahload(jit_State *J, IRRef xref) { IRIns *xr = IR(xref); IRRef lim = xref; /* Search limit. */ IRRef ref; /* Search for conflicting stores. */ ref = J->chain[fins->o+IRDELTA_L2S]; while (ref > xref) { IRIns *store = IR(ref); switch (aa_ahref(J, xr, IR(store->op1))) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: lim = ref; goto cselim; /* Limit search for load. */ case ALIAS_MUST: return store->op2; /* Store forwarding. */ } ref = store->prev; } /* No conflicting store (yet): const-fold loads from allocations. */ { IRIns *ir = (xr->o == IR_HREFK || xr->o == IR_AREF) ? IR(xr->op1) : xr; IRRef tab = ir->op1; ir = IR(tab); if (ir->o == IR_TNEW || (ir->o == IR_TDUP && irref_isk(xr->op2))) { /* A NEWREF with a number key may end up pointing to the array part. ** But it's referenced from HSTORE and not found in the ASTORE chain. ** For now simply consider this a conflict without forwarding anything. */ if (xr->o == IR_AREF) { IRRef ref2 = J->chain[IR_NEWREF]; while (ref2 > tab) { IRIns *newref = IR(ref2); if (irt_isnum(IR(newref->op2)->t)) goto cselim; ref2 = newref->prev; } } /* NEWREF inhibits CSE for HREF, and dependent FLOADs from HREFK/AREF. ** But the above search for conflicting stores was limited by xref. ** So continue searching, limited by the TNEW/TDUP. Store forwarding ** is ok, too. A conflict does NOT limit the search for a matching load. */ while (ref > tab) { IRIns *store = IR(ref); switch (aa_ahref(J, xr, IR(store->op1))) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: goto cselim; /* Conflicting store. */ case ALIAS_MUST: return store->op2; /* Store forwarding. */ } ref = store->prev; } lua_assert(ir->o != IR_TNEW || irt_isnil(fins->t)); if (irt_ispri(fins->t)) { return TREF_PRI(irt_type(fins->t)); } else if (irt_isnum(fins->t) || (LJ_DUALNUM && irt_isint(fins->t)) || irt_isstr(fins->t)) { TValue keyv; cTValue *tv; IRIns *key = IR(xr->op2); if (key->o == IR_KSLOT) key = IR(key->op1); lj_ir_kvalue(J->L, &keyv, key); tv = lj_tab_get(J->L, ir_ktab(IR(ir->op1)), &keyv); lua_assert(itype2irt(tv) == irt_type(fins->t)); if (irt_isnum(fins->t)) return lj_ir_knum_u64(J, tv->u64); else if (LJ_DUALNUM && irt_isint(fins->t)) return lj_ir_kint(J, intV(tv)); else return lj_ir_kstr(J, strV(tv)); } /* Othwerwise: don't intern as a constant. */ } } cselim: /* Try to find a matching load. Below the conflicting store, if any. */ ref = J->chain[fins->o]; while (ref > lim) { IRIns *load = IR(ref); if (load->op1 == xref) return ref; /* Load forwarding. */ ref = load->prev; } return 0; /* Conflict or no match. */ } /* Reassociate ALOAD across PHIs to handle t[i-1] forwarding case. */ static TRef fwd_aload_reassoc(jit_State *J) { IRIns *irx = IR(fins->op1); IRIns *key = IR(irx->op2); if (key->o == IR_ADD && irref_isk(key->op2)) { IRIns *add2 = IR(key->op1); if (add2->o == IR_ADD && irref_isk(add2->op2) && IR(key->op2)->i == -IR(add2->op2)->i) { IRRef ref = J->chain[IR_AREF]; IRRef lim = add2->op1; if (irx->op1 > lim) lim = irx->op1; while (ref > lim) { IRIns *ir = IR(ref); if (ir->op1 == irx->op1 && ir->op2 == add2->op1) return fwd_ahload(J, ref); ref = ir->prev; } } } return 0; } /* ALOAD forwarding. */ TRef LJ_FASTCALL lj_opt_fwd_aload(jit_State *J) { IRRef ref; if ((ref = fwd_ahload(J, fins->op1)) || (ref = fwd_aload_reassoc(J))) return ref; return EMITFOLD; } /* HLOAD forwarding. */ TRef LJ_FASTCALL lj_opt_fwd_hload(jit_State *J) { IRRef ref = fwd_ahload(J, fins->op1); if (ref) return ref; return EMITFOLD; } /* HREFK forwarding. */ TRef LJ_FASTCALL lj_opt_fwd_hrefk(jit_State *J) { IRRef tab = fleft->op1; IRRef ref = J->chain[IR_NEWREF]; while (ref > tab) { IRIns *newref = IR(ref); if (tab == newref->op1) { if (fright->op1 == newref->op2) return ref; /* Forward from NEWREF. */ else goto docse; } else if (aa_table(J, tab, newref->op1) != ALIAS_NO) { goto docse; } ref = newref->prev; } /* No conflicting NEWREF: key location unchanged for HREFK of TDUP. */ if (IR(tab)->o == IR_TDUP) fins->t.irt &= ~IRT_GUARD; /* Drop HREFK guard. */ docse: return CSEFOLD; } /* Check whether HREF of TNEW/TDUP can be folded to niltv. */ int LJ_FASTCALL lj_opt_fwd_href_nokey(jit_State *J) { IRRef lim = fins->op1; /* Search limit. */ IRRef ref; /* The key for an ASTORE may end up in the hash part after a NEWREF. */ if (irt_isnum(fright->t) && J->chain[IR_NEWREF] > lim) { ref = J->chain[IR_ASTORE]; while (ref > lim) { if (ref < J->chain[IR_NEWREF]) return 0; /* Conflict. */ ref = IR(ref)->prev; } } /* Search for conflicting stores. */ ref = J->chain[IR_HSTORE]; while (ref > lim) { IRIns *store = IR(ref); if (aa_ahref(J, fins, IR(store->op1)) != ALIAS_NO) return 0; /* Conflict. */ ref = store->prev; } return 1; /* No conflict. Can fold to niltv. */ } /* Check whether there's no aliasing NEWREF for the left operand. */ int LJ_FASTCALL lj_opt_fwd_tptr(jit_State *J, IRRef lim) { IRRef ta = fins->op1; IRRef ref = J->chain[IR_NEWREF]; while (ref > lim) { IRIns *newref = IR(ref); if (ta == newref->op1 || aa_table(J, ta, newref->op1) != ALIAS_NO) return 0; /* Conflict. */ ref = newref->prev; } return 1; /* No conflict. Can safely FOLD/CSE. */ } /* ASTORE/HSTORE elimination. */ TRef LJ_FASTCALL lj_opt_dse_ahstore(jit_State *J) { IRRef xref = fins->op1; /* xREF reference. */ IRRef val = fins->op2; /* Stored value reference. */ IRIns *xr = IR(xref); IRRef1 *refp = &J->chain[fins->o]; IRRef ref = *refp; while (ref > xref) { /* Search for redundant or conflicting stores. */ IRIns *store = IR(ref); switch (aa_ahref(J, xr, IR(store->op1))) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: /* Store to MAYBE the same location. */ if (store->op2 != val) /* Conflict if the value is different. */ goto doemit; break; /* Otherwise continue searching. */ case ALIAS_MUST: /* Store to the same location. */ if (store->op2 == val) /* Same value: drop the new store. */ return DROPFOLD; /* Different value: try to eliminate the redundant store. */ if (ref > J->chain[IR_LOOP]) { /* Quick check to avoid crossing LOOP. */ IRIns *ir; /* Check for any intervening guards (includes conflicting loads). */ for (ir = IR(J->cur.nins-1); ir > store; ir--) if (irt_isguard(ir->t) || ir->o == IR_CALLL) goto doemit; /* No elimination possible. */ /* Remove redundant store from chain and replace with NOP. */ *refp = store->prev; store->o = IR_NOP; store->t.irt = IRT_NIL; store->op1 = store->op2 = 0; store->prev = 0; /* Now emit the new store instead. */ } goto doemit; } ref = *(refp = &store->prev); } doemit: return EMITFOLD; /* Otherwise we have a conflict or simply no match. */ } /* -- ULOAD forwarding ---------------------------------------------------- */ /* The current alias analysis for upvalues is very simplistic. It only ** disambiguates between the unique upvalues of the same function. ** This is good enough for now, since most upvalues are read-only. ** ** A more precise analysis would be feasible with the help of the parser: ** generate a unique key for every upvalue, even across all prototypes. ** Lacking a realistic use-case, it's unclear whether this is beneficial. */ static AliasRet aa_uref(IRIns *refa, IRIns *refb) { if (refa->o != refb->o) return ALIAS_NO; /* Different UREFx type. */ if (refa->op1 == refb->op1) { /* Same function. */ if (refa->op2 == refb->op2) return ALIAS_MUST; /* Same function, same upvalue idx. */ else return ALIAS_NO; /* Same function, different upvalue idx. */ } else { /* Different functions, check disambiguation hash values. */ if (((refa->op2 ^ refb->op2) & 0xff)) return ALIAS_NO; /* Upvalues with different hash values cannot alias. */ else return ALIAS_MAY; /* No conclusion can be drawn for same hash value. */ } } /* ULOAD forwarding. */ TRef LJ_FASTCALL lj_opt_fwd_uload(jit_State *J) { IRRef uref = fins->op1; IRRef lim = REF_BASE; /* Search limit. */ IRIns *xr = IR(uref); IRRef ref; /* Search for conflicting stores. */ ref = J->chain[IR_USTORE]; while (ref > lim) { IRIns *store = IR(ref); switch (aa_uref(xr, IR(store->op1))) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: lim = ref; goto cselim; /* Limit search for load. */ case ALIAS_MUST: return store->op2; /* Store forwarding. */ } ref = store->prev; } cselim: /* Try to find a matching load. Below the conflicting store, if any. */ ref = J->chain[IR_ULOAD]; while (ref > lim) { IRIns *ir = IR(ref); if (ir->op1 == uref || (IR(ir->op1)->op12 == IR(uref)->op12 && IR(ir->op1)->o == IR(uref)->o)) return ref; /* Match for identical or equal UREFx (non-CSEable UREFO). */ ref = ir->prev; } return lj_ir_emit(J); } /* USTORE elimination. */ TRef LJ_FASTCALL lj_opt_dse_ustore(jit_State *J) { IRRef xref = fins->op1; /* xREF reference. */ IRRef val = fins->op2; /* Stored value reference. */ IRIns *xr = IR(xref); IRRef1 *refp = &J->chain[IR_USTORE]; IRRef ref = *refp; while (ref > xref) { /* Search for redundant or conflicting stores. */ IRIns *store = IR(ref); switch (aa_uref(xr, IR(store->op1))) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: /* Store to MAYBE the same location. */ if (store->op2 != val) /* Conflict if the value is different. */ goto doemit; break; /* Otherwise continue searching. */ case ALIAS_MUST: /* Store to the same location. */ if (store->op2 == val) /* Same value: drop the new store. */ return DROPFOLD; /* Different value: try to eliminate the redundant store. */ if (ref > J->chain[IR_LOOP]) { /* Quick check to avoid crossing LOOP. */ IRIns *ir; /* Check for any intervening guards (includes conflicting loads). */ for (ir = IR(J->cur.nins-1); ir > store; ir--) if (irt_isguard(ir->t)) goto doemit; /* No elimination possible. */ /* Remove redundant store from chain and replace with NOP. */ *refp = store->prev; store->o = IR_NOP; store->t.irt = IRT_NIL; store->op1 = store->op2 = 0; store->prev = 0; if (ref+1 < J->cur.nins && store[1].o == IR_OBAR && store[1].op1 == xref) { IRRef1 *bp = &J->chain[IR_OBAR]; IRIns *obar; for (obar = IR(*bp); *bp > ref+1; obar = IR(*bp)) bp = &obar->prev; /* Remove OBAR, too. */ *bp = obar->prev; obar->o = IR_NOP; obar->t.irt = IRT_NIL; obar->op1 = obar->op2 = 0; obar->prev = 0; } /* Now emit the new store instead. */ } goto doemit; } ref = *(refp = &store->prev); } doemit: return EMITFOLD; /* Otherwise we have a conflict or simply no match. */ } /* -- FLOAD forwarding and FSTORE elimination ----------------------------- */ /* Alias analysis for field access. ** Field loads are cheap and field stores are rare. ** Simple disambiguation based on field types is good enough. */ static AliasRet aa_fref(jit_State *J, IRIns *refa, IRIns *refb) { if (refa->op2 != refb->op2) return ALIAS_NO; /* Different fields. */ if (refa->op1 == refb->op1) return ALIAS_MUST; /* Same field, same object. */ else if (refa->op2 >= IRFL_TAB_META && refa->op2 <= IRFL_TAB_NOMM) return aa_table(J, refa->op1, refb->op1); /* Disambiguate tables. */ else return ALIAS_MAY; /* Same field, possibly different object. */ } /* Only the loads for mutable fields end up here (see FOLD). */ TRef LJ_FASTCALL lj_opt_fwd_fload(jit_State *J) { IRRef oref = fins->op1; /* Object reference. */ IRRef fid = fins->op2; /* Field ID. */ IRRef lim = oref; /* Search limit. */ IRRef ref; /* Search for conflicting stores. */ ref = J->chain[IR_FSTORE]; while (ref > oref) { IRIns *store = IR(ref); switch (aa_fref(J, fins, IR(store->op1))) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: lim = ref; goto cselim; /* Limit search for load. */ case ALIAS_MUST: return store->op2; /* Store forwarding. */ } ref = store->prev; } /* No conflicting store: const-fold field loads from allocations. */ if (fid == IRFL_TAB_META) { IRIns *ir = IR(oref); if (ir->o == IR_TNEW || ir->o == IR_TDUP) return lj_ir_knull(J, IRT_TAB); } cselim: /* Try to find a matching load. Below the conflicting store, if any. */ return lj_opt_cselim(J, lim); } /* FSTORE elimination. */ TRef LJ_FASTCALL lj_opt_dse_fstore(jit_State *J) { IRRef fref = fins->op1; /* FREF reference. */ IRRef val = fins->op2; /* Stored value reference. */ IRIns *xr = IR(fref); IRRef1 *refp = &J->chain[IR_FSTORE]; IRRef ref = *refp; while (ref > fref) { /* Search for redundant or conflicting stores. */ IRIns *store = IR(ref); switch (aa_fref(J, xr, IR(store->op1))) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: if (store->op2 != val) /* Conflict if the value is different. */ goto doemit; break; /* Otherwise continue searching. */ case ALIAS_MUST: if (store->op2 == val) /* Same value: drop the new store. */ return DROPFOLD; /* Different value: try to eliminate the redundant store. */ if (ref > J->chain[IR_LOOP]) { /* Quick check to avoid crossing LOOP. */ IRIns *ir; /* Check for any intervening guards or conflicting loads. */ for (ir = IR(J->cur.nins-1); ir > store; ir--) if (irt_isguard(ir->t) || (ir->o == IR_FLOAD && ir->op2 == xr->op2)) goto doemit; /* No elimination possible. */ /* Remove redundant store from chain and replace with NOP. */ *refp = store->prev; store->o = IR_NOP; store->t.irt = IRT_NIL; store->op1 = store->op2 = 0; store->prev = 0; /* Now emit the new store instead. */ } goto doemit; } ref = *(refp = &store->prev); } doemit: return EMITFOLD; /* Otherwise we have a conflict or simply no match. */ } /* -- XLOAD forwarding and XSTORE elimination ----------------------------- */ /* Find cdata allocation for a reference (if any). */ static IRIns *aa_findcnew(jit_State *J, IRIns *ir) { while (ir->o == IR_ADD) { if (!irref_isk(ir->op1)) { IRIns *ir1 = aa_findcnew(J, IR(ir->op1)); /* Left-recursion. */ if (ir1) return ir1; } if (irref_isk(ir->op2)) return NULL; ir = IR(ir->op2); /* Flatten right-recursion. */ } return ir->o == IR_CNEW ? ir : NULL; } /* Alias analysis for two cdata allocations. */ static AliasRet aa_cnew(jit_State *J, IRIns *refa, IRIns *refb) { IRIns *cnewa = aa_findcnew(J, refa); IRIns *cnewb = aa_findcnew(J, refb); if (cnewa == cnewb) return ALIAS_MAY; /* Same allocation or neither is an allocation. */ if (cnewa && cnewb) return ALIAS_NO; /* Two different allocations never alias. */ if (cnewb) { cnewa = cnewb; refb = refa; } return aa_escape(J, cnewa, refb); } /* Alias analysis for XLOAD/XSTORE. */ static AliasRet aa_xref(jit_State *J, IRIns *refa, IRIns *xa, IRIns *xb) { ptrdiff_t ofsa = 0, ofsb = 0; IRIns *refb = IR(xb->op1); IRIns *basea = refa, *baseb = refb; if (refa == refb && irt_sametype(xa->t, xb->t)) return ALIAS_MUST; /* Shortcut for same refs with identical type. */ /* Offset-based disambiguation. */ if (refa->o == IR_ADD && irref_isk(refa->op2)) { IRIns *irk = IR(refa->op2); basea = IR(refa->op1); ofsa = (LJ_64 && irk->o == IR_KINT64) ? (ptrdiff_t)ir_k64(irk)->u64 : (ptrdiff_t)irk->i; } if (refb->o == IR_ADD && irref_isk(refb->op2)) { IRIns *irk = IR(refb->op2); baseb = IR(refb->op1); ofsb = (LJ_64 && irk->o == IR_KINT64) ? (ptrdiff_t)ir_k64(irk)->u64 : (ptrdiff_t)irk->i; } /* Treat constified pointers like base vs. base+offset. */ if (basea->o == IR_KPTR && baseb->o == IR_KPTR) { ofsb += (char *)ir_kptr(baseb) - (char *)ir_kptr(basea); baseb = basea; } /* This implements (very) strict aliasing rules. ** Different types do NOT alias, except for differences in signedness. ** Type punning through unions is allowed (but forces a reload). */ if (basea == baseb) { ptrdiff_t sza = irt_size(xa->t), szb = irt_size(xb->t); if (ofsa == ofsb) { if (sza == szb && irt_isfp(xa->t) == irt_isfp(xb->t)) return ALIAS_MUST; /* Same-sized, same-kind. May need to convert. */ } else if (ofsa + sza <= ofsb || ofsb + szb <= ofsa) { return ALIAS_NO; /* Non-overlapping base+-o1 vs. base+-o2. */ } /* NYI: extract, extend or reinterpret bits (int <-> fp). */ return ALIAS_MAY; /* Overlapping or type punning: force reload. */ } if (!irt_sametype(xa->t, xb->t) && !(irt_typerange(xa->t, IRT_I8, IRT_U64) && ((xa->t.irt - IRT_I8) ^ (xb->t.irt - IRT_I8)) == 1)) return ALIAS_NO; /* NYI: structural disambiguation. */ return aa_cnew(J, basea, baseb); /* Try to disambiguate allocations. */ } /* Return CSEd reference or 0. Caveat: swaps lower ref to the right! */ static IRRef reassoc_trycse(jit_State *J, IROp op, IRRef op1, IRRef op2) { IRRef ref = J->chain[op]; IRRef lim = op1; if (op2 > lim) { lim = op2; op2 = op1; op1 = lim; } while (ref > lim) { IRIns *ir = IR(ref); if (ir->op1 == op1 && ir->op2 == op2) return ref; ref = ir->prev; } return 0; } /* Reassociate index references. */ static IRRef reassoc_xref(jit_State *J, IRIns *ir) { ptrdiff_t ofs = 0; if (ir->o == IR_ADD && irref_isk(ir->op2)) { /* Get constant offset. */ IRIns *irk = IR(ir->op2); ofs = (LJ_64 && irk->o == IR_KINT64) ? (ptrdiff_t)ir_k64(irk)->u64 : (ptrdiff_t)irk->i; ir = IR(ir->op1); } if (ir->o == IR_ADD) { /* Add of base + index. */ /* Index ref > base ref for loop-carried dependences. Only check op1. */ IRIns *ir2, *ir1 = IR(ir->op1); int32_t shift = 0; IRRef idxref; /* Determine index shifts. Don't bother with IR_MUL here. */ if (ir1->o == IR_BSHL && irref_isk(ir1->op2)) shift = IR(ir1->op2)->i; else if (ir1->o == IR_ADD && ir1->op1 == ir1->op2) shift = 1; else ir1 = ir; ir2 = IR(ir1->op1); /* A non-reassociated add. Must be a loop-carried dependence. */ if (ir2->o == IR_ADD && irt_isint(ir2->t) && irref_isk(ir2->op2)) ofs += (ptrdiff_t)IR(ir2->op2)->i << shift; else return 0; idxref = ir2->op1; /* Try to CSE the reassociated chain. Give up if not found. */ if (ir1 != ir && !(idxref = reassoc_trycse(J, ir1->o, idxref, ir1->o == IR_BSHL ? ir1->op2 : idxref))) return 0; if (!(idxref = reassoc_trycse(J, IR_ADD, idxref, ir->op2))) return 0; if (ofs != 0) { IRRef refk = tref_ref(lj_ir_kintp(J, ofs)); if (!(idxref = reassoc_trycse(J, IR_ADD, idxref, refk))) return 0; } return idxref; /* Success, found a reassociated index reference. Phew. */ } return 0; /* Failure. */ } /* XLOAD forwarding. */ TRef LJ_FASTCALL lj_opt_fwd_xload(jit_State *J) { IRRef xref = fins->op1; IRIns *xr = IR(xref); IRRef lim = xref; /* Search limit. */ IRRef ref; if ((fins->op2 & IRXLOAD_READONLY)) goto cselim; if ((fins->op2 & IRXLOAD_VOLATILE)) goto doemit; /* Search for conflicting stores. */ ref = J->chain[IR_XSTORE]; retry: if (J->chain[IR_CALLXS] > lim) lim = J->chain[IR_CALLXS]; if (J->chain[IR_XBAR] > lim) lim = J->chain[IR_XBAR]; while (ref > lim) { IRIns *store = IR(ref); switch (aa_xref(J, xr, fins, store)) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: lim = ref; goto cselim; /* Limit search for load. */ case ALIAS_MUST: /* Emit conversion if the loaded type doesn't match the forwarded type. */ if (!irt_sametype(fins->t, IR(store->op2)->t)) { IRType dt = irt_type(fins->t), st = irt_type(IR(store->op2)->t); if (dt == IRT_I8 || dt == IRT_I16) { /* Trunc + sign-extend. */ st = dt | IRCONV_SEXT; dt = IRT_INT; } else if (dt == IRT_U8 || dt == IRT_U16) { /* Trunc + zero-extend. */ st = dt; dt = IRT_INT; } fins->ot = IRT(IR_CONV, dt); fins->op1 = store->op2; fins->op2 = (dt<<5)|st; return RETRYFOLD; } return store->op2; /* Store forwarding. */ } ref = store->prev; } cselim: /* Try to find a matching load. Below the conflicting store, if any. */ ref = J->chain[IR_XLOAD]; while (ref > lim) { /* CSE for XLOAD depends on the type, but not on the IRXLOAD_* flags. */ if (IR(ref)->op1 == xref && irt_sametype(IR(ref)->t, fins->t)) return ref; ref = IR(ref)->prev; } /* Reassociate XLOAD across PHIs to handle a[i-1] forwarding case. */ if (!(fins->op2 & IRXLOAD_READONLY) && J->chain[IR_LOOP] && xref == fins->op1 && (xref = reassoc_xref(J, xr)) != 0) { ref = J->chain[IR_XSTORE]; while (ref > lim) /* Skip stores that have already been checked. */ ref = IR(ref)->prev; lim = xref; xr = IR(xref); goto retry; /* Retry with the reassociated reference. */ } doemit: return EMITFOLD; } /* XSTORE elimination. */ TRef LJ_FASTCALL lj_opt_dse_xstore(jit_State *J) { IRRef xref = fins->op1; IRIns *xr = IR(xref); IRRef lim = xref; /* Search limit. */ IRRef val = fins->op2; /* Stored value reference. */ IRRef1 *refp = &J->chain[IR_XSTORE]; IRRef ref = *refp; if (J->chain[IR_CALLXS] > lim) lim = J->chain[IR_CALLXS]; if (J->chain[IR_XBAR] > lim) lim = J->chain[IR_XBAR]; if (J->chain[IR_XSNEW] > lim) lim = J->chain[IR_XSNEW]; while (ref > lim) { /* Search for redundant or conflicting stores. */ IRIns *store = IR(ref); switch (aa_xref(J, xr, fins, store)) { case ALIAS_NO: break; /* Continue searching. */ case ALIAS_MAY: if (store->op2 != val) /* Conflict if the value is different. */ goto doemit; break; /* Otherwise continue searching. */ case ALIAS_MUST: if (store->op2 == val) /* Same value: drop the new store. */ return DROPFOLD; /* Different value: try to eliminate the redundant store. */ if (ref > J->chain[IR_LOOP]) { /* Quick check to avoid crossing LOOP. */ IRIns *ir; /* Check for any intervening guards or any XLOADs (no AA performed). */ for (ir = IR(J->cur.nins-1); ir > store; ir--) if (irt_isguard(ir->t) || ir->o == IR_XLOAD) goto doemit; /* No elimination possible. */ /* Remove redundant store from chain and replace with NOP. */ *refp = store->prev; store->o = IR_NOP; store->t.irt = IRT_NIL; store->op1 = store->op2 = 0; store->prev = 0; /* Now emit the new store instead. */ } goto doemit; } ref = *(refp = &store->prev); } doemit: return EMITFOLD; /* Otherwise we have a conflict or simply no match. */ } /* -- Forwarding of lj_tab_len -------------------------------------------- */ /* This is rather simplistic right now, but better than nothing. */ TRef LJ_FASTCALL lj_opt_fwd_tab_len(jit_State *J) { IRRef tab = fins->op1; /* Table reference. */ IRRef lim = tab; /* Search limit. */ IRRef ref; /* Any ASTORE is a conflict and limits the search. */ if (J->chain[IR_ASTORE] > lim) lim = J->chain[IR_ASTORE]; /* Search for conflicting HSTORE with numeric key. */ ref = J->chain[IR_HSTORE]; while (ref > lim) { IRIns *store = IR(ref); IRIns *href = IR(store->op1); IRIns *key = IR(href->op2); if (irt_isnum(key->o == IR_KSLOT ? IR(key->op1)->t : key->t)) { lim = ref; /* Conflicting store found, limits search for TLEN. */ break; } ref = store->prev; } /* Try to find a matching load. Below the conflicting store, if any. */ return lj_opt_cselim(J, lim); } /* -- ASTORE/HSTORE previous type analysis -------------------------------- */ /* Check whether the previous value for a table store is non-nil. ** This can be derived either from a previous store or from a previous ** load (because all loads from tables perform a type check). ** ** The result of the analysis can be used to avoid the metatable check ** and the guard against HREF returning niltv. Both of these are cheap, ** so let's not spend too much effort on the analysis. ** ** A result of 1 is exact: previous value CANNOT be nil. ** A result of 0 is inexact: previous value MAY be nil. */ int lj_opt_fwd_wasnonnil(jit_State *J, IROpT loadop, IRRef xref) { /* First check stores. */ IRRef ref = J->chain[loadop+IRDELTA_L2S]; while (ref > xref) { IRIns *store = IR(ref); if (store->op1 == xref) { /* Same xREF. */ /* A nil store MAY alias, but a non-nil store MUST alias. */ return !irt_isnil(store->t); } else if (irt_isnil(store->t)) { /* Must check any nil store. */ IRRef skref = IR(store->op1)->op2; IRRef xkref = IR(xref)->op2; /* Same key type MAY alias. Need ALOAD check due to multiple int types. */ if (loadop == IR_ALOAD || irt_sametype(IR(skref)->t, IR(xkref)->t)) { if (skref == xkref || !irref_isk(skref) || !irref_isk(xkref)) return 0; /* A nil store with same const key or var key MAY alias. */ /* Different const keys CANNOT alias. */ } /* Different key types CANNOT alias. */ } /* Other non-nil stores MAY alias. */ ref = store->prev; } /* Check loads since nothing could be derived from stores. */ ref = J->chain[loadop]; while (ref > xref) { IRIns *load = IR(ref); if (load->op1 == xref) { /* Same xREF. */ /* A nil load MAY alias, but a non-nil load MUST alias. */ return !irt_isnil(load->t); } /* Other non-nil loads MAY alias. */ ref = load->prev; } return 0; /* Nothing derived at all, previous value MAY be nil. */ } /* ------------------------------------------------------------------------ */ #undef IR #undef fins #undef fleft #undef fright #endif wcc-0.0.2/src/wsh/luajit-2.0/src/luajit.h0000644000175000017500000000501513122010155016333 0ustar philphil/* ** LuaJIT -- a Just-In-Time Compiler for Lua. http://luajit.org/ ** ** Copyright (C) 2005-2016 Mike Pall. All rights reserved. ** ** Permission is hereby granted, free of charge, to any person obtaining ** a copy of this software and associated documentation files (the ** "Software"), to deal in the Software without restriction, including ** without limitation the rights to use, copy, modify, merge, publish, ** distribute, sublicense, and/or sell copies of the Software, and to ** permit persons to whom the Software is furnished to do so, subject to ** the following conditions: ** ** The above copyright notice and this permission notice shall be ** included in all copies or substantial portions of the Software. ** ** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ** EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. ** IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY ** CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, ** TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ** SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ** ** [ MIT license: http://www.opensource.org/licenses/mit-license.php ] */ #ifndef _LUAJIT_H #define _LUAJIT_H #include "lua.h" #define LUAJIT_VERSION "LuaJIT 2.0.4" #define LUAJIT_VERSION_NUM 20004 /* Version 2.0.4 = 02.00.04. */ #define LUAJIT_VERSION_SYM luaJIT_version_2_0_4 #define LUAJIT_COPYRIGHT "Copyright (C) 2005-2016 Mike Pall" #define LUAJIT_URL "http://luajit.org/" /* Modes for luaJIT_setmode. */ #define LUAJIT_MODE_MASK 0x00ff enum { LUAJIT_MODE_ENGINE, /* Set mode for whole JIT engine. */ LUAJIT_MODE_DEBUG, /* Set debug mode (idx = level). */ LUAJIT_MODE_FUNC, /* Change mode for a function. */ LUAJIT_MODE_ALLFUNC, /* Recurse into subroutine protos. */ LUAJIT_MODE_ALLSUBFUNC, /* Change only the subroutines. */ LUAJIT_MODE_TRACE, /* Flush a compiled trace. */ LUAJIT_MODE_WRAPCFUNC = 0x10, /* Set wrapper mode for C function calls. */ LUAJIT_MODE_MAX }; /* Flags or'ed in to the mode. */ #define LUAJIT_MODE_OFF 0x0000 /* Turn feature off. */ #define LUAJIT_MODE_ON 0x0100 /* Turn feature on. */ #define LUAJIT_MODE_FLUSH 0x0200 /* Flush JIT-compiled code. */ /* LuaJIT public C API. */ /* Control the JIT engine. */ LUA_API int luaJIT_setmode(lua_State *L, int idx, int mode); /* Enforce (dynamic) linker error for version mismatches. Call from main. */ LUA_API void LUAJIT_VERSION_SYM(void); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_asm.c0000644000175000017500000016027713122010155016317 0ustar philphil/* ** IR assembler (SSA IR -> machine code). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_asm_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_gc.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_frame.h" #if LJ_HASFFI #include "lj_ctype.h" #endif #include "lj_ir.h" #include "lj_jit.h" #include "lj_ircall.h" #include "lj_iropt.h" #include "lj_mcode.h" #include "lj_iropt.h" #include "lj_trace.h" #include "lj_snap.h" #include "lj_asm.h" #include "lj_dispatch.h" #include "lj_vm.h" #include "lj_target.h" #ifdef LUA_USE_ASSERT #include #endif /* -- Assembler state and common macros ----------------------------------- */ /* Assembler state. */ typedef struct ASMState { RegCost cost[RID_MAX]; /* Reference and blended allocation cost for regs. */ MCode *mcp; /* Current MCode pointer (grows down). */ MCode *mclim; /* Lower limit for MCode memory + red zone. */ #ifdef LUA_USE_ASSERT MCode *mcp_prev; /* Red zone overflow check. */ #endif IRIns *ir; /* Copy of pointer to IR instructions/constants. */ jit_State *J; /* JIT compiler state. */ #if LJ_TARGET_X86ORX64 x86ModRM mrm; /* Fused x86 address operand. */ #endif RegSet freeset; /* Set of free registers. */ RegSet modset; /* Set of registers modified inside the loop. */ RegSet weakset; /* Set of weakly referenced registers. */ RegSet phiset; /* Set of PHI registers. */ uint32_t flags; /* Copy of JIT compiler flags. */ int loopinv; /* Loop branch inversion (0:no, 1:yes, 2:yes+CC_P). */ int32_t evenspill; /* Next even spill slot. */ int32_t oddspill; /* Next odd spill slot (or 0). */ IRRef curins; /* Reference of current instruction. */ IRRef stopins; /* Stop assembly before hitting this instruction. */ IRRef orignins; /* Original T->nins. */ IRRef snapref; /* Current snapshot is active after this reference. */ IRRef snaprename; /* Rename highwater mark for snapshot check. */ SnapNo snapno; /* Current snapshot number. */ SnapNo loopsnapno; /* Loop snapshot number. */ IRRef fuseref; /* Fusion limit (loopref, 0 or FUSE_DISABLED). */ IRRef sectref; /* Section base reference (loopref or 0). */ IRRef loopref; /* Reference of LOOP instruction (or 0). */ BCReg topslot; /* Number of slots for stack check (unless 0). */ int32_t gcsteps; /* Accumulated number of GC steps (per section). */ GCtrace *T; /* Trace to assemble. */ GCtrace *parent; /* Parent trace (or NULL). */ MCode *mcbot; /* Bottom of reserved MCode. */ MCode *mctop; /* Top of generated MCode. */ MCode *mcloop; /* Pointer to loop MCode (or NULL). */ MCode *invmcp; /* Points to invertible loop branch (or NULL). */ MCode *flagmcp; /* Pending opportunity to merge flag setting ins. */ MCode *realign; /* Realign loop if not NULL. */ #ifdef RID_NUM_KREF int32_t krefk[RID_NUM_KREF]; #endif IRRef1 phireg[RID_MAX]; /* PHI register references. */ uint16_t parentmap[LJ_MAX_JSLOTS]; /* Parent instruction to RegSP map. */ } ASMState; #define IR(ref) (&as->ir[(ref)]) #define ASMREF_TMP1 REF_TRUE /* Temp. register. */ #define ASMREF_TMP2 REF_FALSE /* Temp. register. */ #define ASMREF_L REF_NIL /* Stores register for L. */ /* Check for variant to invariant references. */ #define iscrossref(as, ref) ((ref) < as->sectref) /* Inhibit memory op fusion from variant to invariant references. */ #define FUSE_DISABLED (~(IRRef)0) #define mayfuse(as, ref) ((ref) > as->fuseref) #define neverfuse(as) (as->fuseref == FUSE_DISABLED) #define canfuse(as, ir) (!neverfuse(as) && !irt_isphi((ir)->t)) #define opisfusableload(o) \ ((o) == IR_ALOAD || (o) == IR_HLOAD || (o) == IR_ULOAD || \ (o) == IR_FLOAD || (o) == IR_XLOAD || (o) == IR_SLOAD || (o) == IR_VLOAD) /* Sparse limit checks using a red zone before the actual limit. */ #define MCLIM_REDZONE 64 static LJ_NORET LJ_NOINLINE void asm_mclimit(ASMState *as) { lj_mcode_limiterr(as->J, (size_t)(as->mctop - as->mcp + 4*MCLIM_REDZONE)); } static LJ_AINLINE void checkmclim(ASMState *as) { #ifdef LUA_USE_ASSERT if (as->mcp + MCLIM_REDZONE < as->mcp_prev) { IRIns *ir = IR(as->curins+1); fprintf(stderr, "RED ZONE OVERFLOW: %p IR %04d %02d %04d %04d\n", as->mcp, as->curins+1-REF_BIAS, ir->o, ir->op1-REF_BIAS, ir->op2-REF_BIAS); lua_assert(0); } #endif if (LJ_UNLIKELY(as->mcp < as->mclim)) asm_mclimit(as); #ifdef LUA_USE_ASSERT as->mcp_prev = as->mcp; #endif } #ifdef RID_NUM_KREF #define ra_iskref(ref) ((ref) < RID_NUM_KREF) #define ra_krefreg(ref) ((Reg)(RID_MIN_KREF + (Reg)(ref))) #define ra_krefk(as, ref) (as->krefk[(ref)]) static LJ_AINLINE void ra_setkref(ASMState *as, Reg r, int32_t k) { IRRef ref = (IRRef)(r - RID_MIN_KREF); as->krefk[ref] = k; as->cost[r] = REGCOST(ref, ref); } #else #define ra_iskref(ref) 0 #define ra_krefreg(ref) RID_MIN_GPR #define ra_krefk(as, ref) 0 #endif /* Arch-specific field offsets. */ static const uint8_t field_ofs[IRFL__MAX+1] = { #define FLOFS(name, ofs) (uint8_t)(ofs), IRFLDEF(FLOFS) #undef FLOFS 0 }; /* -- Target-specific instruction emitter --------------------------------- */ #if LJ_TARGET_X86ORX64 #include "lj_emit_x86.h" #elif LJ_TARGET_ARM #include "lj_emit_arm.h" #elif LJ_TARGET_PPC #include "lj_emit_ppc.h" #elif LJ_TARGET_MIPS #include "lj_emit_mips.h" #else #error "Missing instruction emitter for target CPU" #endif /* -- Register allocator debugging ---------------------------------------- */ /* #define LUAJIT_DEBUG_RA */ #ifdef LUAJIT_DEBUG_RA #include #include #define RIDNAME(name) #name, static const char *const ra_regname[] = { GPRDEF(RIDNAME) FPRDEF(RIDNAME) VRIDDEF(RIDNAME) NULL }; #undef RIDNAME static char ra_dbg_buf[65536]; static char *ra_dbg_p; static char *ra_dbg_merge; static MCode *ra_dbg_mcp; static void ra_dstart(void) { ra_dbg_p = ra_dbg_buf; ra_dbg_merge = NULL; ra_dbg_mcp = NULL; } static void ra_dflush(void) { fwrite(ra_dbg_buf, 1, (size_t)(ra_dbg_p-ra_dbg_buf), stdout); ra_dstart(); } static void ra_dprintf(ASMState *as, const char *fmt, ...) { char *p; va_list argp; va_start(argp, fmt); p = ra_dbg_mcp == as->mcp ? ra_dbg_merge : ra_dbg_p; ra_dbg_mcp = NULL; p += sprintf(p, "%08x \e[36m%04d ", (uintptr_t)as->mcp, as->curins-REF_BIAS); for (;;) { const char *e = strchr(fmt, '$'); if (e == NULL) break; memcpy(p, fmt, (size_t)(e-fmt)); p += e-fmt; if (e[1] == 'r') { Reg r = va_arg(argp, Reg) & RID_MASK; if (r <= RID_MAX) { const char *q; for (q = ra_regname[r]; *q; q++) *p++ = *q >= 'A' && *q <= 'Z' ? *q + 0x20 : *q; } else { *p++ = '?'; lua_assert(0); } } else if (e[1] == 'f' || e[1] == 'i') { IRRef ref; if (e[1] == 'f') ref = va_arg(argp, IRRef); else ref = va_arg(argp, IRIns *) - as->ir; if (ref >= REF_BIAS) p += sprintf(p, "%04d", ref - REF_BIAS); else p += sprintf(p, "K%03d", REF_BIAS - ref); } else if (e[1] == 's') { uint32_t slot = va_arg(argp, uint32_t); p += sprintf(p, "[sp+0x%x]", sps_scale(slot)); } else if (e[1] == 'x') { p += sprintf(p, "%08x", va_arg(argp, int32_t)); } else { lua_assert(0); } fmt = e+2; } va_end(argp); while (*fmt) *p++ = *fmt++; *p++ = '\e'; *p++ = '['; *p++ = 'm'; *p++ = '\n'; if (p > ra_dbg_buf+sizeof(ra_dbg_buf)-256) { fwrite(ra_dbg_buf, 1, (size_t)(p-ra_dbg_buf), stdout); p = ra_dbg_buf; } ra_dbg_p = p; } #define RA_DBG_START() ra_dstart() #define RA_DBG_FLUSH() ra_dflush() #define RA_DBG_REF() \ do { char *_p = ra_dbg_p; ra_dprintf(as, ""); \ ra_dbg_merge = _p; ra_dbg_mcp = as->mcp; } while (0) #define RA_DBGX(x) ra_dprintf x #else #define RA_DBG_START() ((void)0) #define RA_DBG_FLUSH() ((void)0) #define RA_DBG_REF() ((void)0) #define RA_DBGX(x) ((void)0) #endif /* -- Register allocator -------------------------------------------------- */ #define ra_free(as, r) rset_set(as->freeset, (r)) #define ra_modified(as, r) rset_set(as->modset, (r)) #define ra_weak(as, r) rset_set(as->weakset, (r)) #define ra_noweak(as, r) rset_clear(as->weakset, (r)) #define ra_used(ir) (ra_hasreg((ir)->r) || ra_hasspill((ir)->s)) /* Setup register allocator. */ static void ra_setup(ASMState *as) { Reg r; /* Initially all regs (except the stack pointer) are free for use. */ as->freeset = RSET_INIT; as->modset = RSET_EMPTY; as->weakset = RSET_EMPTY; as->phiset = RSET_EMPTY; memset(as->phireg, 0, sizeof(as->phireg)); for (r = RID_MIN_GPR; r < RID_MAX; r++) as->cost[r] = REGCOST(~0u, 0u); } /* Rematerialize constants. */ static Reg ra_rematk(ASMState *as, IRRef ref) { IRIns *ir; Reg r; if (ra_iskref(ref)) { r = ra_krefreg(ref); lua_assert(!rset_test(as->freeset, r)); ra_free(as, r); ra_modified(as, r); emit_loadi(as, r, ra_krefk(as, ref)); return r; } ir = IR(ref); r = ir->r; lua_assert(ra_hasreg(r) && !ra_hasspill(ir->s)); ra_free(as, r); ra_modified(as, r); ir->r = RID_INIT; /* Do not keep any hint. */ RA_DBGX((as, "remat $i $r", ir, r)); #if !LJ_SOFTFP if (ir->o == IR_KNUM) { emit_loadn(as, r, ir_knum(ir)); } else #endif if (emit_canremat(REF_BASE) && ir->o == IR_BASE) { ra_sethint(ir->r, RID_BASE); /* Restore BASE register hint. */ emit_getgl(as, r, jit_base); } else if (emit_canremat(ASMREF_L) && ir->o == IR_KPRI) { lua_assert(irt_isnil(ir->t)); /* REF_NIL stores ASMREF_L register. */ emit_getgl(as, r, jit_L); #if LJ_64 } else if (ir->o == IR_KINT64) { emit_loadu64(as, r, ir_kint64(ir)->u64); #endif } else { lua_assert(ir->o == IR_KINT || ir->o == IR_KGC || ir->o == IR_KPTR || ir->o == IR_KKPTR || ir->o == IR_KNULL); emit_loadi(as, r, ir->i); } return r; } /* Force a spill. Allocate a new spill slot if needed. */ static int32_t ra_spill(ASMState *as, IRIns *ir) { int32_t slot = ir->s; lua_assert(ir >= as->ir + REF_TRUE); if (!ra_hasspill(slot)) { if (irt_is64(ir->t)) { slot = as->evenspill; as->evenspill += 2; } else if (as->oddspill) { slot = as->oddspill; as->oddspill = 0; } else { slot = as->evenspill; as->oddspill = slot+1; as->evenspill += 2; } if (as->evenspill > 256) lj_trace_err(as->J, LJ_TRERR_SPILLOV); ir->s = (uint8_t)slot; } return sps_scale(slot); } /* Release the temporarily allocated register in ASMREF_TMP1/ASMREF_TMP2. */ static Reg ra_releasetmp(ASMState *as, IRRef ref) { IRIns *ir = IR(ref); Reg r = ir->r; lua_assert(ra_hasreg(r) && !ra_hasspill(ir->s)); ra_free(as, r); ra_modified(as, r); ir->r = RID_INIT; return r; } /* Restore a register (marked as free). Rematerialize or force a spill. */ static Reg ra_restore(ASMState *as, IRRef ref) { if (emit_canremat(ref)) { return ra_rematk(as, ref); } else { IRIns *ir = IR(ref); int32_t ofs = ra_spill(as, ir); /* Force a spill slot. */ Reg r = ir->r; lua_assert(ra_hasreg(r)); ra_sethint(ir->r, r); /* Keep hint. */ ra_free(as, r); if (!rset_test(as->weakset, r)) { /* Only restore non-weak references. */ ra_modified(as, r); RA_DBGX((as, "restore $i $r", ir, r)); emit_spload(as, ir, r, ofs); } return r; } } /* Save a register to a spill slot. */ static void ra_save(ASMState *as, IRIns *ir, Reg r) { RA_DBGX((as, "save $i $r", ir, r)); emit_spstore(as, ir, r, sps_scale(ir->s)); } #define MINCOST(name) \ if (rset_test(RSET_ALL, RID_##name) && \ LJ_LIKELY(allow&RID2RSET(RID_##name)) && as->cost[RID_##name] < cost) \ cost = as->cost[RID_##name]; /* Evict the register with the lowest cost, forcing a restore. */ static Reg ra_evict(ASMState *as, RegSet allow) { IRRef ref; RegCost cost = ~(RegCost)0; lua_assert(allow != RSET_EMPTY); if (RID_NUM_FPR == 0 || allow < RID2RSET(RID_MAX_GPR)) { GPRDEF(MINCOST) } else { FPRDEF(MINCOST) } ref = regcost_ref(cost); lua_assert(ra_iskref(ref) || (ref >= as->T->nk && ref < as->T->nins)); /* Preferably pick any weak ref instead of a non-weak, non-const ref. */ if (!irref_isk(ref) && (as->weakset & allow)) { IRIns *ir = IR(ref); if (!rset_test(as->weakset, ir->r)) ref = regcost_ref(as->cost[rset_pickbot((as->weakset & allow))]); } return ra_restore(as, ref); } /* Pick any register (marked as free). Evict on-demand. */ static Reg ra_pick(ASMState *as, RegSet allow) { RegSet pick = as->freeset & allow; if (!pick) return ra_evict(as, allow); else return rset_picktop(pick); } /* Get a scratch register (marked as free). */ static Reg ra_scratch(ASMState *as, RegSet allow) { Reg r = ra_pick(as, allow); ra_modified(as, r); RA_DBGX((as, "scratch $r", r)); return r; } /* Evict all registers from a set (if not free). */ static void ra_evictset(ASMState *as, RegSet drop) { RegSet work; as->modset |= drop; #if !LJ_SOFTFP work = (drop & ~as->freeset) & RSET_FPR; while (work) { Reg r = rset_pickbot(work); ra_restore(as, regcost_ref(as->cost[r])); rset_clear(work, r); checkmclim(as); } #endif work = (drop & ~as->freeset); while (work) { Reg r = rset_pickbot(work); ra_restore(as, regcost_ref(as->cost[r])); rset_clear(work, r); checkmclim(as); } } /* Evict (rematerialize) all registers allocated to constants. */ static void ra_evictk(ASMState *as) { RegSet work; #if !LJ_SOFTFP work = ~as->freeset & RSET_FPR; while (work) { Reg r = rset_pickbot(work); IRRef ref = regcost_ref(as->cost[r]); if (emit_canremat(ref) && irref_isk(ref)) { ra_rematk(as, ref); checkmclim(as); } rset_clear(work, r); } #endif work = ~as->freeset & RSET_GPR; while (work) { Reg r = rset_pickbot(work); IRRef ref = regcost_ref(as->cost[r]); if (emit_canremat(ref) && irref_isk(ref)) { ra_rematk(as, ref); checkmclim(as); } rset_clear(work, r); } } #ifdef RID_NUM_KREF /* Allocate a register for a constant. */ static Reg ra_allock(ASMState *as, int32_t k, RegSet allow) { /* First try to find a register which already holds the same constant. */ RegSet pick, work = ~as->freeset & RSET_GPR; Reg r; while (work) { IRRef ref; r = rset_pickbot(work); ref = regcost_ref(as->cost[r]); if (ref < ASMREF_L && k == (ra_iskref(ref) ? ra_krefk(as, ref) : IR(ref)->i)) return r; rset_clear(work, r); } pick = as->freeset & allow; if (pick) { /* Constants should preferably get unmodified registers. */ if ((pick & ~as->modset)) pick &= ~as->modset; r = rset_pickbot(pick); /* Reduce conflicts with inverse allocation. */ } else { r = ra_evict(as, allow); } RA_DBGX((as, "allock $x $r", k, r)); ra_setkref(as, r, k); rset_clear(as->freeset, r); ra_noweak(as, r); return r; } /* Allocate a specific register for a constant. */ static void ra_allockreg(ASMState *as, int32_t k, Reg r) { Reg kr = ra_allock(as, k, RID2RSET(r)); if (kr != r) { IRIns irdummy; irdummy.t.irt = IRT_INT; ra_scratch(as, RID2RSET(r)); emit_movrr(as, &irdummy, r, kr); } } #else #define ra_allockreg(as, k, r) emit_loadi(as, (r), (k)) #endif /* Allocate a register for ref from the allowed set of registers. ** Note: this function assumes the ref does NOT have a register yet! ** Picks an optimal register, sets the cost and marks the register as non-free. */ static Reg ra_allocref(ASMState *as, IRRef ref, RegSet allow) { IRIns *ir = IR(ref); RegSet pick = as->freeset & allow; Reg r; lua_assert(ra_noreg(ir->r)); if (pick) { /* First check register hint from propagation or PHI. */ if (ra_hashint(ir->r)) { r = ra_gethint(ir->r); if (rset_test(pick, r)) /* Use hint register if possible. */ goto found; /* Rematerialization is cheaper than missing a hint. */ if (rset_test(allow, r) && emit_canremat(regcost_ref(as->cost[r]))) { ra_rematk(as, regcost_ref(as->cost[r])); goto found; } RA_DBGX((as, "hintmiss $f $r", ref, r)); } /* Invariants should preferably get unmodified registers. */ if (ref < as->loopref && !irt_isphi(ir->t)) { if ((pick & ~as->modset)) pick &= ~as->modset; r = rset_pickbot(pick); /* Reduce conflicts with inverse allocation. */ } else { /* We've got plenty of regs, so get callee-save regs if possible. */ if (RID_NUM_GPR > 8 && (pick & ~RSET_SCRATCH)) pick &= ~RSET_SCRATCH; r = rset_picktop(pick); } } else { r = ra_evict(as, allow); } found: RA_DBGX((as, "alloc $f $r", ref, r)); ir->r = (uint8_t)r; rset_clear(as->freeset, r); ra_noweak(as, r); as->cost[r] = REGCOST_REF_T(ref, irt_t(ir->t)); return r; } /* Allocate a register on-demand. */ static Reg ra_alloc1(ASMState *as, IRRef ref, RegSet allow) { Reg r = IR(ref)->r; /* Note: allow is ignored if the register is already allocated. */ if (ra_noreg(r)) r = ra_allocref(as, ref, allow); ra_noweak(as, r); return r; } /* Rename register allocation and emit move. */ static void ra_rename(ASMState *as, Reg down, Reg up) { IRRef ren, ref = regcost_ref(as->cost[up] = as->cost[down]); IRIns *ir = IR(ref); ir->r = (uint8_t)up; as->cost[down] = 0; lua_assert((down < RID_MAX_GPR) == (up < RID_MAX_GPR)); lua_assert(!rset_test(as->freeset, down) && rset_test(as->freeset, up)); ra_free(as, down); /* 'down' is free ... */ ra_modified(as, down); rset_clear(as->freeset, up); /* ... and 'up' is now allocated. */ ra_noweak(as, up); RA_DBGX((as, "rename $f $r $r", regcost_ref(as->cost[up]), down, up)); emit_movrr(as, ir, down, up); /* Backwards codegen needs inverse move. */ if (!ra_hasspill(IR(ref)->s)) { /* Add the rename to the IR. */ lj_ir_set(as->J, IRT(IR_RENAME, IRT_NIL), ref, as->snapno); ren = tref_ref(lj_ir_emit(as->J)); as->ir = as->T->ir; /* The IR may have been reallocated. */ IR(ren)->r = (uint8_t)down; IR(ren)->s = SPS_NONE; } } /* Pick a destination register (marked as free). ** Caveat: allow is ignored if there's already a destination register. ** Use ra_destreg() to get a specific register. */ static Reg ra_dest(ASMState *as, IRIns *ir, RegSet allow) { Reg dest = ir->r; if (ra_hasreg(dest)) { ra_free(as, dest); ra_modified(as, dest); } else { if (ra_hashint(dest) && rset_test((as->freeset&allow), ra_gethint(dest))) { dest = ra_gethint(dest); ra_modified(as, dest); RA_DBGX((as, "dest $r", dest)); } else { dest = ra_scratch(as, allow); } ir->r = dest; } if (LJ_UNLIKELY(ra_hasspill(ir->s))) ra_save(as, ir, dest); return dest; } /* Force a specific destination register (marked as free). */ static void ra_destreg(ASMState *as, IRIns *ir, Reg r) { Reg dest = ra_dest(as, ir, RID2RSET(r)); if (dest != r) { lua_assert(rset_test(as->freeset, r)); ra_modified(as, r); emit_movrr(as, ir, dest, r); } } #if LJ_TARGET_X86ORX64 /* Propagate dest register to left reference. Emit moves as needed. ** This is a required fixup step for all 2-operand machine instructions. */ static void ra_left(ASMState *as, Reg dest, IRRef lref) { IRIns *ir = IR(lref); Reg left = ir->r; if (ra_noreg(left)) { if (irref_isk(lref)) { if (ir->o == IR_KNUM) { cTValue *tv = ir_knum(ir); /* FP remat needs a load except for +0. Still better than eviction. */ if (tvispzero(tv) || !(as->freeset & RSET_FPR)) { emit_loadn(as, dest, tv); return; } #if LJ_64 } else if (ir->o == IR_KINT64) { emit_loadu64(as, dest, ir_kint64(ir)->u64); return; #endif } else { lua_assert(ir->o == IR_KINT || ir->o == IR_KGC || ir->o == IR_KPTR || ir->o == IR_KKPTR || ir->o == IR_KNULL); emit_loadi(as, dest, ir->i); return; } } if (!ra_hashint(left) && !iscrossref(as, lref)) ra_sethint(ir->r, dest); /* Propagate register hint. */ left = ra_allocref(as, lref, dest < RID_MAX_GPR ? RSET_GPR : RSET_FPR); } ra_noweak(as, left); /* Move needed for true 3-operand instruction: y=a+b ==> y=a; y+=b. */ if (dest != left) { /* Use register renaming if dest is the PHI reg. */ if (irt_isphi(ir->t) && as->phireg[dest] == lref) { ra_modified(as, left); ra_rename(as, left, dest); } else { emit_movrr(as, ir, dest, left); } } } #else /* Similar to ra_left, except we override any hints. */ static void ra_leftov(ASMState *as, Reg dest, IRRef lref) { IRIns *ir = IR(lref); Reg left = ir->r; if (ra_noreg(left)) { ra_sethint(ir->r, dest); /* Propagate register hint. */ left = ra_allocref(as, lref, (LJ_SOFTFP || dest < RID_MAX_GPR) ? RSET_GPR : RSET_FPR); } ra_noweak(as, left); if (dest != left) { /* Use register renaming if dest is the PHI reg. */ if (irt_isphi(ir->t) && as->phireg[dest] == lref) { ra_modified(as, left); ra_rename(as, left, dest); } else { emit_movrr(as, ir, dest, left); } } } #endif #if !LJ_64 /* Force a RID_RETLO/RID_RETHI destination register pair (marked as free). */ static void ra_destpair(ASMState *as, IRIns *ir) { Reg destlo = ir->r, desthi = (ir+1)->r; /* First spill unrelated refs blocking the destination registers. */ if (!rset_test(as->freeset, RID_RETLO) && destlo != RID_RETLO && desthi != RID_RETLO) ra_restore(as, regcost_ref(as->cost[RID_RETLO])); if (!rset_test(as->freeset, RID_RETHI) && destlo != RID_RETHI && desthi != RID_RETHI) ra_restore(as, regcost_ref(as->cost[RID_RETHI])); /* Next free the destination registers (if any). */ if (ra_hasreg(destlo)) { ra_free(as, destlo); ra_modified(as, destlo); } else { destlo = RID_RETLO; } if (ra_hasreg(desthi)) { ra_free(as, desthi); ra_modified(as, desthi); } else { desthi = RID_RETHI; } /* Check for conflicts and shuffle the registers as needed. */ if (destlo == RID_RETHI) { if (desthi == RID_RETLO) { #if LJ_TARGET_X86 *--as->mcp = XI_XCHGa + RID_RETHI; #else emit_movrr(as, ir, RID_RETHI, RID_TMP); emit_movrr(as, ir, RID_RETLO, RID_RETHI); emit_movrr(as, ir, RID_TMP, RID_RETLO); #endif } else { emit_movrr(as, ir, RID_RETHI, RID_RETLO); if (desthi != RID_RETHI) emit_movrr(as, ir, desthi, RID_RETHI); } } else if (desthi == RID_RETLO) { emit_movrr(as, ir, RID_RETLO, RID_RETHI); if (destlo != RID_RETLO) emit_movrr(as, ir, destlo, RID_RETLO); } else { if (desthi != RID_RETHI) emit_movrr(as, ir, desthi, RID_RETHI); if (destlo != RID_RETLO) emit_movrr(as, ir, destlo, RID_RETLO); } /* Restore spill slots (if any). */ if (ra_hasspill((ir+1)->s)) ra_save(as, ir+1, RID_RETHI); if (ra_hasspill(ir->s)) ra_save(as, ir, RID_RETLO); } #endif /* -- Snapshot handling --------- ----------------------------------------- */ /* Can we rematerialize a KNUM instead of forcing a spill? */ static int asm_snap_canremat(ASMState *as) { Reg r; for (r = RID_MIN_FPR; r < RID_MAX_FPR; r++) if (irref_isk(regcost_ref(as->cost[r]))) return 1; return 0; } /* Check whether a sunk store corresponds to an allocation. */ static int asm_sunk_store(ASMState *as, IRIns *ira, IRIns *irs) { if (irs->s == 255) { if (irs->o == IR_ASTORE || irs->o == IR_HSTORE || irs->o == IR_FSTORE || irs->o == IR_XSTORE) { IRIns *irk = IR(irs->op1); if (irk->o == IR_AREF || irk->o == IR_HREFK) irk = IR(irk->op1); return (IR(irk->op1) == ira); } return 0; } else { return (ira + irs->s == irs); /* Quick check. */ } } /* Allocate register or spill slot for a ref that escapes to a snapshot. */ static void asm_snap_alloc1(ASMState *as, IRRef ref) { IRIns *ir = IR(ref); if (!irref_isk(ref) && (!(ra_used(ir) || ir->r == RID_SUNK))) { if (ir->r == RID_SINK) { ir->r = RID_SUNK; #if LJ_HASFFI if (ir->o == IR_CNEWI) { /* Allocate CNEWI value. */ asm_snap_alloc1(as, ir->op2); if (LJ_32 && (ir+1)->o == IR_HIOP) asm_snap_alloc1(as, (ir+1)->op2); } else #endif { /* Allocate stored values for TNEW, TDUP and CNEW. */ IRIns *irs; lua_assert(ir->o == IR_TNEW || ir->o == IR_TDUP || ir->o == IR_CNEW); for (irs = IR(as->snapref-1); irs > ir; irs--) if (irs->r == RID_SINK && asm_sunk_store(as, ir, irs)) { lua_assert(irs->o == IR_ASTORE || irs->o == IR_HSTORE || irs->o == IR_FSTORE || irs->o == IR_XSTORE); asm_snap_alloc1(as, irs->op2); if (LJ_32 && (irs+1)->o == IR_HIOP) asm_snap_alloc1(as, (irs+1)->op2); } } } else { RegSet allow; if (ir->o == IR_CONV && ir->op2 == IRCONV_NUM_INT) { IRIns *irc; for (irc = IR(as->curins); irc > ir; irc--) if ((irc->op1 == ref || irc->op2 == ref) && !(irc->r == RID_SINK || irc->r == RID_SUNK)) goto nosink; /* Don't sink conversion if result is used. */ asm_snap_alloc1(as, ir->op1); return; } nosink: allow = (!LJ_SOFTFP && irt_isfp(ir->t)) ? RSET_FPR : RSET_GPR; if ((as->freeset & allow) || (allow == RSET_FPR && asm_snap_canremat(as))) { /* Get a weak register if we have a free one or can rematerialize. */ Reg r = ra_allocref(as, ref, allow); /* Allocate a register. */ if (!irt_isphi(ir->t)) ra_weak(as, r); /* But mark it as weakly referenced. */ checkmclim(as); RA_DBGX((as, "snapreg $f $r", ref, ir->r)); } else { ra_spill(as, ir); /* Otherwise force a spill slot. */ RA_DBGX((as, "snapspill $f $s", ref, ir->s)); } } } } /* Allocate refs escaping to a snapshot. */ static void asm_snap_alloc(ASMState *as) { SnapShot *snap = &as->T->snap[as->snapno]; SnapEntry *map = &as->T->snapmap[snap->mapofs]; MSize n, nent = snap->nent; for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; IRRef ref = snap_ref(sn); if (!irref_isk(ref)) { asm_snap_alloc1(as, ref); if (LJ_SOFTFP && (sn & SNAP_SOFTFPNUM)) { lua_assert(irt_type(IR(ref+1)->t) == IRT_SOFTFP); asm_snap_alloc1(as, ref+1); } } } } /* All guards for a snapshot use the same exitno. This is currently the ** same as the snapshot number. Since the exact origin of the exit cannot ** be determined, all guards for the same snapshot must exit with the same ** RegSP mapping. ** A renamed ref which has been used in a prior guard for the same snapshot ** would cause an inconsistency. The easy way out is to force a spill slot. */ static int asm_snap_checkrename(ASMState *as, IRRef ren) { SnapShot *snap = &as->T->snap[as->snapno]; SnapEntry *map = &as->T->snapmap[snap->mapofs]; MSize n, nent = snap->nent; for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; IRRef ref = snap_ref(sn); if (ref == ren || (LJ_SOFTFP && (sn & SNAP_SOFTFPNUM) && ++ref == ren)) { IRIns *ir = IR(ref); ra_spill(as, ir); /* Register renamed, so force a spill slot. */ RA_DBGX((as, "snaprensp $f $s", ref, ir->s)); return 1; /* Found. */ } } return 0; /* Not found. */ } /* Prepare snapshot for next guard instruction. */ static void asm_snap_prep(ASMState *as) { if (as->curins < as->snapref) { do { if (as->snapno == 0) return; /* Called by sunk stores before snap #0. */ as->snapno--; as->snapref = as->T->snap[as->snapno].ref; } while (as->curins < as->snapref); asm_snap_alloc(as); as->snaprename = as->T->nins; } else { /* Process any renames above the highwater mark. */ for (; as->snaprename < as->T->nins; as->snaprename++) { IRIns *ir = IR(as->snaprename); if (asm_snap_checkrename(as, ir->op1)) ir->op2 = REF_BIAS-1; /* Kill rename. */ } } } /* -- Miscellaneous helpers ----------------------------------------------- */ /* Collect arguments from CALL* and CARG instructions. */ static void asm_collectargs(ASMState *as, IRIns *ir, const CCallInfo *ci, IRRef *args) { uint32_t n = CCI_NARGS(ci); lua_assert(n <= CCI_NARGS_MAX*2); /* Account for split args. */ if ((ci->flags & CCI_L)) { *args++ = ASMREF_L; n--; } while (n-- > 1) { ir = IR(ir->op1); lua_assert(ir->o == IR_CARG); args[n] = ir->op2 == REF_NIL ? 0 : ir->op2; } args[0] = ir->op1 == REF_NIL ? 0 : ir->op1; lua_assert(IR(ir->op1)->o != IR_CARG); } /* Reconstruct CCallInfo flags for CALLX*. */ static uint32_t asm_callx_flags(ASMState *as, IRIns *ir) { uint32_t nargs = 0; if (ir->op1 != REF_NIL) { /* Count number of arguments first. */ IRIns *ira = IR(ir->op1); nargs++; while (ira->o == IR_CARG) { nargs++; ira = IR(ira->op1); } } #if LJ_HASFFI if (IR(ir->op2)->o == IR_CARG) { /* Copy calling convention info. */ CTypeID id = (CTypeID)IR(IR(ir->op2)->op2)->i; CType *ct = ctype_get(ctype_ctsG(J2G(as->J)), id); nargs |= ((ct->info & CTF_VARARG) ? CCI_VARARG : 0); #if LJ_TARGET_X86 nargs |= (ctype_cconv(ct->info) << CCI_CC_SHIFT); #endif } #endif return (nargs | (ir->t.irt << CCI_OTSHIFT)); } /* Calculate stack adjustment. */ static int32_t asm_stack_adjust(ASMState *as) { if (as->evenspill <= SPS_FIXED) return 0; return sps_scale(sps_align(as->evenspill)); } /* Must match with hash*() in lj_tab.c. */ static uint32_t ir_khash(IRIns *ir) { uint32_t lo, hi; if (irt_isstr(ir->t)) { return ir_kstr(ir)->hash; } else if (irt_isnum(ir->t)) { lo = ir_knum(ir)->u32.lo; hi = ir_knum(ir)->u32.hi << 1; } else if (irt_ispri(ir->t)) { lua_assert(!irt_isnil(ir->t)); return irt_type(ir->t)-IRT_FALSE; } else { lua_assert(irt_isgcv(ir->t)); lo = u32ptr(ir_kgc(ir)); hi = lo + HASH_BIAS; } return hashrot(lo, hi); } /* -- Allocations --------------------------------------------------------- */ static void asm_gencall(ASMState *as, const CCallInfo *ci, IRRef *args); static void asm_setupresult(ASMState *as, IRIns *ir, const CCallInfo *ci); static void asm_snew(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_new]; IRRef args[3]; args[0] = ASMREF_L; /* lua_State *L */ args[1] = ir->op1; /* const char *str */ args[2] = ir->op2; /* size_t len */ as->gcsteps++; asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); } static void asm_tnew(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_tab_new1]; IRRef args[2]; args[0] = ASMREF_L; /* lua_State *L */ args[1] = ASMREF_TMP1; /* uint32_t ahsize */ as->gcsteps++; asm_setupresult(as, ir, ci); /* GCtab * */ asm_gencall(as, ci, args); ra_allockreg(as, ir->op1 | (ir->op2 << 24), ra_releasetmp(as, ASMREF_TMP1)); } static void asm_tdup(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_tab_dup]; IRRef args[2]; args[0] = ASMREF_L; /* lua_State *L */ args[1] = ir->op1; /* const GCtab *kt */ as->gcsteps++; asm_setupresult(as, ir, ci); /* GCtab * */ asm_gencall(as, ci, args); } static void asm_gc_check(ASMState *as); /* Explicit GC step. */ static void asm_gcstep(ASMState *as, IRIns *ir) { IRIns *ira; for (ira = IR(as->stopins+1); ira < ir; ira++) if ((ira->o == IR_TNEW || ira->o == IR_TDUP || (LJ_HASFFI && (ira->o == IR_CNEW || ira->o == IR_CNEWI))) && ra_used(ira)) as->gcsteps++; if (as->gcsteps) asm_gc_check(as); as->gcsteps = 0x80000000; /* Prevent implicit GC check further up. */ } /* -- PHI and loop handling ----------------------------------------------- */ /* Break a PHI cycle by renaming to a free register (evict if needed). */ static void asm_phi_break(ASMState *as, RegSet blocked, RegSet blockedby, RegSet allow) { RegSet candidates = blocked & allow; if (candidates) { /* If this register file has candidates. */ /* Note: the set for ra_pick cannot be empty, since each register file ** has some registers never allocated to PHIs. */ Reg down, up = ra_pick(as, ~blocked & allow); /* Get a free register. */ if (candidates & ~blockedby) /* Optimize shifts, else it's a cycle. */ candidates = candidates & ~blockedby; down = rset_picktop(candidates); /* Pick candidate PHI register. */ ra_rename(as, down, up); /* And rename it to the free register. */ } } /* PHI register shuffling. ** ** The allocator tries hard to preserve PHI register assignments across ** the loop body. Most of the time this loop does nothing, since there ** are no register mismatches. ** ** If a register mismatch is detected and ... ** - the register is currently free: rename it. ** - the register is blocked by an invariant: restore/remat and rename it. ** - Otherwise the register is used by another PHI, so mark it as blocked. ** ** The renames are order-sensitive, so just retry the loop if a register ** is marked as blocked, but has been freed in the meantime. A cycle is ** detected if all of the blocked registers are allocated. To break the ** cycle rename one of them to a free register and retry. ** ** Note that PHI spill slots are kept in sync and don't need to be shuffled. */ static void asm_phi_shuffle(ASMState *as) { RegSet work; /* Find and resolve PHI register mismatches. */ for (;;) { RegSet blocked = RSET_EMPTY; RegSet blockedby = RSET_EMPTY; RegSet phiset = as->phiset; while (phiset) { /* Check all left PHI operand registers. */ Reg r = rset_pickbot(phiset); IRIns *irl = IR(as->phireg[r]); Reg left = irl->r; if (r != left) { /* Mismatch? */ if (!rset_test(as->freeset, r)) { /* PHI register blocked? */ IRRef ref = regcost_ref(as->cost[r]); /* Blocked by other PHI (w/reg)? */ if (!ra_iskref(ref) && irt_ismarked(IR(ref)->t)) { rset_set(blocked, r); if (ra_hasreg(left)) rset_set(blockedby, left); left = RID_NONE; } else { /* Otherwise grab register from invariant. */ ra_restore(as, ref); checkmclim(as); } } if (ra_hasreg(left)) { ra_rename(as, left, r); checkmclim(as); } } rset_clear(phiset, r); } if (!blocked) break; /* Finished. */ if (!(as->freeset & blocked)) { /* Break cycles if none are free. */ asm_phi_break(as, blocked, blockedby, RSET_GPR); if (!LJ_SOFTFP) asm_phi_break(as, blocked, blockedby, RSET_FPR); checkmclim(as); } /* Else retry some more renames. */ } /* Restore/remat invariants whose registers are modified inside the loop. */ #if !LJ_SOFTFP work = as->modset & ~(as->freeset | as->phiset) & RSET_FPR; while (work) { Reg r = rset_pickbot(work); ra_restore(as, regcost_ref(as->cost[r])); rset_clear(work, r); checkmclim(as); } #endif work = as->modset & ~(as->freeset | as->phiset); while (work) { Reg r = rset_pickbot(work); ra_restore(as, regcost_ref(as->cost[r])); rset_clear(work, r); checkmclim(as); } /* Allocate and save all unsaved PHI regs and clear marks. */ work = as->phiset; while (work) { Reg r = rset_picktop(work); IRRef lref = as->phireg[r]; IRIns *ir = IR(lref); if (ra_hasspill(ir->s)) { /* Left PHI gained a spill slot? */ irt_clearmark(ir->t); /* Handled here, so clear marker now. */ ra_alloc1(as, lref, RID2RSET(r)); ra_save(as, ir, r); /* Save to spill slot inside the loop. */ checkmclim(as); } rset_clear(work, r); } } /* Copy unsynced left/right PHI spill slots. Rarely needed. */ static void asm_phi_copyspill(ASMState *as) { int need = 0; IRIns *ir; for (ir = IR(as->orignins-1); ir->o == IR_PHI; ir--) if (ra_hasspill(ir->s) && ra_hasspill(IR(ir->op1)->s)) need |= irt_isfp(ir->t) ? 2 : 1; /* Unsynced spill slot? */ if ((need & 1)) { /* Copy integer spill slots. */ #if !LJ_TARGET_X86ORX64 Reg r = RID_TMP; #else Reg r = RID_RET; if ((as->freeset & RSET_GPR)) r = rset_pickbot((as->freeset & RSET_GPR)); else emit_spload(as, IR(regcost_ref(as->cost[r])), r, SPOFS_TMP); #endif for (ir = IR(as->orignins-1); ir->o == IR_PHI; ir--) { if (ra_hasspill(ir->s)) { IRIns *irl = IR(ir->op1); if (ra_hasspill(irl->s) && !irt_isfp(ir->t)) { emit_spstore(as, irl, r, sps_scale(irl->s)); emit_spload(as, ir, r, sps_scale(ir->s)); checkmclim(as); } } } #if LJ_TARGET_X86ORX64 if (!rset_test(as->freeset, r)) emit_spstore(as, IR(regcost_ref(as->cost[r])), r, SPOFS_TMP); #endif } #if !LJ_SOFTFP if ((need & 2)) { /* Copy FP spill slots. */ #if LJ_TARGET_X86 Reg r = RID_XMM0; #else Reg r = RID_FPRET; #endif if ((as->freeset & RSET_FPR)) r = rset_pickbot((as->freeset & RSET_FPR)); if (!rset_test(as->freeset, r)) emit_spload(as, IR(regcost_ref(as->cost[r])), r, SPOFS_TMP); for (ir = IR(as->orignins-1); ir->o == IR_PHI; ir--) { if (ra_hasspill(ir->s)) { IRIns *irl = IR(ir->op1); if (ra_hasspill(irl->s) && irt_isfp(ir->t)) { emit_spstore(as, irl, r, sps_scale(irl->s)); emit_spload(as, ir, r, sps_scale(ir->s)); checkmclim(as); } } } if (!rset_test(as->freeset, r)) emit_spstore(as, IR(regcost_ref(as->cost[r])), r, SPOFS_TMP); } #endif } /* Emit renames for left PHIs which are only spilled outside the loop. */ static void asm_phi_fixup(ASMState *as) { RegSet work = as->phiset; while (work) { Reg r = rset_picktop(work); IRRef lref = as->phireg[r]; IRIns *ir = IR(lref); if (irt_ismarked(ir->t)) { irt_clearmark(ir->t); /* Left PHI gained a spill slot before the loop? */ if (ra_hasspill(ir->s)) { IRRef ren; lj_ir_set(as->J, IRT(IR_RENAME, IRT_NIL), lref, as->loopsnapno); ren = tref_ref(lj_ir_emit(as->J)); as->ir = as->T->ir; /* The IR may have been reallocated. */ IR(ren)->r = (uint8_t)r; IR(ren)->s = SPS_NONE; } } rset_clear(work, r); } } /* Setup right PHI reference. */ static void asm_phi(ASMState *as, IRIns *ir) { RegSet allow = ((!LJ_SOFTFP && irt_isfp(ir->t)) ? RSET_FPR : RSET_GPR) & ~as->phiset; RegSet afree = (as->freeset & allow); IRIns *irl = IR(ir->op1); IRIns *irr = IR(ir->op2); if (ir->r == RID_SINK) /* Sink PHI. */ return; /* Spill slot shuffling is not implemented yet (but rarely needed). */ if (ra_hasspill(irl->s) || ra_hasspill(irr->s)) lj_trace_err(as->J, LJ_TRERR_NYIPHI); /* Leave at least one register free for non-PHIs (and PHI cycle breaking). */ if ((afree & (afree-1))) { /* Two or more free registers? */ Reg r; if (ra_noreg(irr->r)) { /* Get a register for the right PHI. */ r = ra_allocref(as, ir->op2, allow); } else { /* Duplicate right PHI, need a copy (rare). */ r = ra_scratch(as, allow); emit_movrr(as, irr, r, irr->r); } ir->r = (uint8_t)r; rset_set(as->phiset, r); as->phireg[r] = (IRRef1)ir->op1; irt_setmark(irl->t); /* Marks left PHIs _with_ register. */ if (ra_noreg(irl->r)) ra_sethint(irl->r, r); /* Set register hint for left PHI. */ } else { /* Otherwise allocate a spill slot. */ /* This is overly restrictive, but it triggers only on synthetic code. */ if (ra_hasreg(irl->r) || ra_hasreg(irr->r)) lj_trace_err(as->J, LJ_TRERR_NYIPHI); ra_spill(as, ir); irr->s = ir->s; /* Set right PHI spill slot. Sync left slot later. */ } } static void asm_loop_fixup(ASMState *as); /* Middle part of a loop. */ static void asm_loop(ASMState *as) { MCode *mcspill; /* LOOP is a guard, so the snapno is up to date. */ as->loopsnapno = as->snapno; if (as->gcsteps) asm_gc_check(as); /* LOOP marks the transition from the variant to the invariant part. */ as->flagmcp = as->invmcp = NULL; as->sectref = 0; if (!neverfuse(as)) as->fuseref = 0; asm_phi_shuffle(as); mcspill = as->mcp; asm_phi_copyspill(as); asm_loop_fixup(as); as->mcloop = as->mcp; RA_DBGX((as, "===== LOOP =====")); if (!as->realign) RA_DBG_FLUSH(); if (as->mcp != mcspill) emit_jmp(as, mcspill); } /* -- Target-specific assembler ------------------------------------------- */ #if LJ_TARGET_X86ORX64 #include "lj_asm_x86.h" #elif LJ_TARGET_ARM #include "lj_asm_arm.h" #elif LJ_TARGET_PPC #include "lj_asm_ppc.h" #elif LJ_TARGET_MIPS #include "lj_asm_mips.h" #else #error "Missing assembler for target CPU" #endif /* -- Head of trace ------------------------------------------------------- */ /* Head of a root trace. */ static void asm_head_root(ASMState *as) { int32_t spadj; asm_head_root_base(as); emit_setvmstate(as, (int32_t)as->T->traceno); spadj = asm_stack_adjust(as); as->T->spadjust = (uint16_t)spadj; emit_spsub(as, spadj); /* Root traces assume a checked stack for the starting proto. */ as->T->topslot = gcref(as->T->startpt)->pt.framesize; } /* Head of a side trace. ** ** The current simplistic algorithm requires that all slots inherited ** from the parent are live in a register between pass 2 and pass 3. This ** avoids the complexity of stack slot shuffling. But of course this may ** overflow the register set in some cases and cause the dreaded error: ** "NYI: register coalescing too complex". A refined algorithm is needed. */ static void asm_head_side(ASMState *as) { IRRef1 sloadins[RID_MAX]; RegSet allow = RSET_ALL; /* Inverse of all coalesced registers. */ RegSet live = RSET_EMPTY; /* Live parent registers. */ IRIns *irp = &as->parent->ir[REF_BASE]; /* Parent base. */ int32_t spadj, spdelta; int pass2 = 0; int pass3 = 0; IRRef i; if (as->snapno && as->topslot > as->parent->topslot) { /* Force snap #0 alloc to prevent register overwrite in stack check. */ as->snapno = 0; asm_snap_alloc(as); } allow = asm_head_side_base(as, irp, allow); /* Scan all parent SLOADs and collect register dependencies. */ for (i = as->stopins; i > REF_BASE; i--) { IRIns *ir = IR(i); RegSP rs; lua_assert((ir->o == IR_SLOAD && (ir->op2 & IRSLOAD_PARENT)) || (LJ_SOFTFP && ir->o == IR_HIOP) || ir->o == IR_PVAL); rs = as->parentmap[i - REF_FIRST]; if (ra_hasreg(ir->r)) { rset_clear(allow, ir->r); if (ra_hasspill(ir->s)) { ra_save(as, ir, ir->r); checkmclim(as); } } else if (ra_hasspill(ir->s)) { irt_setmark(ir->t); pass2 = 1; } if (ir->r == rs) { /* Coalesce matching registers right now. */ ra_free(as, ir->r); } else if (ra_hasspill(regsp_spill(rs))) { if (ra_hasreg(ir->r)) pass3 = 1; } else if (ra_used(ir)) { sloadins[rs] = (IRRef1)i; rset_set(live, rs); /* Block live parent register. */ } } /* Calculate stack frame adjustment. */ spadj = asm_stack_adjust(as); spdelta = spadj - (int32_t)as->parent->spadjust; if (spdelta < 0) { /* Don't shrink the stack frame. */ spadj = (int32_t)as->parent->spadjust; spdelta = 0; } as->T->spadjust = (uint16_t)spadj; /* Reload spilled target registers. */ if (pass2) { for (i = as->stopins; i > REF_BASE; i--) { IRIns *ir = IR(i); if (irt_ismarked(ir->t)) { RegSet mask; Reg r; RegSP rs; irt_clearmark(ir->t); rs = as->parentmap[i - REF_FIRST]; if (!ra_hasspill(regsp_spill(rs))) ra_sethint(ir->r, rs); /* Hint may be gone, set it again. */ else if (sps_scale(regsp_spill(rs))+spdelta == sps_scale(ir->s)) continue; /* Same spill slot, do nothing. */ mask = ((!LJ_SOFTFP && irt_isfp(ir->t)) ? RSET_FPR : RSET_GPR) & allow; if (mask == RSET_EMPTY) lj_trace_err(as->J, LJ_TRERR_NYICOAL); r = ra_allocref(as, i, mask); ra_save(as, ir, r); rset_clear(allow, r); if (r == rs) { /* Coalesce matching registers right now. */ ra_free(as, r); rset_clear(live, r); } else if (ra_hasspill(regsp_spill(rs))) { pass3 = 1; } checkmclim(as); } } } /* Store trace number and adjust stack frame relative to the parent. */ emit_setvmstate(as, (int32_t)as->T->traceno); emit_spsub(as, spdelta); #if !LJ_TARGET_X86ORX64 /* Restore BASE register from parent spill slot. */ if (ra_hasspill(irp->s)) emit_spload(as, IR(REF_BASE), IR(REF_BASE)->r, sps_scale(irp->s)); #endif /* Restore target registers from parent spill slots. */ if (pass3) { RegSet work = ~as->freeset & RSET_ALL; while (work) { Reg r = rset_pickbot(work); IRRef ref = regcost_ref(as->cost[r]); RegSP rs = as->parentmap[ref - REF_FIRST]; rset_clear(work, r); if (ra_hasspill(regsp_spill(rs))) { int32_t ofs = sps_scale(regsp_spill(rs)); ra_free(as, r); emit_spload(as, IR(ref), r, ofs); checkmclim(as); } } } /* Shuffle registers to match up target regs with parent regs. */ for (;;) { RegSet work; /* Repeatedly coalesce free live registers by moving to their target. */ while ((work = as->freeset & live) != RSET_EMPTY) { Reg rp = rset_pickbot(work); IRIns *ir = IR(sloadins[rp]); rset_clear(live, rp); rset_clear(allow, rp); ra_free(as, ir->r); emit_movrr(as, ir, ir->r, rp); checkmclim(as); } /* We're done if no live registers remain. */ if (live == RSET_EMPTY) break; /* Break cycles by renaming one target to a temp. register. */ if (live & RSET_GPR) { RegSet tmpset = as->freeset & ~live & allow & RSET_GPR; if (tmpset == RSET_EMPTY) lj_trace_err(as->J, LJ_TRERR_NYICOAL); ra_rename(as, rset_pickbot(live & RSET_GPR), rset_pickbot(tmpset)); } if (!LJ_SOFTFP && (live & RSET_FPR)) { RegSet tmpset = as->freeset & ~live & allow & RSET_FPR; if (tmpset == RSET_EMPTY) lj_trace_err(as->J, LJ_TRERR_NYICOAL); ra_rename(as, rset_pickbot(live & RSET_FPR), rset_pickbot(tmpset)); } checkmclim(as); /* Continue with coalescing to fix up the broken cycle(s). */ } /* Inherit top stack slot already checked by parent trace. */ as->T->topslot = as->parent->topslot; if (as->topslot > as->T->topslot) { /* Need to check for higher slot? */ #ifdef EXITSTATE_CHECKEXIT /* Highest exit + 1 indicates stack check. */ ExitNo exitno = as->T->nsnap; #else /* Reuse the parent exit in the context of the parent trace. */ ExitNo exitno = as->J->exitno; #endif as->T->topslot = (uint8_t)as->topslot; /* Remember for child traces. */ asm_stack_check(as, as->topslot, irp, allow & RSET_GPR, exitno); } } /* -- Tail of trace ------------------------------------------------------- */ /* Get base slot for a snapshot. */ static BCReg asm_baseslot(ASMState *as, SnapShot *snap, int *gotframe) { SnapEntry *map = &as->T->snapmap[snap->mapofs]; MSize n; for (n = snap->nent; n > 0; n--) { SnapEntry sn = map[n-1]; if ((sn & SNAP_FRAME)) { *gotframe = 1; return snap_slot(sn); } } return 0; } /* Link to another trace. */ static void asm_tail_link(ASMState *as) { SnapNo snapno = as->T->nsnap-1; /* Last snapshot. */ SnapShot *snap = &as->T->snap[snapno]; int gotframe = 0; BCReg baseslot = asm_baseslot(as, snap, &gotframe); as->topslot = snap->topslot; checkmclim(as); ra_allocref(as, REF_BASE, RID2RSET(RID_BASE)); if (as->T->link == 0) { /* Setup fixed registers for exit to interpreter. */ const BCIns *pc = snap_pc(as->T->snapmap[snap->mapofs + snap->nent]); int32_t mres; if (bc_op(*pc) == BC_JLOOP) { /* NYI: find a better way to do this. */ BCIns *retpc = &traceref(as->J, bc_d(*pc))->startins; if (bc_isret(bc_op(*retpc))) pc = retpc; } ra_allockreg(as, i32ptr(J2GG(as->J)->dispatch), RID_DISPATCH); ra_allockreg(as, i32ptr(pc), RID_LPC); mres = (int32_t)(snap->nslots - baseslot); switch (bc_op(*pc)) { case BC_CALLM: case BC_CALLMT: mres -= (int32_t)(1 + bc_a(*pc) + bc_c(*pc)); break; case BC_RETM: mres -= (int32_t)(bc_a(*pc) + bc_d(*pc)); break; case BC_TSETM: mres -= (int32_t)bc_a(*pc); break; default: if (bc_op(*pc) < BC_FUNCF) mres = 0; break; } ra_allockreg(as, mres, RID_RET); /* Return MULTRES or 0. */ } else if (baseslot) { /* Save modified BASE for linking to trace with higher start frame. */ emit_setgl(as, RID_BASE, jit_base); } emit_addptr(as, RID_BASE, 8*(int32_t)baseslot); /* Sync the interpreter state with the on-trace state. */ asm_stack_restore(as, snap); /* Root traces that add frames need to check the stack at the end. */ if (!as->parent && gotframe) asm_stack_check(as, as->topslot, NULL, as->freeset & RSET_GPR, snapno); } /* -- Trace setup --------------------------------------------------------- */ /* Clear reg/sp for all instructions and add register hints. */ static void asm_setup_regsp(ASMState *as) { GCtrace *T = as->T; int sink = T->sinktags; IRRef nins = T->nins; IRIns *ir, *lastir; int inloop; #if LJ_TARGET_ARM uint32_t rload = 0xa6402a64; #endif ra_setup(as); /* Clear reg/sp for constants. */ for (ir = IR(T->nk), lastir = IR(REF_BASE); ir < lastir; ir++) ir->prev = REGSP_INIT; /* REF_BASE is used for implicit references to the BASE register. */ lastir->prev = REGSP_HINT(RID_BASE); ir = IR(nins-1); if (ir->o == IR_RENAME) { do { ir--; nins--; } while (ir->o == IR_RENAME); T->nins = nins; /* Remove any renames left over from ASM restart. */ } as->snaprename = nins; as->snapref = nins; as->snapno = T->nsnap; as->stopins = REF_BASE; as->orignins = nins; as->curins = nins; /* Setup register hints for parent link instructions. */ ir = IR(REF_FIRST); if (as->parent) { uint16_t *p; lastir = lj_snap_regspmap(as->parent, as->J->exitno, ir); if (lastir - ir > LJ_MAX_JSLOTS) lj_trace_err(as->J, LJ_TRERR_NYICOAL); as->stopins = (IRRef)((lastir-1) - as->ir); for (p = as->parentmap; ir < lastir; ir++) { RegSP rs = ir->prev; *p++ = (uint16_t)rs; /* Copy original parent RegSP to parentmap. */ if (!ra_hasspill(regsp_spill(rs))) ir->prev = (uint16_t)REGSP_HINT(regsp_reg(rs)); else ir->prev = REGSP_INIT; } } inloop = 0; as->evenspill = SPS_FIRST; for (lastir = IR(nins); ir < lastir; ir++) { if (sink) { if (ir->r == RID_SINK) continue; if (ir->r == RID_SUNK) { /* Revert after ASM restart. */ ir->r = RID_SINK; continue; } } switch (ir->o) { case IR_LOOP: inloop = 1; break; #if LJ_TARGET_ARM case IR_SLOAD: if (!((ir->op2 & IRSLOAD_TYPECHECK) || (ir+1)->o == IR_HIOP)) break; /* fallthrough */ case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: if (!LJ_SOFTFP && irt_isnum(ir->t)) break; ir->prev = (uint16_t)REGSP_HINT((rload & 15)); rload = lj_ror(rload, 4); continue; #endif case IR_CALLXS: { CCallInfo ci; ci.flags = asm_callx_flags(as, ir); ir->prev = asm_setup_call_slots(as, ir, &ci); if (inloop) as->modset |= RSET_SCRATCH; continue; } case IR_CALLN: case IR_CALLL: case IR_CALLS: { const CCallInfo *ci = &lj_ir_callinfo[ir->op2]; ir->prev = asm_setup_call_slots(as, ir, ci); if (inloop) as->modset |= (ci->flags & CCI_NOFPRCLOBBER) ? (RSET_SCRATCH & ~RSET_FPR) : RSET_SCRATCH; continue; } #if LJ_SOFTFP || (LJ_32 && LJ_HASFFI) case IR_HIOP: switch ((ir-1)->o) { #if LJ_SOFTFP && LJ_TARGET_ARM case IR_SLOAD: case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: if (ra_hashint((ir-1)->r)) { ir->prev = (ir-1)->prev + 1; continue; } break; #endif #if !LJ_SOFTFP && LJ_NEED_FP64 case IR_CONV: if (irt_isfp((ir-1)->t)) { ir->prev = REGSP_HINT(RID_FPRET); continue; } /* fallthrough */ #endif case IR_CALLN: case IR_CALLXS: #if LJ_SOFTFP case IR_MIN: case IR_MAX: #endif (ir-1)->prev = REGSP_HINT(RID_RETLO); ir->prev = REGSP_HINT(RID_RETHI); continue; default: break; } break; #endif #if LJ_SOFTFP case IR_MIN: case IR_MAX: if ((ir+1)->o != IR_HIOP) break; /* fallthrough */ #endif /* C calls evict all scratch regs and return results in RID_RET. */ case IR_SNEW: case IR_XSNEW: case IR_NEWREF: if (REGARG_NUMGPR < 3 && as->evenspill < 3) as->evenspill = 3; /* lj_str_new and lj_tab_newkey need 3 args. */ case IR_TNEW: case IR_TDUP: case IR_CNEW: case IR_CNEWI: case IR_TOSTR: ir->prev = REGSP_HINT(RID_RET); if (inloop) as->modset = RSET_SCRATCH; continue; case IR_STRTO: case IR_OBAR: if (inloop) as->modset = RSET_SCRATCH; break; #if !LJ_TARGET_X86ORX64 && !LJ_SOFTFP case IR_ATAN2: case IR_LDEXP: #endif case IR_POW: if (!LJ_SOFTFP && irt_isnum(ir->t)) { #if LJ_TARGET_X86ORX64 ir->prev = REGSP_HINT(RID_XMM0); if (inloop) as->modset |= RSET_RANGE(RID_XMM0, RID_XMM1+1)|RID2RSET(RID_EAX); #else ir->prev = REGSP_HINT(RID_FPRET); if (inloop) as->modset |= RSET_SCRATCH; #endif continue; } /* fallthrough for integer POW */ case IR_DIV: case IR_MOD: if (!irt_isnum(ir->t)) { ir->prev = REGSP_HINT(RID_RET); if (inloop) as->modset |= (RSET_SCRATCH & RSET_GPR); continue; } break; case IR_FPMATH: #if LJ_TARGET_X86ORX64 if (ir->op2 == IRFPM_EXP2) { /* May be joined to lj_vm_pow_sse. */ ir->prev = REGSP_HINT(RID_XMM0); #if !LJ_64 if (as->evenspill < 4) /* Leave room for 16 byte scratch area. */ as->evenspill = 4; #endif if (inloop) as->modset |= RSET_RANGE(RID_XMM0, RID_XMM2+1)|RID2RSET(RID_EAX); continue; } else if (ir->op2 <= IRFPM_TRUNC && !(as->flags & JIT_F_SSE4_1)) { ir->prev = REGSP_HINT(RID_XMM0); if (inloop) as->modset |= RSET_RANGE(RID_XMM0, RID_XMM3+1)|RID2RSET(RID_EAX); continue; } break; #else ir->prev = REGSP_HINT(RID_FPRET); if (inloop) as->modset |= RSET_SCRATCH; continue; #endif #if LJ_TARGET_X86ORX64 /* Non-constant shift counts need to be in RID_ECX on x86/x64. */ case IR_BSHL: case IR_BSHR: case IR_BSAR: case IR_BROL: case IR_BROR: if (!irref_isk(ir->op2) && !ra_hashint(IR(ir->op2)->r)) { IR(ir->op2)->r = REGSP_HINT(RID_ECX); if (inloop) rset_set(as->modset, RID_ECX); } break; #endif /* Do not propagate hints across type conversions or loads. */ case IR_TOBIT: case IR_XLOAD: #if !LJ_TARGET_ARM case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: #endif break; case IR_CONV: if (irt_isfp(ir->t) || (ir->op2 & IRCONV_SRCMASK) == IRT_NUM || (ir->op2 & IRCONV_SRCMASK) == IRT_FLOAT) break; /* fallthrough */ default: /* Propagate hints across likely 'op reg, imm' or 'op reg'. */ if (irref_isk(ir->op2) && !irref_isk(ir->op1) && ra_hashint(regsp_reg(IR(ir->op1)->prev))) { ir->prev = IR(ir->op1)->prev; continue; } break; } ir->prev = REGSP_INIT; } if ((as->evenspill & 1)) as->oddspill = as->evenspill++; else as->oddspill = 0; } /* -- Assembler core ------------------------------------------------------ */ /* Assemble a trace. */ void lj_asm_trace(jit_State *J, GCtrace *T) { ASMState as_; ASMState *as = &as_; MCode *origtop; /* Ensure an initialized instruction beyond the last one for HIOP checks. */ J->cur.nins = lj_ir_nextins(J); J->cur.ir[J->cur.nins].o = IR_NOP; /* Setup initial state. Copy some fields to reduce indirections. */ as->J = J; as->T = T; as->ir = T->ir; as->flags = J->flags; as->loopref = J->loopref; as->realign = NULL; as->loopinv = 0; as->parent = J->parent ? traceref(J, J->parent) : NULL; /* Reserve MCode memory. */ as->mctop = origtop = lj_mcode_reserve(J, &as->mcbot); as->mcp = as->mctop; as->mclim = as->mcbot + MCLIM_REDZONE; asm_setup_target(as); do { as->mcp = as->mctop; #ifdef LUA_USE_ASSERT as->mcp_prev = as->mcp; #endif as->curins = T->nins; RA_DBG_START(); RA_DBGX((as, "===== STOP =====")); /* General trace setup. Emit tail of trace. */ asm_tail_prep(as); as->mcloop = NULL; as->flagmcp = NULL; as->topslot = 0; as->gcsteps = 0; as->sectref = as->loopref; as->fuseref = (as->flags & JIT_F_OPT_FUSE) ? as->loopref : FUSE_DISABLED; asm_setup_regsp(as); if (!as->loopref) asm_tail_link(as); /* Assemble a trace in linear backwards order. */ for (as->curins--; as->curins > as->stopins; as->curins--) { IRIns *ir = IR(as->curins); lua_assert(!(LJ_32 && irt_isint64(ir->t))); /* Handled by SPLIT. */ if (!ra_used(ir) && !ir_sideeff(ir) && (as->flags & JIT_F_OPT_DCE)) continue; /* Dead-code elimination can be soooo easy. */ if (irt_isguard(ir->t)) asm_snap_prep(as); RA_DBG_REF(); checkmclim(as); asm_ir(as, ir); } } while (as->realign); /* Retry in case the MCode needs to be realigned. */ /* Emit head of trace. */ RA_DBG_REF(); checkmclim(as); if (as->gcsteps > 0) { as->curins = as->T->snap[0].ref; asm_snap_prep(as); /* The GC check is a guard. */ asm_gc_check(as); } ra_evictk(as); if (as->parent) asm_head_side(as); else asm_head_root(as); asm_phi_fixup(as); RA_DBGX((as, "===== START ====")); RA_DBG_FLUSH(); if (as->freeset != RSET_ALL) lj_trace_err(as->J, LJ_TRERR_BADRA); /* Ouch! Should never happen. */ /* Set trace entry point before fixing up tail to allow link to self. */ T->mcode = as->mcp; T->mcloop = as->mcloop ? (MSize)((char *)as->mcloop - (char *)as->mcp) : 0; if (!as->loopref) asm_tail_fixup(as, T->link); /* Note: this may change as->mctop! */ T->szmcode = (MSize)((char *)as->mctop - (char *)as->mcp); lj_mcode_sync(T->mcode, origtop); } #undef IR #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_vmevent.h0000644000175000017500000000304313122010155017213 0ustar philphil/* ** VM event handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_VMEVENT_H #define _LJ_VMEVENT_H #include "lj_obj.h" /* Registry key for VM event handler table. */ #define LJ_VMEVENTS_REGKEY "_VMEVENTS" #define LJ_VMEVENTS_HSIZE 4 #define VMEVENT_MASK(ev) ((uint8_t)1 << ((int)(ev) & 7)) #define VMEVENT_HASH(ev) ((int)(ev) & ~7) #define VMEVENT_HASHIDX(h) ((int)(h) << 3) #define VMEVENT_NOCACHE 255 #define VMEVENT_DEF(name, hash) \ LJ_VMEVENT_##name##_, \ LJ_VMEVENT_##name = ((LJ_VMEVENT_##name##_) & 7)|((hash) << 3) /* VM event IDs. */ typedef enum { VMEVENT_DEF(BC, 0x00003883), VMEVENT_DEF(TRACE, 0xb2d91467), VMEVENT_DEF(RECORD, 0x9284bf4f), VMEVENT_DEF(TEXIT, 0xb29df2b0), LJ_VMEVENT__MAX } VMEvent; #ifdef LUAJIT_DISABLE_VMEVENT #define lj_vmevent_send(L, ev, args) UNUSED(L) #define lj_vmevent_send_(L, ev, args, post) UNUSED(L) #else #define lj_vmevent_send(L, ev, args) \ if (G(L)->vmevmask & VMEVENT_MASK(LJ_VMEVENT_##ev)) { \ ptrdiff_t argbase = lj_vmevent_prepare(L, LJ_VMEVENT_##ev); \ if (argbase) { \ args \ lj_vmevent_call(L, argbase); \ } \ } #define lj_vmevent_send_(L, ev, args, post) \ if (G(L)->vmevmask & VMEVENT_MASK(LJ_VMEVENT_##ev)) { \ ptrdiff_t argbase = lj_vmevent_prepare(L, LJ_VMEVENT_##ev); \ if (argbase) { \ args \ lj_vmevent_call(L, argbase); \ post \ } \ } LJ_FUNC ptrdiff_t lj_vmevent_prepare(lua_State *L, VMEvent ev); LJ_FUNC void lj_vmevent_call(lua_State *L, ptrdiff_t argbase); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_gc.h0000644000175000017500000001146113122010155016123 0ustar philphil/* ** Garbage collector. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_GC_H #define _LJ_GC_H #include "lj_obj.h" /* Garbage collector states. Order matters. */ enum { GCSpause, GCSpropagate, GCSatomic, GCSsweepstring, GCSsweep, GCSfinalize }; /* Bitmasks for marked field of GCobj. */ #define LJ_GC_WHITE0 0x01 #define LJ_GC_WHITE1 0x02 #define LJ_GC_BLACK 0x04 #define LJ_GC_FINALIZED 0x08 #define LJ_GC_WEAKKEY 0x08 #define LJ_GC_WEAKVAL 0x10 #define LJ_GC_CDATA_FIN 0x10 #define LJ_GC_FIXED 0x20 #define LJ_GC_SFIXED 0x40 #define LJ_GC_WHITES (LJ_GC_WHITE0 | LJ_GC_WHITE1) #define LJ_GC_COLORS (LJ_GC_WHITES | LJ_GC_BLACK) #define LJ_GC_WEAK (LJ_GC_WEAKKEY | LJ_GC_WEAKVAL) /* Macros to test and set GCobj colors. */ #define iswhite(x) ((x)->gch.marked & LJ_GC_WHITES) #define isblack(x) ((x)->gch.marked & LJ_GC_BLACK) #define isgray(x) (!((x)->gch.marked & (LJ_GC_BLACK|LJ_GC_WHITES))) #define tviswhite(x) (tvisgcv(x) && iswhite(gcV(x))) #define otherwhite(g) (g->gc.currentwhite ^ LJ_GC_WHITES) #define isdead(g, v) ((v)->gch.marked & otherwhite(g) & LJ_GC_WHITES) #define curwhite(g) ((g)->gc.currentwhite & LJ_GC_WHITES) #define newwhite(g, x) (obj2gco(x)->gch.marked = (uint8_t)curwhite(g)) #define makewhite(g, x) \ ((x)->gch.marked = ((x)->gch.marked & (uint8_t)~LJ_GC_COLORS) | curwhite(g)) #define flipwhite(x) ((x)->gch.marked ^= LJ_GC_WHITES) #define black2gray(x) ((x)->gch.marked &= (uint8_t)~LJ_GC_BLACK) #define fixstring(s) ((s)->marked |= LJ_GC_FIXED) #define markfinalized(x) ((x)->gch.marked |= LJ_GC_FINALIZED) /* Collector. */ LJ_FUNC size_t lj_gc_separateudata(global_State *g, int all); LJ_FUNC void lj_gc_finalize_udata(lua_State *L); #if LJ_HASFFI LJ_FUNC void lj_gc_finalize_cdata(lua_State *L); #else #define lj_gc_finalize_cdata(L) UNUSED(L) #endif LJ_FUNC void lj_gc_freeall(global_State *g); LJ_FUNCA int LJ_FASTCALL lj_gc_step(lua_State *L); LJ_FUNCA void LJ_FASTCALL lj_gc_step_fixtop(lua_State *L); #if LJ_HASJIT LJ_FUNC int LJ_FASTCALL lj_gc_step_jit(global_State *g, MSize steps); #endif LJ_FUNC void lj_gc_fullgc(lua_State *L); /* GC check: drive collector forward if the GC threshold has been reached. */ #define lj_gc_check(L) \ { if (LJ_UNLIKELY(G(L)->gc.total >= G(L)->gc.threshold)) \ lj_gc_step(L); } #define lj_gc_check_fixtop(L) \ { if (LJ_UNLIKELY(G(L)->gc.total >= G(L)->gc.threshold)) \ lj_gc_step_fixtop(L); } /* Write barriers. */ LJ_FUNC void lj_gc_barrierf(global_State *g, GCobj *o, GCobj *v); LJ_FUNCA void LJ_FASTCALL lj_gc_barrieruv(global_State *g, TValue *tv); LJ_FUNC void lj_gc_closeuv(global_State *g, GCupval *uv); #if LJ_HASJIT LJ_FUNC void lj_gc_barriertrace(global_State *g, uint32_t traceno); #endif /* Move the GC propagation frontier back for tables (make it gray again). */ static LJ_AINLINE void lj_gc_barrierback(global_State *g, GCtab *t) { GCobj *o = obj2gco(t); lua_assert(isblack(o) && !isdead(g, o)); lua_assert(g->gc.state != GCSfinalize && g->gc.state != GCSpause); black2gray(o); setgcrefr(t->gclist, g->gc.grayagain); setgcref(g->gc.grayagain, o); } /* Barrier for stores to table objects. TValue and GCobj variant. */ #define lj_gc_anybarriert(L, t) \ { if (LJ_UNLIKELY(isblack(obj2gco(t)))) lj_gc_barrierback(G(L), (t)); } #define lj_gc_barriert(L, t, tv) \ { if (tviswhite(tv) && isblack(obj2gco(t))) \ lj_gc_barrierback(G(L), (t)); } #define lj_gc_objbarriert(L, t, o) \ { if (iswhite(obj2gco(o)) && isblack(obj2gco(t))) \ lj_gc_barrierback(G(L), (t)); } /* Barrier for stores to any other object. TValue and GCobj variant. */ #define lj_gc_barrier(L, p, tv) \ { if (tviswhite(tv) && isblack(obj2gco(p))) \ lj_gc_barrierf(G(L), obj2gco(p), gcV(tv)); } #define lj_gc_objbarrier(L, p, o) \ { if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) \ lj_gc_barrierf(G(L), obj2gco(p), obj2gco(o)); } /* Allocator. */ LJ_FUNC void *lj_mem_realloc(lua_State *L, void *p, MSize osz, MSize nsz); LJ_FUNC void * LJ_FASTCALL lj_mem_newgco(lua_State *L, MSize size); LJ_FUNC void *lj_mem_grow(lua_State *L, void *p, MSize *szp, MSize lim, MSize esz); #define lj_mem_new(L, s) lj_mem_realloc(L, NULL, 0, (s)) static LJ_AINLINE void lj_mem_free(global_State *g, void *p, size_t osize) { g->gc.total -= (MSize)osize; g->allocf(g->allocd, p, osize, 0); } #define lj_mem_newvec(L, n, t) ((t *)lj_mem_new(L, (MSize)((n)*sizeof(t)))) #define lj_mem_reallocvec(L, p, on, n, t) \ ((p) = (t *)lj_mem_realloc(L, p, (on)*sizeof(t), (MSize)((n)*sizeof(t)))) #define lj_mem_growvec(L, p, n, m, t) \ ((p) = (t *)lj_mem_grow(L, (p), &(n), (m), (MSize)sizeof(t))) #define lj_mem_freevec(g, p, n, t) lj_mem_free(g, (p), (n)*sizeof(t)) #define lj_mem_newobj(L, t) ((t *)lj_mem_newgco(L, sizeof(t))) #define lj_mem_newt(L, s, t) ((t *)lj_mem_new(L, (s))) #define lj_mem_freet(g, p) lj_mem_free(g, (p), sizeof(*(p))) #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lauxlib.h0000644000175000017500000001356613122010155016515 0ustar philphil/* ** $Id: lauxlib.h,v 1.88.1.1 2007/12/27 13:02:25 roberto Exp $ ** Auxiliary functions for building Lua libraries ** See Copyright Notice in lua.h */ #ifndef lauxlib_h #define lauxlib_h #include #include #include "lua.h" #define luaL_getn(L,i) ((int)lua_objlen(L, i)) #define luaL_setn(L,i,j) ((void)0) /* no op! */ /* extra error code for `luaL_load' */ #define LUA_ERRFILE (LUA_ERRERR+1) typedef struct luaL_Reg { const char *name; lua_CFunction func; } luaL_Reg; LUALIB_API void (luaL_openlib) (lua_State *L, const char *libname, const luaL_Reg *l, int nup); LUALIB_API void (luaL_register) (lua_State *L, const char *libname, const luaL_Reg *l); LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e); LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e); LUALIB_API int (luaL_typerror) (lua_State *L, int narg, const char *tname); LUALIB_API int (luaL_argerror) (lua_State *L, int numarg, const char *extramsg); LUALIB_API const char *(luaL_checklstring) (lua_State *L, int numArg, size_t *l); LUALIB_API const char *(luaL_optlstring) (lua_State *L, int numArg, const char *def, size_t *l); LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int numArg); LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int nArg, lua_Number def); LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int numArg); LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int nArg, lua_Integer def); LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg); LUALIB_API void (luaL_checktype) (lua_State *L, int narg, int t); LUALIB_API void (luaL_checkany) (lua_State *L, int narg); LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname); LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname); LUALIB_API void (luaL_where) (lua_State *L, int lvl); LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...); LUALIB_API int (luaL_checkoption) (lua_State *L, int narg, const char *def, const char *const lst[]); LUALIB_API int (luaL_ref) (lua_State *L, int t); LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref); LUALIB_API int (luaL_loadfile) (lua_State *L, const char *filename); LUALIB_API int (luaL_loadbuffer) (lua_State *L, const char *buff, size_t sz, const char *name); LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s); LUALIB_API lua_State *(luaL_newstate) (void); LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p, const char *r); LUALIB_API const char *(luaL_findtable) (lua_State *L, int idx, const char *fname, int szhint); /* From Lua 5.2. */ LUALIB_API int luaL_fileresult(lua_State *L, int stat, const char *fname); LUALIB_API int luaL_execresult(lua_State *L, int stat); LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename, const char *mode); LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz, const char *name, const char *mode); LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1, const char *msg, int level); /* ** =============================================================== ** some useful macros ** =============================================================== */ #define luaL_argcheck(L, cond,numarg,extramsg) \ ((void)((cond) || luaL_argerror(L, (numarg), (extramsg)))) #define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL)) #define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL)) #define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n))) #define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d))) #define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n))) #define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d))) #define luaL_typename(L,i) lua_typename(L, lua_type(L,(i))) #define luaL_dofile(L, fn) \ (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_dostring(L, s) \ (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n))) #define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) /* ** {====================================================== ** Generic Buffer manipulation ** ======================================================= */ typedef struct luaL_Buffer { char *p; /* current position in buffer */ int lvl; /* number of strings in the stack (level) */ lua_State *L; char buffer[LUAL_BUFFERSIZE]; } luaL_Buffer; #define luaL_addchar(B,c) \ ((void)((B)->p < ((B)->buffer+LUAL_BUFFERSIZE) || luaL_prepbuffer(B)), \ (*(B)->p++ = (char)(c))) /* compatibility only */ #define luaL_putchar(B,c) luaL_addchar(B,c) #define luaL_addsize(B,n) ((B)->p += (n)) LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B); LUALIB_API char *(luaL_prepbuffer) (luaL_Buffer *B); LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l); LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s); LUALIB_API void (luaL_addvalue) (luaL_Buffer *B); LUALIB_API void (luaL_pushresult) (luaL_Buffer *B); /* }====================================================== */ /* compatibility with ref system */ /* pre-defined references */ #define LUA_NOREF (-2) #define LUA_REFNIL (-1) #define lua_ref(L,lock) ((lock) ? luaL_ref(L, LUA_REGISTRYINDEX) : \ (lua_pushstring(L, "unlocked references are obsolete"), lua_error(L), 0)) #define lua_unref(L,ref) luaL_unref(L, LUA_REGISTRYINDEX, (ref)) #define lua_getref(L,ref) lua_rawgeti(L, LUA_REGISTRYINDEX, (ref)) #define luaL_reg luaL_Reg #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ctype.h0000644000175000017500000004103513122010155016656 0ustar philphil/* ** C type management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CTYPE_H #define _LJ_CTYPE_H #include "lj_obj.h" #include "lj_gc.h" #if LJ_HASFFI /* -- C type definitions -------------------------------------------------- */ /* C type numbers. Highest 4 bits of C type info. ORDER CT. */ enum { /* Externally visible types. */ CT_NUM, /* Integer or floating-point numbers. */ CT_STRUCT, /* Struct or union. */ CT_PTR, /* Pointer or reference. */ CT_ARRAY, /* Array or complex type. */ CT_MAYCONVERT = CT_ARRAY, CT_VOID, /* Void type. */ CT_ENUM, /* Enumeration. */ CT_HASSIZE = CT_ENUM, /* Last type where ct->size holds the actual size. */ CT_FUNC, /* Function. */ CT_TYPEDEF, /* Typedef. */ CT_ATTRIB, /* Miscellaneous attributes. */ /* Internal element types. */ CT_FIELD, /* Struct/union field or function parameter. */ CT_BITFIELD, /* Struct/union bitfield. */ CT_CONSTVAL, /* Constant value. */ CT_EXTERN, /* External reference. */ CT_KW /* Keyword. */ }; LJ_STATIC_ASSERT(((int)CT_PTR & (int)CT_ARRAY) == CT_PTR); LJ_STATIC_ASSERT(((int)CT_STRUCT & (int)CT_ARRAY) == CT_STRUCT); /* ** ---------- info ------------ ** |type flags... A cid | size | sib | next | name | ** +----------------------------+--------+-------+-------+-------+-- ** |NUM BFcvUL.. A | size | | type | | ** |STRUCT ..cvU..V A | size | field | name? | name? | ** |PTR ..cvR... A cid | size | | type | | ** |ARRAY VCcv...V A cid | size | | type | | ** |VOID ..cv.... A | size | | type | | ** |ENUM A cid | size | const | name? | name? | ** |FUNC ....VS.. cc cid | nargs | field | name? | name? | ** |TYPEDEF cid | | | name | name | ** |ATTRIB attrnum cid | attr | sib? | type? | | ** |FIELD cid | offset | field | | name? | ** |BITFIELD B.cvU csz bsz pos | offset | field | | name? | ** |CONSTVAL c cid | value | const | name | name | ** |EXTERN cid | | sib? | name | name | ** |KW tok | size | | name | name | ** +----------------------------+--------+-------+-------+-------+-- ** ^^ ^^--- bits used for C type conversion dispatch */ /* C type info flags. TFFArrrr */ #define CTF_BOOL 0x08000000u /* Boolean: NUM, BITFIELD. */ #define CTF_FP 0x04000000u /* Floating-point: NUM. */ #define CTF_CONST 0x02000000u /* Const qualifier. */ #define CTF_VOLATILE 0x01000000u /* Volatile qualifier. */ #define CTF_UNSIGNED 0x00800000u /* Unsigned: NUM, BITFIELD. */ #define CTF_LONG 0x00400000u /* Long: NUM. */ #define CTF_VLA 0x00100000u /* Variable-length: ARRAY, STRUCT. */ #define CTF_REF 0x00800000u /* Reference: PTR. */ #define CTF_VECTOR 0x08000000u /* Vector: ARRAY. */ #define CTF_COMPLEX 0x04000000u /* Complex: ARRAY. */ #define CTF_UNION 0x00800000u /* Union: STRUCT. */ #define CTF_VARARG 0x00800000u /* Vararg: FUNC. */ #define CTF_SSEREGPARM 0x00400000u /* SSE register parameters: FUNC. */ #define CTF_QUAL (CTF_CONST|CTF_VOLATILE) #define CTF_ALIGN (CTMASK_ALIGN< 0 ? CTF_UNSIGNED : 0) /* Flags used in parser. .F.Ammvf cp->attr */ #define CTFP_ALIGNED 0x00000001u /* cp->attr + ALIGN */ #define CTFP_PACKED 0x00000002u /* cp->attr */ /* ...C...f cp->fattr */ #define CTFP_CCONV 0x00000001u /* cp->fattr + CCONV/[SSE]REGPARM */ /* C type info bitfields. */ #define CTMASK_CID 0x0000ffffu /* Max. 65536 type IDs. */ #define CTMASK_NUM 0xf0000000u /* Max. 16 type numbers. */ #define CTSHIFT_NUM 28 #define CTMASK_ALIGN 15 /* Max. alignment is 2^15. */ #define CTSHIFT_ALIGN 16 #define CTMASK_ATTRIB 255 /* Max. 256 attributes. */ #define CTSHIFT_ATTRIB 16 #define CTMASK_CCONV 3 /* Max. 4 calling conventions. */ #define CTSHIFT_CCONV 16 #define CTMASK_REGPARM 3 /* Max. 0-3 regparms. */ #define CTSHIFT_REGPARM 18 /* Bitfields only used in parser. */ #define CTMASK_VSIZEP 15 /* Max. vector size is 2^15. */ #define CTSHIFT_VSIZEP 4 #define CTMASK_MSIZEP 255 /* Max. type size (via mode) is 128. */ #define CTSHIFT_MSIZEP 8 /* Info bits for BITFIELD. Max. size of bitfield is 64 bits. */ #define CTBSZ_MAX 32 /* Max. size of bitfield is 32 bit. */ #define CTBSZ_FIELD 127 /* Temp. marker for regular field. */ #define CTMASK_BITPOS 127 #define CTMASK_BITBSZ 127 #define CTMASK_BITCSZ 127 #define CTSHIFT_BITPOS 0 #define CTSHIFT_BITBSZ 8 #define CTSHIFT_BITCSZ 16 #define CTF_INSERT(info, field, val) \ info = (info & ~(CTMASK_##field<> CTSHIFT_NUM) #define ctype_cid(info) ((CTypeID)((info) & CTMASK_CID)) #define ctype_align(info) (((info) >> CTSHIFT_ALIGN) & CTMASK_ALIGN) #define ctype_attrib(info) (((info) >> CTSHIFT_ATTRIB) & CTMASK_ATTRIB) #define ctype_bitpos(info) (((info) >> CTSHIFT_BITPOS) & CTMASK_BITPOS) #define ctype_bitbsz(info) (((info) >> CTSHIFT_BITBSZ) & CTMASK_BITBSZ) #define ctype_bitcsz(info) (((info) >> CTSHIFT_BITCSZ) & CTMASK_BITCSZ) #define ctype_vsizeP(info) (((info) >> CTSHIFT_VSIZEP) & CTMASK_VSIZEP) #define ctype_msizeP(info) (((info) >> CTSHIFT_MSIZEP) & CTMASK_MSIZEP) #define ctype_cconv(info) (((info) >> CTSHIFT_CCONV) & CTMASK_CCONV) /* Simple type checks. */ #define ctype_isnum(info) (ctype_type((info)) == CT_NUM) #define ctype_isvoid(info) (ctype_type((info)) == CT_VOID) #define ctype_isptr(info) (ctype_type((info)) == CT_PTR) #define ctype_isarray(info) (ctype_type((info)) == CT_ARRAY) #define ctype_isstruct(info) (ctype_type((info)) == CT_STRUCT) #define ctype_isfunc(info) (ctype_type((info)) == CT_FUNC) #define ctype_isenum(info) (ctype_type((info)) == CT_ENUM) #define ctype_istypedef(info) (ctype_type((info)) == CT_TYPEDEF) #define ctype_isattrib(info) (ctype_type((info)) == CT_ATTRIB) #define ctype_isfield(info) (ctype_type((info)) == CT_FIELD) #define ctype_isbitfield(info) (ctype_type((info)) == CT_BITFIELD) #define ctype_isconstval(info) (ctype_type((info)) == CT_CONSTVAL) #define ctype_isextern(info) (ctype_type((info)) == CT_EXTERN) #define ctype_hassize(info) (ctype_type((info)) <= CT_HASSIZE) /* Combined type and flag checks. */ #define ctype_isinteger(info) \ (((info) & (CTMASK_NUM|CTF_BOOL|CTF_FP)) == CTINFO(CT_NUM, 0)) #define ctype_isinteger_or_bool(info) \ (((info) & (CTMASK_NUM|CTF_FP)) == CTINFO(CT_NUM, 0)) #define ctype_isbool(info) \ (((info) & (CTMASK_NUM|CTF_BOOL)) == CTINFO(CT_NUM, CTF_BOOL)) #define ctype_isfp(info) \ (((info) & (CTMASK_NUM|CTF_FP)) == CTINFO(CT_NUM, CTF_FP)) #define ctype_ispointer(info) \ ((ctype_type(info) >> 1) == (CT_PTR >> 1)) /* Pointer or array. */ #define ctype_isref(info) \ (((info) & (CTMASK_NUM|CTF_REF)) == CTINFO(CT_PTR, CTF_REF)) #define ctype_isrefarray(info) \ (((info) & (CTMASK_NUM|CTF_VECTOR|CTF_COMPLEX)) == CTINFO(CT_ARRAY, 0)) #define ctype_isvector(info) \ (((info) & (CTMASK_NUM|CTF_VECTOR)) == CTINFO(CT_ARRAY, CTF_VECTOR)) #define ctype_iscomplex(info) \ (((info) & (CTMASK_NUM|CTF_COMPLEX)) == CTINFO(CT_ARRAY, CTF_COMPLEX)) #define ctype_isvltype(info) \ (((info) & ((CTMASK_NUM|CTF_VLA) - (2u<") _(STRING, "") \ _(INTEGER, "") _(EOF, "") \ _(OROR, "||") _(ANDAND, "&&") _(EQ, "==") _(NE, "!=") \ _(LE, "<=") _(GE, ">=") _(SHL, "<<") _(SHR, ">>") _(DEREF, "->") /* Simple declaration specifiers. */ #define CDSDEF(_) \ _(VOID) _(BOOL) _(CHAR) _(INT) _(FP) \ _(LONG) _(LONGLONG) _(SHORT) _(COMPLEX) _(SIGNED) _(UNSIGNED) \ _(CONST) _(VOLATILE) _(RESTRICT) _(INLINE) \ _(TYPEDEF) _(EXTERN) _(STATIC) _(AUTO) _(REGISTER) /* C keywords. */ #define CKWDEF(_) \ CDSDEF(_) _(EXTENSION) _(ASM) _(ATTRIBUTE) \ _(DECLSPEC) _(CCDECL) _(PTRSZ) \ _(STRUCT) _(UNION) _(ENUM) \ _(SIZEOF) _(ALIGNOF) /* C token numbers. */ enum { CTOK_OFS = 255, #define CTOKNUM(name, sym) CTOK_##name, #define CKWNUM(name) CTOK_##name, CTOKDEF(CTOKNUM) CKWDEF(CKWNUM) #undef CTOKNUM #undef CKWNUM CTOK_FIRSTDECL = CTOK_VOID, CTOK_FIRSTSCL = CTOK_TYPEDEF, CTOK_LASTDECLFLAG = CTOK_REGISTER, CTOK_LASTDECL = CTOK_ENUM }; /* Declaration specifier flags. */ enum { #define CDSFLAG(name) CDF_##name = (1u << (CTOK_##name - CTOK_FIRSTDECL)), CDSDEF(CDSFLAG) #undef CDSFLAG CDF__END }; #define CDF_SCL (CDF_TYPEDEF|CDF_EXTERN|CDF_STATIC|CDF_AUTO|CDF_REGISTER) /* -- C type management --------------------------------------------------- */ #define ctype_ctsG(g) (mref((g)->ctype_state, CTState)) /* Get C type state. */ static LJ_AINLINE CTState *ctype_cts(lua_State *L) { CTState *cts = ctype_ctsG(G(L)); cts->L = L; /* Save L for errors and allocations. */ return cts; } /* Save and restore state of C type table. */ #define LJ_CTYPE_SAVE(cts) CTState savects_ = *(cts) #define LJ_CTYPE_RESTORE(cts) \ ((cts)->top = savects_.top, \ memcpy((cts)->hash, savects_.hash, sizeof(savects_.hash))) /* Check C type ID for validity when assertions are enabled. */ static LJ_AINLINE CTypeID ctype_check(CTState *cts, CTypeID id) { lua_assert(id > 0 && id < cts->top); UNUSED(cts); return id; } /* Get C type for C type ID. */ static LJ_AINLINE CType *ctype_get(CTState *cts, CTypeID id) { return &cts->tab[ctype_check(cts, id)]; } /* Get C type ID for a C type. */ #define ctype_typeid(cts, ct) ((CTypeID)((ct) - (cts)->tab)) /* Get child C type. */ static LJ_AINLINE CType *ctype_child(CTState *cts, CType *ct) { lua_assert(!(ctype_isvoid(ct->info) || ctype_isstruct(ct->info) || ctype_isbitfield(ct->info))); /* These don't have children. */ return ctype_get(cts, ctype_cid(ct->info)); } /* Get raw type for a C type ID. */ static LJ_AINLINE CType *ctype_raw(CTState *cts, CTypeID id) { CType *ct = ctype_get(cts, id); while (ctype_isattrib(ct->info)) ct = ctype_child(cts, ct); return ct; } /* Get raw type of the child of a C type. */ static LJ_AINLINE CType *ctype_rawchild(CTState *cts, CType *ct) { do { ct = ctype_child(cts, ct); } while (ctype_isattrib(ct->info)); return ct; } /* Set the name of a C type table element. */ static LJ_AINLINE void ctype_setname(CType *ct, GCstr *s) { /* NOBARRIER: mark string as fixed -- the C type table is never collected. */ fixstring(s); setgcref(ct->name, obj2gco(s)); } LJ_FUNC CTypeID lj_ctype_new(CTState *cts, CType **ctp); LJ_FUNC CTypeID lj_ctype_intern(CTState *cts, CTInfo info, CTSize size); LJ_FUNC void lj_ctype_addname(CTState *cts, CType *ct, CTypeID id); LJ_FUNC CTypeID lj_ctype_getname(CTState *cts, CType **ctp, GCstr *name, uint32_t tmask); LJ_FUNC CType *lj_ctype_getfieldq(CTState *cts, CType *ct, GCstr *name, CTSize *ofs, CTInfo *qual); #define lj_ctype_getfield(cts, ct, name, ofs) \ lj_ctype_getfieldq((cts), (ct), (name), (ofs), NULL) LJ_FUNC CType *lj_ctype_rawref(CTState *cts, CTypeID id); LJ_FUNC CTSize lj_ctype_size(CTState *cts, CTypeID id); LJ_FUNC CTSize lj_ctype_vlsize(CTState *cts, CType *ct, CTSize nelem); LJ_FUNC CTInfo lj_ctype_info(CTState *cts, CTypeID id, CTSize *szp); LJ_FUNC cTValue *lj_ctype_meta(CTState *cts, CTypeID id, MMS mm); LJ_FUNC GCstr *lj_ctype_repr(lua_State *L, CTypeID id, GCstr *name); LJ_FUNC GCstr *lj_ctype_repr_int64(lua_State *L, uint64_t n, int isunsigned); LJ_FUNC GCstr *lj_ctype_repr_complex(lua_State *L, void *sp, CTSize size); LJ_FUNC CTState *lj_ctype_init(lua_State *L); LJ_FUNC void lj_ctype_freestate(global_State *g); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_tab.h0000644000175000017500000000450213122010155016276 0ustar philphil/* ** Table handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_TAB_H #define _LJ_TAB_H #include "lj_obj.h" /* Hash constants. Tuned using a brute force search. */ #define HASH_BIAS (-0x04c11db7) #define HASH_ROT1 14 #define HASH_ROT2 5 #define HASH_ROT3 13 /* Scramble the bits of numbers and pointers. */ static LJ_AINLINE uint32_t hashrot(uint32_t lo, uint32_t hi) { #if LJ_TARGET_X86ORX64 /* Prefer variant that compiles well for a 2-operand CPU. */ lo ^= hi; hi = lj_rol(hi, HASH_ROT1); lo -= hi; hi = lj_rol(hi, HASH_ROT2); hi ^= lo; hi -= lj_rol(lo, HASH_ROT3); #else lo ^= hi; lo = lo - lj_rol(hi, HASH_ROT1); hi = lo ^ lj_rol(hi, HASH_ROT1 + HASH_ROT2); hi = hi - lj_rol(lo, HASH_ROT3); #endif return hi; } #define hsize2hbits(s) ((s) ? ((s)==1 ? 1 : 1+lj_fls((uint32_t)((s)-1))) : 0) LJ_FUNCA GCtab *lj_tab_new(lua_State *L, uint32_t asize, uint32_t hbits); #if LJ_HASJIT LJ_FUNC GCtab * LJ_FASTCALL lj_tab_new1(lua_State *L, uint32_t ahsize); #endif LJ_FUNCA GCtab * LJ_FASTCALL lj_tab_dup(lua_State *L, const GCtab *kt); LJ_FUNC void LJ_FASTCALL lj_tab_free(global_State *g, GCtab *t); #if LJ_HASFFI LJ_FUNC void lj_tab_rehash(lua_State *L, GCtab *t); #endif LJ_FUNCA void lj_tab_reasize(lua_State *L, GCtab *t, uint32_t nasize); /* Caveat: all getters except lj_tab_get() can return NULL! */ LJ_FUNCA cTValue * LJ_FASTCALL lj_tab_getinth(GCtab *t, int32_t key); LJ_FUNC cTValue *lj_tab_getstr(GCtab *t, GCstr *key); LJ_FUNCA cTValue *lj_tab_get(lua_State *L, GCtab *t, cTValue *key); /* Caveat: all setters require a write barrier for the stored value. */ LJ_FUNCA TValue *lj_tab_newkey(lua_State *L, GCtab *t, cTValue *key); LJ_FUNC TValue *lj_tab_setinth(lua_State *L, GCtab *t, int32_t key); LJ_FUNC TValue *lj_tab_setstr(lua_State *L, GCtab *t, GCstr *key); LJ_FUNC TValue *lj_tab_set(lua_State *L, GCtab *t, cTValue *key); #define inarray(t, key) ((MSize)(key) < (MSize)(t)->asize) #define arrayslot(t, i) (&tvref((t)->array)[(i)]) #define lj_tab_getint(t, key) \ (inarray((t), (key)) ? arrayslot((t), (key)) : lj_tab_getinth((t), (key))) #define lj_tab_setint(L, t, key) \ (inarray((t), (key)) ? arrayslot((t), (key)) : lj_tab_setinth(L, (t), (key))) LJ_FUNCA int lj_tab_next(lua_State *L, GCtab *t, TValue *key); LJ_FUNCA MSize LJ_FASTCALL lj_tab_len(GCtab *t); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_debug.c0000644000175000017500000004103313122010155016611 0ustar philphil/* ** Debugging and introspection. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_debug_c #define LUA_CORE #include "lj_obj.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_state.h" #include "lj_frame.h" #include "lj_bc.h" #include "lj_vm.h" #if LJ_HASJIT #include "lj_jit.h" #endif /* -- Frames -------------------------------------------------------------- */ /* Get frame corresponding to a level. */ cTValue *lj_debug_frame(lua_State *L, int level, int *size) { cTValue *frame, *nextframe, *bot = tvref(L->stack); /* Traverse frames backwards. */ for (nextframe = frame = L->base-1; frame > bot; ) { if (frame_gc(frame) == obj2gco(L)) level++; /* Skip dummy frames. See lj_meta_call(). */ if (level-- == 0) { *size = (int)(nextframe - frame); return frame; /* Level found. */ } nextframe = frame; if (frame_islua(frame)) { frame = frame_prevl(frame); } else { if (frame_isvarg(frame)) level++; /* Skip vararg pseudo-frame. */ frame = frame_prevd(frame); } } *size = level; return NULL; /* Level not found. */ } /* Invalid bytecode position. */ #define NO_BCPOS (~(BCPos)0) /* Return bytecode position for function/frame or NO_BCPOS. */ static BCPos debug_framepc(lua_State *L, GCfunc *fn, cTValue *nextframe) { const BCIns *ins; GCproto *pt; BCPos pos; lua_assert(fn->c.gct == ~LJ_TFUNC || fn->c.gct == ~LJ_TTHREAD); if (!isluafunc(fn)) { /* Cannot derive a PC for non-Lua functions. */ return NO_BCPOS; } else if (nextframe == NULL) { /* Lua function on top. */ void *cf = cframe_raw(L->cframe); if (cf == NULL || (char *)cframe_pc(cf) == (char *)cframe_L(cf)) return NO_BCPOS; ins = cframe_pc(cf); /* Only happens during error/hook handling. */ } else { if (frame_islua(nextframe)) { ins = frame_pc(nextframe); } else if (frame_iscont(nextframe)) { ins = frame_contpc(nextframe); } else { /* Lua function below errfunc/gc/hook: find cframe to get the PC. */ void *cf = cframe_raw(L->cframe); TValue *f = L->base-1; for (;;) { if (cf == NULL) return NO_BCPOS; while (cframe_nres(cf) < 0) { if (f >= restorestack(L, -cframe_nres(cf))) break; cf = cframe_raw(cframe_prev(cf)); if (cf == NULL) return NO_BCPOS; } if (f < nextframe) break; if (frame_islua(f)) { f = frame_prevl(f); } else { if (frame_isc(f) || (LJ_HASFFI && frame_iscont(f) && (f-1)->u32.lo == LJ_CONT_FFI_CALLBACK)) cf = cframe_raw(cframe_prev(cf)); f = frame_prevd(f); } } ins = cframe_pc(cf); } } pt = funcproto(fn); pos = proto_bcpos(pt, ins) - 1; #if LJ_HASJIT if (pos > pt->sizebc) { /* Undo the effects of lj_trace_exit for JLOOP. */ GCtrace *T = (GCtrace *)((char *)(ins-1) - offsetof(GCtrace, startins)); lua_assert(bc_isret(bc_op(ins[-1]))); pos = proto_bcpos(pt, mref(T->startpc, const BCIns)); } #endif return pos; } /* -- Line numbers -------------------------------------------------------- */ /* Get line number for a bytecode position. */ BCLine LJ_FASTCALL lj_debug_line(GCproto *pt, BCPos pc) { const void *lineinfo = proto_lineinfo(pt); if (pc <= pt->sizebc && lineinfo) { BCLine first = pt->firstline; if (pc == pt->sizebc) return first + pt->numline; if (pc-- == 0) return first; if (pt->numline < 256) return first + (BCLine)((const uint8_t *)lineinfo)[pc]; else if (pt->numline < 65536) return first + (BCLine)((const uint16_t *)lineinfo)[pc]; else return first + (BCLine)((const uint32_t *)lineinfo)[pc]; } return 0; } /* Get line number for function/frame. */ static BCLine debug_frameline(lua_State *L, GCfunc *fn, cTValue *nextframe) { BCPos pc = debug_framepc(L, fn, nextframe); if (pc != NO_BCPOS) { GCproto *pt = funcproto(fn); lua_assert(pc <= pt->sizebc); return lj_debug_line(pt, pc); } return -1; } /* -- Variable names ------------------------------------------------------ */ /* Read ULEB128 value. */ static uint32_t debug_read_uleb128(const uint8_t **pp) { const uint8_t *p = *pp; uint32_t v = *p++; if (LJ_UNLIKELY(v >= 0x80)) { int sh = 0; v &= 0x7f; do { v |= ((*p & 0x7f) << (sh += 7)); } while (*p++ >= 0x80); } *pp = p; return v; } /* Get name of a local variable from slot number and PC. */ static const char *debug_varname(const GCproto *pt, BCPos pc, BCReg slot) { const uint8_t *p = proto_varinfo(pt); if (p) { BCPos lastpc = 0; for (;;) { const char *name = (const char *)p; uint32_t vn = *p++; BCPos startpc, endpc; if (vn < VARNAME__MAX) { if (vn == VARNAME_END) break; /* End of varinfo. */ } else { while (*p++) ; /* Skip over variable name string. */ } lastpc = startpc = lastpc + debug_read_uleb128(&p); if (startpc > pc) break; endpc = startpc + debug_read_uleb128(&p); if (pc < endpc && slot-- == 0) { if (vn < VARNAME__MAX) { #define VARNAMESTR(name, str) str "\0" name = VARNAMEDEF(VARNAMESTR); #undef VARNAMESTR if (--vn) while (*name++ || --vn) ; } return name; } } } return NULL; } /* Get name of local variable from 1-based slot number and function/frame. */ static TValue *debug_localname(lua_State *L, const lua_Debug *ar, const char **name, BCReg slot1) { uint32_t offset = (uint32_t)ar->i_ci & 0xffff; uint32_t size = (uint32_t)ar->i_ci >> 16; TValue *frame = tvref(L->stack) + offset; TValue *nextframe = size ? frame + size : NULL; GCfunc *fn = frame_func(frame); BCPos pc = debug_framepc(L, fn, nextframe); if (!nextframe) nextframe = L->top; if ((int)slot1 < 0) { /* Negative slot number is for varargs. */ if (pc != NO_BCPOS) { GCproto *pt = funcproto(fn); if ((pt->flags & PROTO_VARARG)) { slot1 = pt->numparams + (BCReg)(-(int)slot1); if (frame_isvarg(frame)) { /* Vararg frame has been set up? (pc!=0) */ nextframe = frame; frame = frame_prevd(frame); } if (frame + slot1 < nextframe) { *name = "(*vararg)"; return frame+slot1; } } } return NULL; } if (pc != NO_BCPOS && (*name = debug_varname(funcproto(fn), pc, slot1-1)) != NULL) ; else if (slot1 > 0 && frame + slot1 < nextframe) *name = "(*temporary)"; return frame+slot1; } /* Get name of upvalue. */ const char *lj_debug_uvname(GCproto *pt, uint32_t idx) { const uint8_t *p = proto_uvinfo(pt); lua_assert(idx < pt->sizeuv); if (!p) return ""; if (idx) while (*p++ || --idx) ; return (const char *)p; } /* Get name and value of upvalue. */ const char *lj_debug_uvnamev(cTValue *o, uint32_t idx, TValue **tvp) { if (tvisfunc(o)) { GCfunc *fn = funcV(o); if (isluafunc(fn)) { GCproto *pt = funcproto(fn); if (idx < pt->sizeuv) { *tvp = uvval(&gcref(fn->l.uvptr[idx])->uv); return lj_debug_uvname(pt, idx); } } else { if (idx < fn->c.nupvalues) { *tvp = &fn->c.upvalue[idx]; return ""; } } } return NULL; } /* Deduce name of an object from slot number and PC. */ const char *lj_debug_slotname(GCproto *pt, const BCIns *ip, BCReg slot, const char **name) { const char *lname; restart: lname = debug_varname(pt, proto_bcpos(pt, ip), slot); if (lname != NULL) { *name = lname; return "local"; } while (--ip > proto_bc(pt)) { BCIns ins = *ip; BCOp op = bc_op(ins); BCReg ra = bc_a(ins); if (bcmode_a(op) == BCMbase) { if (slot >= ra && (op != BC_KNIL || slot <= bc_d(ins))) return NULL; } else if (bcmode_a(op) == BCMdst && ra == slot) { switch (bc_op(ins)) { case BC_MOV: if (ra == slot) { slot = bc_d(ins); goto restart; } break; case BC_GGET: *name = strdata(gco2str(proto_kgc(pt, ~(ptrdiff_t)bc_d(ins)))); return "global"; case BC_TGETS: *name = strdata(gco2str(proto_kgc(pt, ~(ptrdiff_t)bc_c(ins)))); if (ip > proto_bc(pt)) { BCIns insp = ip[-1]; if (bc_op(insp) == BC_MOV && bc_a(insp) == ra+1 && bc_d(insp) == bc_b(ins)) return "method"; } return "field"; case BC_UGET: *name = lj_debug_uvname(pt, bc_d(ins)); return "upvalue"; default: return NULL; } } } return NULL; } /* Deduce function name from caller of a frame. */ const char *lj_debug_funcname(lua_State *L, TValue *frame, const char **name) { TValue *pframe; GCfunc *fn; BCPos pc; if (frame <= tvref(L->stack)) return NULL; if (frame_isvarg(frame)) frame = frame_prevd(frame); pframe = frame_prev(frame); fn = frame_func(pframe); pc = debug_framepc(L, fn, frame); if (pc != NO_BCPOS) { GCproto *pt = funcproto(fn); const BCIns *ip = &proto_bc(pt)[check_exp(pc < pt->sizebc, pc)]; MMS mm = bcmode_mm(bc_op(*ip)); if (mm == MM_call) { BCReg slot = bc_a(*ip); if (bc_op(*ip) == BC_ITERC) slot -= 3; return lj_debug_slotname(pt, ip, slot, name); } else if (mm != MM__MAX) { *name = strdata(mmname_str(G(L), mm)); return "metamethod"; } } return NULL; } /* -- Source code locations ----------------------------------------------- */ /* Generate shortened source name. */ void lj_debug_shortname(char *out, GCstr *str) { const char *src = strdata(str); if (*src == '=') { strncpy(out, src+1, LUA_IDSIZE); /* Remove first char. */ out[LUA_IDSIZE-1] = '\0'; /* Ensures null termination. */ } else if (*src == '@') { /* Output "source", or "...source". */ size_t len = str->len-1; src++; /* Skip the `@' */ if (len >= LUA_IDSIZE) { src += len-(LUA_IDSIZE-4); /* Get last part of file name. */ *out++ = '.'; *out++ = '.'; *out++ = '.'; } strcpy(out, src); } else { /* Output [string "string"]. */ size_t len; /* Length, up to first control char. */ for (len = 0; len < LUA_IDSIZE-12; len++) if (((const unsigned char *)src)[len] < ' ') break; strcpy(out, "[string \""); out += 9; if (src[len] != '\0') { /* Must truncate? */ if (len > LUA_IDSIZE-15) len = LUA_IDSIZE-15; strncpy(out, src, len); out += len; strcpy(out, "..."); out += 3; } else { strcpy(out, src); out += len; } strcpy(out, "\"]"); } } /* Add current location of a frame to error message. */ void lj_debug_addloc(lua_State *L, const char *msg, cTValue *frame, cTValue *nextframe) { if (frame) { GCfunc *fn = frame_func(frame); if (isluafunc(fn)) { BCLine line = debug_frameline(L, fn, nextframe); if (line >= 0) { char buf[LUA_IDSIZE]; lj_debug_shortname(buf, proto_chunkname(funcproto(fn))); lj_str_pushf(L, "%s:%d: %s", buf, line, msg); return; } } } lj_str_pushf(L, "%s", msg); } /* Push location string for a bytecode position to Lua stack. */ void lj_debug_pushloc(lua_State *L, GCproto *pt, BCPos pc) { GCstr *name = proto_chunkname(pt); const char *s = strdata(name); MSize i, len = name->len; BCLine line = lj_debug_line(pt, pc); if (*s == '@') { s++; len--; for (i = len; i > 0; i--) if (s[i] == '/' || s[i] == '\\') { s += i+1; break; } lj_str_pushf(L, "%s:%d", s, line); } else if (len > 40) { lj_str_pushf(L, "%p:%d", pt, line); } else if (*s == '=') { lj_str_pushf(L, "%s:%d", s+1, line); } else { lj_str_pushf(L, "\"%s\":%d", s, line); } } /* -- Public debug API ---------------------------------------------------- */ /* lua_getupvalue() and lua_setupvalue() are in lj_api.c. */ LUA_API const char *lua_getlocal(lua_State *L, const lua_Debug *ar, int n) { const char *name = NULL; if (ar) { TValue *o = debug_localname(L, ar, &name, (BCReg)n); if (name) { copyTV(L, L->top, o); incr_top(L); } } else if (tvisfunc(L->top-1) && isluafunc(funcV(L->top-1))) { name = debug_varname(funcproto(funcV(L->top-1)), 0, (BCReg)n-1); } return name; } LUA_API const char *lua_setlocal(lua_State *L, const lua_Debug *ar, int n) { const char *name = NULL; TValue *o = debug_localname(L, ar, &name, (BCReg)n); if (name) copyTV(L, o, L->top-1); L->top--; return name; } int lj_debug_getinfo(lua_State *L, const char *what, lj_Debug *ar, int ext) { int opt_f = 0, opt_L = 0; TValue *frame = NULL; TValue *nextframe = NULL; GCfunc *fn; if (*what == '>') { TValue *func = L->top - 1; api_check(L, tvisfunc(func)); fn = funcV(func); L->top--; what++; } else { uint32_t offset = (uint32_t)ar->i_ci & 0xffff; uint32_t size = (uint32_t)ar->i_ci >> 16; lua_assert(offset != 0); frame = tvref(L->stack) + offset; if (size) nextframe = frame + size; lua_assert(frame <= tvref(L->maxstack) && (!nextframe || nextframe <= tvref(L->maxstack))); fn = frame_func(frame); lua_assert(fn->c.gct == ~LJ_TFUNC); } for (; *what; what++) { if (*what == 'S') { if (isluafunc(fn)) { GCproto *pt = funcproto(fn); BCLine firstline = pt->firstline; GCstr *name = proto_chunkname(pt); ar->source = strdata(name); lj_debug_shortname(ar->short_src, name); ar->linedefined = (int)firstline; ar->lastlinedefined = (int)(firstline + pt->numline); ar->what = (firstline || !pt->numline) ? "Lua" : "main"; } else { ar->source = "=[C]"; ar->short_src[0] = '['; ar->short_src[1] = 'C'; ar->short_src[2] = ']'; ar->short_src[3] = '\0'; ar->linedefined = -1; ar->lastlinedefined = -1; ar->what = "C"; } } else if (*what == 'l') { ar->currentline = frame ? debug_frameline(L, fn, nextframe) : -1; } else if (*what == 'u') { ar->nups = fn->c.nupvalues; if (ext) { if (isluafunc(fn)) { GCproto *pt = funcproto(fn); ar->nparams = pt->numparams; ar->isvararg = !!(pt->flags & PROTO_VARARG); } else { ar->nparams = 0; ar->isvararg = 1; } } } else if (*what == 'n') { ar->namewhat = frame ? lj_debug_funcname(L, frame, &ar->name) : NULL; if (ar->namewhat == NULL) { ar->namewhat = ""; ar->name = NULL; } } else if (*what == 'f') { opt_f = 1; } else if (*what == 'L') { opt_L = 1; } else { return 0; /* Bad option. */ } } if (opt_f) { setfuncV(L, L->top, fn); incr_top(L); } if (opt_L) { if (isluafunc(fn)) { GCtab *t = lj_tab_new(L, 0, 0); GCproto *pt = funcproto(fn); const void *lineinfo = proto_lineinfo(pt); if (lineinfo) { BCLine first = pt->firstline; int sz = pt->numline < 256 ? 1 : pt->numline < 65536 ? 2 : 4; MSize i, szl = pt->sizebc-1; for (i = 0; i < szl; i++) { BCLine line = first + (sz == 1 ? (BCLine)((const uint8_t *)lineinfo)[i] : sz == 2 ? (BCLine)((const uint16_t *)lineinfo)[i] : (BCLine)((const uint32_t *)lineinfo)[i]); setboolV(lj_tab_setint(L, t, line), 1); } } settabV(L, L->top, t); } else { setnilV(L->top); } incr_top(L); } return 1; /* Ok. */ } LUA_API int lua_getinfo(lua_State *L, const char *what, lua_Debug *ar) { return lj_debug_getinfo(L, what, (lj_Debug *)ar, 0); } LUA_API int lua_getstack(lua_State *L, int level, lua_Debug *ar) { int size; cTValue *frame = lj_debug_frame(L, level, &size); if (frame) { ar->i_ci = (size << 16) + (int)(frame - tvref(L->stack)); return 1; } else { ar->i_ci = level - size; return 0; } } /* Number of frames for the leading and trailing part of a traceback. */ #define TRACEBACK_LEVELS1 12 #define TRACEBACK_LEVELS2 10 LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1, const char *msg, int level) { int top = (int)(L->top - L->base); int lim = TRACEBACK_LEVELS1; lua_Debug ar; if (msg) lua_pushfstring(L, "%s\n", msg); lua_pushliteral(L, "stack traceback:"); while (lua_getstack(L1, level++, &ar)) { GCfunc *fn; if (level > lim) { if (!lua_getstack(L1, level + TRACEBACK_LEVELS2, &ar)) { level--; } else { lua_pushliteral(L, "\n\t..."); lua_getstack(L1, -10, &ar); level = ar.i_ci - TRACEBACK_LEVELS2; } lim = 2147483647; continue; } lua_getinfo(L1, "Snlf", &ar); fn = funcV(L1->top-1); L1->top--; if (isffunc(fn) && !*ar.namewhat) lua_pushfstring(L, "\n\t[builtin#%d]:", fn->c.ffid); else lua_pushfstring(L, "\n\t%s:", ar.short_src); if (ar.currentline > 0) lua_pushfstring(L, "%d:", ar.currentline); if (*ar.namewhat) { lua_pushfstring(L, " in function " LUA_QS, ar.name); } else { if (*ar.what == 'm') { lua_pushliteral(L, " in main chunk"); } else if (*ar.what == 'C') { lua_pushfstring(L, " at %p", fn->c.f); } else { lua_pushfstring(L, " in function <%s:%d>", ar.short_src, ar.linedefined); } } if ((int)(L->top - L->base) - top >= 15) lua_concat(L, (int)(L->top - L->base) - top); } lua_concat(L, (int)(L->top - L->base) - top); } wcc-0.0.2/src/wsh/luajit-2.0/src/Makefile0000644000175000017500000005316413122010155016342 0ustar philphil############################################################################## # LuaJIT Makefile. Requires GNU Make. # # Please read doc/install.html before changing any variables! # # Suitable for POSIX platforms (Linux, *BSD, OSX etc.). # Also works with MinGW and Cygwin on Windows. # Please check msvcbuild.bat for building with MSVC on Windows. # # Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ############################################################################## MAJVER= 2 MINVER= 0 RELVER= 4 ABIVER= 5.1 NODOTABIVER= 51 ############################################################################## ############################# COMPILER OPTIONS ############################# ############################################################################## # These options mainly affect the speed of the JIT compiler itself, not the # speed of the JIT-compiled code. Turn any of the optional settings on by # removing the '#' in front of them. Make sure you force a full recompile # with "make clean", followed by "make" if you change any options. # DEFAULT_CC = gcc # # LuaJIT builds as a native 32 or 64 bit binary by default. CC= $(DEFAULT_CC) # # Use this if you want to force a 32 bit build on a 64 bit multilib OS. #CC= $(DEFAULT_CC) -m32 # # Since the assembler part does NOT maintain a frame pointer, it's pointless # to slow down the C part by not omitting it. Debugging, tracebacks and # unwinding are not affected -- the assembler part has frame unwind # information and GCC emits it where needed (x64) or with -g (see CCDEBUG). CCOPT= -O2 -fomit-frame-pointer # Use this if you want to generate a smaller binary (but it's slower): #CCOPT= -Os -fomit-frame-pointer # Note: it's no longer recommended to use -O3 with GCC 4.x. # The I-Cache bloat usually outweighs the benefits from aggressive inlining. # # Target-specific compiler options: # # x86 only: it's recommended to compile at least for i686. Better yet, # compile for an architecture that has SSE2, too (-msse -msse2). # # x86/x64 only: For GCC 4.2 or higher and if you don't intend to distribute # the binaries to a different machine you could also use: -march=native # CCOPT_x86= -march=i686 CCOPT_x64= CCOPT_arm= CCOPT_ppc= CCOPT_ppcspe= CCOPT_mips= # CCDEBUG= # Uncomment the next line to generate debug information: #CCDEBUG= -g # CCWARN= -Wall # Uncomment the next line to enable more warnings: #CCWARN+= -Wextra -Wdeclaration-after-statement -Wredundant-decls -Wshadow -Wpointer-arith # ############################################################################## ############################################################################## ################################ BUILD MODE ################################ ############################################################################## # The default build mode is mixed mode on POSIX. On Windows this is the same # as dynamic mode. # # Mixed mode creates a static + dynamic library and a statically linked luajit. BUILDMODE= mixed # # Static mode creates a static library and a statically linked luajit. #BUILDMODE= static # # Dynamic mode creates a dynamic library and a dynamically linked luajit. # Note: this executable will only run when the library is installed! #BUILDMODE= dynamic # ############################################################################## ############################################################################## ################################# FEATURES ################################# ############################################################################## # Enable/disable these features as needed, but make sure you force a full # recompile with "make clean", followed by "make". XCFLAGS= # # Permanently disable the FFI extension to reduce the size of the LuaJIT # executable. But please consider that the FFI library is compiled-in, # but NOT loaded by default. It only allocates any memory, if you actually # make use of it. #XCFLAGS+= -DLUAJIT_DISABLE_FFI # # Features from Lua 5.2 that are unlikely to break existing code are # enabled by default. Some other features that *might* break some existing # code (e.g. __pairs or os.execute() return values) can be enabled here. # Note: this does not provide full compatibility with Lua 5.2 at this time. #XCFLAGS+= -DLUAJIT_ENABLE_LUA52COMPAT # # Disable the JIT compiler, i.e. turn LuaJIT into a pure interpreter. #XCFLAGS+= -DLUAJIT_DISABLE_JIT # # Some architectures (e.g. PPC) can use either single-number (1) or # dual-number (2) mode. Uncomment one of these lines to override the # default mode. Please see LJ_ARCH_NUMMODE in lj_arch.h for details. #XCFLAGS+= -DLUAJIT_NUMMODE=1 #XCFLAGS+= -DLUAJIT_NUMMODE=2 # ############################################################################## ############################################################################## ############################ DEBUGGING SUPPORT ############################# ############################################################################## # Enable these options as needed, but make sure you force a full recompile # with "make clean", followed by "make". # Note that most of these are NOT suitable for benchmarking or release mode! # # Use the system provided memory allocator (realloc) instead of the # bundled memory allocator. This is slower, but sometimes helpful for # debugging. This option cannot be enabled on x64, since realloc usually # doesn't return addresses in the right address range. # OTOH this option is mandatory for Valgrind's memcheck tool on x64 and # the only way to get useful results from it for all other architectures. #XCFLAGS+= -DLUAJIT_USE_SYSMALLOC # # This define is required to run LuaJIT under Valgrind. The Valgrind # header files must be installed. You should enable debug information, too. # Use --suppressions=lj.supp to avoid some false positives. #XCFLAGS+= -DLUAJIT_USE_VALGRIND # # This is the client for the GDB JIT API. GDB 7.0 or higher is required # to make use of it. See lj_gdbjit.c for details. Enabling this causes # a non-negligible overhead, even when not running under GDB. #XCFLAGS+= -DLUAJIT_USE_GDBJIT # # Turn on assertions for the Lua/C API to debug problems with lua_* calls. # This is rather slow -- use only while developing C libraries/embeddings. #XCFLAGS+= -DLUA_USE_APICHECK # # Turn on assertions for the whole LuaJIT VM. This significantly slows down # everything. Use only if you suspect a problem with LuaJIT itself. #XCFLAGS+= -DLUA_USE_ASSERT # ############################################################################## # You probably don't need to change anything below this line! ############################################################################## ############################################################################## # Host system detection. ############################################################################## ifeq (Windows,$(findstring Windows,$(OS))$(MSYSTEM)$(TERM)) HOST_SYS= Windows HOST_RM= del else HOST_SYS:= $(shell uname -s) ifneq (,$(findstring MINGW,$(HOST_SYS))) HOST_SYS= Windows HOST_MSYS= mingw endif ifneq (,$(findstring CYGWIN,$(HOST_SYS))) HOST_SYS= Windows HOST_MSYS= cygwin endif endif ############################################################################## # Flags and options for host and target. ############################################################################## # You can override the following variables at the make command line: # CC HOST_CC STATIC_CC DYNAMIC_CC # CFLAGS HOST_CFLAGS TARGET_CFLAGS # LDFLAGS HOST_LDFLAGS TARGET_LDFLAGS TARGET_SHLDFLAGS # LIBS HOST_LIBS TARGET_LIBS # CROSS HOST_SYS TARGET_SYS TARGET_FLAGS # # Cross-compilation examples: # make HOST_CC="gcc -m32" CROSS=i586-mingw32msvc- TARGET_SYS=Windows # make HOST_CC="gcc -m32" CROSS=powerpc-linux-gnu- CCOPTIONS= $(CCDEBUG) $(CCOPT) $(CCWARN) $(XCFLAGS) $(CFLAGS) LDOPTIONS= $(CCDEBUG) $(LDFLAGS) HOST_CC= $(CC) HOST_RM= rm -f # If left blank, minilua is built and used. You can supply an installed # copy of (plain) Lua 5.1 or 5.2, plus Lua BitOp. E.g. with: HOST_LUA=lua HOST_LUA= HOST_XCFLAGS= -I. HOST_XLDFLAGS= HOST_XLIBS= HOST_ACFLAGS= $(CCOPTIONS) $(HOST_XCFLAGS) $(TARGET_ARCH) $(HOST_CFLAGS) HOST_ALDFLAGS= $(LDOPTIONS) $(HOST_XLDFLAGS) $(HOST_LDFLAGS) HOST_ALIBS= $(HOST_XLIBS) $(LIBS) $(HOST_LIBS) STATIC_CC = $(CROSS)$(CC) DYNAMIC_CC = $(CROSS)$(CC) -fPIC TARGET_CC= $(STATIC_CC) TARGET_STCC= $(STATIC_CC) TARGET_DYNCC= $(DYNAMIC_CC) TARGET_LD= $(CROSS)$(CC) TARGET_AR= $(CROSS)ar rcus TARGET_STRIP= $(CROSS)strip TARGET_LIBPATH= $(or $(PREFIX),/usr/local)/$(or $(MULTILIB),lib) TARGET_SONAME= libluajit-$(ABIVER).so.$(MAJVER) TARGET_DYLIBNAME= libluajit-$(ABIVER).$(MAJVER).dylib TARGET_DYLIBPATH= $(TARGET_LIBPATH)/$(TARGET_DYLIBNAME) TARGET_DLLNAME= lua$(NODOTABIVER).dll TARGET_XSHLDFLAGS= -shared -fPIC -Wl,-soname,$(TARGET_SONAME) TARGET_DYNXLDOPTS= TARGET_LFSFLAGS= -D_FILE_OFFSET_BITS=64 -D_LARGEFILE_SOURCE TARGET_XCFLAGS= $(TARGET_LFSFLAGS) -U_FORTIFY_SOURCE TARGET_XLDFLAGS= TARGET_XLIBS= -lm TARGET_TCFLAGS= $(CCOPTIONS) $(TARGET_XCFLAGS) $(TARGET_FLAGS) $(TARGET_CFLAGS) TARGET_ACFLAGS= $(CCOPTIONS) $(TARGET_XCFLAGS) $(TARGET_FLAGS) $(TARGET_CFLAGS) TARGET_ALDFLAGS= $(LDOPTIONS) $(TARGET_XLDFLAGS) $(TARGET_FLAGS) $(TARGET_LDFLAGS) TARGET_ASHLDFLAGS= $(LDOPTIONS) $(TARGET_XSHLDFLAGS) $(TARGET_FLAGS) $(TARGET_SHLDFLAGS) TARGET_ALIBS= $(TARGET_XLIBS) $(LIBS) $(TARGET_LIBS) TARGET_TESTARCH=$(shell $(TARGET_CC) $(TARGET_TCFLAGS) -E lj_arch.h -dM) ifneq (,$(findstring LJ_TARGET_X64 ,$(TARGET_TESTARCH))) TARGET_LJARCH= x64 else ifneq (,$(findstring LJ_TARGET_X86 ,$(TARGET_TESTARCH))) TARGET_LJARCH= x86 else ifneq (,$(findstring LJ_TARGET_ARM ,$(TARGET_TESTARCH))) TARGET_LJARCH= arm else ifneq (,$(findstring LJ_TARGET_PPC ,$(TARGET_TESTARCH))) TARGET_LJARCH= ppc else ifneq (,$(findstring LJ_TARGET_PPCSPE ,$(TARGET_TESTARCH))) TARGET_LJARCH= ppcspe else ifneq (,$(findstring LJ_TARGET_MIPS ,$(TARGET_TESTARCH))) ifneq (,$(findstring MIPSEL ,$(TARGET_TESTARCH))) TARGET_ARCH= -D__MIPSEL__=1 endif TARGET_LJARCH= mips else $(error Unsupported target architecture) endif endif endif endif endif endif ifneq (,$(findstring LJ_TARGET_PS3 1,$(TARGET_TESTARCH))) TARGET_SYS= PS3 TARGET_ARCH+= -D__CELLOS_LV2__ TARGET_XCFLAGS+= -DLUAJIT_USE_SYSMALLOC endif TARGET_XCFLAGS+= $(CCOPT_$(TARGET_LJARCH)) TARGET_ARCH+= $(patsubst %,-DLUAJIT_TARGET=LUAJIT_ARCH_%,$(TARGET_LJARCH)) ifneq (,$(PREFIX)) ifneq (/usr/local,$(PREFIX)) TARGET_XCFLAGS+= -DLUA_ROOT=\"$(PREFIX)\" ifneq (/usr,$(PREFIX)) TARGET_DYNXLDOPTS= -Wl,-rpath,$(TARGET_LIBPATH) endif endif endif ifneq (,$(MULTILIB)) TARGET_XCFLAGS+= -DLUA_MULTILIB=\"$(MULTILIB)\" endif ifneq (,$(LMULTILIB)) TARGET_XCFLAGS+= -DLUA_LMULTILIB=\"$(LMULTILIB)\" endif ############################################################################## # Target system detection. ############################################################################## TARGET_SYS?= $(HOST_SYS) ifeq (Windows,$(TARGET_SYS)) TARGET_STRIP+= --strip-unneeded TARGET_XSHLDFLAGS= -shared TARGET_DYNXLDOPTS= else ifeq (,$(shell $(TARGET_CC) -o /dev/null -c -x c /dev/null -fno-stack-protector 2>/dev/null || echo 1)) TARGET_XCFLAGS+= -fno-stack-protector endif ifeq (Darwin,$(TARGET_SYS)) ifeq (,$(MACOSX_DEPLOYMENT_TARGET)) export MACOSX_DEPLOYMENT_TARGET=10.4 endif TARGET_STRIP+= -x TARGET_AR+= 2>/dev/null TARGET_XSHLDFLAGS= -dynamiclib -single_module -undefined dynamic_lookup -fPIC TARGET_DYNXLDOPTS= TARGET_XSHLDFLAGS+= -install_name $(TARGET_DYLIBPATH) -compatibility_version $(MAJVER).$(MINVER) -current_version $(MAJVER).$(MINVER).$(RELVER) ifeq (x64,$(TARGET_LJARCH)) TARGET_XLDFLAGS+= -pagezero_size 10000 -image_base 100000000 TARGET_XSHLDFLAGS+= -image_base 7fff04c4a000 endif else ifeq (iOS,$(TARGET_SYS)) TARGET_STRIP+= -x TARGET_AR+= 2>/dev/null TARGET_XSHLDFLAGS= -dynamiclib -single_module -undefined dynamic_lookup -fPIC TARGET_DYNXLDOPTS= TARGET_XSHLDFLAGS+= -install_name $(TARGET_DYLIBPATH) -compatibility_version $(MAJVER).$(MINVER) -current_version $(MAJVER).$(MINVER).$(RELVER) else ifneq (SunOS,$(TARGET_SYS)) ifneq (PS3,$(TARGET_SYS)) TARGET_XLDFLAGS+= -Wl,-E endif endif ifeq (Linux,$(TARGET_SYS)) TARGET_XLIBS+= -ldl endif ifeq (GNU/kFreeBSD,$(TARGET_SYS)) TARGET_XLIBS+= -ldl endif endif endif endif ifneq ($(HOST_SYS),$(TARGET_SYS)) ifeq (Windows,$(TARGET_SYS)) HOST_XCFLAGS+= -malign-double -DLUAJIT_OS=LUAJIT_OS_WINDOWS else ifeq (Linux,$(TARGET_SYS)) HOST_XCFLAGS+= -DLUAJIT_OS=LUAJIT_OS_LINUX else ifeq (Darwin,$(TARGET_SYS)) HOST_XCFLAGS+= -DLUAJIT_OS=LUAJIT_OS_OSX else ifeq (iOS,$(TARGET_SYS)) HOST_XCFLAGS+= -DLUAJIT_OS=LUAJIT_OS_OSX else HOST_XCFLAGS+= -DLUAJIT_OS=LUAJIT_OS_OTHER endif endif endif endif endif ifneq (,$(CCDEBUG)) TARGET_STRIP= @: endif ############################################################################## # Files and pathnames. ############################################################################## MINILUA_O= host/minilua.o MINILUA_LIBS= -lm MINILUA_T= host/minilua MINILUA_X= $(MINILUA_T) ifeq (,$(HOST_LUA)) HOST_LUA= $(MINILUA_X) DASM_DEP= $(MINILUA_T) endif DASM_DIR= ../dynasm DASM= $(HOST_LUA) $(DASM_DIR)/dynasm.lua DASM_XFLAGS= DASM_AFLAGS= DASM_ARCH= $(TARGET_LJARCH) ifneq (,$(findstring LJ_ARCH_BITS 64,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D P64 endif ifneq (,$(findstring LJ_HASJIT 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D JIT endif ifneq (,$(findstring LJ_HASFFI 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D FFI endif ifneq (,$(findstring LJ_DUALNUM 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D DUALNUM endif ifneq (,$(findstring LJ_ARCH_HASFPU 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D FPU TARGET_ARCH+= -DLJ_ARCH_HASFPU=1 else TARGET_ARCH+= -DLJ_ARCH_HASFPU=0 endif ifeq (,$(findstring LJ_ABI_SOFTFP 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D HFABI TARGET_ARCH+= -DLJ_ABI_SOFTFP=0 else TARGET_ARCH+= -DLJ_ABI_SOFTFP=1 endif ifneq (,$(findstring LJ_NO_UNWIND 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D NO_UNWIND TARGET_ARCH+= -DLUAJIT_NO_UNWIND endif DASM_AFLAGS+= -D VER=$(subst LJ_ARCH_VERSION_,,$(filter LJ_ARCH_VERSION_%,$(subst LJ_ARCH_VERSION ,LJ_ARCH_VERSION_,$(TARGET_TESTARCH)))) ifeq (Windows,$(TARGET_SYS)) DASM_AFLAGS+= -D WIN endif ifeq (x86,$(TARGET_LJARCH)) ifneq (,$(findstring __SSE2__ 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D SSE endif else ifeq (x64,$(TARGET_LJARCH)) DASM_ARCH= x86 else ifeq (arm,$(TARGET_LJARCH)) ifeq (iOS,$(TARGET_SYS)) DASM_AFLAGS+= -D IOS endif else ifeq (ppc,$(TARGET_LJARCH)) ifneq (,$(findstring LJ_ARCH_SQRT 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D SQRT endif ifneq (,$(findstring LJ_ARCH_ROUND 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D ROUND endif ifneq (,$(findstring LJ_ARCH_PPC64 1,$(TARGET_TESTARCH))) DASM_AFLAGS+= -D GPR64 endif ifeq (PS3,$(TARGET_SYS)) DASM_AFLAGS+= -D PPE -D TOC endif endif endif endif endif DASM_FLAGS= $(DASM_XFLAGS) $(DASM_AFLAGS) DASM_DASC= vm_$(DASM_ARCH).dasc BUILDVM_O= host/buildvm.o host/buildvm_asm.o host/buildvm_peobj.o \ host/buildvm_lib.o host/buildvm_fold.o BUILDVM_T= host/buildvm BUILDVM_X= $(BUILDVM_T) HOST_O= $(MINILUA_O) $(BUILDVM_O) HOST_T= $(MINILUA_T) $(BUILDVM_T) LJVM_S= lj_vm.s LJVM_O= lj_vm.o LJVM_BOUT= $(LJVM_S) LJVM_MODE= elfasm LJLIB_O= lib_base.o lib_math.o lib_bit.o lib_string.o lib_table.o \ lib_io.o lib_os.o lib_package.o lib_debug.o lib_jit.o lib_ffi.o LJLIB_C= $(LJLIB_O:.o=.c) LJCORE_O= lj_gc.o lj_err.o lj_char.o lj_bc.o lj_obj.o \ lj_str.o lj_tab.o lj_func.o lj_udata.o lj_meta.o lj_debug.o \ lj_state.o lj_dispatch.o lj_vmevent.o lj_vmmath.o lj_strscan.o \ lj_api.o lj_lex.o lj_parse.o lj_bcread.o lj_bcwrite.o lj_load.o \ lj_ir.o lj_opt_mem.o lj_opt_fold.o lj_opt_narrow.o \ lj_opt_dce.o lj_opt_loop.o lj_opt_split.o lj_opt_sink.o \ lj_mcode.o lj_snap.o lj_record.o lj_crecord.o lj_ffrecord.o \ lj_asm.o lj_trace.o lj_gdbjit.o \ lj_ctype.o lj_cdata.o lj_cconv.o lj_ccall.o lj_ccallback.o \ lj_carith.o lj_clib.o lj_cparse.o \ lj_lib.o lj_alloc.o lib_aux.o \ $(LJLIB_O) lib_init.o LJVMCORE_O= $(LJVM_O) $(LJCORE_O) LJVMCORE_DYNO= $(LJVMCORE_O:.o=_dyn.o) LIB_VMDEF= jit/vmdef.lua LIB_VMDEFP= $(LIB_VMDEF) LUAJIT_O= luajit.o LUAJIT_A= libluajit.a LUAJIT_SO= libluajit.so LUAJIT_T= luajit ALL_T= $(LUAJIT_T) $(LUAJIT_A) $(LUAJIT_SO) $(HOST_T) ALL_HDRGEN= lj_bcdef.h lj_ffdef.h lj_libdef.h lj_recdef.h lj_folddef.h \ host/buildvm_arch.h ALL_GEN= $(LJVM_S) $(ALL_HDRGEN) $(LIB_VMDEFP) WIN_RM= *.obj *.lib *.exp *.dll *.exe *.manifest *.pdb *.ilk ALL_RM= $(ALL_T) $(ALL_GEN) *.o host/*.o $(WIN_RM) ############################################################################## # Build mode handling. ############################################################################## # Mixed mode defaults. TARGET_O= $(LUAJIT_A) TARGET_T= $(LUAJIT_T) $(LUAJIT_SO) TARGET_DEP= $(LIB_VMDEF) $(LUAJIT_SO) ifeq (Windows,$(TARGET_SYS)) TARGET_DYNCC= $(STATIC_CC) LJVM_MODE= peobj LJVM_BOUT= $(LJVM_O) LUAJIT_T= luajit.exe ifeq (cygwin,$(HOST_MSYS)) LUAJIT_SO= cyg$(TARGET_DLLNAME) else LUAJIT_SO= $(TARGET_DLLNAME) endif # Mixed mode is not supported on Windows. And static mode doesn't work well. # C modules cannot be loaded, because they bind to lua51.dll. ifneq (static,$(BUILDMODE)) BUILDMODE= dynamic TARGET_XCFLAGS+= -DLUA_BUILD_AS_DLL endif endif ifeq (Darwin,$(TARGET_SYS)) LJVM_MODE= machasm endif ifeq (iOS,$(TARGET_SYS)) LJVM_MODE= machasm endif ifeq (SunOS,$(TARGET_SYS)) BUILDMODE= static endif ifeq (PS3,$(TARGET_SYS)) BUILDMODE= static endif ifeq (Windows,$(HOST_SYS)) MINILUA_T= host/minilua.exe BUILDVM_T= host/buildvm.exe ifeq (,$(HOST_MSYS)) MINILUA_X= host\minilua BUILDVM_X= host\buildvm ALL_RM:= $(subst /,\,$(ALL_RM)) endif endif ifeq (static,$(BUILDMODE)) TARGET_DYNCC= @: TARGET_T= $(LUAJIT_T) TARGET_DEP= $(LIB_VMDEF) else ifeq (dynamic,$(BUILDMODE)) ifneq (Windows,$(TARGET_SYS)) TARGET_CC= $(DYNAMIC_CC) endif TARGET_DYNCC= @: LJVMCORE_DYNO= $(LJVMCORE_O) TARGET_O= $(LUAJIT_SO) TARGET_XLDFLAGS+= $(TARGET_DYNXLDOPTS) else ifeq (Darwin,$(TARGET_SYS)) TARGET_DYNCC= @: LJVMCORE_DYNO= $(LJVMCORE_O) endif ifeq (iOS,$(TARGET_SYS)) TARGET_DYNCC= @: LJVMCORE_DYNO= $(LJVMCORE_O) endif endif endif Q= @ E= @echo #Q= #E= @: ############################################################################## # Make targets. ############################################################################## default all: $(TARGET_T) amalg: @grep "^[+|]" ljamalg.c $(MAKE) all "LJCORE_O=ljamalg.o" clean: $(HOST_RM) $(ALL_RM) depend: @for file in $(ALL_HDRGEN); do \ test -f $$file || touch $$file; \ done @$(HOST_CC) $(HOST_ACFLAGS) -MM *.c host/*.c | \ sed -e "s| [^ ]*/dasm_\S*\.h||g" \ -e "s|^\([^l ]\)|host/\1|" \ -e "s| lj_target_\S*\.h| lj_target_*.h|g" \ -e "s| lj_emit_\S*\.h| lj_emit_*.h|g" \ -e "s| lj_asm_\S*\.h| lj_asm_*.h|g" >Makefile.dep @for file in $(ALL_HDRGEN); do \ test -s $$file || $(HOST_RM) $$file; \ done .PHONY: default all amalg clean depend ############################################################################## # Rules for generated files. ############################################################################## $(MINILUA_T): $(MINILUA_O) $(E) "HOSTLINK $@" $(Q)$(HOST_CC) $(HOST_ALDFLAGS) -o $@ $(MINILUA_O) $(MINILUA_LIBS) $(HOST_ALIBS) host/buildvm_arch.h: $(DASM_DASC) $(DASM_DEP) $(E) "DYNASM $@" $(Q)$(DASM) $(DASM_FLAGS) -o $@ $(DASM_DASC) host/buildvm.o: $(DASM_DIR)/dasm_*.h $(BUILDVM_T): $(BUILDVM_O) $(E) "HOSTLINK $@" $(Q)$(HOST_CC) $(HOST_ALDFLAGS) -o $@ $(BUILDVM_O) $(HOST_ALIBS) $(LJVM_BOUT): $(BUILDVM_T) $(E) "BUILDVM $@" $(Q)$(BUILDVM_X) -m $(LJVM_MODE) -o $@ lj_bcdef.h: $(BUILDVM_T) $(LJLIB_C) $(E) "BUILDVM $@" $(Q)$(BUILDVM_X) -m bcdef -o $@ $(LJLIB_C) lj_ffdef.h: $(BUILDVM_T) $(LJLIB_C) $(E) "BUILDVM $@" $(Q)$(BUILDVM_X) -m ffdef -o $@ $(LJLIB_C) lj_libdef.h: $(BUILDVM_T) $(LJLIB_C) $(E) "BUILDVM $@" $(Q)$(BUILDVM_X) -m libdef -o $@ $(LJLIB_C) lj_recdef.h: $(BUILDVM_T) $(LJLIB_C) $(E) "BUILDVM $@" $(Q)$(BUILDVM_X) -m recdef -o $@ $(LJLIB_C) $(LIB_VMDEF): $(BUILDVM_T) $(LJLIB_C) $(E) "BUILDVM $@" $(Q)$(BUILDVM_X) -m vmdef -o $(LIB_VMDEFP) $(LJLIB_C) lj_folddef.h: $(BUILDVM_T) lj_opt_fold.c $(E) "BUILDVM $@" $(Q)$(BUILDVM_X) -m folddef -o $@ lj_opt_fold.c ############################################################################## # Object file rules. ############################################################################## %.o: %.c $(E) "CC $@" $(Q)$(TARGET_DYNCC) $(TARGET_ACFLAGS) -c -o $(@:.o=_dyn.o) $< $(Q)$(TARGET_CC) $(TARGET_ACFLAGS) -c -o $@ $< %.o: %.s $(E) "ASM $@" $(Q)$(TARGET_DYNCC) $(TARGET_ACFLAGS) -c -o $(@:.o=_dyn.o) $< $(Q)$(TARGET_CC) $(TARGET_ACFLAGS) -c -o $@ $< $(LUAJIT_O): $(E) "CC $@" $(Q)$(TARGET_STCC) $(TARGET_ACFLAGS) -c -o $@ $< $(HOST_O): %.o: %.c $(E) "HOSTCC $@" $(Q)$(HOST_CC) $(HOST_ACFLAGS) -c -o $@ $< include Makefile.dep ############################################################################## # Target file rules. ############################################################################## $(LUAJIT_A): $(LJVMCORE_O) $(E) "AR $@" $(Q)$(TARGET_AR) $@ $(LJVMCORE_O) # The dependency on _O, but linking with _DYNO is intentional. $(LUAJIT_SO): $(LJVMCORE_O) $(E) "DYNLINK $@" $(Q)$(TARGET_LD) $(TARGET_ASHLDFLAGS) -o $@ $(LJVMCORE_DYNO) $(TARGET_ALIBS) $(Q)$(TARGET_STRIP) $@ $(LUAJIT_T): $(TARGET_O) $(LUAJIT_O) $(TARGET_DEP) $(E) "LINK $@" $(Q)$(TARGET_LD) $(TARGET_ALDFLAGS) -o $@ $(LUAJIT_O) $(TARGET_O) $(TARGET_ALIBS) $(Q)$(TARGET_STRIP) $@ $(E) "OK Successfully built LuaJIT" ############################################################################## wcc-0.0.2/src/wsh/luajit-2.0/src/lj_cconv.h0000644000175000017500000000375113122010155016645 0ustar philphil/* ** C type conversions. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CCONV_H #define _LJ_CCONV_H #include "lj_obj.h" #include "lj_ctype.h" #if LJ_HASFFI /* Compressed C type index. ORDER CCX. */ enum { CCX_B, /* Bool. */ CCX_I, /* Integer. */ CCX_F, /* Floating-point number. */ CCX_C, /* Complex. */ CCX_V, /* Vector. */ CCX_P, /* Pointer. */ CCX_A, /* Refarray. */ CCX_S /* Struct/union. */ }; /* Convert C type info to compressed C type index. ORDER CT. ORDER CCX. */ static LJ_AINLINE uint32_t cconv_idx(CTInfo info) { uint32_t idx = ((info >> 26) & 15u); /* Dispatch bits. */ lua_assert(ctype_type(info) <= CT_MAYCONVERT); #if LJ_64 idx = ((uint32_t)(U64x(f436fff5,fff7f021) >> 4*idx) & 15u); #else idx = (((idx < 8 ? 0xfff7f021u : 0xf436fff5) >> 4*(idx & 7u)) & 15u); #endif lua_assert(idx < 8); return idx; } #define cconv_idx2(dinfo, sinfo) \ ((cconv_idx((dinfo)) << 3) + cconv_idx((sinfo))) #define CCX(dst, src) ((CCX_##dst << 3) + CCX_##src) /* Conversion flags. */ #define CCF_CAST 0x00000001u #define CCF_FROMTV 0x00000002u #define CCF_SAME 0x00000004u #define CCF_IGNQUAL 0x00000008u #define CCF_ARG_SHIFT 8 #define CCF_ARG(n) ((n) << CCF_ARG_SHIFT) #define CCF_GETARG(f) ((f) >> CCF_ARG_SHIFT) LJ_FUNC int lj_cconv_compatptr(CTState *cts, CType *d, CType *s, CTInfo flags); LJ_FUNC void lj_cconv_ct_ct(CTState *cts, CType *d, CType *s, uint8_t *dp, uint8_t *sp, CTInfo flags); LJ_FUNC int lj_cconv_tv_ct(CTState *cts, CType *s, CTypeID sid, TValue *o, uint8_t *sp); LJ_FUNC int lj_cconv_tv_bf(CTState *cts, CType *s, TValue *o, uint8_t *sp); LJ_FUNC void lj_cconv_ct_tv(CTState *cts, CType *d, uint8_t *dp, TValue *o, CTInfo flags); LJ_FUNC void lj_cconv_bf_tv(CTState *cts, CType *d, uint8_t *dp, TValue *o); LJ_FUNC int lj_cconv_multi_init(CTState *cts, CType *d, TValue *o); LJ_FUNC void lj_cconv_ct_init(CTState *cts, CType *d, CTSize sz, uint8_t *dp, TValue *o, MSize len); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_emit_ppc.h0000644000175000017500000001552713122010155017341 0ustar philphil/* ** PPC instruction emitter. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Emit basic instructions --------------------------------------------- */ static void emit_tab(ASMState *as, PPCIns pi, Reg rt, Reg ra, Reg rb) { *--as->mcp = pi | PPCF_T(rt) | PPCF_A(ra) | PPCF_B(rb); } #define emit_asb(as, pi, ra, rs, rb) emit_tab(as, (pi), (rs), (ra), (rb)) #define emit_as(as, pi, ra, rs) emit_tab(as, (pi), (rs), (ra), 0) #define emit_ab(as, pi, ra, rb) emit_tab(as, (pi), 0, (ra), (rb)) static void emit_tai(ASMState *as, PPCIns pi, Reg rt, Reg ra, int32_t i) { *--as->mcp = pi | PPCF_T(rt) | PPCF_A(ra) | (i & 0xffff); } #define emit_ti(as, pi, rt, i) emit_tai(as, (pi), (rt), 0, (i)) #define emit_ai(as, pi, ra, i) emit_tai(as, (pi), 0, (ra), (i)) #define emit_asi(as, pi, ra, rs, i) emit_tai(as, (pi), (rs), (ra), (i)) #define emit_fab(as, pi, rf, ra, rb) \ emit_tab(as, (pi), (rf)&31, (ra)&31, (rb)&31) #define emit_fb(as, pi, rf, rb) emit_tab(as, (pi), (rf)&31, 0, (rb)&31) #define emit_fac(as, pi, rf, ra, rc) \ emit_tab(as, (pi) | PPCF_C((rc) & 31), (rf)&31, (ra)&31, 0) #define emit_facb(as, pi, rf, ra, rc, rb) \ emit_tab(as, (pi) | PPCF_C((rc) & 31), (rf)&31, (ra)&31, (rb)&31) #define emit_fai(as, pi, rf, ra, i) emit_tai(as, (pi), (rf)&31, (ra), (i)) static void emit_rot(ASMState *as, PPCIns pi, Reg ra, Reg rs, int32_t n, int32_t b, int32_t e) { *--as->mcp = pi | PPCF_T(rs) | PPCF_A(ra) | PPCF_B(n) | PPCF_MB(b) | PPCF_ME(e); } static void emit_slwi(ASMState *as, Reg ra, Reg rs, int32_t n) { lua_assert(n >= 0 && n < 32); emit_rot(as, PPCI_RLWINM, ra, rs, n, 0, 31-n); } static void emit_rotlwi(ASMState *as, Reg ra, Reg rs, int32_t n) { lua_assert(n >= 0 && n < 32); emit_rot(as, PPCI_RLWINM, ra, rs, n, 0, 31); } /* -- Emit loads/stores --------------------------------------------------- */ /* Prefer rematerialization of BASE/L from global_State over spills. */ #define emit_canremat(ref) ((ref) <= REF_BASE) /* Try to find a one step delta relative to another constant. */ static int emit_kdelta1(ASMState *as, Reg t, int32_t i) { RegSet work = ~as->freeset & RSET_GPR; while (work) { Reg r = rset_picktop(work); IRRef ref = regcost_ref(as->cost[r]); lua_assert(r != t); if (ref < ASMREF_L) { int32_t delta = i - (ra_iskref(ref) ? ra_krefk(as, ref) : IR(ref)->i); if (checki16(delta)) { emit_tai(as, PPCI_ADDI, t, r, delta); return 1; } } rset_clear(work, r); } return 0; /* Failed. */ } /* Load a 32 bit constant into a GPR. */ static void emit_loadi(ASMState *as, Reg r, int32_t i) { if (checki16(i)) { emit_ti(as, PPCI_LI, r, i); } else { if ((i & 0xffff)) { int32_t jgl = i32ptr(J2G(as->J)); if ((uint32_t)(i-jgl) < 65536) { emit_tai(as, PPCI_ADDI, r, RID_JGL, i-jgl-32768); return; } else if (emit_kdelta1(as, r, i)) { return; } emit_asi(as, PPCI_ORI, r, r, i); } emit_ti(as, PPCI_LIS, r, (i >> 16)); } } #define emit_loada(as, r, addr) emit_loadi(as, (r), i32ptr((addr))) static Reg ra_allock(ASMState *as, int32_t k, RegSet allow); /* Get/set from constant pointer. */ static void emit_lsptr(ASMState *as, PPCIns pi, Reg r, void *p, RegSet allow) { int32_t jgl = i32ptr(J2G(as->J)); int32_t i = i32ptr(p); Reg base; if ((uint32_t)(i-jgl) < 65536) { i = i-jgl-32768; base = RID_JGL; } else { base = ra_allock(as, i-(int16_t)i, allow); } emit_tai(as, pi, r, base, i); } #define emit_loadn(as, r, tv) \ emit_lsptr(as, PPCI_LFD, ((r) & 31), (void *)(tv), RSET_GPR) /* Get/set global_State fields. */ static void emit_lsglptr(ASMState *as, PPCIns pi, Reg r, int32_t ofs) { emit_tai(as, pi, r, RID_JGL, ofs-32768); } #define emit_getgl(as, r, field) \ emit_lsglptr(as, PPCI_LWZ, (r), (int32_t)offsetof(global_State, field)) #define emit_setgl(as, r, field) \ emit_lsglptr(as, PPCI_STW, (r), (int32_t)offsetof(global_State, field)) /* Trace number is determined from per-trace exit stubs. */ #define emit_setvmstate(as, i) UNUSED(i) /* -- Emit control-flow instructions -------------------------------------- */ /* Label for internal jumps. */ typedef MCode *MCLabel; /* Return label pointing to current PC. */ #define emit_label(as) ((as)->mcp) static void emit_condbranch(ASMState *as, PPCIns pi, PPCCC cc, MCode *target) { MCode *p = --as->mcp; ptrdiff_t delta = (char *)target - (char *)p; lua_assert(((delta + 0x8000) >> 16) == 0); pi ^= (delta & 0x8000) * (PPCF_Y/0x8000); *p = pi | PPCF_CC(cc) | ((uint32_t)delta & 0xffffu); } static void emit_jmp(ASMState *as, MCode *target) { MCode *p = --as->mcp; ptrdiff_t delta = (char *)target - (char *)p; *p = PPCI_B | (delta & 0x03fffffcu); } static void emit_call(ASMState *as, void *target) { MCode *p = --as->mcp; ptrdiff_t delta = (char *)target - (char *)p; if ((((delta>>2) + 0x00800000) >> 24) == 0) { *p = PPCI_BL | (delta & 0x03fffffcu); } else { /* Target out of range: need indirect call. Don't use arg reg. */ RegSet allow = RSET_GPR & ~RSET_RANGE(RID_R0, REGARG_LASTGPR+1); Reg r = ra_allock(as, i32ptr(target), allow); *p = PPCI_BCTRL; p[-1] = PPCI_MTCTR | PPCF_T(r); as->mcp = p-1; } } /* -- Emit generic operations --------------------------------------------- */ #define emit_mr(as, dst, src) \ emit_asb(as, PPCI_MR, (dst), (src), (src)) /* Generic move between two regs. */ static void emit_movrr(ASMState *as, IRIns *ir, Reg dst, Reg src) { UNUSED(ir); if (dst < RID_MAX_GPR) emit_mr(as, dst, src); else emit_fb(as, PPCI_FMR, dst, src); } /* Generic load of register from stack slot. */ static void emit_spload(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { if (r < RID_MAX_GPR) emit_tai(as, PPCI_LWZ, r, RID_SP, ofs); else emit_fai(as, irt_isnum(ir->t) ? PPCI_LFD : PPCI_LFS, r, RID_SP, ofs); } /* Generic store of register to stack slot. */ static void emit_spstore(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { if (r < RID_MAX_GPR) emit_tai(as, PPCI_STW, r, RID_SP, ofs); else emit_fai(as, irt_isnum(ir->t) ? PPCI_STFD : PPCI_STFS, r, RID_SP, ofs); } /* Emit a compare (for equality) with a constant operand. */ static void emit_cmpi(ASMState *as, Reg r, int32_t k) { if (checki16(k)) { emit_ai(as, PPCI_CMPWI, r, k); } else if (checku16(k)) { emit_ai(as, PPCI_CMPLWI, r, k); } else { emit_ai(as, PPCI_CMPLWI, RID_TMP, k); emit_asi(as, PPCI_XORIS, RID_TMP, r, (k >> 16)); } } /* Add offset to pointer. */ static void emit_addptr(ASMState *as, Reg r, int32_t ofs) { if (ofs) { emit_tai(as, PPCI_ADDI, r, r, ofs); if (!checki16(ofs)) emit_tai(as, PPCI_ADDIS, r, r, (ofs + 32768) >> 16); } } static void emit_spsub(ASMState *as, int32_t ofs) { if (ofs) { emit_tai(as, PPCI_STWU, RID_TMP, RID_SP, -ofs); emit_tai(as, PPCI_ADDI, RID_TMP, RID_SP, CFRAME_SIZE + (as->parent ? as->parent->spadjust : 0)); } } wcc-0.0.2/src/wsh/luajit-2.0/src/jit/0000755000175000017500000000000013122010155015457 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/src/jit/bcsave.lua0000644000175000017500000004333513122010155017435 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT module to save/list bytecode. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- -- This module saves or lists the bytecode for an input file. -- It's run by the -b command line option. -- ------------------------------------------------------------------------------ local jit = require("jit") assert(jit.version_num == 20004, "LuaJIT core/library version mismatch") local bit = require("bit") -- Symbol name prefix for LuaJIT bytecode. local LJBC_PREFIX = "luaJIT_BC_" ------------------------------------------------------------------------------ local function usage() io.stderr:write[[ Save LuaJIT bytecode: luajit -b[options] input output -l Only list bytecode. -s Strip debug info (default). -g Keep debug info. -n name Set module name (default: auto-detect from input name). -t type Set output file type (default: auto-detect from output name). -a arch Override architecture for object files (default: native). -o os Override OS for object files (default: native). -e chunk Use chunk string as input. -- Stop handling options. - Use stdin as input and/or stdout as output. File types: c h obj o raw (default) ]] os.exit(1) end local function check(ok, ...) if ok then return ok, ... end io.stderr:write("luajit: ", ...) io.stderr:write("\n") os.exit(1) end local function readfile(input) if type(input) == "function" then return input end if input == "-" then input = nil end return check(loadfile(input)) end local function savefile(name, mode) if name == "-" then return io.stdout end return check(io.open(name, mode)) end ------------------------------------------------------------------------------ local map_type = { raw = "raw", c = "c", h = "h", o = "obj", obj = "obj", } local map_arch = { x86 = true, x64 = true, arm = true, ppc = true, ppcspe = true, mips = true, mipsel = true, } local map_os = { linux = true, windows = true, osx = true, freebsd = true, netbsd = true, openbsd = true, dragonfly = true, solaris = true, } local function checkarg(str, map, err) str = string.lower(str) local s = check(map[str], "unknown ", err) return s == true and str or s end local function detecttype(str) local ext = string.match(string.lower(str), "%.(%a+)$") return map_type[ext] or "raw" end local function checkmodname(str) check(string.match(str, "^[%w_.%-]+$"), "bad module name") return string.gsub(str, "[%.%-]", "_") end local function detectmodname(str) if type(str) == "string" then local tail = string.match(str, "[^/\\]+$") if tail then str = tail end local head = string.match(str, "^(.*)%.[^.]*$") if head then str = head end str = string.match(str, "^[%w_.%-]+") else str = nil end check(str, "cannot derive module name, use -n name") return string.gsub(str, "[%.%-]", "_") end ------------------------------------------------------------------------------ local function bcsave_tail(fp, output, s) local ok, err = fp:write(s) if ok and output ~= "-" then ok, err = fp:close() end check(ok, "cannot write ", output, ": ", err) end local function bcsave_raw(output, s) local fp = savefile(output, "wb") bcsave_tail(fp, output, s) end local function bcsave_c(ctx, output, s) local fp = savefile(output, "w") if ctx.type == "c" then fp:write(string.format([[ #ifdef _cplusplus extern "C" #endif #ifdef _WIN32 __declspec(dllexport) #endif const char %s%s[] = { ]], LJBC_PREFIX, ctx.modname)) else fp:write(string.format([[ #define %s%s_SIZE %d static const char %s%s[] = { ]], LJBC_PREFIX, ctx.modname, #s, LJBC_PREFIX, ctx.modname)) end local t, n, m = {}, 0, 0 for i=1,#s do local b = tostring(string.byte(s, i)) m = m + #b + 1 if m > 78 then fp:write(table.concat(t, ",", 1, n), ",\n") n, m = 0, #b + 1 end n = n + 1 t[n] = b end bcsave_tail(fp, output, table.concat(t, ",", 1, n).."\n};\n") end local function bcsave_elfobj(ctx, output, s, ffi) ffi.cdef[[ typedef struct { uint8_t emagic[4], eclass, eendian, eversion, eosabi, eabiversion, epad[7]; uint16_t type, machine; uint32_t version; uint32_t entry, phofs, shofs; uint32_t flags; uint16_t ehsize, phentsize, phnum, shentsize, shnum, shstridx; } ELF32header; typedef struct { uint8_t emagic[4], eclass, eendian, eversion, eosabi, eabiversion, epad[7]; uint16_t type, machine; uint32_t version; uint64_t entry, phofs, shofs; uint32_t flags; uint16_t ehsize, phentsize, phnum, shentsize, shnum, shstridx; } ELF64header; typedef struct { uint32_t name, type, flags, addr, ofs, size, link, info, align, entsize; } ELF32sectheader; typedef struct { uint32_t name, type; uint64_t flags, addr, ofs, size; uint32_t link, info; uint64_t align, entsize; } ELF64sectheader; typedef struct { uint32_t name, value, size; uint8_t info, other; uint16_t sectidx; } ELF32symbol; typedef struct { uint32_t name; uint8_t info, other; uint16_t sectidx; uint64_t value, size; } ELF64symbol; typedef struct { ELF32header hdr; ELF32sectheader sect[6]; ELF32symbol sym[2]; uint8_t space[4096]; } ELF32obj; typedef struct { ELF64header hdr; ELF64sectheader sect[6]; ELF64symbol sym[2]; uint8_t space[4096]; } ELF64obj; ]] local symname = LJBC_PREFIX..ctx.modname local is64, isbe = false, false if ctx.arch == "x64" then is64 = true elseif ctx.arch == "ppc" or ctx.arch == "ppcspe" or ctx.arch == "mips" then isbe = true end -- Handle different host/target endianess. local function f32(x) return x end local f16, fofs = f32, f32 if ffi.abi("be") ~= isbe then f32 = bit.bswap function f16(x) return bit.rshift(bit.bswap(x), 16) end if is64 then local two32 = ffi.cast("int64_t", 2^32) function fofs(x) return bit.bswap(x)*two32 end else fofs = f32 end end -- Create ELF object and fill in header. local o = ffi.new(is64 and "ELF64obj" or "ELF32obj") local hdr = o.hdr if ctx.os == "bsd" or ctx.os == "other" then -- Determine native hdr.eosabi. local bf = assert(io.open("/bin/ls", "rb")) local bs = bf:read(9) bf:close() ffi.copy(o, bs, 9) check(hdr.emagic[0] == 127, "no support for writing native object files") else hdr.emagic = "\127ELF" hdr.eosabi = ({ freebsd=9, netbsd=2, openbsd=12, solaris=6 })[ctx.os] or 0 end hdr.eclass = is64 and 2 or 1 hdr.eendian = isbe and 2 or 1 hdr.eversion = 1 hdr.type = f16(1) hdr.machine = f16(({ x86=3, x64=62, arm=40, ppc=20, ppcspe=20, mips=8, mipsel=8 })[ctx.arch]) if ctx.arch == "mips" or ctx.arch == "mipsel" then hdr.flags = 0x50001006 end hdr.version = f32(1) hdr.shofs = fofs(ffi.offsetof(o, "sect")) hdr.ehsize = f16(ffi.sizeof(hdr)) hdr.shentsize = f16(ffi.sizeof(o.sect[0])) hdr.shnum = f16(6) hdr.shstridx = f16(2) -- Fill in sections and symbols. local sofs, ofs = ffi.offsetof(o, "space"), 1 for i,name in ipairs{ ".symtab", ".shstrtab", ".strtab", ".rodata", ".note.GNU-stack", } do local sect = o.sect[i] sect.align = fofs(1) sect.name = f32(ofs) ffi.copy(o.space+ofs, name) ofs = ofs + #name+1 end o.sect[1].type = f32(2) -- .symtab o.sect[1].link = f32(3) o.sect[1].info = f32(1) o.sect[1].align = fofs(8) o.sect[1].ofs = fofs(ffi.offsetof(o, "sym")) o.sect[1].entsize = fofs(ffi.sizeof(o.sym[0])) o.sect[1].size = fofs(ffi.sizeof(o.sym)) o.sym[1].name = f32(1) o.sym[1].sectidx = f16(4) o.sym[1].size = fofs(#s) o.sym[1].info = 17 o.sect[2].type = f32(3) -- .shstrtab o.sect[2].ofs = fofs(sofs) o.sect[2].size = fofs(ofs) o.sect[3].type = f32(3) -- .strtab o.sect[3].ofs = fofs(sofs + ofs) o.sect[3].size = fofs(#symname+1) ffi.copy(o.space+ofs+1, symname) ofs = ofs + #symname + 2 o.sect[4].type = f32(1) -- .rodata o.sect[4].flags = fofs(2) o.sect[4].ofs = fofs(sofs + ofs) o.sect[4].size = fofs(#s) o.sect[5].type = f32(1) -- .note.GNU-stack o.sect[5].ofs = fofs(sofs + ofs + #s) -- Write ELF object file. local fp = savefile(output, "wb") fp:write(ffi.string(o, ffi.sizeof(o)-4096+ofs)) bcsave_tail(fp, output, s) end local function bcsave_peobj(ctx, output, s, ffi) ffi.cdef[[ typedef struct { uint16_t arch, nsects; uint32_t time, symtabofs, nsyms; uint16_t opthdrsz, flags; } PEheader; typedef struct { char name[8]; uint32_t vsize, vaddr, size, ofs, relocofs, lineofs; uint16_t nreloc, nline; uint32_t flags; } PEsection; typedef struct __attribute((packed)) { union { char name[8]; uint32_t nameref[2]; }; uint32_t value; int16_t sect; uint16_t type; uint8_t scl, naux; } PEsym; typedef struct __attribute((packed)) { uint32_t size; uint16_t nreloc, nline; uint32_t cksum; uint16_t assoc; uint8_t comdatsel, unused[3]; } PEsymaux; typedef struct { PEheader hdr; PEsection sect[2]; // Must be an even number of symbol structs. PEsym sym0; PEsymaux sym0aux; PEsym sym1; PEsymaux sym1aux; PEsym sym2; PEsym sym3; uint32_t strtabsize; uint8_t space[4096]; } PEobj; ]] local symname = LJBC_PREFIX..ctx.modname local is64 = false if ctx.arch == "x86" then symname = "_"..symname elseif ctx.arch == "x64" then is64 = true end local symexport = " /EXPORT:"..symname..",DATA " -- The file format is always little-endian. Swap if the host is big-endian. local function f32(x) return x end local f16 = f32 if ffi.abi("be") then f32 = bit.bswap function f16(x) return bit.rshift(bit.bswap(x), 16) end end -- Create PE object and fill in header. local o = ffi.new("PEobj") local hdr = o.hdr hdr.arch = f16(({ x86=0x14c, x64=0x8664, arm=0x1c0, ppc=0x1f2, mips=0x366, mipsel=0x366 })[ctx.arch]) hdr.nsects = f16(2) hdr.symtabofs = f32(ffi.offsetof(o, "sym0")) hdr.nsyms = f32(6) -- Fill in sections and symbols. o.sect[0].name = ".drectve" o.sect[0].size = f32(#symexport) o.sect[0].flags = f32(0x00100a00) o.sym0.sect = f16(1) o.sym0.scl = 3 o.sym0.name = ".drectve" o.sym0.naux = 1 o.sym0aux.size = f32(#symexport) o.sect[1].name = ".rdata" o.sect[1].size = f32(#s) o.sect[1].flags = f32(0x40300040) o.sym1.sect = f16(2) o.sym1.scl = 3 o.sym1.name = ".rdata" o.sym1.naux = 1 o.sym1aux.size = f32(#s) o.sym2.sect = f16(2) o.sym2.scl = 2 o.sym2.nameref[1] = f32(4) o.sym3.sect = f16(-1) o.sym3.scl = 2 o.sym3.value = f32(1) o.sym3.name = "@feat.00" -- Mark as SafeSEH compliant. ffi.copy(o.space, symname) local ofs = #symname + 1 o.strtabsize = f32(ofs + 4) o.sect[0].ofs = f32(ffi.offsetof(o, "space") + ofs) ffi.copy(o.space + ofs, symexport) ofs = ofs + #symexport o.sect[1].ofs = f32(ffi.offsetof(o, "space") + ofs) -- Write PE object file. local fp = savefile(output, "wb") fp:write(ffi.string(o, ffi.sizeof(o)-4096+ofs)) bcsave_tail(fp, output, s) end local function bcsave_machobj(ctx, output, s, ffi) ffi.cdef[[ typedef struct { uint32_t magic, cputype, cpusubtype, filetype, ncmds, sizeofcmds, flags; } mach_header; typedef struct { mach_header; uint32_t reserved; } mach_header_64; typedef struct { uint32_t cmd, cmdsize; char segname[16]; uint32_t vmaddr, vmsize, fileoff, filesize; uint32_t maxprot, initprot, nsects, flags; } mach_segment_command; typedef struct { uint32_t cmd, cmdsize; char segname[16]; uint64_t vmaddr, vmsize, fileoff, filesize; uint32_t maxprot, initprot, nsects, flags; } mach_segment_command_64; typedef struct { char sectname[16], segname[16]; uint32_t addr, size; uint32_t offset, align, reloff, nreloc, flags; uint32_t reserved1, reserved2; } mach_section; typedef struct { char sectname[16], segname[16]; uint64_t addr, size; uint32_t offset, align, reloff, nreloc, flags; uint32_t reserved1, reserved2, reserved3; } mach_section_64; typedef struct { uint32_t cmd, cmdsize, symoff, nsyms, stroff, strsize; } mach_symtab_command; typedef struct { int32_t strx; uint8_t type, sect; int16_t desc; uint32_t value; } mach_nlist; typedef struct { uint32_t strx; uint8_t type, sect; uint16_t desc; uint64_t value; } mach_nlist_64; typedef struct { uint32_t magic, nfat_arch; } mach_fat_header; typedef struct { uint32_t cputype, cpusubtype, offset, size, align; } mach_fat_arch; typedef struct { struct { mach_header hdr; mach_segment_command seg; mach_section sec; mach_symtab_command sym; } arch[1]; mach_nlist sym_entry; uint8_t space[4096]; } mach_obj; typedef struct { struct { mach_header_64 hdr; mach_segment_command_64 seg; mach_section_64 sec; mach_symtab_command sym; } arch[1]; mach_nlist_64 sym_entry; uint8_t space[4096]; } mach_obj_64; typedef struct { mach_fat_header fat; mach_fat_arch fat_arch[4]; struct { mach_header hdr; mach_segment_command seg; mach_section sec; mach_symtab_command sym; } arch[4]; mach_nlist sym_entry; uint8_t space[4096]; } mach_fat_obj; ]] local symname = '_'..LJBC_PREFIX..ctx.modname local isfat, is64, align, mobj = false, false, 4, "mach_obj" if ctx.arch == "x64" then is64, align, mobj = true, 8, "mach_obj_64" elseif ctx.arch == "arm" then isfat, mobj = true, "mach_fat_obj" else check(ctx.arch == "x86", "unsupported architecture for OSX") end local function aligned(v, a) return bit.band(v+a-1, -a) end local be32 = bit.bswap -- Mach-O FAT is BE, supported archs are LE. -- Create Mach-O object and fill in header. local o = ffi.new(mobj) local mach_size = aligned(ffi.offsetof(o, "space")+#symname+2, align) local cputype = ({ x86={7}, x64={0x01000007}, arm={7,12,12,12} })[ctx.arch] local cpusubtype = ({ x86={3}, x64={3}, arm={3,6,9,11} })[ctx.arch] if isfat then o.fat.magic = be32(0xcafebabe) o.fat.nfat_arch = be32(#cpusubtype) end -- Fill in sections and symbols. for i=0,#cpusubtype-1 do local ofs = 0 if isfat then local a = o.fat_arch[i] a.cputype = be32(cputype[i+1]) a.cpusubtype = be32(cpusubtype[i+1]) -- Subsequent slices overlap each other to share data. ofs = ffi.offsetof(o, "arch") + i*ffi.sizeof(o.arch[0]) a.offset = be32(ofs) a.size = be32(mach_size-ofs+#s) end local a = o.arch[i] a.hdr.magic = is64 and 0xfeedfacf or 0xfeedface a.hdr.cputype = cputype[i+1] a.hdr.cpusubtype = cpusubtype[i+1] a.hdr.filetype = 1 a.hdr.ncmds = 2 a.hdr.sizeofcmds = ffi.sizeof(a.seg)+ffi.sizeof(a.sec)+ffi.sizeof(a.sym) a.seg.cmd = is64 and 0x19 or 0x1 a.seg.cmdsize = ffi.sizeof(a.seg)+ffi.sizeof(a.sec) a.seg.vmsize = #s a.seg.fileoff = mach_size-ofs a.seg.filesize = #s a.seg.maxprot = 1 a.seg.initprot = 1 a.seg.nsects = 1 ffi.copy(a.sec.sectname, "__data") ffi.copy(a.sec.segname, "__DATA") a.sec.size = #s a.sec.offset = mach_size-ofs a.sym.cmd = 2 a.sym.cmdsize = ffi.sizeof(a.sym) a.sym.symoff = ffi.offsetof(o, "sym_entry")-ofs a.sym.nsyms = 1 a.sym.stroff = ffi.offsetof(o, "sym_entry")+ffi.sizeof(o.sym_entry)-ofs a.sym.strsize = aligned(#symname+2, align) end o.sym_entry.type = 0xf o.sym_entry.sect = 1 o.sym_entry.strx = 1 ffi.copy(o.space+1, symname) -- Write Macho-O object file. local fp = savefile(output, "wb") fp:write(ffi.string(o, mach_size)) bcsave_tail(fp, output, s) end local function bcsave_obj(ctx, output, s) local ok, ffi = pcall(require, "ffi") check(ok, "FFI library required to write this file type") if ctx.os == "windows" then return bcsave_peobj(ctx, output, s, ffi) elseif ctx.os == "osx" then return bcsave_machobj(ctx, output, s, ffi) else return bcsave_elfobj(ctx, output, s, ffi) end end ------------------------------------------------------------------------------ local function bclist(input, output) local f = readfile(input) require("jit.bc").dump(f, savefile(output, "w"), true) end local function bcsave(ctx, input, output) local f = readfile(input) local s = string.dump(f, ctx.strip) local t = ctx.type if not t then t = detecttype(output) ctx.type = t end if t == "raw" then bcsave_raw(output, s) else if not ctx.modname then ctx.modname = detectmodname(input) end if t == "obj" then bcsave_obj(ctx, output, s) else bcsave_c(ctx, output, s) end end end local function docmd(...) local arg = {...} local n = 1 local list = false local ctx = { strip = true, arch = jit.arch, os = string.lower(jit.os), type = false, modname = false, } while n <= #arg do local a = arg[n] if type(a) == "string" and string.sub(a, 1, 1) == "-" and a ~= "-" then table.remove(arg, n) if a == "--" then break end for m=2,#a do local opt = string.sub(a, m, m) if opt == "l" then list = true elseif opt == "s" then ctx.strip = true elseif opt == "g" then ctx.strip = false else if arg[n] == nil or m ~= #a then usage() end if opt == "e" then if n ~= 1 then usage() end arg[1] = check(loadstring(arg[1])) elseif opt == "n" then ctx.modname = checkmodname(table.remove(arg, n)) elseif opt == "t" then ctx.type = checkarg(table.remove(arg, n), map_type, "file type") elseif opt == "a" then ctx.arch = checkarg(table.remove(arg, n), map_arch, "architecture") elseif opt == "o" then ctx.os = checkarg(table.remove(arg, n), map_os, "OS name") else usage() end end end else n = n + 1 end end if list then if #arg == 0 or #arg > 2 then usage() end bclist(arg[1], arg[2] or "-") else if #arg ~= 2 then usage() end bcsave(ctx, arg[1], arg[2]) end end ------------------------------------------------------------------------------ -- Public module functions. module(...) start = docmd -- Process -b command line option. wcc-0.0.2/src/wsh/luajit-2.0/src/jit/dis_arm.lua0000644000175000017500000004562113122010155017610 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT ARM disassembler module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- This is a helper module used by the LuaJIT machine code dumper module. -- -- It disassembles most user-mode ARMv7 instructions -- NYI: Advanced SIMD and VFP instructions. ------------------------------------------------------------------------------ local type = type local sub, byte, format = string.sub, string.byte, string.format local match, gmatch = string.match, string.gmatch local concat = table.concat local bit = require("bit") local band, bor, ror, tohex = bit.band, bit.bor, bit.ror, bit.tohex local lshift, rshift, arshift = bit.lshift, bit.rshift, bit.arshift ------------------------------------------------------------------------------ -- Opcode maps ------------------------------------------------------------------------------ local map_loadc = { shift = 8, mask = 15, [10] = { shift = 20, mask = 1, [0] = { shift = 23, mask = 3, [0] = "vmovFmDN", "vstmFNdr", _ = { shift = 21, mask = 1, [0] = "vstrFdl", { shift = 16, mask = 15, [13] = "vpushFdr", _ = "vstmdbFNdr", } }, }, { shift = 23, mask = 3, [0] = "vmovFDNm", { shift = 16, mask = 15, [13] = "vpopFdr", _ = "vldmFNdr", }, _ = { shift = 21, mask = 1, [0] = "vldrFdl", "vldmdbFNdr", }, }, }, [11] = { shift = 20, mask = 1, [0] = { shift = 23, mask = 3, [0] = "vmovGmDN", "vstmGNdr", _ = { shift = 21, mask = 1, [0] = "vstrGdl", { shift = 16, mask = 15, [13] = "vpushGdr", _ = "vstmdbGNdr", } }, }, { shift = 23, mask = 3, [0] = "vmovGDNm", { shift = 16, mask = 15, [13] = "vpopGdr", _ = "vldmGNdr", }, _ = { shift = 21, mask = 1, [0] = "vldrGdl", "vldmdbGNdr", }, }, }, _ = { shift = 0, mask = 0 -- NYI ldc, mcrr, mrrc. }, } local map_vfps = { shift = 6, mask = 0x2c001, [0] = "vmlaF.dnm", "vmlsF.dnm", [0x04000] = "vnmlsF.dnm", [0x04001] = "vnmlaF.dnm", [0x08000] = "vmulF.dnm", [0x08001] = "vnmulF.dnm", [0x0c000] = "vaddF.dnm", [0x0c001] = "vsubF.dnm", [0x20000] = "vdivF.dnm", [0x24000] = "vfnmsF.dnm", [0x24001] = "vfnmaF.dnm", [0x28000] = "vfmaF.dnm", [0x28001] = "vfmsF.dnm", [0x2c000] = "vmovF.dY", [0x2c001] = { shift = 7, mask = 0x1e01, [0] = "vmovF.dm", "vabsF.dm", [0x0200] = "vnegF.dm", [0x0201] = "vsqrtF.dm", [0x0800] = "vcmpF.dm", [0x0801] = "vcmpeF.dm", [0x0a00] = "vcmpzF.d", [0x0a01] = "vcmpzeF.d", [0x0e01] = "vcvtG.dF.m", [0x1000] = "vcvt.f32.u32Fdm", [0x1001] = "vcvt.f32.s32Fdm", [0x1800] = "vcvtr.u32F.dm", [0x1801] = "vcvt.u32F.dm", [0x1a00] = "vcvtr.s32F.dm", [0x1a01] = "vcvt.s32F.dm", }, } local map_vfpd = { shift = 6, mask = 0x2c001, [0] = "vmlaG.dnm", "vmlsG.dnm", [0x04000] = "vnmlsG.dnm", [0x04001] = "vnmlaG.dnm", [0x08000] = "vmulG.dnm", [0x08001] = "vnmulG.dnm", [0x0c000] = "vaddG.dnm", [0x0c001] = "vsubG.dnm", [0x20000] = "vdivG.dnm", [0x24000] = "vfnmsG.dnm", [0x24001] = "vfnmaG.dnm", [0x28000] = "vfmaG.dnm", [0x28001] = "vfmsG.dnm", [0x2c000] = "vmovG.dY", [0x2c001] = { shift = 7, mask = 0x1e01, [0] = "vmovG.dm", "vabsG.dm", [0x0200] = "vnegG.dm", [0x0201] = "vsqrtG.dm", [0x0800] = "vcmpG.dm", [0x0801] = "vcmpeG.dm", [0x0a00] = "vcmpzG.d", [0x0a01] = "vcmpzeG.d", [0x0e01] = "vcvtF.dG.m", [0x1000] = "vcvt.f64.u32GdFm", [0x1001] = "vcvt.f64.s32GdFm", [0x1800] = "vcvtr.u32FdG.m", [0x1801] = "vcvt.u32FdG.m", [0x1a00] = "vcvtr.s32FdG.m", [0x1a01] = "vcvt.s32FdG.m", }, } local map_datac = { shift = 24, mask = 1, [0] = { shift = 4, mask = 1, [0] = { shift = 8, mask = 15, [10] = map_vfps, [11] = map_vfpd, -- NYI cdp, mcr, mrc. }, { shift = 8, mask = 15, [10] = { shift = 20, mask = 15, [0] = "vmovFnD", "vmovFDn", [14] = "vmsrD", [15] = { shift = 12, mask = 15, [15] = "vmrs", _ = "vmrsD", }, }, }, }, "svcT", } local map_loadcu = { shift = 0, mask = 0, -- NYI unconditional CP load/store. } local map_datacu = { shift = 0, mask = 0, -- NYI unconditional CP data. } local map_simddata = { shift = 0, mask = 0, -- NYI SIMD data. } local map_simdload = { shift = 0, mask = 0, -- NYI SIMD load/store, preload. } local map_preload = { shift = 0, mask = 0, -- NYI preload. } local map_media = { shift = 20, mask = 31, [0] = false, { --01 shift = 5, mask = 7, [0] = "sadd16DNM", "sasxDNM", "ssaxDNM", "ssub16DNM", "sadd8DNM", false, false, "ssub8DNM", }, { --02 shift = 5, mask = 7, [0] = "qadd16DNM", "qasxDNM", "qsaxDNM", "qsub16DNM", "qadd8DNM", false, false, "qsub8DNM", }, { --03 shift = 5, mask = 7, [0] = "shadd16DNM", "shasxDNM", "shsaxDNM", "shsub16DNM", "shadd8DNM", false, false, "shsub8DNM", }, false, { --05 shift = 5, mask = 7, [0] = "uadd16DNM", "uasxDNM", "usaxDNM", "usub16DNM", "uadd8DNM", false, false, "usub8DNM", }, { --06 shift = 5, mask = 7, [0] = "uqadd16DNM", "uqasxDNM", "uqsaxDNM", "uqsub16DNM", "uqadd8DNM", false, false, "uqsub8DNM", }, { --07 shift = 5, mask = 7, [0] = "uhadd16DNM", "uhasxDNM", "uhsaxDNM", "uhsub16DNM", "uhadd8DNM", false, false, "uhsub8DNM", }, { --08 shift = 5, mask = 7, [0] = "pkhbtDNMU", false, "pkhtbDNMU", { shift = 16, mask = 15, [15] = "sxtb16DMU", _ = "sxtab16DNMU", }, "pkhbtDNMU", "selDNM", "pkhtbDNMU", }, false, { --0a shift = 5, mask = 7, [0] = "ssatDxMu", "ssat16DxM", "ssatDxMu", { shift = 16, mask = 15, [15] = "sxtbDMU", _ = "sxtabDNMU", }, "ssatDxMu", false, "ssatDxMu", }, { --0b shift = 5, mask = 7, [0] = "ssatDxMu", "revDM", "ssatDxMu", { shift = 16, mask = 15, [15] = "sxthDMU", _ = "sxtahDNMU", }, "ssatDxMu", "rev16DM", "ssatDxMu", }, { --0c shift = 5, mask = 7, [3] = { shift = 16, mask = 15, [15] = "uxtb16DMU", _ = "uxtab16DNMU", }, }, false, { --0e shift = 5, mask = 7, [0] = "usatDwMu", "usat16DwM", "usatDwMu", { shift = 16, mask = 15, [15] = "uxtbDMU", _ = "uxtabDNMU", }, "usatDwMu", false, "usatDwMu", }, { --0f shift = 5, mask = 7, [0] = "usatDwMu", "rbitDM", "usatDwMu", { shift = 16, mask = 15, [15] = "uxthDMU", _ = "uxtahDNMU", }, "usatDwMu", "revshDM", "usatDwMu", }, { --10 shift = 12, mask = 15, [15] = { shift = 5, mask = 7, "smuadNMS", "smuadxNMS", "smusdNMS", "smusdxNMS", }, _ = { shift = 5, mask = 7, [0] = "smladNMSD", "smladxNMSD", "smlsdNMSD", "smlsdxNMSD", }, }, false, false, false, { --14 shift = 5, mask = 7, [0] = "smlaldDNMS", "smlaldxDNMS", "smlsldDNMS", "smlsldxDNMS", }, { --15 shift = 5, mask = 7, [0] = { shift = 12, mask = 15, [15] = "smmulNMS", _ = "smmlaNMSD", }, { shift = 12, mask = 15, [15] = "smmulrNMS", _ = "smmlarNMSD", }, false, false, false, false, "smmlsNMSD", "smmlsrNMSD", }, false, false, { --18 shift = 5, mask = 7, [0] = { shift = 12, mask = 15, [15] = "usad8NMS", _ = "usada8NMSD", }, }, false, { --1a shift = 5, mask = 3, [2] = "sbfxDMvw", }, { --1b shift = 5, mask = 3, [2] = "sbfxDMvw", }, { --1c shift = 5, mask = 3, [0] = { shift = 0, mask = 15, [15] = "bfcDvX", _ = "bfiDMvX", }, }, { --1d shift = 5, mask = 3, [0] = { shift = 0, mask = 15, [15] = "bfcDvX", _ = "bfiDMvX", }, }, { --1e shift = 5, mask = 3, [2] = "ubfxDMvw", }, { --1f shift = 5, mask = 3, [2] = "ubfxDMvw", }, } local map_load = { shift = 21, mask = 9, { shift = 20, mask = 5, [0] = "strtDL", "ldrtDL", [4] = "strbtDL", [5] = "ldrbtDL", }, _ = { shift = 20, mask = 5, [0] = "strDL", "ldrDL", [4] = "strbDL", [5] = "ldrbDL", } } local map_load1 = { shift = 4, mask = 1, [0] = map_load, map_media, } local map_loadm = { shift = 20, mask = 1, [0] = { shift = 23, mask = 3, [0] = "stmdaNR", "stmNR", { shift = 16, mask = 63, [45] = "pushR", _ = "stmdbNR", }, "stmibNR", }, { shift = 23, mask = 3, [0] = "ldmdaNR", { shift = 16, mask = 63, [61] = "popR", _ = "ldmNR", }, "ldmdbNR", "ldmibNR", }, } local map_data = { shift = 21, mask = 15, [0] = "andDNPs", "eorDNPs", "subDNPs", "rsbDNPs", "addDNPs", "adcDNPs", "sbcDNPs", "rscDNPs", "tstNP", "teqNP", "cmpNP", "cmnNP", "orrDNPs", "movDPs", "bicDNPs", "mvnDPs", } local map_mul = { shift = 21, mask = 7, [0] = "mulNMSs", "mlaNMSDs", "umaalDNMS", "mlsDNMS", "umullDNMSs", "umlalDNMSs", "smullDNMSs", "smlalDNMSs", } local map_sync = { shift = 20, mask = 15, -- NYI: brackets around N. R(D+1) for ldrexd/strexd. [0] = "swpDMN", false, false, false, "swpbDMN", false, false, false, "strexDMN", "ldrexDN", "strexdDN", "ldrexdDN", "strexbDMN", "ldrexbDN", "strexhDN", "ldrexhDN", } local map_mulh = { shift = 21, mask = 3, [0] = { shift = 5, mask = 3, [0] = "smlabbNMSD", "smlatbNMSD", "smlabtNMSD", "smlattNMSD", }, { shift = 5, mask = 3, [0] = "smlawbNMSD", "smulwbNMS", "smlawtNMSD", "smulwtNMS", }, { shift = 5, mask = 3, [0] = "smlalbbDNMS", "smlaltbDNMS", "smlalbtDNMS", "smlalttDNMS", }, { shift = 5, mask = 3, [0] = "smulbbNMS", "smultbNMS", "smulbtNMS", "smulttNMS", }, } local map_misc = { shift = 4, mask = 7, -- NYI: decode PSR bits of msr. [0] = { shift = 21, mask = 1, [0] = "mrsD", "msrM", }, { shift = 21, mask = 3, "bxM", false, "clzDM", }, { shift = 21, mask = 3, "bxjM", }, { shift = 21, mask = 3, "blxM", }, false, { shift = 21, mask = 3, [0] = "qaddDMN", "qsubDMN", "qdaddDMN", "qdsubDMN", }, false, { shift = 21, mask = 3, "bkptK", }, } local map_datar = { shift = 4, mask = 9, [9] = { shift = 5, mask = 3, [0] = { shift = 24, mask = 1, [0] = map_mul, map_sync, }, { shift = 20, mask = 1, [0] = "strhDL", "ldrhDL", }, { shift = 20, mask = 1, [0] = "ldrdDL", "ldrsbDL", }, { shift = 20, mask = 1, [0] = "strdDL", "ldrshDL", }, }, _ = { shift = 20, mask = 25, [16] = { shift = 7, mask = 1, [0] = map_misc, map_mulh, }, _ = { shift = 0, mask = 0xffffffff, [bor(0xe1a00000)] = "nop", _ = map_data, } }, } local map_datai = { shift = 20, mask = 31, -- NYI: decode PSR bits of msr. Decode imm12. [16] = "movwDW", [20] = "movtDW", [18] = { shift = 0, mask = 0xf00ff, [0] = "nopv6", _ = "msrNW", }, [22] = "msrNW", _ = map_data, } local map_branch = { shift = 24, mask = 1, [0] = "bB", "blB" } local map_condins = { [0] = map_datar, map_datai, map_load, map_load1, map_loadm, map_branch, map_loadc, map_datac } -- NYI: setend. local map_uncondins = { [0] = false, map_simddata, map_simdload, map_preload, false, "blxB", map_loadcu, map_datacu, } ------------------------------------------------------------------------------ local map_gpr = { [0] = "r0", "r1", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", "r11", "r12", "sp", "lr", "pc", } local map_cond = { [0] = "eq", "ne", "hs", "lo", "mi", "pl", "vs", "vc", "hi", "ls", "ge", "lt", "gt", "le", "al", } local map_shift = { [0] = "lsl", "lsr", "asr", "ror", } ------------------------------------------------------------------------------ -- Output a nicely formatted line with an opcode and operands. local function putop(ctx, text, operands) local pos = ctx.pos local extra = "" if ctx.rel then local sym = ctx.symtab[ctx.rel] if sym then extra = "\t->"..sym elseif band(ctx.op, 0x0e000000) ~= 0x0a000000 then extra = "\t; 0x"..tohex(ctx.rel) end end if ctx.hexdump > 0 then ctx.out(format("%08x %s %-5s %s%s\n", ctx.addr+pos, tohex(ctx.op), text, concat(operands, ", "), extra)) else ctx.out(format("%08x %-5s %s%s\n", ctx.addr+pos, text, concat(operands, ", "), extra)) end ctx.pos = pos + 4 end -- Fallback for unknown opcodes. local function unknown(ctx) return putop(ctx, ".long", { "0x"..tohex(ctx.op) }) end -- Format operand 2 of load/store opcodes. local function fmtload(ctx, op, pos) local base = map_gpr[band(rshift(op, 16), 15)] local x, ofs local ext = (band(op, 0x04000000) == 0) if not ext and band(op, 0x02000000) == 0 then ofs = band(op, 4095) if band(op, 0x00800000) == 0 then ofs = -ofs end if base == "pc" then ctx.rel = ctx.addr + pos + 8 + ofs end ofs = "#"..ofs elseif ext and band(op, 0x00400000) ~= 0 then ofs = band(op, 15) + band(rshift(op, 4), 0xf0) if band(op, 0x00800000) == 0 then ofs = -ofs end if base == "pc" then ctx.rel = ctx.addr + pos + 8 + ofs end ofs = "#"..ofs else ofs = map_gpr[band(op, 15)] if ext or band(op, 0xfe0) == 0 then elseif band(op, 0xfe0) == 0x60 then ofs = format("%s, rrx", ofs) else local sh = band(rshift(op, 7), 31) if sh == 0 then sh = 32 end ofs = format("%s, %s #%d", ofs, map_shift[band(rshift(op, 5), 3)], sh) end if band(op, 0x00800000) == 0 then ofs = "-"..ofs end end if ofs == "#0" then x = format("[%s]", base) elseif band(op, 0x01000000) == 0 then x = format("[%s], %s", base, ofs) else x = format("[%s, %s]", base, ofs) end if band(op, 0x01200000) == 0x01200000 then x = x.."!" end return x end -- Format operand 2 of vector load/store opcodes. local function fmtvload(ctx, op, pos) local base = map_gpr[band(rshift(op, 16), 15)] local ofs = band(op, 255)*4 if band(op, 0x00800000) == 0 then ofs = -ofs end if base == "pc" then ctx.rel = ctx.addr + pos + 8 + ofs end if ofs == 0 then return format("[%s]", base) else return format("[%s, #%d]", base, ofs) end end local function fmtvr(op, vr, sh0, sh1) if vr == "s" then return format("s%d", 2*band(rshift(op, sh0), 15)+band(rshift(op, sh1), 1)) else return format("d%d", band(rshift(op, sh0), 15)+band(rshift(op, sh1-4), 16)) end end -- Disassemble a single instruction. local function disass_ins(ctx) local pos = ctx.pos local b0, b1, b2, b3 = byte(ctx.code, pos+1, pos+4) local op = bor(lshift(b3, 24), lshift(b2, 16), lshift(b1, 8), b0) local operands = {} local suffix = "" local last, name, pat local vr ctx.op = op ctx.rel = nil local cond = rshift(op, 28) local opat if cond == 15 then opat = map_uncondins[band(rshift(op, 25), 7)] else if cond ~= 14 then suffix = map_cond[cond] end opat = map_condins[band(rshift(op, 25), 7)] end while type(opat) ~= "string" do if not opat then return unknown(ctx) end opat = opat[band(rshift(op, opat.shift), opat.mask)] or opat._ end name, pat = match(opat, "^([a-z0-9]*)(.*)") if sub(pat, 1, 1) == "." then local s2, p2 = match(pat, "^([a-z0-9.]*)(.*)") suffix = suffix..s2 pat = p2 end for p in gmatch(pat, ".") do local x = nil if p == "D" then x = map_gpr[band(rshift(op, 12), 15)] elseif p == "N" then x = map_gpr[band(rshift(op, 16), 15)] elseif p == "S" then x = map_gpr[band(rshift(op, 8), 15)] elseif p == "M" then x = map_gpr[band(op, 15)] elseif p == "d" then x = fmtvr(op, vr, 12, 22) elseif p == "n" then x = fmtvr(op, vr, 16, 7) elseif p == "m" then x = fmtvr(op, vr, 0, 5) elseif p == "P" then if band(op, 0x02000000) ~= 0 then x = ror(band(op, 255), 2*band(rshift(op, 8), 15)) else x = map_gpr[band(op, 15)] if band(op, 0xff0) ~= 0 then operands[#operands+1] = x local s = map_shift[band(rshift(op, 5), 3)] local r = nil if band(op, 0xf90) == 0 then if s == "ror" then s = "rrx" else r = "#32" end elseif band(op, 0x10) == 0 then r = "#"..band(rshift(op, 7), 31) else r = map_gpr[band(rshift(op, 8), 15)] end if name == "mov" then name = s; x = r elseif r then x = format("%s %s", s, r) else x = s end end end elseif p == "L" then x = fmtload(ctx, op, pos) elseif p == "l" then x = fmtvload(ctx, op, pos) elseif p == "B" then local addr = ctx.addr + pos + 8 + arshift(lshift(op, 8), 6) if cond == 15 then addr = addr + band(rshift(op, 23), 2) end ctx.rel = addr x = "0x"..tohex(addr) elseif p == "F" then vr = "s" elseif p == "G" then vr = "d" elseif p == "." then suffix = suffix..(vr == "s" and ".f32" or ".f64") elseif p == "R" then if band(op, 0x00200000) ~= 0 and #operands == 1 then operands[1] = operands[1].."!" end local t = {} for i=0,15 do if band(rshift(op, i), 1) == 1 then t[#t+1] = map_gpr[i] end end x = "{"..concat(t, ", ").."}" elseif p == "r" then if band(op, 0x00200000) ~= 0 and #operands == 2 then operands[1] = operands[1].."!" end local s = tonumber(sub(last, 2)) local n = band(op, 255) if vr == "d" then n = rshift(n, 1) end operands[#operands] = format("{%s-%s%d}", last, vr, s+n-1) elseif p == "W" then x = band(op, 0x0fff) + band(rshift(op, 4), 0xf000) elseif p == "T" then x = "#0x"..tohex(band(op, 0x00ffffff), 6) elseif p == "U" then x = band(rshift(op, 7), 31) if x == 0 then x = nil end elseif p == "u" then x = band(rshift(op, 7), 31) if band(op, 0x40) == 0 then if x == 0 then x = nil else x = "lsl #"..x end else if x == 0 then x = "asr #32" else x = "asr #"..x end end elseif p == "v" then x = band(rshift(op, 7), 31) elseif p == "w" then x = band(rshift(op, 16), 31) elseif p == "x" then x = band(rshift(op, 16), 31) + 1 elseif p == "X" then x = band(rshift(op, 16), 31) - last + 1 elseif p == "Y" then x = band(rshift(op, 12), 0xf0) + band(op, 0x0f) elseif p == "K" then x = "#0x"..tohex(band(rshift(op, 4), 0x0000fff0) + band(op, 15), 4) elseif p == "s" then if band(op, 0x00100000) ~= 0 then suffix = "s"..suffix end else assert(false) end if x then last = x if type(x) == "number" then x = "#"..x end operands[#operands+1] = x end end return putop(ctx, name..suffix, operands) end ------------------------------------------------------------------------------ -- Disassemble a block of code. local function disass_block(ctx, ofs, len) if not ofs then ofs = 0 end local stop = len and ofs+len or #ctx.code ctx.pos = ofs ctx.rel = nil while ctx.pos < stop do disass_ins(ctx) end end -- Extended API: create a disassembler context. Then call ctx:disass(ofs, len). local function create_(code, addr, out) local ctx = {} ctx.code = code ctx.addr = addr or 0 ctx.out = out or io.write ctx.symtab = {} ctx.disass = disass_block ctx.hexdump = 8 return ctx end -- Simple API: disassemble code (a string) at address and output via out. local function disass_(code, addr, out) create_(code, addr, out):disass() end -- Return register name for RID. local function regname_(r) if r < 16 then return map_gpr[r] end return "d"..(r-16) end -- Public module functions. module(...) create = create_ disass = disass_ regname = regname_ wcc-0.0.2/src/wsh/luajit-2.0/src/jit/dis_ppc.lua0000644000175000017500000004751613122010155017620 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT PPC disassembler module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT/X license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- This is a helper module used by the LuaJIT machine code dumper module. -- -- It disassembles all common, non-privileged 32/64 bit PowerPC instructions -- plus the e500 SPE instructions and some Cell/Xenon extensions. -- -- NYI: VMX, VMX128 ------------------------------------------------------------------------------ local type = type local byte, format = string.byte, string.format local match, gmatch, gsub = string.match, string.gmatch, string.gsub local concat = table.concat local bit = require("bit") local band, bor, tohex = bit.band, bit.bor, bit.tohex local lshift, rshift, arshift = bit.lshift, bit.rshift, bit.arshift ------------------------------------------------------------------------------ -- Primary and extended opcode maps ------------------------------------------------------------------------------ local map_crops = { shift = 1, mask = 1023, [0] = "mcrfXX", [33] = "crnor|crnotCCC=", [129] = "crandcCCC", [193] = "crxor|crclrCCC%", [225] = "crnandCCC", [257] = "crandCCC", [289] = "creqv|crsetCCC%", [417] = "crorcCCC", [449] = "cror|crmoveCCC=", [16] = "b_lrKB", [528] = "b_ctrKB", [150] = "isync", } local map_rlwinm = setmetatable({ shift = 0, mask = -1, }, { __index = function(t, x) local rot = band(rshift(x, 11), 31) local mb = band(rshift(x, 6), 31) local me = band(rshift(x, 1), 31) if mb == 0 and me == 31-rot then return "slwiRR~A." elseif me == 31 and mb == 32-rot then return "srwiRR~-A." else return "rlwinmRR~AAA." end end }) local map_rld = { shift = 2, mask = 7, [0] = "rldiclRR~HM.", "rldicrRR~HM.", "rldicRR~HM.", "rldimiRR~HM.", { shift = 1, mask = 1, [0] = "rldclRR~RM.", "rldcrRR~RM.", }, } local map_ext = setmetatable({ shift = 1, mask = 1023, [0] = "cmp_YLRR", [32] = "cmpl_YLRR", [4] = "twARR", [68] = "tdARR", [8] = "subfcRRR.", [40] = "subfRRR.", [104] = "negRR.", [136] = "subfeRRR.", [200] = "subfzeRR.", [232] = "subfmeRR.", [520] = "subfcoRRR.", [552] = "subfoRRR.", [616] = "negoRR.", [648] = "subfeoRRR.", [712] = "subfzeoRR.", [744] = "subfmeoRR.", [9] = "mulhduRRR.", [73] = "mulhdRRR.", [233] = "mulldRRR.", [457] = "divduRRR.", [489] = "divdRRR.", [745] = "mulldoRRR.", [969] = "divduoRRR.", [1001] = "divdoRRR.", [10] = "addcRRR.", [138] = "addeRRR.", [202] = "addzeRR.", [234] = "addmeRR.", [266] = "addRRR.", [522] = "addcoRRR.", [650] = "addeoRRR.", [714] = "addzeoRR.", [746] = "addmeoRR.", [778] = "addoRRR.", [11] = "mulhwuRRR.", [75] = "mulhwRRR.", [235] = "mullwRRR.", [459] = "divwuRRR.", [491] = "divwRRR.", [747] = "mullwoRRR.", [971] = "divwouRRR.", [1003] = "divwoRRR.", [15] = "iselltRRR", [47] = "iselgtRRR", [79] = "iseleqRRR", [144] = { shift = 20, mask = 1, [0] = "mtcrfRZ~", "mtocrfRZ~", }, [19] = { shift = 20, mask = 1, [0] = "mfcrR", "mfocrfRZ", }, [371] = { shift = 11, mask = 1023, [392] = "mftbR", [424] = "mftbuR", }, [339] = { shift = 11, mask = 1023, [32] = "mferR", [256] = "mflrR", [288] = "mfctrR", [16] = "mfspefscrR", }, [467] = { shift = 11, mask = 1023, [32] = "mtxerR", [256] = "mtlrR", [288] = "mtctrR", [16] = "mtspefscrR", }, [20] = "lwarxRR0R", [84] = "ldarxRR0R", [21] = "ldxRR0R", [53] = "lduxRRR", [149] = "stdxRR0R", [181] = "stduxRRR", [341] = "lwaxRR0R", [373] = "lwauxRRR", [23] = "lwzxRR0R", [55] = "lwzuxRRR", [87] = "lbzxRR0R", [119] = "lbzuxRRR", [151] = "stwxRR0R", [183] = "stwuxRRR", [215] = "stbxRR0R", [247] = "stbuxRRR", [279] = "lhzxRR0R", [311] = "lhzuxRRR", [343] = "lhaxRR0R", [375] = "lhauxRRR", [407] = "sthxRR0R", [439] = "sthuxRRR", [54] = "dcbst-R0R", [86] = "dcbf-R0R", [150] = "stwcxRR0R.", [214] = "stdcxRR0R.", [246] = "dcbtst-R0R", [278] = "dcbt-R0R", [310] = "eciwxRR0R", [438] = "ecowxRR0R", [470] = "dcbi-RR", [598] = { shift = 21, mask = 3, [0] = "sync", "lwsync", "ptesync", }, [758] = "dcba-RR", [854] = "eieio", [982] = "icbi-R0R", [1014] = "dcbz-R0R", [26] = "cntlzwRR~", [58] = "cntlzdRR~", [122] = "popcntbRR~", [154] = "prtywRR~", [186] = "prtydRR~", [28] = "andRR~R.", [60] = "andcRR~R.", [124] = "nor|notRR~R=.", [284] = "eqvRR~R.", [316] = "xorRR~R.", [412] = "orcRR~R.", [444] = "or|mrRR~R=.", [476] = "nandRR~R.", [508] = "cmpbRR~R", [512] = "mcrxrX", [532] = "ldbrxRR0R", [660] = "stdbrxRR0R", [533] = "lswxRR0R", [597] = "lswiRR0A", [661] = "stswxRR0R", [725] = "stswiRR0A", [534] = "lwbrxRR0R", [662] = "stwbrxRR0R", [790] = "lhbrxRR0R", [918] = "sthbrxRR0R", [535] = "lfsxFR0R", [567] = "lfsuxFRR", [599] = "lfdxFR0R", [631] = "lfduxFRR", [663] = "stfsxFR0R", [695] = "stfsuxFRR", [727] = "stfdxFR0R", [759] = "stfduxFR0R", [855] = "lfiwaxFR0R", [983] = "stfiwxFR0R", [24] = "slwRR~R.", [27] = "sldRR~R.", [536] = "srwRR~R.", [792] = "srawRR~R.", [824] = "srawiRR~A.", [794] = "sradRR~R.", [826] = "sradiRR~H.", [827] = "sradiRR~H.", [922] = "extshRR~.", [954] = "extsbRR~.", [986] = "extswRR~.", [539] = "srdRR~R.", }, { __index = function(t, x) if band(x, 31) == 15 then return "iselRRRC" end end }) local map_ld = { shift = 0, mask = 3, [0] = "ldRRE", "lduRRE", "lwaRRE", } local map_std = { shift = 0, mask = 3, [0] = "stdRRE", "stduRRE", } local map_fps = { shift = 5, mask = 1, { shift = 1, mask = 15, [0] = false, false, "fdivsFFF.", false, "fsubsFFF.", "faddsFFF.", "fsqrtsF-F.", false, "fresF-F.", "fmulsFF-F.", "frsqrtesF-F.", false, "fmsubsFFFF~.", "fmaddsFFFF~.", "fnmsubsFFFF~.", "fnmaddsFFFF~.", } } local map_fpd = { shift = 5, mask = 1, [0] = { shift = 1, mask = 1023, [0] = "fcmpuXFF", [32] = "fcmpoXFF", [64] = "mcrfsXX", [38] = "mtfsb1A.", [70] = "mtfsb0A.", [134] = "mtfsfiA>>-A>", [8] = "fcpsgnFFF.", [40] = "fnegF-F.", [72] = "fmrF-F.", [136] = "fnabsF-F.", [264] = "fabsF-F.", [12] = "frspF-F.", [14] = "fctiwF-F.", [15] = "fctiwzF-F.", [583] = "mffsF.", [711] = "mtfsfZF.", [392] = "frinF-F.", [424] = "frizF-F.", [456] = "fripF-F.", [488] = "frimF-F.", [814] = "fctidF-F.", [815] = "fctidzF-F.", [846] = "fcfidF-F.", }, { shift = 1, mask = 15, [0] = false, false, "fdivFFF.", false, "fsubFFF.", "faddFFF.", "fsqrtF-F.", "fselFFFF~.", "freF-F.", "fmulFF-F.", "frsqrteF-F.", false, "fmsubFFFF~.", "fmaddFFFF~.", "fnmsubFFFF~.", "fnmaddFFFF~.", } } local map_spe = { shift = 0, mask = 2047, [512] = "evaddwRRR", [514] = "evaddiwRAR~", [516] = "evsubwRRR~", [518] = "evsubiwRAR~", [520] = "evabsRR", [521] = "evnegRR", [522] = "evextsbRR", [523] = "evextshRR", [524] = "evrndwRR", [525] = "evcntlzwRR", [526] = "evcntlswRR", [527] = "brincRRR", [529] = "evandRRR", [530] = "evandcRRR", [534] = "evxorRRR", [535] = "evor|evmrRRR=", [536] = "evnor|evnotRRR=", [537] = "eveqvRRR", [539] = "evorcRRR", [542] = "evnandRRR", [544] = "evsrwuRRR", [545] = "evsrwsRRR", [546] = "evsrwiuRRA", [547] = "evsrwisRRA", [548] = "evslwRRR", [550] = "evslwiRRA", [552] = "evrlwRRR", [553] = "evsplatiRS", [554] = "evrlwiRRA", [555] = "evsplatfiRS", [556] = "evmergehiRRR", [557] = "evmergeloRRR", [558] = "evmergehiloRRR", [559] = "evmergelohiRRR", [560] = "evcmpgtuYRR", [561] = "evcmpgtsYRR", [562] = "evcmpltuYRR", [563] = "evcmpltsYRR", [564] = "evcmpeqYRR", [632] = "evselRRR", [633] = "evselRRRW", [634] = "evselRRRW", [635] = "evselRRRW", [636] = "evselRRRW", [637] = "evselRRRW", [638] = "evselRRRW", [639] = "evselRRRW", [640] = "evfsaddRRR", [641] = "evfssubRRR", [644] = "evfsabsRR", [645] = "evfsnabsRR", [646] = "evfsnegRR", [648] = "evfsmulRRR", [649] = "evfsdivRRR", [652] = "evfscmpgtYRR", [653] = "evfscmpltYRR", [654] = "evfscmpeqYRR", [656] = "evfscfuiR-R", [657] = "evfscfsiR-R", [658] = "evfscfufR-R", [659] = "evfscfsfR-R", [660] = "evfsctuiR-R", [661] = "evfsctsiR-R", [662] = "evfsctufR-R", [663] = "evfsctsfR-R", [664] = "evfsctuizR-R", [666] = "evfsctsizR-R", [668] = "evfststgtYRR", [669] = "evfststltYRR", [670] = "evfststeqYRR", [704] = "efsaddRRR", [705] = "efssubRRR", [708] = "efsabsRR", [709] = "efsnabsRR", [710] = "efsnegRR", [712] = "efsmulRRR", [713] = "efsdivRRR", [716] = "efscmpgtYRR", [717] = "efscmpltYRR", [718] = "efscmpeqYRR", [719] = "efscfdR-R", [720] = "efscfuiR-R", [721] = "efscfsiR-R", [722] = "efscfufR-R", [723] = "efscfsfR-R", [724] = "efsctuiR-R", [725] = "efsctsiR-R", [726] = "efsctufR-R", [727] = "efsctsfR-R", [728] = "efsctuizR-R", [730] = "efsctsizR-R", [732] = "efststgtYRR", [733] = "efststltYRR", [734] = "efststeqYRR", [736] = "efdaddRRR", [737] = "efdsubRRR", [738] = "efdcfuidR-R", [739] = "efdcfsidR-R", [740] = "efdabsRR", [741] = "efdnabsRR", [742] = "efdnegRR", [744] = "efdmulRRR", [745] = "efddivRRR", [746] = "efdctuidzR-R", [747] = "efdctsidzR-R", [748] = "efdcmpgtYRR", [749] = "efdcmpltYRR", [750] = "efdcmpeqYRR", [751] = "efdcfsR-R", [752] = "efdcfuiR-R", [753] = "efdcfsiR-R", [754] = "efdcfufR-R", [755] = "efdcfsfR-R", [756] = "efdctuiR-R", [757] = "efdctsiR-R", [758] = "efdctufR-R", [759] = "efdctsfR-R", [760] = "efdctuizR-R", [762] = "efdctsizR-R", [764] = "efdtstgtYRR", [765] = "efdtstltYRR", [766] = "efdtsteqYRR", [768] = "evlddxRR0R", [769] = "evlddRR8", [770] = "evldwxRR0R", [771] = "evldwRR8", [772] = "evldhxRR0R", [773] = "evldhRR8", [776] = "evlhhesplatxRR0R", [777] = "evlhhesplatRR2", [780] = "evlhhousplatxRR0R", [781] = "evlhhousplatRR2", [782] = "evlhhossplatxRR0R", [783] = "evlhhossplatRR2", [784] = "evlwhexRR0R", [785] = "evlwheRR4", [788] = "evlwhouxRR0R", [789] = "evlwhouRR4", [790] = "evlwhosxRR0R", [791] = "evlwhosRR4", [792] = "evlwwsplatxRR0R", [793] = "evlwwsplatRR4", [796] = "evlwhsplatxRR0R", [797] = "evlwhsplatRR4", [800] = "evstddxRR0R", [801] = "evstddRR8", [802] = "evstdwxRR0R", [803] = "evstdwRR8", [804] = "evstdhxRR0R", [805] = "evstdhRR8", [816] = "evstwhexRR0R", [817] = "evstwheRR4", [820] = "evstwhoxRR0R", [821] = "evstwhoRR4", [824] = "evstwwexRR0R", [825] = "evstwweRR4", [828] = "evstwwoxRR0R", [829] = "evstwwoRR4", [1027] = "evmhessfRRR", [1031] = "evmhossfRRR", [1032] = "evmheumiRRR", [1033] = "evmhesmiRRR", [1035] = "evmhesmfRRR", [1036] = "evmhoumiRRR", [1037] = "evmhosmiRRR", [1039] = "evmhosmfRRR", [1059] = "evmhessfaRRR", [1063] = "evmhossfaRRR", [1064] = "evmheumiaRRR", [1065] = "evmhesmiaRRR", [1067] = "evmhesmfaRRR", [1068] = "evmhoumiaRRR", [1069] = "evmhosmiaRRR", [1071] = "evmhosmfaRRR", [1095] = "evmwhssfRRR", [1096] = "evmwlumiRRR", [1100] = "evmwhumiRRR", [1101] = "evmwhsmiRRR", [1103] = "evmwhsmfRRR", [1107] = "evmwssfRRR", [1112] = "evmwumiRRR", [1113] = "evmwsmiRRR", [1115] = "evmwsmfRRR", [1127] = "evmwhssfaRRR", [1128] = "evmwlumiaRRR", [1132] = "evmwhumiaRRR", [1133] = "evmwhsmiaRRR", [1135] = "evmwhsmfaRRR", [1139] = "evmwssfaRRR", [1144] = "evmwumiaRRR", [1145] = "evmwsmiaRRR", [1147] = "evmwsmfaRRR", [1216] = "evaddusiaawRR", [1217] = "evaddssiaawRR", [1218] = "evsubfusiaawRR", [1219] = "evsubfssiaawRR", [1220] = "evmraRR", [1222] = "evdivwsRRR", [1223] = "evdivwuRRR", [1224] = "evaddumiaawRR", [1225] = "evaddsmiaawRR", [1226] = "evsubfumiaawRR", [1227] = "evsubfsmiaawRR", [1280] = "evmheusiaawRRR", [1281] = "evmhessiaawRRR", [1283] = "evmhessfaawRRR", [1284] = "evmhousiaawRRR", [1285] = "evmhossiaawRRR", [1287] = "evmhossfaawRRR", [1288] = "evmheumiaawRRR", [1289] = "evmhesmiaawRRR", [1291] = "evmhesmfaawRRR", [1292] = "evmhoumiaawRRR", [1293] = "evmhosmiaawRRR", [1295] = "evmhosmfaawRRR", [1320] = "evmhegumiaaRRR", [1321] = "evmhegsmiaaRRR", [1323] = "evmhegsmfaaRRR", [1324] = "evmhogumiaaRRR", [1325] = "evmhogsmiaaRRR", [1327] = "evmhogsmfaaRRR", [1344] = "evmwlusiaawRRR", [1345] = "evmwlssiaawRRR", [1352] = "evmwlumiaawRRR", [1353] = "evmwlsmiaawRRR", [1363] = "evmwssfaaRRR", [1368] = "evmwumiaaRRR", [1369] = "evmwsmiaaRRR", [1371] = "evmwsmfaaRRR", [1408] = "evmheusianwRRR", [1409] = "evmhessianwRRR", [1411] = "evmhessfanwRRR", [1412] = "evmhousianwRRR", [1413] = "evmhossianwRRR", [1415] = "evmhossfanwRRR", [1416] = "evmheumianwRRR", [1417] = "evmhesmianwRRR", [1419] = "evmhesmfanwRRR", [1420] = "evmhoumianwRRR", [1421] = "evmhosmianwRRR", [1423] = "evmhosmfanwRRR", [1448] = "evmhegumianRRR", [1449] = "evmhegsmianRRR", [1451] = "evmhegsmfanRRR", [1452] = "evmhogumianRRR", [1453] = "evmhogsmianRRR", [1455] = "evmhogsmfanRRR", [1472] = "evmwlusianwRRR", [1473] = "evmwlssianwRRR", [1480] = "evmwlumianwRRR", [1481] = "evmwlsmianwRRR", [1491] = "evmwssfanRRR", [1496] = "evmwumianRRR", [1497] = "evmwsmianRRR", [1499] = "evmwsmfanRRR", } local map_pri = { [0] = false, false, "tdiARI", "twiARI", map_spe, false, false, "mulliRRI", "subficRRI", false, "cmpl_iYLRU", "cmp_iYLRI", "addicRRI", "addic.RRI", "addi|liRR0I", "addis|lisRR0I", "b_KBJ", "sc", "bKJ", map_crops, "rlwimiRR~AAA.", map_rlwinm, false, "rlwnmRR~RAA.", "oriNRR~U", "orisRR~U", "xoriRR~U", "xorisRR~U", "andi.RR~U", "andis.RR~U", map_rld, map_ext, "lwzRRD", "lwzuRRD", "lbzRRD", "lbzuRRD", "stwRRD", "stwuRRD", "stbRRD", "stbuRRD", "lhzRRD", "lhzuRRD", "lhaRRD", "lhauRRD", "sthRRD", "sthuRRD", "lmwRRD", "stmwRRD", "lfsFRD", "lfsuFRD", "lfdFRD", "lfduFRD", "stfsFRD", "stfsuFRD", "stfdFRD", "stfduFRD", false, false, map_ld, map_fps, false, false, map_std, map_fpd, } ------------------------------------------------------------------------------ local map_gpr = { [0] = "r0", "sp", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", "r11", "r12", "r13", "r14", "r15", "r16", "r17", "r18", "r19", "r20", "r21", "r22", "r23", "r24", "r25", "r26", "r27", "r28", "r29", "r30", "r31", } local map_cond = { [0] = "lt", "gt", "eq", "so", "ge", "le", "ne", "ns", } -- Format a condition bit. local function condfmt(cond) if cond <= 3 then return map_cond[band(cond, 3)] else return format("4*cr%d+%s", rshift(cond, 2), map_cond[band(cond, 3)]) end end ------------------------------------------------------------------------------ -- Output a nicely formatted line with an opcode and operands. local function putop(ctx, text, operands) local pos = ctx.pos local extra = "" if ctx.rel then local sym = ctx.symtab[ctx.rel] if sym then extra = "\t->"..sym end end if ctx.hexdump > 0 then ctx.out(format("%08x %s %-7s %s%s\n", ctx.addr+pos, tohex(ctx.op), text, concat(operands, ", "), extra)) else ctx.out(format("%08x %-7s %s%s\n", ctx.addr+pos, text, concat(operands, ", "), extra)) end ctx.pos = pos + 4 end -- Fallback for unknown opcodes. local function unknown(ctx) return putop(ctx, ".long", { "0x"..tohex(ctx.op) }) end -- Disassemble a single instruction. local function disass_ins(ctx) local pos = ctx.pos local b0, b1, b2, b3 = byte(ctx.code, pos+1, pos+4) local op = bor(lshift(b0, 24), lshift(b1, 16), lshift(b2, 8), b3) local operands = {} local last = nil local rs = 21 ctx.op = op ctx.rel = nil local opat = map_pri[rshift(b0, 2)] while type(opat) ~= "string" do if not opat then return unknown(ctx) end opat = opat[band(rshift(op, opat.shift), opat.mask)] end local name, pat = match(opat, "^([a-z0-9_.]*)(.*)") local altname, pat2 = match(pat, "|([a-z0-9_.]*)(.*)") if altname then pat = pat2 end for p in gmatch(pat, ".") do local x = nil if p == "R" then x = map_gpr[band(rshift(op, rs), 31)] rs = rs - 5 elseif p == "F" then x = "f"..band(rshift(op, rs), 31) rs = rs - 5 elseif p == "A" then x = band(rshift(op, rs), 31) rs = rs - 5 elseif p == "S" then x = arshift(lshift(op, 27-rs), 27) rs = rs - 5 elseif p == "I" then x = arshift(lshift(op, 16), 16) elseif p == "U" then x = band(op, 0xffff) elseif p == "D" or p == "E" then local disp = arshift(lshift(op, 16), 16) if p == "E" then disp = band(disp, -4) end if last == "r0" then last = "0" end operands[#operands] = format("%d(%s)", disp, last) elseif p >= "2" and p <= "8" then local disp = band(rshift(op, rs), 31) * p if last == "r0" then last = "0" end operands[#operands] = format("%d(%s)", disp, last) elseif p == "H" then x = band(rshift(op, rs), 31) + lshift(band(op, 2), 4) rs = rs - 5 elseif p == "M" then x = band(rshift(op, rs), 31) + band(op, 0x20) elseif p == "C" then x = condfmt(band(rshift(op, rs), 31)) rs = rs - 5 elseif p == "B" then local bo = rshift(op, 21) local cond = band(rshift(op, 16), 31) local cn = "" rs = rs - 10 if band(bo, 4) == 0 then cn = band(bo, 2) == 0 and "dnz" or "dz" if band(bo, 0x10) == 0 then cn = cn..(band(bo, 8) == 0 and "f" or "t") end if band(bo, 0x10) == 0 then x = condfmt(cond) end name = name..(band(bo, 1) == band(rshift(op, 15), 1) and "-" or "+") elseif band(bo, 0x10) == 0 then cn = map_cond[band(cond, 3) + (band(bo, 8) == 0 and 4 or 0)] if cond > 3 then x = "cr"..rshift(cond, 2) end name = name..(band(bo, 1) == band(rshift(op, 15), 1) and "-" or "+") end name = gsub(name, "_", cn) elseif p == "J" then x = arshift(lshift(op, 27-rs), 29-rs)*4 if band(op, 2) == 0 then x = ctx.addr + pos + x end ctx.rel = x x = "0x"..tohex(x) elseif p == "K" then if band(op, 1) ~= 0 then name = name.."l" end if band(op, 2) ~= 0 then name = name.."a" end elseif p == "X" or p == "Y" then x = band(rshift(op, rs+2), 7) if x == 0 and p == "Y" then x = nil else x = "cr"..x end rs = rs - 5 elseif p == "W" then x = "cr"..band(op, 7) elseif p == "Z" then x = band(rshift(op, rs-4), 255) rs = rs - 10 elseif p == ">" then operands[#operands] = rshift(operands[#operands], 1) elseif p == "0" then if last == "r0" then operands[#operands] = nil if altname then name = altname end end elseif p == "L" then name = gsub(name, "_", band(op, 0x00200000) ~= 0 and "d" or "w") elseif p == "." then if band(op, 1) == 1 then name = name.."." end elseif p == "N" then if op == 0x60000000 then name = "nop"; break end elseif p == "~" then local n = #operands operands[n-1], operands[n] = operands[n], operands[n-1] elseif p == "=" then local n = #operands if last == operands[n-1] then operands[n] = nil name = altname end elseif p == "%" then local n = #operands if last == operands[n-1] and last == operands[n-2] then operands[n] = nil operands[n-1] = nil name = altname end elseif p == "-" then rs = rs - 5 else assert(false) end if x then operands[#operands+1] = x; last = x end end return putop(ctx, name, operands) end ------------------------------------------------------------------------------ -- Disassemble a block of code. local function disass_block(ctx, ofs, len) if not ofs then ofs = 0 end local stop = len and ofs+len or #ctx.code stop = stop - stop % 4 ctx.pos = ofs - ofs % 4 ctx.rel = nil while ctx.pos < stop do disass_ins(ctx) end end -- Extended API: create a disassembler context. Then call ctx:disass(ofs, len). local function create_(code, addr, out) local ctx = {} ctx.code = code ctx.addr = addr or 0 ctx.out = out or io.write ctx.symtab = {} ctx.disass = disass_block ctx.hexdump = 8 return ctx end -- Simple API: disassemble code (a string) at address and output via out. local function disass_(code, addr, out) create_(code, addr, out):disass() end -- Return register name for RID. local function regname_(r) if r < 32 then return map_gpr[r] end return "f"..(r-32) end -- Public module functions. module(...) create = create_ disass = disass_ regname = regname_ wcc-0.0.2/src/wsh/luajit-2.0/src/jit/dis_x86.lua0000644000175000017500000007122213122010155017452 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT x86/x64 disassembler module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- This is a helper module used by the LuaJIT machine code dumper module. -- -- Sending small code snippets to an external disassembler and mixing the -- output with our own stuff was too fragile. So I had to bite the bullet -- and write yet another x86 disassembler. Oh well ... -- -- The output format is very similar to what ndisasm generates. But it has -- been developed independently by looking at the opcode tables from the -- Intel and AMD manuals. The supported instruction set is quite extensive -- and reflects what a current generation Intel or AMD CPU implements in -- 32 bit and 64 bit mode. Yes, this includes MMX, SSE, SSE2, SSE3, SSSE3, -- SSE4.1, SSE4.2, SSE4a and even privileged and hypervisor (VMX/SVM) -- instructions. -- -- Notes: -- * The (useless) a16 prefix, 3DNow and pre-586 opcodes are unsupported. -- * No attempt at optimization has been made -- it's fast enough for my needs. -- * The public API may change when more architectures are added. ------------------------------------------------------------------------------ local type = type local sub, byte, format = string.sub, string.byte, string.format local match, gmatch, gsub = string.match, string.gmatch, string.gsub local lower, rep = string.lower, string.rep -- Map for 1st opcode byte in 32 bit mode. Ugly? Well ... read on. local map_opc1_32 = { --0x [0]="addBmr","addVmr","addBrm","addVrm","addBai","addVai","push es","pop es", "orBmr","orVmr","orBrm","orVrm","orBai","orVai","push cs","opc2*", --1x "adcBmr","adcVmr","adcBrm","adcVrm","adcBai","adcVai","push ss","pop ss", "sbbBmr","sbbVmr","sbbBrm","sbbVrm","sbbBai","sbbVai","push ds","pop ds", --2x "andBmr","andVmr","andBrm","andVrm","andBai","andVai","es:seg","daa", "subBmr","subVmr","subBrm","subVrm","subBai","subVai","cs:seg","das", --3x "xorBmr","xorVmr","xorBrm","xorVrm","xorBai","xorVai","ss:seg","aaa", "cmpBmr","cmpVmr","cmpBrm","cmpVrm","cmpBai","cmpVai","ds:seg","aas", --4x "incVR","incVR","incVR","incVR","incVR","incVR","incVR","incVR", "decVR","decVR","decVR","decVR","decVR","decVR","decVR","decVR", --5x "pushUR","pushUR","pushUR","pushUR","pushUR","pushUR","pushUR","pushUR", "popUR","popUR","popUR","popUR","popUR","popUR","popUR","popUR", --6x "sz*pushaw,pusha","sz*popaw,popa","boundVrm","arplWmr", "fs:seg","gs:seg","o16:","a16", "pushUi","imulVrmi","pushBs","imulVrms", "insb","insVS","outsb","outsVS", --7x "joBj","jnoBj","jbBj","jnbBj","jzBj","jnzBj","jbeBj","jaBj", "jsBj","jnsBj","jpeBj","jpoBj","jlBj","jgeBj","jleBj","jgBj", --8x "arith!Bmi","arith!Vmi","arith!Bmi","arith!Vms", "testBmr","testVmr","xchgBrm","xchgVrm", "movBmr","movVmr","movBrm","movVrm", "movVmg","leaVrm","movWgm","popUm", --9x "nop*xchgVaR|pause|xchgWaR|repne nop","xchgVaR","xchgVaR","xchgVaR", "xchgVaR","xchgVaR","xchgVaR","xchgVaR", "sz*cbw,cwde,cdqe","sz*cwd,cdq,cqo","call farViw","wait", "sz*pushfw,pushf","sz*popfw,popf","sahf","lahf", --Ax "movBao","movVao","movBoa","movVoa", "movsb","movsVS","cmpsb","cmpsVS", "testBai","testVai","stosb","stosVS", "lodsb","lodsVS","scasb","scasVS", --Bx "movBRi","movBRi","movBRi","movBRi","movBRi","movBRi","movBRi","movBRi", "movVRI","movVRI","movVRI","movVRI","movVRI","movVRI","movVRI","movVRI", --Cx "shift!Bmu","shift!Vmu","retBw","ret","$lesVrm","$ldsVrm","movBmi","movVmi", "enterBwu","leave","retfBw","retf","int3","intBu","into","iretVS", --Dx "shift!Bm1","shift!Vm1","shift!Bmc","shift!Vmc","aamBu","aadBu","salc","xlatb", "fp*0","fp*1","fp*2","fp*3","fp*4","fp*5","fp*6","fp*7", --Ex "loopneBj","loopeBj","loopBj","sz*jcxzBj,jecxzBj,jrcxzBj", "inBau","inVau","outBua","outVua", "callVj","jmpVj","jmp farViw","jmpBj","inBad","inVad","outBda","outVda", --Fx "lock:","int1","repne:rep","rep:","hlt","cmc","testb!Bm","testv!Vm", "clc","stc","cli","sti","cld","std","incb!Bm","incd!Vm", } assert(#map_opc1_32 == 255) -- Map for 1st opcode byte in 64 bit mode (overrides only). local map_opc1_64 = setmetatable({ [0x06]=false, [0x07]=false, [0x0e]=false, [0x16]=false, [0x17]=false, [0x1e]=false, [0x1f]=false, [0x27]=false, [0x2f]=false, [0x37]=false, [0x3f]=false, [0x60]=false, [0x61]=false, [0x62]=false, [0x63]="movsxdVrDmt", [0x67]="a32:", [0x40]="rex*", [0x41]="rex*b", [0x42]="rex*x", [0x43]="rex*xb", [0x44]="rex*r", [0x45]="rex*rb", [0x46]="rex*rx", [0x47]="rex*rxb", [0x48]="rex*w", [0x49]="rex*wb", [0x4a]="rex*wx", [0x4b]="rex*wxb", [0x4c]="rex*wr", [0x4d]="rex*wrb", [0x4e]="rex*wrx", [0x4f]="rex*wrxb", [0x82]=false, [0x9a]=false, [0xc4]=false, [0xc5]=false, [0xce]=false, [0xd4]=false, [0xd5]=false, [0xd6]=false, [0xea]=false, }, { __index = map_opc1_32 }) -- Map for 2nd opcode byte (0F xx). True CISC hell. Hey, I told you. -- Prefix dependent MMX/SSE opcodes: (none)|rep|o16|repne, -|F3|66|F2 local map_opc2 = { --0x [0]="sldt!Dmp","sgdt!Ump","larVrm","lslVrm",nil,"syscall","clts","sysret", "invd","wbinvd",nil,"ud1",nil,"$prefetch!Bm","femms","3dnowMrmu", --1x "movupsXrm|movssXrm|movupdXrm|movsdXrm", "movupsXmr|movssXmr|movupdXmr|movsdXmr", "movhlpsXrm$movlpsXrm|movsldupXrm|movlpdXrm|movddupXrm", "movlpsXmr||movlpdXmr", "unpcklpsXrm||unpcklpdXrm", "unpckhpsXrm||unpckhpdXrm", "movlhpsXrm$movhpsXrm|movshdupXrm|movhpdXrm", "movhpsXmr||movhpdXmr", "$prefetcht!Bm","hintnopVm","hintnopVm","hintnopVm", "hintnopVm","hintnopVm","hintnopVm","hintnopVm", --2x "movUmx$","movUmy$","movUxm$","movUym$","movUmz$",nil,"movUzm$",nil, "movapsXrm||movapdXrm", "movapsXmr||movapdXmr", "cvtpi2psXrMm|cvtsi2ssXrVmt|cvtpi2pdXrMm|cvtsi2sdXrVmt", "movntpsXmr|movntssXmr|movntpdXmr|movntsdXmr", "cvttps2piMrXm|cvttss2siVrXm|cvttpd2piMrXm|cvttsd2siVrXm", "cvtps2piMrXm|cvtss2siVrXm|cvtpd2piMrXm|cvtsd2siVrXm", "ucomissXrm||ucomisdXrm", "comissXrm||comisdXrm", --3x "wrmsr","rdtsc","rdmsr","rdpmc","sysenter","sysexit",nil,"getsec", "opc3*38",nil,"opc3*3a",nil,nil,nil,nil,nil, --4x "cmovoVrm","cmovnoVrm","cmovbVrm","cmovnbVrm", "cmovzVrm","cmovnzVrm","cmovbeVrm","cmovaVrm", "cmovsVrm","cmovnsVrm","cmovpeVrm","cmovpoVrm", "cmovlVrm","cmovgeVrm","cmovleVrm","cmovgVrm", --5x "movmskpsVrXm$||movmskpdVrXm$","sqrtpsXrm|sqrtssXrm|sqrtpdXrm|sqrtsdXrm", "rsqrtpsXrm|rsqrtssXrm","rcppsXrm|rcpssXrm", "andpsXrm||andpdXrm","andnpsXrm||andnpdXrm", "orpsXrm||orpdXrm","xorpsXrm||xorpdXrm", "addpsXrm|addssXrm|addpdXrm|addsdXrm","mulpsXrm|mulssXrm|mulpdXrm|mulsdXrm", "cvtps2pdXrm|cvtss2sdXrm|cvtpd2psXrm|cvtsd2ssXrm", "cvtdq2psXrm|cvttps2dqXrm|cvtps2dqXrm", "subpsXrm|subssXrm|subpdXrm|subsdXrm","minpsXrm|minssXrm|minpdXrm|minsdXrm", "divpsXrm|divssXrm|divpdXrm|divsdXrm","maxpsXrm|maxssXrm|maxpdXrm|maxsdXrm", --6x "punpcklbwPrm","punpcklwdPrm","punpckldqPrm","packsswbPrm", "pcmpgtbPrm","pcmpgtwPrm","pcmpgtdPrm","packuswbPrm", "punpckhbwPrm","punpckhwdPrm","punpckhdqPrm","packssdwPrm", "||punpcklqdqXrm","||punpckhqdqXrm", "movPrVSm","movqMrm|movdquXrm|movdqaXrm", --7x "pshufwMrmu|pshufhwXrmu|pshufdXrmu|pshuflwXrmu","pshiftw!Pmu", "pshiftd!Pmu","pshiftq!Mmu||pshiftdq!Xmu", "pcmpeqbPrm","pcmpeqwPrm","pcmpeqdPrm","emms|", "vmreadUmr||extrqXmuu$|insertqXrmuu$","vmwriteUrm||extrqXrm$|insertqXrm$", nil,nil, "||haddpdXrm|haddpsXrm","||hsubpdXrm|hsubpsXrm", "movVSmMr|movqXrm|movVSmXr","movqMmr|movdquXmr|movdqaXmr", --8x "joVj","jnoVj","jbVj","jnbVj","jzVj","jnzVj","jbeVj","jaVj", "jsVj","jnsVj","jpeVj","jpoVj","jlVj","jgeVj","jleVj","jgVj", --9x "setoBm","setnoBm","setbBm","setnbBm","setzBm","setnzBm","setbeBm","setaBm", "setsBm","setnsBm","setpeBm","setpoBm","setlBm","setgeBm","setleBm","setgBm", --Ax "push fs","pop fs","cpuid","btVmr","shldVmru","shldVmrc",nil,nil, "push gs","pop gs","rsm","btsVmr","shrdVmru","shrdVmrc","fxsave!Dmp","imulVrm", --Bx "cmpxchgBmr","cmpxchgVmr","$lssVrm","btrVmr", "$lfsVrm","$lgsVrm","movzxVrBmt","movzxVrWmt", "|popcntVrm","ud2Dp","bt!Vmu","btcVmr", "bsfVrm","bsrVrm|lzcntVrm|bsrWrm","movsxVrBmt","movsxVrWmt", --Cx "xaddBmr","xaddVmr", "cmppsXrmu|cmpssXrmu|cmppdXrmu|cmpsdXrmu","$movntiVmr|", "pinsrwPrWmu","pextrwDrPmu", "shufpsXrmu||shufpdXrmu","$cmpxchg!Qmp", "bswapVR","bswapVR","bswapVR","bswapVR","bswapVR","bswapVR","bswapVR","bswapVR", --Dx "||addsubpdXrm|addsubpsXrm","psrlwPrm","psrldPrm","psrlqPrm", "paddqPrm","pmullwPrm", "|movq2dqXrMm|movqXmr|movdq2qMrXm$","pmovmskbVrMm||pmovmskbVrXm", "psubusbPrm","psubuswPrm","pminubPrm","pandPrm", "paddusbPrm","padduswPrm","pmaxubPrm","pandnPrm", --Ex "pavgbPrm","psrawPrm","psradPrm","pavgwPrm", "pmulhuwPrm","pmulhwPrm", "|cvtdq2pdXrm|cvttpd2dqXrm|cvtpd2dqXrm","$movntqMmr||$movntdqXmr", "psubsbPrm","psubswPrm","pminswPrm","porPrm", "paddsbPrm","paddswPrm","pmaxswPrm","pxorPrm", --Fx "|||lddquXrm","psllwPrm","pslldPrm","psllqPrm", "pmuludqPrm","pmaddwdPrm","psadbwPrm","maskmovqMrm||maskmovdquXrm$", "psubbPrm","psubwPrm","psubdPrm","psubqPrm", "paddbPrm","paddwPrm","padddPrm","ud", } assert(map_opc2[255] == "ud") -- Map for three-byte opcodes. Can't wait for their next invention. local map_opc3 = { ["38"] = { -- [66] 0f 38 xx --0x [0]="pshufbPrm","phaddwPrm","phadddPrm","phaddswPrm", "pmaddubswPrm","phsubwPrm","phsubdPrm","phsubswPrm", "psignbPrm","psignwPrm","psigndPrm","pmulhrswPrm", nil,nil,nil,nil, --1x "||pblendvbXrma",nil,nil,nil, "||blendvpsXrma","||blendvpdXrma",nil,"||ptestXrm", nil,nil,nil,nil, "pabsbPrm","pabswPrm","pabsdPrm",nil, --2x "||pmovsxbwXrm","||pmovsxbdXrm","||pmovsxbqXrm","||pmovsxwdXrm", "||pmovsxwqXrm","||pmovsxdqXrm",nil,nil, "||pmuldqXrm","||pcmpeqqXrm","||$movntdqaXrm","||packusdwXrm", nil,nil,nil,nil, --3x "||pmovzxbwXrm","||pmovzxbdXrm","||pmovzxbqXrm","||pmovzxwdXrm", "||pmovzxwqXrm","||pmovzxdqXrm",nil,"||pcmpgtqXrm", "||pminsbXrm","||pminsdXrm","||pminuwXrm","||pminudXrm", "||pmaxsbXrm","||pmaxsdXrm","||pmaxuwXrm","||pmaxudXrm", --4x "||pmulddXrm","||phminposuwXrm", --Fx [0xf0] = "|||crc32TrBmt",[0xf1] = "|||crc32TrVmt", }, ["3a"] = { -- [66] 0f 3a xx --0x [0x00]=nil,nil,nil,nil,nil,nil,nil,nil, "||roundpsXrmu","||roundpdXrmu","||roundssXrmu","||roundsdXrmu", "||blendpsXrmu","||blendpdXrmu","||pblendwXrmu","palignrPrmu", --1x nil,nil,nil,nil, "||pextrbVmXru","||pextrwVmXru","||pextrVmSXru","||extractpsVmXru", nil,nil,nil,nil,nil,nil,nil,nil, --2x "||pinsrbXrVmu","||insertpsXrmu","||pinsrXrVmuS",nil, --4x [0x40] = "||dppsXrmu", [0x41] = "||dppdXrmu", [0x42] = "||mpsadbwXrmu", --6x [0x60] = "||pcmpestrmXrmu",[0x61] = "||pcmpestriXrmu", [0x62] = "||pcmpistrmXrmu",[0x63] = "||pcmpistriXrmu", }, } -- Map for VMX/SVM opcodes 0F 01 C0-FF (sgdt group with register operands). local map_opcvm = { [0xc1]="vmcall",[0xc2]="vmlaunch",[0xc3]="vmresume",[0xc4]="vmxoff", [0xc8]="monitor",[0xc9]="mwait", [0xd8]="vmrun",[0xd9]="vmmcall",[0xda]="vmload",[0xdb]="vmsave", [0xdc]="stgi",[0xdd]="clgi",[0xde]="skinit",[0xdf]="invlpga", [0xf8]="swapgs",[0xf9]="rdtscp", } -- Map for FP opcodes. And you thought stack machines are simple? local map_opcfp = { -- D8-DF 00-BF: opcodes with a memory operand. -- D8 [0]="faddFm","fmulFm","fcomFm","fcompFm","fsubFm","fsubrFm","fdivFm","fdivrFm", "fldFm",nil,"fstFm","fstpFm","fldenvVm","fldcwWm","fnstenvVm","fnstcwWm", -- DA "fiaddDm","fimulDm","ficomDm","ficompDm", "fisubDm","fisubrDm","fidivDm","fidivrDm", -- DB "fildDm","fisttpDm","fistDm","fistpDm",nil,"fld twordFmp",nil,"fstp twordFmp", -- DC "faddGm","fmulGm","fcomGm","fcompGm","fsubGm","fsubrGm","fdivGm","fdivrGm", -- DD "fldGm","fisttpQm","fstGm","fstpGm","frstorDmp",nil,"fnsaveDmp","fnstswWm", -- DE "fiaddWm","fimulWm","ficomWm","ficompWm", "fisubWm","fisubrWm","fidivWm","fidivrWm", -- DF "fildWm","fisttpWm","fistWm","fistpWm", "fbld twordFmp","fildQm","fbstp twordFmp","fistpQm", -- xx C0-FF: opcodes with a pseudo-register operand. -- D8 "faddFf","fmulFf","fcomFf","fcompFf","fsubFf","fsubrFf","fdivFf","fdivrFf", -- D9 "fldFf","fxchFf",{"fnop"},nil, {"fchs","fabs",nil,nil,"ftst","fxam"}, {"fld1","fldl2t","fldl2e","fldpi","fldlg2","fldln2","fldz"}, {"f2xm1","fyl2x","fptan","fpatan","fxtract","fprem1","fdecstp","fincstp"}, {"fprem","fyl2xp1","fsqrt","fsincos","frndint","fscale","fsin","fcos"}, -- DA "fcmovbFf","fcmoveFf","fcmovbeFf","fcmovuFf",nil,{nil,"fucompp"},nil,nil, -- DB "fcmovnbFf","fcmovneFf","fcmovnbeFf","fcmovnuFf", {nil,nil,"fnclex","fninit"},"fucomiFf","fcomiFf",nil, -- DC "fadd toFf","fmul toFf",nil,nil, "fsub toFf","fsubr toFf","fdivr toFf","fdiv toFf", -- DD "ffreeFf",nil,"fstFf","fstpFf","fucomFf","fucompFf",nil,nil, -- DE "faddpFf","fmulpFf",nil,{nil,"fcompp"}, "fsubrpFf","fsubpFf","fdivrpFf","fdivpFf", -- DF nil,nil,nil,nil,{"fnstsw ax"},"fucomipFf","fcomipFf",nil, } assert(map_opcfp[126] == "fcomipFf") -- Map for opcode groups. The subkey is sp from the ModRM byte. local map_opcgroup = { arith = { "add", "or", "adc", "sbb", "and", "sub", "xor", "cmp" }, shift = { "rol", "ror", "rcl", "rcr", "shl", "shr", "sal", "sar" }, testb = { "testBmi", "testBmi", "not", "neg", "mul", "imul", "div", "idiv" }, testv = { "testVmi", "testVmi", "not", "neg", "mul", "imul", "div", "idiv" }, incb = { "inc", "dec" }, incd = { "inc", "dec", "callUmp", "$call farDmp", "jmpUmp", "$jmp farDmp", "pushUm" }, sldt = { "sldt", "str", "lldt", "ltr", "verr", "verw" }, sgdt = { "vm*$sgdt", "vm*$sidt", "$lgdt", "vm*$lidt", "smsw", nil, "lmsw", "vm*$invlpg" }, bt = { nil, nil, nil, nil, "bt", "bts", "btr", "btc" }, cmpxchg = { nil, "sz*,cmpxchg8bQmp,cmpxchg16bXmp", nil, nil, nil, nil, "vmptrld|vmxon|vmclear", "vmptrst" }, pshiftw = { nil, nil, "psrlw", nil, "psraw", nil, "psllw" }, pshiftd = { nil, nil, "psrld", nil, "psrad", nil, "pslld" }, pshiftq = { nil, nil, "psrlq", nil, nil, nil, "psllq" }, pshiftdq = { nil, nil, "psrlq", "psrldq", nil, nil, "psllq", "pslldq" }, fxsave = { "$fxsave", "$fxrstor", "$ldmxcsr", "$stmxcsr", nil, "lfenceDp$", "mfenceDp$", "sfenceDp$clflush" }, prefetch = { "prefetch", "prefetchw" }, prefetcht = { "prefetchnta", "prefetcht0", "prefetcht1", "prefetcht2" }, } ------------------------------------------------------------------------------ -- Maps for register names. local map_regs = { B = { "al", "cl", "dl", "bl", "ah", "ch", "dh", "bh", "r8b", "r9b", "r10b", "r11b", "r12b", "r13b", "r14b", "r15b" }, B64 = { "al", "cl", "dl", "bl", "spl", "bpl", "sil", "dil", "r8b", "r9b", "r10b", "r11b", "r12b", "r13b", "r14b", "r15b" }, W = { "ax", "cx", "dx", "bx", "sp", "bp", "si", "di", "r8w", "r9w", "r10w", "r11w", "r12w", "r13w", "r14w", "r15w" }, D = { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "r8d", "r9d", "r10d", "r11d", "r12d", "r13d", "r14d", "r15d" }, Q = { "rax", "rcx", "rdx", "rbx", "rsp", "rbp", "rsi", "rdi", "r8", "r9", "r10", "r11", "r12", "r13", "r14", "r15" }, M = { "mm0", "mm1", "mm2", "mm3", "mm4", "mm5", "mm6", "mm7", "mm0", "mm1", "mm2", "mm3", "mm4", "mm5", "mm6", "mm7" }, -- No x64 ext! X = { "xmm0", "xmm1", "xmm2", "xmm3", "xmm4", "xmm5", "xmm6", "xmm7", "xmm8", "xmm9", "xmm10", "xmm11", "xmm12", "xmm13", "xmm14", "xmm15" }, } local map_segregs = { "es", "cs", "ss", "ds", "fs", "gs", "segr6", "segr7" } -- Maps for size names. local map_sz2n = { B = 1, W = 2, D = 4, Q = 8, M = 8, X = 16, } local map_sz2prefix = { B = "byte", W = "word", D = "dword", Q = "qword", M = "qword", X = "xword", F = "dword", G = "qword", -- No need for sizes/register names for these two. } ------------------------------------------------------------------------------ -- Output a nicely formatted line with an opcode and operands. local function putop(ctx, text, operands) local code, pos, hex = ctx.code, ctx.pos, "" local hmax = ctx.hexdump if hmax > 0 then for i=ctx.start,pos-1 do hex = hex..format("%02X", byte(code, i, i)) end if #hex > hmax then hex = sub(hex, 1, hmax)..". " else hex = hex..rep(" ", hmax-#hex+2) end end if operands then text = text.." "..operands end if ctx.o16 then text = "o16 "..text; ctx.o16 = false end if ctx.a32 then text = "a32 "..text; ctx.a32 = false end if ctx.rep then text = ctx.rep.." "..text; ctx.rep = false end if ctx.rex then local t = (ctx.rexw and "w" or "")..(ctx.rexr and "r" or "").. (ctx.rexx and "x" or "")..(ctx.rexb and "b" or "") if t ~= "" then text = "rex."..t.." "..text end ctx.rexw = false; ctx.rexr = false; ctx.rexx = false; ctx.rexb = false ctx.rex = false end if ctx.seg then local text2, n = gsub(text, "%[", "["..ctx.seg..":") if n == 0 then text = ctx.seg.." "..text else text = text2 end ctx.seg = false end if ctx.lock then text = "lock "..text; ctx.lock = false end local imm = ctx.imm if imm then local sym = ctx.symtab[imm] if sym then text = text.."\t->"..sym end end ctx.out(format("%08x %s%s\n", ctx.addr+ctx.start, hex, text)) ctx.mrm = false ctx.start = pos ctx.imm = nil end -- Clear all prefix flags. local function clearprefixes(ctx) ctx.o16 = false; ctx.seg = false; ctx.lock = false; ctx.rep = false ctx.rexw = false; ctx.rexr = false; ctx.rexx = false; ctx.rexb = false ctx.rex = false; ctx.a32 = false end -- Fallback for incomplete opcodes at the end. local function incomplete(ctx) ctx.pos = ctx.stop+1 clearprefixes(ctx) return putop(ctx, "(incomplete)") end -- Fallback for unknown opcodes. local function unknown(ctx) clearprefixes(ctx) return putop(ctx, "(unknown)") end -- Return an immediate of the specified size. local function getimm(ctx, pos, n) if pos+n-1 > ctx.stop then return incomplete(ctx) end local code = ctx.code if n == 1 then local b1 = byte(code, pos, pos) return b1 elseif n == 2 then local b1, b2 = byte(code, pos, pos+1) return b1+b2*256 else local b1, b2, b3, b4 = byte(code, pos, pos+3) local imm = b1+b2*256+b3*65536+b4*16777216 ctx.imm = imm return imm end end -- Process pattern string and generate the operands. local function putpat(ctx, name, pat) local operands, regs, sz, mode, sp, rm, sc, rx, sdisp local code, pos, stop = ctx.code, ctx.pos, ctx.stop -- Chars used: 1DFGIMPQRSTUVWXacdfgijmoprstuwxyz for p in gmatch(pat, ".") do local x = nil if p == "V" or p == "U" then if ctx.rexw then sz = "Q"; ctx.rexw = false elseif ctx.o16 then sz = "W"; ctx.o16 = false elseif p == "U" and ctx.x64 then sz = "Q" else sz = "D" end regs = map_regs[sz] elseif p == "T" then if ctx.rexw then sz = "Q"; ctx.rexw = false else sz = "D" end regs = map_regs[sz] elseif p == "B" then sz = "B" regs = ctx.rex and map_regs.B64 or map_regs.B elseif match(p, "[WDQMXFG]") then sz = p regs = map_regs[sz] elseif p == "P" then sz = ctx.o16 and "X" or "M"; ctx.o16 = false regs = map_regs[sz] elseif p == "S" then name = name..lower(sz) elseif p == "s" then local imm = getimm(ctx, pos, 1); if not imm then return end x = imm <= 127 and format("+0x%02x", imm) or format("-0x%02x", 256-imm) pos = pos+1 elseif p == "u" then local imm = getimm(ctx, pos, 1); if not imm then return end x = format("0x%02x", imm) pos = pos+1 elseif p == "w" then local imm = getimm(ctx, pos, 2); if not imm then return end x = format("0x%x", imm) pos = pos+2 elseif p == "o" then -- [offset] if ctx.x64 then local imm1 = getimm(ctx, pos, 4); if not imm1 then return end local imm2 = getimm(ctx, pos+4, 4); if not imm2 then return end x = format("[0x%08x%08x]", imm2, imm1) pos = pos+8 else local imm = getimm(ctx, pos, 4); if not imm then return end x = format("[0x%08x]", imm) pos = pos+4 end elseif p == "i" or p == "I" then local n = map_sz2n[sz] if n == 8 and ctx.x64 and p == "I" then local imm1 = getimm(ctx, pos, 4); if not imm1 then return end local imm2 = getimm(ctx, pos+4, 4); if not imm2 then return end x = format("0x%08x%08x", imm2, imm1) else if n == 8 then n = 4 end local imm = getimm(ctx, pos, n); if not imm then return end if sz == "Q" and (imm < 0 or imm > 0x7fffffff) then imm = (0xffffffff+1)-imm x = format(imm > 65535 and "-0x%08x" or "-0x%x", imm) else x = format(imm > 65535 and "0x%08x" or "0x%x", imm) end end pos = pos+n elseif p == "j" then local n = map_sz2n[sz] if n == 8 then n = 4 end local imm = getimm(ctx, pos, n); if not imm then return end if sz == "B" and imm > 127 then imm = imm-256 elseif imm > 2147483647 then imm = imm-4294967296 end pos = pos+n imm = imm + pos + ctx.addr if imm > 4294967295 and not ctx.x64 then imm = imm-4294967296 end ctx.imm = imm if sz == "W" then x = format("word 0x%04x", imm%65536) elseif ctx.x64 then local lo = imm % 0x1000000 x = format("0x%02x%06x", (imm-lo) / 0x1000000, lo) else x = format("0x%08x", imm) end elseif p == "R" then local r = byte(code, pos-1, pos-1)%8 if ctx.rexb then r = r + 8; ctx.rexb = false end x = regs[r+1] elseif p == "a" then x = regs[1] elseif p == "c" then x = "cl" elseif p == "d" then x = "dx" elseif p == "1" then x = "1" else if not mode then mode = ctx.mrm if not mode then if pos > stop then return incomplete(ctx) end mode = byte(code, pos, pos) pos = pos+1 end rm = mode%8; mode = (mode-rm)/8 sp = mode%8; mode = (mode-sp)/8 sdisp = "" if mode < 3 then if rm == 4 then if pos > stop then return incomplete(ctx) end sc = byte(code, pos, pos) pos = pos+1 rm = sc%8; sc = (sc-rm)/8 rx = sc%8; sc = (sc-rx)/8 if ctx.rexx then rx = rx + 8; ctx.rexx = false end if rx == 4 then rx = nil end end if mode > 0 or rm == 5 then local dsz = mode if dsz ~= 1 then dsz = 4 end local disp = getimm(ctx, pos, dsz); if not disp then return end if mode == 0 then rm = nil end if rm or rx or (not sc and ctx.x64 and not ctx.a32) then if dsz == 1 and disp > 127 then sdisp = format("-0x%x", 256-disp) elseif disp >= 0 and disp <= 0x7fffffff then sdisp = format("+0x%x", disp) else sdisp = format("-0x%x", (0xffffffff+1)-disp) end else sdisp = format(ctx.x64 and not ctx.a32 and not (disp >= 0 and disp <= 0x7fffffff) and "0xffffffff%08x" or "0x%08x", disp) end pos = pos+dsz end end if rm and ctx.rexb then rm = rm + 8; ctx.rexb = false end if ctx.rexr then sp = sp + 8; ctx.rexr = false end end if p == "m" then if mode == 3 then x = regs[rm+1] else local aregs = ctx.a32 and map_regs.D or ctx.aregs local srm, srx = "", "" if rm then srm = aregs[rm+1] elseif not sc and ctx.x64 and not ctx.a32 then srm = "rip" end ctx.a32 = false if rx then if rm then srm = srm.."+" end srx = aregs[rx+1] if sc > 0 then srx = srx.."*"..(2^sc) end end x = format("[%s%s%s]", srm, srx, sdisp) end if mode < 3 and (not match(pat, "[aRrgp]") or match(pat, "t")) then -- Yuck. x = map_sz2prefix[sz].." "..x end elseif p == "r" then x = regs[sp+1] elseif p == "g" then x = map_segregs[sp+1] elseif p == "p" then -- Suppress prefix. elseif p == "f" then x = "st"..rm elseif p == "x" then if sp == 0 and ctx.lock and not ctx.x64 then x = "CR8"; ctx.lock = false else x = "CR"..sp end elseif p == "y" then x = "DR"..sp elseif p == "z" then x = "TR"..sp elseif p == "t" then else error("bad pattern `"..pat.."'") end end if x then operands = operands and operands..", "..x or x end end ctx.pos = pos return putop(ctx, name, operands) end -- Forward declaration. local map_act -- Fetch and cache MRM byte. local function getmrm(ctx) local mrm = ctx.mrm if not mrm then local pos = ctx.pos if pos > ctx.stop then return nil end mrm = byte(ctx.code, pos, pos) ctx.pos = pos+1 ctx.mrm = mrm end return mrm end -- Dispatch to handler depending on pattern. local function dispatch(ctx, opat, patgrp) if not opat then return unknown(ctx) end if match(opat, "%|") then -- MMX/SSE variants depending on prefix. local p if ctx.rep then p = ctx.rep=="rep" and "%|([^%|]*)" or "%|[^%|]*%|[^%|]*%|([^%|]*)" ctx.rep = false elseif ctx.o16 then p = "%|[^%|]*%|([^%|]*)"; ctx.o16 = false else p = "^[^%|]*" end opat = match(opat, p) if not opat then return unknown(ctx) end -- ctx.rep = false; ctx.o16 = false --XXX fails for 66 f2 0f 38 f1 06 crc32 eax,WORD PTR [esi] --XXX remove in branches? end if match(opat, "%$") then -- reg$mem variants. local mrm = getmrm(ctx); if not mrm then return incomplete(ctx) end opat = match(opat, mrm >= 192 and "^[^%$]*" or "%$(.*)") if opat == "" then return unknown(ctx) end end if opat == "" then return unknown(ctx) end local name, pat = match(opat, "^([a-z0-9 ]*)(.*)") if pat == "" and patgrp then pat = patgrp end return map_act[sub(pat, 1, 1)](ctx, name, pat) end -- Get a pattern from an opcode map and dispatch to handler. local function dispatchmap(ctx, opcmap) local pos = ctx.pos local opat = opcmap[byte(ctx.code, pos, pos)] pos = pos + 1 ctx.pos = pos return dispatch(ctx, opat) end -- Map for action codes. The key is the first char after the name. map_act = { -- Simple opcodes without operands. [""] = function(ctx, name, pat) return putop(ctx, name) end, -- Operand size chars fall right through. B = putpat, W = putpat, D = putpat, Q = putpat, V = putpat, U = putpat, T = putpat, M = putpat, X = putpat, P = putpat, F = putpat, G = putpat, -- Collect prefixes. [":"] = function(ctx, name, pat) ctx[pat == ":" and name or sub(pat, 2)] = name if ctx.pos - ctx.start > 5 then return unknown(ctx) end -- Limit #prefixes. end, -- Chain to special handler specified by name. ["*"] = function(ctx, name, pat) return map_act[name](ctx, name, sub(pat, 2)) end, -- Use named subtable for opcode group. ["!"] = function(ctx, name, pat) local mrm = getmrm(ctx); if not mrm then return incomplete(ctx) end return dispatch(ctx, map_opcgroup[name][((mrm-(mrm%8))/8)%8+1], sub(pat, 2)) end, -- o16,o32[,o64] variants. sz = function(ctx, name, pat) if ctx.o16 then ctx.o16 = false else pat = match(pat, ",(.*)") if ctx.rexw then local p = match(pat, ",(.*)") if p then pat = p; ctx.rexw = false end end end pat = match(pat, "^[^,]*") return dispatch(ctx, pat) end, -- Two-byte opcode dispatch. opc2 = function(ctx, name, pat) return dispatchmap(ctx, map_opc2) end, -- Three-byte opcode dispatch. opc3 = function(ctx, name, pat) return dispatchmap(ctx, map_opc3[pat]) end, -- VMX/SVM dispatch. vm = function(ctx, name, pat) return dispatch(ctx, map_opcvm[ctx.mrm]) end, -- Floating point opcode dispatch. fp = function(ctx, name, pat) local mrm = getmrm(ctx); if not mrm then return incomplete(ctx) end local rm = mrm%8 local idx = pat*8 + ((mrm-rm)/8)%8 if mrm >= 192 then idx = idx + 64 end local opat = map_opcfp[idx] if type(opat) == "table" then opat = opat[rm+1] end return dispatch(ctx, opat) end, -- REX prefix. rex = function(ctx, name, pat) if ctx.rex then return unknown(ctx) end -- Only 1 REX prefix allowed. for p in gmatch(pat, ".") do ctx["rex"..p] = true end ctx.rex = true end, -- Special case for nop with REX prefix. nop = function(ctx, name, pat) return dispatch(ctx, ctx.rex and pat or "nop") end, } ------------------------------------------------------------------------------ -- Disassemble a block of code. local function disass_block(ctx, ofs, len) if not ofs then ofs = 0 end local stop = len and ofs+len or #ctx.code ofs = ofs + 1 ctx.start = ofs ctx.pos = ofs ctx.stop = stop ctx.imm = nil ctx.mrm = false clearprefixes(ctx) while ctx.pos <= stop do dispatchmap(ctx, ctx.map1) end if ctx.pos ~= ctx.start then incomplete(ctx) end end -- Extended API: create a disassembler context. Then call ctx:disass(ofs, len). local function create_(code, addr, out) local ctx = {} ctx.code = code ctx.addr = (addr or 0) - 1 ctx.out = out or io.write ctx.symtab = {} ctx.disass = disass_block ctx.hexdump = 16 ctx.x64 = false ctx.map1 = map_opc1_32 ctx.aregs = map_regs.D return ctx end local function create64_(code, addr, out) local ctx = create_(code, addr, out) ctx.x64 = true ctx.map1 = map_opc1_64 ctx.aregs = map_regs.Q return ctx end -- Simple API: disassemble code (a string) at address and output via out. local function disass_(code, addr, out) create_(code, addr, out):disass() end local function disass64_(code, addr, out) create64_(code, addr, out):disass() end -- Return register name for RID. local function regname_(r) if r < 8 then return map_regs.D[r+1] end return map_regs.X[r-7] end local function regname64_(r) if r < 16 then return map_regs.Q[r+1] end return map_regs.X[r-15] end -- Public module functions. module(...) create = create_ create64 = create64_ disass = disass_ disass64 = disass64_ regname = regname_ regname64 = regname64_ wcc-0.0.2/src/wsh/luajit-2.0/src/jit/dis_x64.lua0000644000175000017500000000130313122010155017437 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT x64 disassembler wrapper module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- This module just exports the 64 bit functions from the combined -- x86/x64 disassembler module. All the interesting stuff is there. ------------------------------------------------------------------------------ local require = require module(...) local dis_x86 = require(_PACKAGE.."dis_x86") create = dis_x86.create64 disass = dis_x86.disass64 regname = dis_x86.regname64 wcc-0.0.2/src/wsh/luajit-2.0/src/jit/bc.lua0000644000175000017500000001274613122010155016560 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT bytecode listing module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- -- This module lists the bytecode of a Lua function. If it's loaded by -jbc -- it hooks into the parser and lists all functions of a chunk as they -- are parsed. -- -- Example usage: -- -- luajit -jbc -e 'local x=0; for i=1,1e6 do x=x+i end; print(x)' -- luajit -jbc=- foo.lua -- luajit -jbc=foo.list foo.lua -- -- Default output is to stderr. To redirect the output to a file, pass a -- filename as an argument (use '-' for stdout) or set the environment -- variable LUAJIT_LISTFILE. The file is overwritten every time the module -- is started. -- -- This module can also be used programmatically: -- -- local bc = require("jit.bc") -- -- local function foo() print("hello") end -- -- bc.dump(foo) --> -- BYTECODE -- [...] -- print(bc.line(foo, 2)) --> 0002 KSTR 1 1 ; "hello" -- -- local out = { -- -- Do something with each line: -- write = function(t, ...) io.write(...) end, -- close = function(t) end, -- flush = function(t) end, -- } -- bc.dump(foo, out) -- ------------------------------------------------------------------------------ -- Cache some library functions and objects. local jit = require("jit") assert(jit.version_num == 20004, "LuaJIT core/library version mismatch") local jutil = require("jit.util") local vmdef = require("jit.vmdef") local bit = require("bit") local sub, gsub, format = string.sub, string.gsub, string.format local byte, band, shr = string.byte, bit.band, bit.rshift local funcinfo, funcbc, funck = jutil.funcinfo, jutil.funcbc, jutil.funck local funcuvname = jutil.funcuvname local bcnames = vmdef.bcnames local stdout, stderr = io.stdout, io.stderr ------------------------------------------------------------------------------ local function ctlsub(c) if c == "\n" then return "\\n" elseif c == "\r" then return "\\r" elseif c == "\t" then return "\\t" else return format("\\%03d", byte(c)) end end -- Return one bytecode line. local function bcline(func, pc, prefix) local ins, m = funcbc(func, pc) if not ins then return end local ma, mb, mc = band(m, 7), band(m, 15*8), band(m, 15*128) local a = band(shr(ins, 8), 0xff) local oidx = 6*band(ins, 0xff) local op = sub(bcnames, oidx+1, oidx+6) local s = format("%04d %s %-6s %3s ", pc, prefix or " ", op, ma == 0 and "" or a) local d = shr(ins, 16) if mc == 13*128 then -- BCMjump return format("%s=> %04d\n", s, pc+d-0x7fff) end if mb ~= 0 then d = band(d, 0xff) elseif mc == 0 then return s.."\n" end local kc if mc == 10*128 then -- BCMstr kc = funck(func, -d-1) kc = format(#kc > 40 and '"%.40s"~' or '"%s"', gsub(kc, "%c", ctlsub)) elseif mc == 9*128 then -- BCMnum kc = funck(func, d) if op == "TSETM " then kc = kc - 2^52 end elseif mc == 12*128 then -- BCMfunc local fi = funcinfo(funck(func, -d-1)) if fi.ffid then kc = vmdef.ffnames[fi.ffid] else kc = fi.loc end elseif mc == 5*128 then -- BCMuv kc = funcuvname(func, d) end if ma == 5 then -- BCMuv local ka = funcuvname(func, a) if kc then kc = ka.." ; "..kc else kc = ka end end if mb ~= 0 then local b = shr(ins, 24) if kc then return format("%s%3d %3d ; %s\n", s, b, d, kc) end return format("%s%3d %3d\n", s, b, d) end if kc then return format("%s%3d ; %s\n", s, d, kc) end if mc == 7*128 and d > 32767 then d = d - 65536 end -- BCMlits return format("%s%3d\n", s, d) end -- Collect branch targets of a function. local function bctargets(func) local target = {} for pc=1,1000000000 do local ins, m = funcbc(func, pc) if not ins then break end if band(m, 15*128) == 13*128 then target[pc+shr(ins, 16)-0x7fff] = true end end return target end -- Dump bytecode instructions of a function. local function bcdump(func, out, all) if not out then out = stdout end local fi = funcinfo(func) if all and fi.children then for n=-1,-1000000000,-1 do local k = funck(func, n) if not k then break end if type(k) == "proto" then bcdump(k, out, true) end end end out:write(format("-- BYTECODE -- %s-%d\n", fi.loc, fi.lastlinedefined)) local target = bctargets(func) for pc=1,1000000000 do local s = bcline(func, pc, target[pc] and "=>") if not s then break end out:write(s) end out:write("\n") out:flush() end ------------------------------------------------------------------------------ -- Active flag and output file handle. local active, out -- List handler. local function h_list(func) return bcdump(func, out) end -- Detach list handler. local function bclistoff() if active then active = false jit.attach(h_list) if out and out ~= stdout and out ~= stderr then out:close() end out = nil end end -- Open the output file and attach list handler. local function bcliston(outfile) if active then bclistoff() end if not outfile then outfile = os.getenv("LUAJIT_LISTFILE") end if outfile then out = outfile == "-" and stdout or assert(io.open(outfile, "w")) else out = stderr end jit.attach(h_list, "bc") active = true end -- Public module functions. module(...) line = bcline dump = bcdump targets = bctargets on = bcliston off = bclistoff start = bcliston -- For -j command line option. wcc-0.0.2/src/wsh/luajit-2.0/src/jit/.gitignore0000644000175000017500000000001213122010155017440 0ustar philphilvmdef.lua wcc-0.0.2/src/wsh/luajit-2.0/src/jit/dis_mipsel.lua0000644000175000017500000000130613122010155020312 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT MIPSEL disassembler wrapper module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- This module just exports the little-endian functions from the -- MIPS disassembler module. All the interesting stuff is there. ------------------------------------------------------------------------------ local require = require module(...) local dis_mips = require(_PACKAGE.."dis_mips") create = dis_mips.create_el disass = dis_mips.disass_el regname = dis_mips.regname wcc-0.0.2/src/wsh/luajit-2.0/src/jit/dis_mips.lua0000644000175000017500000003160213122010155017773 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT MIPS disassembler module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT/X license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- This is a helper module used by the LuaJIT machine code dumper module. -- -- It disassembles all standard MIPS32R1/R2 instructions. -- Default mode is big-endian, but see: dis_mipsel.lua ------------------------------------------------------------------------------ local type = type local byte, format = string.byte, string.format local match, gmatch = string.match, string.gmatch local concat = table.concat local bit = require("bit") local band, bor, tohex = bit.band, bit.bor, bit.tohex local lshift, rshift, arshift = bit.lshift, bit.rshift, bit.arshift ------------------------------------------------------------------------------ -- Primary and extended opcode maps ------------------------------------------------------------------------------ local map_movci = { shift = 16, mask = 1, [0] = "movfDSC", "movtDSC", } local map_srl = { shift = 21, mask = 1, [0] = "srlDTA", "rotrDTA", } local map_srlv = { shift = 6, mask = 1, [0] = "srlvDTS", "rotrvDTS", } local map_special = { shift = 0, mask = 63, [0] = { shift = 0, mask = -1, [0] = "nop", _ = "sllDTA" }, map_movci, map_srl, "sraDTA", "sllvDTS", false, map_srlv, "sravDTS", "jrS", "jalrD1S", "movzDST", "movnDST", "syscallY", "breakY", false, "sync", "mfhiD", "mthiS", "mfloD", "mtloS", false, false, false, false, "multST", "multuST", "divST", "divuST", false, false, false, false, "addDST", "addu|moveDST0", "subDST", "subu|neguDS0T", "andDST", "orDST", "xorDST", "nor|notDST0", false, false, "sltDST", "sltuDST", false, false, false, false, "tgeSTZ", "tgeuSTZ", "tltSTZ", "tltuSTZ", "teqSTZ", false, "tneSTZ", } local map_special2 = { shift = 0, mask = 63, [0] = "maddST", "madduST", "mulDST", false, "msubST", "msubuST", [32] = "clzDS", [33] = "cloDS", [63] = "sdbbpY", } local map_bshfl = { shift = 6, mask = 31, [2] = "wsbhDT", [16] = "sebDT", [24] = "sehDT", } local map_special3 = { shift = 0, mask = 63, [0] = "extTSAK", [4] = "insTSAL", [32] = map_bshfl, [59] = "rdhwrTD", } local map_regimm = { shift = 16, mask = 31, [0] = "bltzSB", "bgezSB", "bltzlSB", "bgezlSB", false, false, false, false, "tgeiSI", "tgeiuSI", "tltiSI", "tltiuSI", "teqiSI", false, "tneiSI", false, "bltzalSB", "bgezalSB", "bltzallSB", "bgezallSB", false, false, false, false, false, false, false, false, false, false, false, "synciSO", } local map_cop0 = { shift = 25, mask = 1, [0] = { shift = 21, mask = 15, [0] = "mfc0TDW", [4] = "mtc0TDW", [10] = "rdpgprDT", [11] = { shift = 5, mask = 1, [0] = "diT0", "eiT0", }, [14] = "wrpgprDT", }, { shift = 0, mask = 63, [1] = "tlbr", [2] = "tlbwi", [6] = "tlbwr", [8] = "tlbp", [24] = "eret", [31] = "deret", [32] = "wait", }, } local map_cop1s = { shift = 0, mask = 63, [0] = "add.sFGH", "sub.sFGH", "mul.sFGH", "div.sFGH", "sqrt.sFG", "abs.sFG", "mov.sFG", "neg.sFG", "round.l.sFG", "trunc.l.sFG", "ceil.l.sFG", "floor.l.sFG", "round.w.sFG", "trunc.w.sFG", "ceil.w.sFG", "floor.w.sFG", false, { shift = 16, mask = 1, [0] = "movf.sFGC", "movt.sFGC" }, "movz.sFGT", "movn.sFGT", false, "recip.sFG", "rsqrt.sFG", false, false, false, false, false, false, false, false, false, false, "cvt.d.sFG", false, false, "cvt.w.sFG", "cvt.l.sFG", "cvt.ps.sFGH", false, false, false, false, false, false, false, false, false, "c.f.sVGH", "c.un.sVGH", "c.eq.sVGH", "c.ueq.sVGH", "c.olt.sVGH", "c.ult.sVGH", "c.ole.sVGH", "c.ule.sVGH", "c.sf.sVGH", "c.ngle.sVGH", "c.seq.sVGH", "c.ngl.sVGH", "c.lt.sVGH", "c.nge.sVGH", "c.le.sVGH", "c.ngt.sVGH", } local map_cop1d = { shift = 0, mask = 63, [0] = "add.dFGH", "sub.dFGH", "mul.dFGH", "div.dFGH", "sqrt.dFG", "abs.dFG", "mov.dFG", "neg.dFG", "round.l.dFG", "trunc.l.dFG", "ceil.l.dFG", "floor.l.dFG", "round.w.dFG", "trunc.w.dFG", "ceil.w.dFG", "floor.w.dFG", false, { shift = 16, mask = 1, [0] = "movf.dFGC", "movt.dFGC" }, "movz.dFGT", "movn.dFGT", false, "recip.dFG", "rsqrt.dFG", false, false, false, false, false, false, false, false, false, "cvt.s.dFG", false, false, false, "cvt.w.dFG", "cvt.l.dFG", false, false, false, false, false, false, false, false, false, false, "c.f.dVGH", "c.un.dVGH", "c.eq.dVGH", "c.ueq.dVGH", "c.olt.dVGH", "c.ult.dVGH", "c.ole.dVGH", "c.ule.dVGH", "c.df.dVGH", "c.ngle.dVGH", "c.deq.dVGH", "c.ngl.dVGH", "c.lt.dVGH", "c.nge.dVGH", "c.le.dVGH", "c.ngt.dVGH", } local map_cop1ps = { shift = 0, mask = 63, [0] = "add.psFGH", "sub.psFGH", "mul.psFGH", false, false, "abs.psFG", "mov.psFG", "neg.psFG", false, false, false, false, false, false, false, false, false, { shift = 16, mask = 1, [0] = "movf.psFGC", "movt.psFGC" }, "movz.psFGT", "movn.psFGT", false, false, false, false, false, false, false, false, false, false, false, false, "cvt.s.puFG", false, false, false, false, false, false, false, "cvt.s.plFG", false, false, false, "pll.psFGH", "plu.psFGH", "pul.psFGH", "puu.psFGH", "c.f.psVGH", "c.un.psVGH", "c.eq.psVGH", "c.ueq.psVGH", "c.olt.psVGH", "c.ult.psVGH", "c.ole.psVGH", "c.ule.psVGH", "c.psf.psVGH", "c.ngle.psVGH", "c.pseq.psVGH", "c.ngl.psVGH", "c.lt.psVGH", "c.nge.psVGH", "c.le.psVGH", "c.ngt.psVGH", } local map_cop1w = { shift = 0, mask = 63, [32] = "cvt.s.wFG", [33] = "cvt.d.wFG", } local map_cop1l = { shift = 0, mask = 63, [32] = "cvt.s.lFG", [33] = "cvt.d.lFG", } local map_cop1bc = { shift = 16, mask = 3, [0] = "bc1fCB", "bc1tCB", "bc1flCB", "bc1tlCB", } local map_cop1 = { shift = 21, mask = 31, [0] = "mfc1TG", false, "cfc1TG", "mfhc1TG", "mtc1TG", false, "ctc1TG", "mthc1TG", map_cop1bc, false, false, false, false, false, false, false, map_cop1s, map_cop1d, false, false, map_cop1w, map_cop1l, map_cop1ps, } local map_cop1x = { shift = 0, mask = 63, [0] = "lwxc1FSX", "ldxc1FSX", false, false, false, "luxc1FSX", false, false, "swxc1FSX", "sdxc1FSX", false, false, false, "suxc1FSX", false, "prefxMSX", false, false, false, false, false, false, false, false, false, false, false, false, false, false, "alnv.psFGHS", false, "madd.sFRGH", "madd.dFRGH", false, false, false, false, "madd.psFRGH", false, "msub.sFRGH", "msub.dFRGH", false, false, false, false, "msub.psFRGH", false, "nmadd.sFRGH", "nmadd.dFRGH", false, false, false, false, "nmadd.psFRGH", false, "nmsub.sFRGH", "nmsub.dFRGH", false, false, false, false, "nmsub.psFRGH", false, } local map_pri = { [0] = map_special, map_regimm, "jJ", "jalJ", "beq|beqz|bST00B", "bne|bnezST0B", "blezSB", "bgtzSB", "addiTSI", "addiu|liTS0I", "sltiTSI", "sltiuTSI", "andiTSU", "ori|liTS0U", "xoriTSU", "luiTU", map_cop0, map_cop1, false, map_cop1x, "beql|beqzlST0B", "bnel|bnezlST0B", "blezlSB", "bgtzlSB", false, false, false, false, map_special2, false, false, map_special3, "lbTSO", "lhTSO", "lwlTSO", "lwTSO", "lbuTSO", "lhuTSO", "lwrTSO", false, "sbTSO", "shTSO", "swlTSO", "swTSO", false, false, "swrTSO", "cacheNSO", "llTSO", "lwc1HSO", "lwc2TSO", "prefNSO", false, "ldc1HSO", "ldc2TSO", false, "scTSO", "swc1HSO", "swc2TSO", false, false, "sdc1HSO", "sdc2TSO", false, } ------------------------------------------------------------------------------ local map_gpr = { [0] = "r0", "r1", "r2", "r3", "r4", "r5", "r6", "r7", "r8", "r9", "r10", "r11", "r12", "r13", "r14", "r15", "r16", "r17", "r18", "r19", "r20", "r21", "r22", "r23", "r24", "r25", "r26", "r27", "r28", "sp", "r30", "ra", } ------------------------------------------------------------------------------ -- Output a nicely formatted line with an opcode and operands. local function putop(ctx, text, operands) local pos = ctx.pos local extra = "" if ctx.rel then local sym = ctx.symtab[ctx.rel] if sym then extra = "\t->"..sym end end if ctx.hexdump > 0 then ctx.out(format("%08x %s %-7s %s%s\n", ctx.addr+pos, tohex(ctx.op), text, concat(operands, ", "), extra)) else ctx.out(format("%08x %-7s %s%s\n", ctx.addr+pos, text, concat(operands, ", "), extra)) end ctx.pos = pos + 4 end -- Fallback for unknown opcodes. local function unknown(ctx) return putop(ctx, ".long", { "0x"..tohex(ctx.op) }) end local function get_be(ctx) local pos = ctx.pos local b0, b1, b2, b3 = byte(ctx.code, pos+1, pos+4) return bor(lshift(b0, 24), lshift(b1, 16), lshift(b2, 8), b3) end local function get_le(ctx) local pos = ctx.pos local b0, b1, b2, b3 = byte(ctx.code, pos+1, pos+4) return bor(lshift(b3, 24), lshift(b2, 16), lshift(b1, 8), b0) end -- Disassemble a single instruction. local function disass_ins(ctx) local op = ctx:get() local operands = {} local last = nil ctx.op = op ctx.rel = nil local opat = map_pri[rshift(op, 26)] while type(opat) ~= "string" do if not opat then return unknown(ctx) end opat = opat[band(rshift(op, opat.shift), opat.mask)] or opat._ end local name, pat = match(opat, "^([a-z0-9_.]*)(.*)") local altname, pat2 = match(pat, "|([a-z0-9_.|]*)(.*)") if altname then pat = pat2 end for p in gmatch(pat, ".") do local x = nil if p == "S" then x = map_gpr[band(rshift(op, 21), 31)] elseif p == "T" then x = map_gpr[band(rshift(op, 16), 31)] elseif p == "D" then x = map_gpr[band(rshift(op, 11), 31)] elseif p == "F" then x = "f"..band(rshift(op, 6), 31) elseif p == "G" then x = "f"..band(rshift(op, 11), 31) elseif p == "H" then x = "f"..band(rshift(op, 16), 31) elseif p == "R" then x = "f"..band(rshift(op, 21), 31) elseif p == "A" then x = band(rshift(op, 6), 31) elseif p == "M" then x = band(rshift(op, 11), 31) elseif p == "N" then x = band(rshift(op, 16), 31) elseif p == "C" then x = band(rshift(op, 18), 7) if x == 0 then x = nil end elseif p == "K" then x = band(rshift(op, 11), 31) + 1 elseif p == "L" then x = band(rshift(op, 11), 31) - last + 1 elseif p == "I" then x = arshift(lshift(op, 16), 16) elseif p == "U" then x = band(op, 0xffff) elseif p == "O" then local disp = arshift(lshift(op, 16), 16) operands[#operands] = format("%d(%s)", disp, last) elseif p == "X" then local index = map_gpr[band(rshift(op, 16), 31)] operands[#operands] = format("%s(%s)", index, last) elseif p == "B" then x = ctx.addr + ctx.pos + arshift(lshift(op, 16), 16)*4 + 4 ctx.rel = x x = "0x"..tohex(x) elseif p == "J" then x = band(ctx.addr + ctx.pos, 0xf0000000) + band(op, 0x03ffffff)*4 ctx.rel = x x = "0x"..tohex(x) elseif p == "V" then x = band(rshift(op, 8), 7) if x == 0 then x = nil end elseif p == "W" then x = band(op, 7) if x == 0 then x = nil end elseif p == "Y" then x = band(rshift(op, 6), 0x000fffff) if x == 0 then x = nil end elseif p == "Z" then x = band(rshift(op, 6), 1023) if x == 0 then x = nil end elseif p == "0" then if last == "r0" or last == 0 then local n = #operands operands[n] = nil last = operands[n-1] if altname then local a1, a2 = match(altname, "([^|]*)|(.*)") if a1 then name, altname = a1, a2 else name = altname end end end elseif p == "1" then if last == "ra" then operands[#operands] = nil end else assert(false) end if x then operands[#operands+1] = x; last = x end end return putop(ctx, name, operands) end ------------------------------------------------------------------------------ -- Disassemble a block of code. local function disass_block(ctx, ofs, len) if not ofs then ofs = 0 end local stop = len and ofs+len or #ctx.code stop = stop - stop % 4 ctx.pos = ofs - ofs % 4 ctx.rel = nil while ctx.pos < stop do disass_ins(ctx) end end -- Extended API: create a disassembler context. Then call ctx:disass(ofs, len). local function create_(code, addr, out) local ctx = {} ctx.code = code ctx.addr = addr or 0 ctx.out = out or io.write ctx.symtab = {} ctx.disass = disass_block ctx.hexdump = 8 ctx.get = get_be return ctx end local function create_el_(code, addr, out) local ctx = create_(code, addr, out) ctx.get = get_le return ctx end -- Simple API: disassemble code (a string) at address and output via out. local function disass_(code, addr, out) create_(code, addr, out):disass() end local function disass_el_(code, addr, out) create_el_(code, addr, out):disass() end -- Return register name for RID. local function regname_(r) if r < 32 then return map_gpr[r] end return "f"..(r-32) end -- Public module functions. module(...) create = create_ create_el = create_el_ disass = disass_ disass_el = disass_el_ regname = regname_ wcc-0.0.2/src/wsh/luajit-2.0/src/jit/dump.lua0000644000175000017500000004610113122010155017131 0ustar philphil---------------------------------------------------------------------------- -- LuaJIT compiler dump module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- -- This module can be used to debug the JIT compiler itself. It dumps the -- code representations and structures used in various compiler stages. -- -- Example usage: -- -- luajit -jdump -e "local x=0; for i=1,1e6 do x=x+i end; print(x)" -- luajit -jdump=im -e "for i=1,1000 do for j=1,1000 do end end" | less -R -- luajit -jdump=is myapp.lua | less -R -- luajit -jdump=-b myapp.lua -- luajit -jdump=+aH,myapp.html myapp.lua -- luajit -jdump=ixT,myapp.dump myapp.lua -- -- The first argument specifies the dump mode. The second argument gives -- the output file name. Default output is to stdout, unless the environment -- variable LUAJIT_DUMPFILE is set. The file is overwritten every time the -- module is started. -- -- Different features can be turned on or off with the dump mode. If the -- mode starts with a '+', the following features are added to the default -- set of features; a '-' removes them. Otherwise the features are replaced. -- -- The following dump features are available (* marks the default): -- -- * t Print a line for each started, ended or aborted trace (see also -jv). -- * b Dump the traced bytecode. -- * i Dump the IR (intermediate representation). -- r Augment the IR with register/stack slots. -- s Dump the snapshot map. -- * m Dump the generated machine code. -- x Print each taken trace exit. -- X Print each taken trace exit and the contents of all registers. -- a Print the IR of aborted traces, too. -- -- The output format can be set with the following characters: -- -- T Plain text output. -- A ANSI-colored text output -- H Colorized HTML + CSS output. -- -- The default output format is plain text. It's set to ANSI-colored text -- if the COLORTERM variable is set. Note: this is independent of any output -- redirection, which is actually considered a feature. -- -- You probably want to use less -R to enjoy viewing ANSI-colored text from -- a pipe or a file. Add this to your ~/.bashrc: export LESS="-R" -- ------------------------------------------------------------------------------ -- Cache some library functions and objects. local jit = require("jit") assert(jit.version_num == 20004, "LuaJIT core/library version mismatch") local jutil = require("jit.util") local vmdef = require("jit.vmdef") local funcinfo, funcbc = jutil.funcinfo, jutil.funcbc local traceinfo, traceir, tracek = jutil.traceinfo, jutil.traceir, jutil.tracek local tracemc, tracesnap = jutil.tracemc, jutil.tracesnap local traceexitstub, ircalladdr = jutil.traceexitstub, jutil.ircalladdr local bit = require("bit") local band, shr = bit.band, bit.rshift local sub, gsub, format = string.sub, string.gsub, string.format local byte, rep = string.byte, string.rep local type, tostring = type, tostring local stdout, stderr = io.stdout, io.stderr -- Load other modules on-demand. local bcline, disass -- Active flag, output file handle and dump mode. local active, out, dumpmode ------------------------------------------------------------------------------ local symtabmt = { __index = false } local symtab = {} local nexitsym = 0 -- Fill nested symbol table with per-trace exit stub addresses. local function fillsymtab_tr(tr, nexit) local t = {} symtabmt.__index = t if jit.arch == "mips" or jit.arch == "mipsel" then t[traceexitstub(tr, 0)] = "exit" return end for i=0,nexit-1 do local addr = traceexitstub(tr, i) t[addr] = tostring(i) end local addr = traceexitstub(tr, nexit) if addr then t[addr] = "stack_check" end end -- Fill symbol table with trace exit stub addresses. local function fillsymtab(tr, nexit) local t = symtab if nexitsym == 0 then local ircall = vmdef.ircall for i=0,#ircall do local addr = ircalladdr(i) if addr ~= 0 then t[addr] = ircall[i] end end end if nexitsym == 1000000 then -- Per-trace exit stubs. fillsymtab_tr(tr, nexit) elseif nexit > nexitsym then -- Shared exit stubs. for i=nexitsym,nexit-1 do local addr = traceexitstub(i) if addr == nil then -- Fall back to per-trace exit stubs. fillsymtab_tr(tr, nexit) setmetatable(symtab, symtabmt) nexit = 1000000 break end t[addr] = tostring(i) end nexitsym = nexit end return t end local function dumpwrite(s) out:write(s) end -- Disassemble machine code. local function dump_mcode(tr) local info = traceinfo(tr) if not info then return end local mcode, addr, loop = tracemc(tr) if not mcode then return end if not disass then disass = require("jit.dis_"..jit.arch) end out:write("---- TRACE ", tr, " mcode ", #mcode, "\n") local ctx = disass.create(mcode, addr, dumpwrite) ctx.hexdump = 0 ctx.symtab = fillsymtab(tr, info.nexit) if loop ~= 0 then symtab[addr+loop] = "LOOP" ctx:disass(0, loop) out:write("->LOOP:\n") ctx:disass(loop, #mcode-loop) symtab[addr+loop] = nil else ctx:disass(0, #mcode) end end ------------------------------------------------------------------------------ local irtype_text = { [0] = "nil", "fal", "tru", "lud", "str", "p32", "thr", "pro", "fun", "p64", "cdt", "tab", "udt", "flt", "num", "i8 ", "u8 ", "i16", "u16", "int", "u32", "i64", "u64", "sfp", } local colortype_ansi = { [0] = "%s", "%s", "%s", "\027[36m%s\027[m", "\027[32m%s\027[m", "%s", "\027[1m%s\027[m", "%s", "\027[1m%s\027[m", "%s", "\027[33m%s\027[m", "\027[31m%s\027[m", "\027[36m%s\027[m", "\027[34m%s\027[m", "\027[34m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", "\027[35m%s\027[m", } local function colorize_text(s) return s end local function colorize_ansi(s, t) return format(colortype_ansi[t], s) end local irtype_ansi = setmetatable({}, { __index = function(tab, t) local s = colorize_ansi(irtype_text[t], t); tab[t] = s; return s; end }) local html_escape = { ["<"] = "<", [">"] = ">", ["&"] = "&", } local function colorize_html(s, t) s = gsub(s, "[<>&]", html_escape) return format('%s', irtype_text[t], s) end local irtype_html = setmetatable({}, { __index = function(tab, t) local s = colorize_html(irtype_text[t], t); tab[t] = s; return s; end }) local header_html = [[ ]] local colorize, irtype -- Lookup tables to convert some literals into names. local litname = { ["SLOAD "] = setmetatable({}, { __index = function(t, mode) local s = "" if band(mode, 1) ~= 0 then s = s.."P" end if band(mode, 2) ~= 0 then s = s.."F" end if band(mode, 4) ~= 0 then s = s.."T" end if band(mode, 8) ~= 0 then s = s.."C" end if band(mode, 16) ~= 0 then s = s.."R" end if band(mode, 32) ~= 0 then s = s.."I" end t[mode] = s return s end}), ["XLOAD "] = { [0] = "", "R", "V", "RV", "U", "RU", "VU", "RVU", }, ["CONV "] = setmetatable({}, { __index = function(t, mode) local s = irtype[band(mode, 31)] s = irtype[band(shr(mode, 5), 31)].."."..s if band(mode, 0x400) ~= 0 then s = s.." trunc" elseif band(mode, 0x800) ~= 0 then s = s.." sext" end local c = shr(mode, 14) if c == 2 then s = s.." index" elseif c == 3 then s = s.." check" end t[mode] = s return s end}), ["FLOAD "] = vmdef.irfield, ["FREF "] = vmdef.irfield, ["FPMATH"] = vmdef.irfpm, } local function ctlsub(c) if c == "\n" then return "\\n" elseif c == "\r" then return "\\r" elseif c == "\t" then return "\\t" else return format("\\%03d", byte(c)) end end local function fmtfunc(func, pc) local fi = funcinfo(func, pc) if fi.loc then return fi.loc elseif fi.ffid then return vmdef.ffnames[fi.ffid] elseif fi.addr then return format("C:%x", fi.addr) else return "(?)" end end local function formatk(tr, idx) local k, t, slot = tracek(tr, idx) local tn = type(k) local s if tn == "number" then if k == 2^52+2^51 then s = "bias" else s = format("%+.14g", k) end elseif tn == "string" then s = format(#k > 20 and '"%.20s"~' or '"%s"', gsub(k, "%c", ctlsub)) elseif tn == "function" then s = fmtfunc(k) elseif tn == "table" then s = format("{%p}", k) elseif tn == "userdata" then if t == 12 then s = format("userdata:%p", k) else s = format("[%p]", k) if s == "[NULL]" then s = "NULL" end end elseif t == 21 then -- int64_t s = sub(tostring(k), 1, -3) if sub(s, 1, 1) ~= "-" then s = "+"..s end else s = tostring(k) -- For primitives. end s = colorize(format("%-4s", s), t) if slot then s = format("%s @%d", s, slot) end return s end local function printsnap(tr, snap) local n = 2 for s=0,snap[1]-1 do local sn = snap[n] if shr(sn, 24) == s then n = n + 1 local ref = band(sn, 0xffff) - 0x8000 -- REF_BIAS if ref < 0 then out:write(formatk(tr, ref)) elseif band(sn, 0x80000) ~= 0 then -- SNAP_SOFTFPNUM out:write(colorize(format("%04d/%04d", ref, ref+1), 14)) else local m, ot, op1, op2 = traceir(tr, ref) out:write(colorize(format("%04d", ref), band(ot, 31))) end out:write(band(sn, 0x10000) == 0 and " " or "|") -- SNAP_FRAME else out:write("---- ") end end out:write("]\n") end -- Dump snapshots (not interleaved with IR). local function dump_snap(tr) out:write("---- TRACE ", tr, " snapshots\n") for i=0,1000000000 do local snap = tracesnap(tr, i) if not snap then break end out:write(format("#%-3d %04d [ ", i, snap[0])) printsnap(tr, snap) end end -- Return a register name or stack slot for a rid/sp location. local function ridsp_name(ridsp, ins) if not disass then disass = require("jit.dis_"..jit.arch) end local rid, slot = band(ridsp, 0xff), shr(ridsp, 8) if rid == 253 or rid == 254 then return (slot == 0 or slot == 255) and " {sink" or format(" {%04d", ins-slot) end if ridsp > 255 then return format("[%x]", slot*4) end if rid < 128 then return disass.regname(rid) end return "" end -- Dump CALL* function ref and return optional ctype. local function dumpcallfunc(tr, ins) local ctype if ins > 0 then local m, ot, op1, op2 = traceir(tr, ins) if band(ot, 31) == 0 then -- nil type means CARG(func, ctype). ins = op1 ctype = formatk(tr, op2) end end if ins < 0 then out:write(format("[0x%x](", tonumber((tracek(tr, ins))))) else out:write(format("%04d (", ins)) end return ctype end -- Recursively gather CALL* args and dump them. local function dumpcallargs(tr, ins) if ins < 0 then out:write(formatk(tr, ins)) else local m, ot, op1, op2 = traceir(tr, ins) local oidx = 6*shr(ot, 8) local op = sub(vmdef.irnames, oidx+1, oidx+6) if op == "CARG " then dumpcallargs(tr, op1) if op2 < 0 then out:write(" ", formatk(tr, op2)) else out:write(" ", format("%04d", op2)) end else out:write(format("%04d", ins)) end end end -- Dump IR and interleaved snapshots. local function dump_ir(tr, dumpsnap, dumpreg) local info = traceinfo(tr) if not info then return end local nins = info.nins out:write("---- TRACE ", tr, " IR\n") local irnames = vmdef.irnames local snapref = 65536 local snap, snapno if dumpsnap then snap = tracesnap(tr, 0) snapref = snap[0] snapno = 0 end for ins=1,nins do if ins >= snapref then if dumpreg then out:write(format(".... SNAP #%-3d [ ", snapno)) else out:write(format(".... SNAP #%-3d [ ", snapno)) end printsnap(tr, snap) snapno = snapno + 1 snap = tracesnap(tr, snapno) snapref = snap and snap[0] or 65536 end local m, ot, op1, op2, ridsp = traceir(tr, ins) local oidx, t = 6*shr(ot, 8), band(ot, 31) local op = sub(irnames, oidx+1, oidx+6) if op == "LOOP " then if dumpreg then out:write(format("%04d ------------ LOOP ------------\n", ins)) else out:write(format("%04d ------ LOOP ------------\n", ins)) end elseif op ~= "NOP " and op ~= "CARG " and (dumpreg or op ~= "RENAME") then local rid = band(ridsp, 255) if dumpreg then out:write(format("%04d %-6s", ins, ridsp_name(ridsp, ins))) else out:write(format("%04d ", ins)) end out:write(format("%s%s %s %s ", (rid == 254 or rid == 253) and "}" or (band(ot, 128) == 0 and " " or ">"), band(ot, 64) == 0 and " " or "+", irtype[t], op)) local m1, m2 = band(m, 3), band(m, 3*4) if sub(op, 1, 4) == "CALL" then local ctype if m2 == 1*4 then -- op2 == IRMlit out:write(format("%-10s (", vmdef.ircall[op2])) else ctype = dumpcallfunc(tr, op2) end if op1 ~= -1 then dumpcallargs(tr, op1) end out:write(")") if ctype then out:write(" ctype ", ctype) end elseif op == "CNEW " and op2 == -1 then out:write(formatk(tr, op1)) elseif m1 ~= 3 then -- op1 != IRMnone if op1 < 0 then out:write(formatk(tr, op1)) else out:write(format(m1 == 0 and "%04d" or "#%-3d", op1)) end if m2 ~= 3*4 then -- op2 != IRMnone if m2 == 1*4 then -- op2 == IRMlit local litn = litname[op] if litn and litn[op2] then out:write(" ", litn[op2]) elseif op == "UREFO " or op == "UREFC " then out:write(format(" #%-3d", shr(op2, 8))) else out:write(format(" #%-3d", op2)) end elseif op2 < 0 then out:write(" ", formatk(tr, op2)) else out:write(format(" %04d", op2)) end end end out:write("\n") end end if snap then if dumpreg then out:write(format(".... SNAP #%-3d [ ", snapno)) else out:write(format(".... SNAP #%-3d [ ", snapno)) end printsnap(tr, snap) end end ------------------------------------------------------------------------------ local recprefix = "" local recdepth = 0 -- Format trace error message. local function fmterr(err, info) if type(err) == "number" then if type(info) == "function" then info = fmtfunc(info) end err = format(vmdef.traceerr[err], info) end return err end -- Dump trace states. local function dump_trace(what, tr, func, pc, otr, oex) if what == "stop" or (what == "abort" and dumpmode.a) then if dumpmode.i then dump_ir(tr, dumpmode.s, dumpmode.r and what == "stop") elseif dumpmode.s then dump_snap(tr) end if dumpmode.m then dump_mcode(tr) end end if what == "start" then if dumpmode.H then out:write('
\n') end
    out:write("---- TRACE ", tr, " ", what)
    if otr then out:write(" ", otr, "/", oex) end
    out:write(" ", fmtfunc(func, pc), "\n")
  elseif what == "stop" or what == "abort" then
    out:write("---- TRACE ", tr, " ", what)
    if what == "abort" then
      out:write(" ", fmtfunc(func, pc), " -- ", fmterr(otr, oex), "\n")
    else
      local info = traceinfo(tr)
      local link, ltype = info.link, info.linktype
      if link == tr or link == 0 then
	out:write(" -> ", ltype, "\n")
      elseif ltype == "root" then
	out:write(" -> ", link, "\n")
      else
	out:write(" -> ", link, " ", ltype, "\n")
      end
    end
    if dumpmode.H then out:write("
\n\n") else out:write("\n") end else if what == "flush" then symtab, nexitsym = {}, 0 end out:write("---- TRACE ", what, "\n\n") end out:flush() end -- Dump recorded bytecode. local function dump_record(tr, func, pc, depth, callee) if depth ~= recdepth then recdepth = depth recprefix = rep(" .", depth) end local line if pc >= 0 then line = bcline(func, pc, recprefix) if dumpmode.H then line = gsub(line, "[<>&]", html_escape) end else line = "0000 "..recprefix.." FUNCC \n" callee = func end if pc <= 0 then out:write(sub(line, 1, -2), " ; ", fmtfunc(func), "\n") else out:write(line) end if pc >= 0 and band(funcbc(func, pc), 0xff) < 16 then -- ORDER BC out:write(bcline(func, pc+1, recprefix)) -- Write JMP for cond. end end ------------------------------------------------------------------------------ -- Dump taken trace exits. local function dump_texit(tr, ex, ngpr, nfpr, ...) out:write("---- TRACE ", tr, " exit ", ex, "\n") if dumpmode.X then local regs = {...} if jit.arch == "x64" then for i=1,ngpr do out:write(format(" %016x", regs[i])) if i % 4 == 0 then out:write("\n") end end else for i=1,ngpr do out:write(format(" %08x", regs[i])) if i % 8 == 0 then out:write("\n") end end end if jit.arch == "mips" or jit.arch == "mipsel" then for i=1,nfpr,2 do out:write(format(" %+17.14g", regs[ngpr+i])) if i % 8 == 7 then out:write("\n") end end else for i=1,nfpr do out:write(format(" %+17.14g", regs[ngpr+i])) if i % 4 == 0 then out:write("\n") end end end end end ------------------------------------------------------------------------------ -- Detach dump handlers. local function dumpoff() if active then active = false jit.attach(dump_texit) jit.attach(dump_record) jit.attach(dump_trace) if out and out ~= stdout and out ~= stderr then out:close() end out = nil end end -- Open the output file and attach dump handlers. local function dumpon(opt, outfile) if active then dumpoff() end local colormode = os.getenv("COLORTERM") and "A" or "T" if opt then opt = gsub(opt, "[TAH]", function(mode) colormode = mode; return ""; end) end local m = { t=true, b=true, i=true, m=true, } if opt and opt ~= "" then local o = sub(opt, 1, 1) if o ~= "+" and o ~= "-" then m = {} end for i=1,#opt do m[sub(opt, i, i)] = (o ~= "-") end end dumpmode = m if m.t or m.b or m.i or m.s or m.m then jit.attach(dump_trace, "trace") end if m.b then jit.attach(dump_record, "record") if not bcline then bcline = require("jit.bc").line end end if m.x or m.X then jit.attach(dump_texit, "texit") end if not outfile then outfile = os.getenv("LUAJIT_DUMPFILE") end if outfile then out = outfile == "-" and stdout or assert(io.open(outfile, "w")) else out = stdout end m[colormode] = true if colormode == "A" then colorize = colorize_ansi irtype = irtype_ansi elseif colormode == "H" then colorize = colorize_html irtype = irtype_html out:write(header_html) else colorize = colorize_text irtype = irtype_text end active = true end -- Public module functions. module(...) on = dumpon off = dumpoff start = dumpon -- For -j command line option. wcc-0.0.2/src/wsh/luajit-2.0/src/jit/v.lua0000644000175000017500000001275613122010155016442 0ustar philphil---------------------------------------------------------------------------- -- Verbose mode of the LuaJIT compiler. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- -- -- This module shows verbose information about the progress of the -- JIT compiler. It prints one line for each generated trace. This module -- is useful to see which code has been compiled or where the compiler -- punts and falls back to the interpreter. -- -- Example usage: -- -- luajit -jv -e "for i=1,1000 do for j=1,1000 do end end" -- luajit -jv=myapp.out myapp.lua -- -- Default output is to stderr. To redirect the output to a file, pass a -- filename as an argument (use '-' for stdout) or set the environment -- variable LUAJIT_VERBOSEFILE. The file is overwritten every time the -- module is started. -- -- The output from the first example should look like this: -- -- [TRACE 1 (command line):1 loop] -- [TRACE 2 (1/3) (command line):1 -> 1] -- -- The first number in each line is the internal trace number. Next are -- the file name ('(command line)') and the line number (':1') where the -- trace has started. Side traces also show the parent trace number and -- the exit number where they are attached to in parentheses ('(1/3)'). -- An arrow at the end shows where the trace links to ('-> 1'), unless -- it loops to itself. -- -- In this case the inner loop gets hot and is traced first, generating -- a root trace. Then the last exit from the 1st trace gets hot, too, -- and triggers generation of the 2nd trace. The side trace follows the -- path along the outer loop and *around* the inner loop, back to its -- start, and then links to the 1st trace. Yes, this may seem unusual, -- if you know how traditional compilers work. Trace compilers are full -- of surprises like this -- have fun! :-) -- -- Aborted traces are shown like this: -- -- [TRACE --- foo.lua:44 -- leaving loop in root trace at foo:lua:50] -- -- Don't worry -- trace aborts are quite common, even in programs which -- can be fully compiled. The compiler may retry several times until it -- finds a suitable trace. -- -- Of course this doesn't work with features that are not-yet-implemented -- (NYI error messages). The VM simply falls back to the interpreter. This -- may not matter at all if the particular trace is not very high up in -- the CPU usage profile. Oh, and the interpreter is quite fast, too. -- -- Also check out the -jdump module, which prints all the gory details. -- ------------------------------------------------------------------------------ -- Cache some library functions and objects. local jit = require("jit") assert(jit.version_num == 20004, "LuaJIT core/library version mismatch") local jutil = require("jit.util") local vmdef = require("jit.vmdef") local funcinfo, traceinfo = jutil.funcinfo, jutil.traceinfo local type, format = type, string.format local stdout, stderr = io.stdout, io.stderr -- Active flag and output file handle. local active, out ------------------------------------------------------------------------------ local startloc, startex local function fmtfunc(func, pc) local fi = funcinfo(func, pc) if fi.loc then return fi.loc elseif fi.ffid then return vmdef.ffnames[fi.ffid] elseif fi.addr then return format("C:%x", fi.addr) else return "(?)" end end -- Format trace error message. local function fmterr(err, info) if type(err) == "number" then if type(info) == "function" then info = fmtfunc(info) end err = format(vmdef.traceerr[err], info) end return err end -- Dump trace states. local function dump_trace(what, tr, func, pc, otr, oex) if what == "start" then startloc = fmtfunc(func, pc) startex = otr and "("..otr.."/"..oex..") " or "" else if what == "abort" then local loc = fmtfunc(func, pc) if loc ~= startloc then out:write(format("[TRACE --- %s%s -- %s at %s]\n", startex, startloc, fmterr(otr, oex), loc)) else out:write(format("[TRACE --- %s%s -- %s]\n", startex, startloc, fmterr(otr, oex))) end elseif what == "stop" then local info = traceinfo(tr) local link, ltype = info.link, info.linktype if ltype == "interpreter" then out:write(format("[TRACE %3s %s%s -- fallback to interpreter]\n", tr, startex, startloc)) elseif link == tr or link == 0 then out:write(format("[TRACE %3s %s%s %s]\n", tr, startex, startloc, ltype)) elseif ltype == "root" then out:write(format("[TRACE %3s %s%s -> %d]\n", tr, startex, startloc, link)) else out:write(format("[TRACE %3s %s%s -> %d %s]\n", tr, startex, startloc, link, ltype)) end else out:write(format("[TRACE %s]\n", what)) end out:flush() end end ------------------------------------------------------------------------------ -- Detach dump handlers. local function dumpoff() if active then active = false jit.attach(dump_trace) if out and out ~= stdout and out ~= stderr then out:close() end out = nil end end -- Open the output file and attach dump handlers. local function dumpon(outfile) if active then dumpoff() end if not outfile then outfile = os.getenv("LUAJIT_VERBOSEFILE") end if outfile then out = outfile == "-" and stdout or assert(io.open(outfile, "w")) else out = stderr end jit.attach(dump_trace, "trace") active = true end -- Public module functions. module(...) on = dumpon off = dumpoff start = dumpon -- For -j command line option. wcc-0.0.2/src/wsh/luajit-2.0/src/lj_target_ppc.h0000644000175000017500000001653513122010155017671 0ustar philphil/* ** Definitions for PPC CPUs. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_TARGET_PPC_H #define _LJ_TARGET_PPC_H /* -- Registers IDs ------------------------------------------------------- */ #define GPRDEF(_) \ _(R0) _(SP) _(SYS1) _(R3) _(R4) _(R5) _(R6) _(R7) \ _(R8) _(R9) _(R10) _(R11) _(R12) _(SYS2) _(R14) _(R15) \ _(R16) _(R17) _(R18) _(R19) _(R20) _(R21) _(R22) _(R23) \ _(R24) _(R25) _(R26) _(R27) _(R28) _(R29) _(R30) _(R31) #define FPRDEF(_) \ _(F0) _(F1) _(F2) _(F3) _(F4) _(F5) _(F6) _(F7) \ _(F8) _(F9) _(F10) _(F11) _(F12) _(F13) _(F14) _(F15) \ _(F16) _(F17) _(F18) _(F19) _(F20) _(F21) _(F22) _(F23) \ _(F24) _(F25) _(F26) _(F27) _(F28) _(F29) _(F30) _(F31) #define VRIDDEF(_) #define RIDENUM(name) RID_##name, enum { GPRDEF(RIDENUM) /* General-purpose registers (GPRs). */ FPRDEF(RIDENUM) /* Floating-point registers (FPRs). */ RID_MAX, RID_TMP = RID_R0, /* Calling conventions. */ RID_RET = RID_R3, RID_RETHI = RID_R3, RID_RETLO = RID_R4, RID_FPRET = RID_F1, /* These definitions must match with the *.dasc file(s): */ RID_BASE = RID_R14, /* Interpreter BASE. */ RID_LPC = RID_R16, /* Interpreter PC. */ RID_DISPATCH = RID_R17, /* Interpreter DISPATCH table. */ RID_LREG = RID_R18, /* Interpreter L. */ RID_JGL = RID_R31, /* On-trace: global_State + 32768. */ /* Register ranges [min, max) and number of registers. */ RID_MIN_GPR = RID_R0, RID_MAX_GPR = RID_R31+1, RID_MIN_FPR = RID_F0, RID_MAX_FPR = RID_F31+1, RID_NUM_GPR = RID_MAX_GPR - RID_MIN_GPR, RID_NUM_FPR = RID_MAX_FPR - RID_MIN_FPR }; #define RID_NUM_KREF RID_NUM_GPR #define RID_MIN_KREF RID_R0 /* -- Register sets ------------------------------------------------------- */ /* Make use of all registers, except TMP, SP, SYS1, SYS2 and JGL. */ #define RSET_FIXED \ (RID2RSET(RID_TMP)|RID2RSET(RID_SP)|RID2RSET(RID_SYS1)|\ RID2RSET(RID_SYS2)|RID2RSET(RID_JGL)) #define RSET_GPR (RSET_RANGE(RID_MIN_GPR, RID_MAX_GPR) - RSET_FIXED) #define RSET_FPR RSET_RANGE(RID_MIN_FPR, RID_MAX_FPR) #define RSET_ALL (RSET_GPR|RSET_FPR) #define RSET_INIT RSET_ALL #define RSET_SCRATCH_GPR (RSET_RANGE(RID_R3, RID_R12+1)) #define RSET_SCRATCH_FPR (RSET_RANGE(RID_F0, RID_F13+1)) #define RSET_SCRATCH (RSET_SCRATCH_GPR|RSET_SCRATCH_FPR) #define REGARG_FIRSTGPR RID_R3 #define REGARG_LASTGPR RID_R10 #define REGARG_NUMGPR 8 #define REGARG_FIRSTFPR RID_F1 #define REGARG_LASTFPR RID_F8 #define REGARG_NUMFPR 8 /* -- Spill slots --------------------------------------------------------- */ /* Spill slots are 32 bit wide. An even/odd pair is used for FPRs. ** ** SPS_FIXED: Available fixed spill slots in interpreter frame. ** This definition must match with the *.dasc file(s). ** ** SPS_FIRST: First spill slot for general use. ** [sp+12] tmplo word \ ** [sp+ 8] tmphi word / tmp dword, parameter area for callee ** [sp+ 4] tmpw, LR of callee ** [sp+ 0] stack chain */ #define SPS_FIXED 7 #define SPS_FIRST 4 /* Stack offsets for temporary slots. Used for FP<->int conversions etc. */ #define SPOFS_TMPW 4 #define SPOFS_TMP 8 #define SPOFS_TMPHI 8 #define SPOFS_TMPLO 12 #define sps_scale(slot) (4 * (int32_t)(slot)) #define sps_align(slot) (((slot) - SPS_FIXED + 3) & ~3) /* -- Exit state ---------------------------------------------------------- */ /* This definition must match with the *.dasc file(s). */ typedef struct { lua_Number fpr[RID_NUM_FPR]; /* Floating-point registers. */ int32_t gpr[RID_NUM_GPR]; /* General-purpose registers. */ int32_t spill[256]; /* Spill slots. */ } ExitState; /* Highest exit + 1 indicates stack check. */ #define EXITSTATE_CHECKEXIT 1 /* Return the address of a per-trace exit stub. */ static LJ_AINLINE uint32_t *exitstub_trace_addr_(uint32_t *p, uint32_t exitno) { while (*p == 0x60000000) p++; /* Skip PPCI_NOP. */ return p + 3 + exitno; } /* Avoid dependence on lj_jit.h if only including lj_target.h. */ #define exitstub_trace_addr(T, exitno) \ exitstub_trace_addr_((MCode *)((char *)(T)->mcode + (T)->szmcode), (exitno)) /* -- Instructions -------------------------------------------------------- */ /* Instruction fields. */ #define PPCF_CC(cc) ((((cc) & 3) << 16) | (((cc) & 4) << 22)) #define PPCF_T(r) ((r) << 21) #define PPCF_A(r) ((r) << 16) #define PPCF_B(r) ((r) << 11) #define PPCF_C(r) ((r) << 6) #define PPCF_MB(n) ((n) << 6) #define PPCF_ME(n) ((n) << 1) #define PPCF_Y 0x00200000 #define PPCF_DOT 0x00000001 typedef enum PPCIns { /* Integer instructions. */ PPCI_MR = 0x7c000378, PPCI_NOP = 0x60000000, PPCI_LI = 0x38000000, PPCI_LIS = 0x3c000000, PPCI_ADD = 0x7c000214, PPCI_ADDC = 0x7c000014, PPCI_ADDO = 0x7c000614, PPCI_ADDE = 0x7c000114, PPCI_ADDZE = 0x7c000194, PPCI_ADDME = 0x7c0001d4, PPCI_ADDI = 0x38000000, PPCI_ADDIS = 0x3c000000, PPCI_ADDIC = 0x30000000, PPCI_ADDICDOT = 0x34000000, PPCI_SUBF = 0x7c000050, PPCI_SUBFC = 0x7c000010, PPCI_SUBFO = 0x7c000450, PPCI_SUBFE = 0x7c000110, PPCI_SUBFZE = 0x7c000190, PPCI_SUBFME = 0x7c0001d0, PPCI_SUBFIC = 0x20000000, PPCI_NEG = 0x7c0000d0, PPCI_AND = 0x7c000038, PPCI_ANDC = 0x7c000078, PPCI_NAND = 0x7c0003b8, PPCI_ANDIDOT = 0x70000000, PPCI_ANDISDOT = 0x74000000, PPCI_OR = 0x7c000378, PPCI_NOR = 0x7c0000f8, PPCI_ORI = 0x60000000, PPCI_ORIS = 0x64000000, PPCI_XOR = 0x7c000278, PPCI_EQV = 0x7c000238, PPCI_XORI = 0x68000000, PPCI_XORIS = 0x6c000000, PPCI_CMPW = 0x7c000000, PPCI_CMPLW = 0x7c000040, PPCI_CMPWI = 0x2c000000, PPCI_CMPLWI = 0x28000000, PPCI_MULLW = 0x7c0001d6, PPCI_MULLI = 0x1c000000, PPCI_MULLWO = 0x7c0005d6, PPCI_EXTSB = 0x7c000774, PPCI_EXTSH = 0x7c000734, PPCI_SLW = 0x7c000030, PPCI_SRW = 0x7c000430, PPCI_SRAW = 0x7c000630, PPCI_SRAWI = 0x7c000670, PPCI_RLWNM = 0x5c000000, PPCI_RLWINM = 0x54000000, PPCI_RLWIMI = 0x50000000, PPCI_B = 0x48000000, PPCI_BL = 0x48000001, PPCI_BC = 0x40800000, PPCI_BCL = 0x40800001, PPCI_BCTR = 0x4e800420, PPCI_BCTRL = 0x4e800421, PPCI_CRANDC = 0x4c000102, PPCI_CRXOR = 0x4c000182, PPCI_CRAND = 0x4c000202, PPCI_CREQV = 0x4c000242, PPCI_CRORC = 0x4c000342, PPCI_CROR = 0x4c000382, PPCI_MFLR = 0x7c0802a6, PPCI_MTCTR = 0x7c0903a6, PPCI_MCRXR = 0x7c000400, /* Load/store instructions. */ PPCI_LWZ = 0x80000000, PPCI_LBZ = 0x88000000, PPCI_STW = 0x90000000, PPCI_STB = 0x98000000, PPCI_LHZ = 0xa0000000, PPCI_LHA = 0xa8000000, PPCI_STH = 0xb0000000, PPCI_STWU = 0x94000000, PPCI_LFS = 0xc0000000, PPCI_LFD = 0xc8000000, PPCI_STFS = 0xd0000000, PPCI_STFD = 0xd8000000, PPCI_LWZX = 0x7c00002e, PPCI_LBZX = 0x7c0000ae, PPCI_STWX = 0x7c00012e, PPCI_STBX = 0x7c0001ae, PPCI_LHZX = 0x7c00022e, PPCI_LHAX = 0x7c0002ae, PPCI_STHX = 0x7c00032e, PPCI_LWBRX = 0x7c00042c, PPCI_STWBRX = 0x7c00052c, PPCI_LFSX = 0x7c00042e, PPCI_LFDX = 0x7c0004ae, PPCI_STFSX = 0x7c00052e, PPCI_STFDX = 0x7c0005ae, /* FP instructions. */ PPCI_FMR = 0xfc000090, PPCI_FNEG = 0xfc000050, PPCI_FABS = 0xfc000210, PPCI_FRSP = 0xfc000018, PPCI_FCTIWZ = 0xfc00001e, PPCI_FADD = 0xfc00002a, PPCI_FSUB = 0xfc000028, PPCI_FMUL = 0xfc000032, PPCI_FDIV = 0xfc000024, PPCI_FSQRT = 0xfc00002c, PPCI_FMADD = 0xfc00003a, PPCI_FMSUB = 0xfc000038, PPCI_FNMSUB = 0xfc00003c, PPCI_FCMPU = 0xfc000000, PPCI_FSEL = 0xfc00002e, } PPCIns; typedef enum PPCCC { CC_GE, CC_LE, CC_NE, CC_NS, CC_LT, CC_GT, CC_EQ, CC_SO } PPCCC; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_target_x86.h0000644000175000017500000002352013122010155017524 0ustar philphil/* ** Definitions for x86 and x64 CPUs. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_TARGET_X86_H #define _LJ_TARGET_X86_H /* -- Registers IDs ------------------------------------------------------- */ #if LJ_64 #define GPRDEF(_) \ _(EAX) _(ECX) _(EDX) _(EBX) _(ESP) _(EBP) _(ESI) _(EDI) \ _(R8D) _(R9D) _(R10D) _(R11D) _(R12D) _(R13D) _(R14D) _(R15D) #define FPRDEF(_) \ _(XMM0) _(XMM1) _(XMM2) _(XMM3) _(XMM4) _(XMM5) _(XMM6) _(XMM7) \ _(XMM8) _(XMM9) _(XMM10) _(XMM11) _(XMM12) _(XMM13) _(XMM14) _(XMM15) #else #define GPRDEF(_) \ _(EAX) _(ECX) _(EDX) _(EBX) _(ESP) _(EBP) _(ESI) _(EDI) #define FPRDEF(_) \ _(XMM0) _(XMM1) _(XMM2) _(XMM3) _(XMM4) _(XMM5) _(XMM6) _(XMM7) #endif #define VRIDDEF(_) \ _(MRM) #define RIDENUM(name) RID_##name, enum { GPRDEF(RIDENUM) /* General-purpose registers (GPRs). */ FPRDEF(RIDENUM) /* Floating-point registers (FPRs). */ RID_MAX, RID_MRM = RID_MAX, /* Pseudo-id for ModRM operand. */ /* Calling conventions. */ RID_RET = RID_EAX, #if LJ_64 RID_FPRET = RID_XMM0, #else RID_RETLO = RID_EAX, RID_RETHI = RID_EDX, #endif /* These definitions must match with the *.dasc file(s): */ RID_BASE = RID_EDX, /* Interpreter BASE. */ #if LJ_64 && !LJ_ABI_WIN RID_LPC = RID_EBX, /* Interpreter PC. */ RID_DISPATCH = RID_R14D, /* Interpreter DISPATCH table. */ #else RID_LPC = RID_ESI, /* Interpreter PC. */ RID_DISPATCH = RID_EBX, /* Interpreter DISPATCH table. */ #endif /* Register ranges [min, max) and number of registers. */ RID_MIN_GPR = RID_EAX, RID_MIN_FPR = RID_XMM0, RID_MAX_GPR = RID_MIN_FPR, RID_MAX_FPR = RID_MAX, RID_NUM_GPR = RID_MAX_GPR - RID_MIN_GPR, RID_NUM_FPR = RID_MAX_FPR - RID_MIN_FPR, }; /* -- Register sets ------------------------------------------------------- */ /* Make use of all registers, except the stack pointer. */ #define RSET_GPR (RSET_RANGE(RID_MIN_GPR, RID_MAX_GPR)-RID2RSET(RID_ESP)) #define RSET_FPR (RSET_RANGE(RID_MIN_FPR, RID_MAX_FPR)) #define RSET_ALL (RSET_GPR|RSET_FPR) #define RSET_INIT RSET_ALL #if LJ_64 /* Note: this requires the use of FORCE_REX! */ #define RSET_GPR8 RSET_GPR #else #define RSET_GPR8 (RSET_RANGE(RID_EAX, RID_EBX+1)) #endif /* ABI-specific register sets. */ #define RSET_ACD (RID2RSET(RID_EAX)|RID2RSET(RID_ECX)|RID2RSET(RID_EDX)) #if LJ_64 #if LJ_ABI_WIN /* Windows x64 ABI. */ #define RSET_SCRATCH \ (RSET_ACD|RSET_RANGE(RID_R8D, RID_R11D+1)|RSET_RANGE(RID_XMM0, RID_XMM5+1)) #define REGARG_GPRS \ (RID_ECX|((RID_EDX|((RID_R8D|(RID_R9D<<5))<<5))<<5)) #define REGARG_NUMGPR 4 #define REGARG_NUMFPR 4 #define REGARG_FIRSTFPR RID_XMM0 #define REGARG_LASTFPR RID_XMM3 #define STACKARG_OFS (4*8) #else /* The rest of the civilized x64 world has a common ABI. */ #define RSET_SCRATCH \ (RSET_ACD|RSET_RANGE(RID_ESI, RID_R11D+1)|RSET_FPR) #define REGARG_GPRS \ (RID_EDI|((RID_ESI|((RID_EDX|((RID_ECX|((RID_R8D|(RID_R9D \ <<5))<<5))<<5))<<5))<<5)) #define REGARG_NUMGPR 6 #define REGARG_NUMFPR 8 #define REGARG_FIRSTFPR RID_XMM0 #define REGARG_LASTFPR RID_XMM7 #define STACKARG_OFS 0 #endif #else /* Common x86 ABI. */ #define RSET_SCRATCH (RSET_ACD|RSET_FPR) #define REGARG_GPRS (RID_ECX|(RID_EDX<<5)) /* Fastcall only. */ #define REGARG_NUMGPR 2 /* Fastcall only. */ #define REGARG_NUMFPR 0 #define STACKARG_OFS 0 #endif #if LJ_64 /* Prefer the low 8 regs of each type to reduce REX prefixes. */ #undef rset_picktop #define rset_picktop(rs) (lj_fls(lj_bswap(rs)) ^ 0x18) #endif /* -- Spill slots --------------------------------------------------------- */ /* Spill slots are 32 bit wide. An even/odd pair is used for FPRs. ** ** SPS_FIXED: Available fixed spill slots in interpreter frame. ** This definition must match with the *.dasc file(s). ** ** SPS_FIRST: First spill slot for general use. Reserve min. two 32 bit slots. */ #if LJ_64 #if LJ_ABI_WIN #define SPS_FIXED (4*2) #define SPS_FIRST (4*2) /* Don't use callee register save area. */ #else #define SPS_FIXED 4 #define SPS_FIRST 2 #endif #else #define SPS_FIXED 6 #define SPS_FIRST 2 #endif #define SPOFS_TMP 0 #define sps_scale(slot) (4 * (int32_t)(slot)) #define sps_align(slot) (((slot) - SPS_FIXED + 3) & ~3) /* -- Exit state ---------------------------------------------------------- */ /* This definition must match with the *.dasc file(s). */ typedef struct { lua_Number fpr[RID_NUM_FPR]; /* Floating-point registers. */ intptr_t gpr[RID_NUM_GPR]; /* General-purpose registers. */ int32_t spill[256]; /* Spill slots. */ } ExitState; /* Limited by the range of a short fwd jump (127): (2+2)*(32-1)-2 = 122. */ #define EXITSTUB_SPACING (2+2) #define EXITSTUBS_PER_GROUP 32 /* -- x86 ModRM operand encoding ------------------------------------------ */ typedef enum { XM_OFS0 = 0x00, XM_OFS8 = 0x40, XM_OFS32 = 0x80, XM_REG = 0xc0, XM_SCALE1 = 0x00, XM_SCALE2 = 0x40, XM_SCALE4 = 0x80, XM_SCALE8 = 0xc0, XM_MASK = 0xc0 } x86Mode; /* Structure to hold variable ModRM operand. */ typedef struct { int32_t ofs; /* Offset. */ uint8_t base; /* Base register or RID_NONE. */ uint8_t idx; /* Index register or RID_NONE. */ uint8_t scale; /* Index scale (XM_SCALE1 .. XM_SCALE8). */ } x86ModRM; /* -- Opcodes ------------------------------------------------------------- */ /* Macros to construct variable-length x86 opcodes. -(len+1) is in LSB. */ #define XO_(o) ((uint32_t)(0x0000fe + (0x##o<<24))) #define XO_FPU(a,b) ((uint32_t)(0x00fd + (0x##a<<16)+(0x##b<<24))) #define XO_0f(o) ((uint32_t)(0x0f00fd + (0x##o<<24))) #define XO_66(o) ((uint32_t)(0x6600fd + (0x##o<<24))) #define XO_660f(o) ((uint32_t)(0x0f66fc + (0x##o<<24))) #define XO_f20f(o) ((uint32_t)(0x0ff2fc + (0x##o<<24))) #define XO_f30f(o) ((uint32_t)(0x0ff3fc + (0x##o<<24))) /* This list of x86 opcodes is not intended to be complete. Opcodes are only ** included when needed. Take a look at DynASM or jit.dis_x86 to see the ** whole mess. */ typedef enum { /* Fixed length opcodes. XI_* prefix. */ XI_NOP = 0x90, XI_XCHGa = 0x90, XI_CALL = 0xe8, XI_JMP = 0xe9, XI_JMPs = 0xeb, XI_PUSH = 0x50, /* Really 50+r. */ XI_JCCs = 0x70, /* Really 7x. */ XI_JCCn = 0x80, /* Really 0f8x. */ XI_LEA = 0x8d, XI_MOVrib = 0xb0, /* Really b0+r. */ XI_MOVri = 0xb8, /* Really b8+r. */ XI_ARITHib = 0x80, XI_ARITHi = 0x81, XI_ARITHi8 = 0x83, XI_PUSHi8 = 0x6a, XI_TESTb = 0x84, XI_TEST = 0x85, XI_MOVmi = 0xc7, XI_GROUP5 = 0xff, /* Note: little-endian byte-order! */ XI_FLDZ = 0xeed9, XI_FLD1 = 0xe8d9, XI_FLDLG2 = 0xecd9, XI_FLDLN2 = 0xedd9, XI_FDUP = 0xc0d9, /* Really fld st0. */ XI_FPOP = 0xd8dd, /* Really fstp st0. */ XI_FPOP1 = 0xd9dd, /* Really fstp st1. */ XI_FRNDINT = 0xfcd9, XI_FSIN = 0xfed9, XI_FCOS = 0xffd9, XI_FPTAN = 0xf2d9, XI_FPATAN = 0xf3d9, XI_FSCALE = 0xfdd9, XI_FYL2X = 0xf1d9, /* Variable-length opcodes. XO_* prefix. */ XO_MOV = XO_(8b), XO_MOVto = XO_(89), XO_MOVtow = XO_66(89), XO_MOVtob = XO_(88), XO_MOVmi = XO_(c7), XO_MOVmib = XO_(c6), XO_LEA = XO_(8d), XO_ARITHib = XO_(80), XO_ARITHi = XO_(81), XO_ARITHi8 = XO_(83), XO_ARITHiw8 = XO_66(83), XO_SHIFTi = XO_(c1), XO_SHIFT1 = XO_(d1), XO_SHIFTcl = XO_(d3), XO_IMUL = XO_0f(af), XO_IMULi = XO_(69), XO_IMULi8 = XO_(6b), XO_CMP = XO_(3b), XO_TESTb = XO_(84), XO_TEST = XO_(85), XO_GROUP3b = XO_(f6), XO_GROUP3 = XO_(f7), XO_GROUP5b = XO_(fe), XO_GROUP5 = XO_(ff), XO_MOVZXb = XO_0f(b6), XO_MOVZXw = XO_0f(b7), XO_MOVSXb = XO_0f(be), XO_MOVSXw = XO_0f(bf), XO_MOVSXd = XO_(63), XO_BSWAP = XO_0f(c8), XO_CMOV = XO_0f(40), XO_MOVSD = XO_f20f(10), XO_MOVSDto = XO_f20f(11), XO_MOVSS = XO_f30f(10), XO_MOVSSto = XO_f30f(11), XO_MOVLPD = XO_660f(12), XO_MOVAPS = XO_0f(28), XO_XORPS = XO_0f(57), XO_ANDPS = XO_0f(54), XO_ADDSD = XO_f20f(58), XO_SUBSD = XO_f20f(5c), XO_MULSD = XO_f20f(59), XO_DIVSD = XO_f20f(5e), XO_SQRTSD = XO_f20f(51), XO_MINSD = XO_f20f(5d), XO_MAXSD = XO_f20f(5f), XO_ROUNDSD = 0x0b3a0ffc, /* Really 66 0f 3a 0b. See asm_fpmath. */ XO_UCOMISD = XO_660f(2e), XO_CVTSI2SD = XO_f20f(2a), XO_CVTSD2SI = XO_f20f(2d), XO_CVTTSD2SI= XO_f20f(2c), XO_CVTSI2SS = XO_f30f(2a), XO_CVTSS2SI = XO_f30f(2d), XO_CVTTSS2SI= XO_f30f(2c), XO_CVTSS2SD = XO_f30f(5a), XO_CVTSD2SS = XO_f20f(5a), XO_ADDSS = XO_f30f(58), XO_MOVD = XO_660f(6e), XO_MOVDto = XO_660f(7e), XO_FLDd = XO_(d9), XOg_FLDd = 0, XO_FLDq = XO_(dd), XOg_FLDq = 0, XO_FILDd = XO_(db), XOg_FILDd = 0, XO_FILDq = XO_(df), XOg_FILDq = 5, XO_FSTPd = XO_(d9), XOg_FSTPd = 3, XO_FSTPq = XO_(dd), XOg_FSTPq = 3, XO_FISTPq = XO_(df), XOg_FISTPq = 7, XO_FISTTPq = XO_(dd), XOg_FISTTPq = 1, XO_FADDq = XO_(dc), XOg_FADDq = 0, XO_FLDCW = XO_(d9), XOg_FLDCW = 5, XO_FNSTCW = XO_(d9), XOg_FNSTCW = 7 } x86Op; /* x86 opcode groups. */ typedef uint32_t x86Group; #define XG_(i8, i, g) ((x86Group)(((i8) << 16) + ((i) << 8) + (g))) #define XG_ARITHi(g) XG_(XI_ARITHi8, XI_ARITHi, g) #define XG_TOXOi(xg) ((x86Op)(0x000000fe + (((xg)<<16) & 0xff000000))) #define XG_TOXOi8(xg) ((x86Op)(0x000000fe + (((xg)<<8) & 0xff000000))) #define XO_ARITH(a) ((x86Op)(0x030000fe + ((a)<<27))) #define XO_ARITHw(a) ((x86Op)(0x036600fd + ((a)<<27))) typedef enum { XOg_ADD, XOg_OR, XOg_ADC, XOg_SBB, XOg_AND, XOg_SUB, XOg_XOR, XOg_CMP, XOg_X_IMUL } x86Arith; typedef enum { XOg_ROL, XOg_ROR, XOg_RCL, XOg_RCR, XOg_SHL, XOg_SHR, XOg_SAL, XOg_SAR } x86Shift; typedef enum { XOg_TEST, XOg_TEST_, XOg_NOT, XOg_NEG, XOg_MUL, XOg_IMUL, XOg_DIV, XOg_IDIV } x86Group3; typedef enum { XOg_INC, XOg_DEC, XOg_CALL, XOg_CALLfar, XOg_JMP, XOg_JMPfar, XOg_PUSH } x86Group5; /* x86 condition codes. */ typedef enum { CC_O, CC_NO, CC_B, CC_NB, CC_E, CC_NE, CC_BE, CC_NBE, CC_S, CC_NS, CC_P, CC_NP, CC_L, CC_NL, CC_LE, CC_NLE, CC_C = CC_B, CC_NAE = CC_C, CC_NC = CC_NB, CC_AE = CC_NB, CC_Z = CC_E, CC_NZ = CC_NE, CC_NA = CC_BE, CC_A = CC_NBE, CC_PE = CC_P, CC_PO = CC_NP, CC_NGE = CC_L, CC_GE = CC_NL, CC_NG = CC_LE, CC_G = CC_NLE } x86CC; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_jit.h0000644000175000017500000003566013122010155016327 0ustar philphil/* ** Common definitions for the JIT compiler. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_JIT_H #define _LJ_JIT_H #include "lj_obj.h" #include "lj_ir.h" /* JIT engine flags. */ #define JIT_F_ON 0x00000001 /* CPU-specific JIT engine flags. */ #if LJ_TARGET_X86ORX64 #define JIT_F_CMOV 0x00000010 #define JIT_F_SSE2 0x00000020 #define JIT_F_SSE3 0x00000040 #define JIT_F_SSE4_1 0x00000080 #define JIT_F_P4 0x00000100 #define JIT_F_PREFER_IMUL 0x00000200 #define JIT_F_SPLIT_XMM 0x00000400 #define JIT_F_LEA_AGU 0x00000800 /* Names for the CPU-specific flags. Must match the order above. */ #define JIT_F_CPU_FIRST JIT_F_CMOV #define JIT_F_CPUSTRING "\4CMOV\4SSE2\4SSE3\6SSE4.1\2P4\3AMD\2K8\4ATOM" #elif LJ_TARGET_ARM #define JIT_F_ARMV6_ 0x00000010 #define JIT_F_ARMV6T2_ 0x00000020 #define JIT_F_ARMV7 0x00000040 #define JIT_F_VFPV2 0x00000080 #define JIT_F_VFPV3 0x00000100 #define JIT_F_ARMV6 (JIT_F_ARMV6_|JIT_F_ARMV6T2_|JIT_F_ARMV7) #define JIT_F_ARMV6T2 (JIT_F_ARMV6T2_|JIT_F_ARMV7) #define JIT_F_VFP (JIT_F_VFPV2|JIT_F_VFPV3) /* Names for the CPU-specific flags. Must match the order above. */ #define JIT_F_CPU_FIRST JIT_F_ARMV6_ #define JIT_F_CPUSTRING "\5ARMv6\7ARMv6T2\5ARMv7\5VFPv2\5VFPv3" #elif LJ_TARGET_PPC #define JIT_F_SQRT 0x00000010 #define JIT_F_ROUND 0x00000020 /* Names for the CPU-specific flags. Must match the order above. */ #define JIT_F_CPU_FIRST JIT_F_SQRT #define JIT_F_CPUSTRING "\4SQRT\5ROUND" #elif LJ_TARGET_MIPS #define JIT_F_MIPS32R2 0x00000010 /* Names for the CPU-specific flags. Must match the order above. */ #define JIT_F_CPU_FIRST JIT_F_MIPS32R2 #define JIT_F_CPUSTRING "\010MIPS32R2" #else #define JIT_F_CPU_FIRST 0 #define JIT_F_CPUSTRING "" #endif /* Optimization flags. */ #define JIT_F_OPT_MASK 0x0fff0000 #define JIT_F_OPT_FOLD 0x00010000 #define JIT_F_OPT_CSE 0x00020000 #define JIT_F_OPT_DCE 0x00040000 #define JIT_F_OPT_FWD 0x00080000 #define JIT_F_OPT_DSE 0x00100000 #define JIT_F_OPT_NARROW 0x00200000 #define JIT_F_OPT_LOOP 0x00400000 #define JIT_F_OPT_ABC 0x00800000 #define JIT_F_OPT_SINK 0x01000000 #define JIT_F_OPT_FUSE 0x02000000 /* Optimizations names for -O. Must match the order above. */ #define JIT_F_OPT_FIRST JIT_F_OPT_FOLD #define JIT_F_OPTSTRING \ "\4fold\3cse\3dce\3fwd\3dse\6narrow\4loop\3abc\4sink\4fuse" /* Optimization levels set a fixed combination of flags. */ #define JIT_F_OPT_0 0 #define JIT_F_OPT_1 (JIT_F_OPT_FOLD|JIT_F_OPT_CSE|JIT_F_OPT_DCE) #define JIT_F_OPT_2 (JIT_F_OPT_1|JIT_F_OPT_NARROW|JIT_F_OPT_LOOP) #define JIT_F_OPT_3 (JIT_F_OPT_2|\ JIT_F_OPT_FWD|JIT_F_OPT_DSE|JIT_F_OPT_ABC|JIT_F_OPT_SINK|JIT_F_OPT_FUSE) #define JIT_F_OPT_DEFAULT JIT_F_OPT_3 #if LJ_TARGET_WINDOWS || LJ_64 /* See: http://blogs.msdn.com/oldnewthing/archive/2003/10/08/55239.aspx */ #define JIT_P_sizemcode_DEFAULT 64 #else /* Could go as low as 4K, but the mmap() overhead would be rather high. */ #define JIT_P_sizemcode_DEFAULT 32 #endif /* Optimization parameters and their defaults. Length is a char in octal! */ #define JIT_PARAMDEF(_) \ _(\010, maxtrace, 1000) /* Max. # of traces in cache. */ \ _(\011, maxrecord, 4000) /* Max. # of recorded IR instructions. */ \ _(\012, maxirconst, 500) /* Max. # of IR constants of a trace. */ \ _(\007, maxside, 100) /* Max. # of side traces of a root trace. */ \ _(\007, maxsnap, 500) /* Max. # of snapshots for a trace. */ \ \ _(\007, hotloop, 56) /* # of iter. to detect a hot loop/call. */ \ _(\007, hotexit, 10) /* # of taken exits to start a side trace. */ \ _(\007, tryside, 4) /* # of attempts to compile a side trace. */ \ \ _(\012, instunroll, 4) /* Max. unroll for instable loops. */ \ _(\012, loopunroll, 15) /* Max. unroll for loop ops in side traces. */ \ _(\012, callunroll, 3) /* Max. unroll for recursive calls. */ \ _(\011, recunroll, 2) /* Min. unroll for true recursion. */ \ \ /* Size of each machine code area (in KBytes). */ \ _(\011, sizemcode, JIT_P_sizemcode_DEFAULT) \ /* Max. total size of all machine code areas (in KBytes). */ \ _(\010, maxmcode, 512) \ /* End of list. */ enum { #define JIT_PARAMENUM(len, name, value) JIT_P_##name, JIT_PARAMDEF(JIT_PARAMENUM) #undef JIT_PARAMENUM JIT_P__MAX }; #define JIT_PARAMSTR(len, name, value) #len #name #define JIT_P_STRING JIT_PARAMDEF(JIT_PARAMSTR) /* Trace compiler state. */ typedef enum { LJ_TRACE_IDLE, /* Trace compiler idle. */ LJ_TRACE_ACTIVE = 0x10, LJ_TRACE_RECORD, /* Bytecode recording active. */ LJ_TRACE_START, /* New trace started. */ LJ_TRACE_END, /* End of trace. */ LJ_TRACE_ASM, /* Assemble trace. */ LJ_TRACE_ERR /* Trace aborted with error. */ } TraceState; /* Post-processing action. */ typedef enum { LJ_POST_NONE, /* No action. */ LJ_POST_FIXCOMP, /* Fixup comparison and emit pending guard. */ LJ_POST_FIXGUARD, /* Fixup and emit pending guard. */ LJ_POST_FIXGUARDSNAP, /* Fixup and emit pending guard and snapshot. */ LJ_POST_FIXBOOL, /* Fixup boolean result. */ LJ_POST_FIXCONST, /* Fixup constant results. */ LJ_POST_FFRETRY /* Suppress recording of retried fast functions. */ } PostProc; /* Machine code type. */ #if LJ_TARGET_X86ORX64 typedef uint8_t MCode; #else typedef uint32_t MCode; #endif /* Stack snapshot header. */ typedef struct SnapShot { uint16_t mapofs; /* Offset into snapshot map. */ IRRef1 ref; /* First IR ref for this snapshot. */ uint8_t nslots; /* Number of valid slots. */ uint8_t topslot; /* Maximum frame extent. */ uint8_t nent; /* Number of compressed entries. */ uint8_t count; /* Count of taken exits for this snapshot. */ } SnapShot; #define SNAPCOUNT_DONE 255 /* Already compiled and linked a side trace. */ /* Compressed snapshot entry. */ typedef uint32_t SnapEntry; #define SNAP_FRAME 0x010000 /* Frame slot. */ #define SNAP_CONT 0x020000 /* Continuation slot. */ #define SNAP_NORESTORE 0x040000 /* No need to restore slot. */ #define SNAP_SOFTFPNUM 0x080000 /* Soft-float number. */ LJ_STATIC_ASSERT(SNAP_FRAME == TREF_FRAME); LJ_STATIC_ASSERT(SNAP_CONT == TREF_CONT); #define SNAP(slot, flags, ref) (((SnapEntry)(slot) << 24) + (flags) + (ref)) #define SNAP_TR(slot, tr) \ (((SnapEntry)(slot) << 24) + ((tr) & (TREF_CONT|TREF_FRAME|TREF_REFMASK))) #define SNAP_MKPC(pc) ((SnapEntry)u32ptr(pc)) #define SNAP_MKFTSZ(ftsz) ((SnapEntry)(ftsz)) #define snap_ref(sn) ((sn) & 0xffff) #define snap_slot(sn) ((BCReg)((sn) >> 24)) #define snap_isframe(sn) ((sn) & SNAP_FRAME) #define snap_pc(sn) ((const BCIns *)(uintptr_t)(sn)) #define snap_setref(sn, ref) (((sn) & (0xffff0000&~SNAP_NORESTORE)) | (ref)) /* Snapshot and exit numbers. */ typedef uint32_t SnapNo; typedef uint32_t ExitNo; /* Trace number. */ typedef uint32_t TraceNo; /* Used to pass around trace numbers. */ typedef uint16_t TraceNo1; /* Stored trace number. */ /* Type of link. ORDER LJ_TRLINK */ typedef enum { LJ_TRLINK_NONE, /* Incomplete trace. No link, yet. */ LJ_TRLINK_ROOT, /* Link to other root trace. */ LJ_TRLINK_LOOP, /* Loop to same trace. */ LJ_TRLINK_TAILREC, /* Tail-recursion. */ LJ_TRLINK_UPREC, /* Up-recursion. */ LJ_TRLINK_DOWNREC, /* Down-recursion. */ LJ_TRLINK_INTERP, /* Fallback to interpreter. */ LJ_TRLINK_RETURN /* Return to interpreter. */ } TraceLink; /* Trace object. */ typedef struct GCtrace { GCHeader; uint8_t topslot; /* Top stack slot already checked to be allocated. */ uint8_t linktype; /* Type of link. */ IRRef nins; /* Next IR instruction. Biased with REF_BIAS. */ GCRef gclist; IRIns *ir; /* IR instructions/constants. Biased with REF_BIAS. */ IRRef nk; /* Lowest IR constant. Biased with REF_BIAS. */ uint16_t nsnap; /* Number of snapshots. */ uint16_t nsnapmap; /* Number of snapshot map elements. */ SnapShot *snap; /* Snapshot array. */ SnapEntry *snapmap; /* Snapshot map. */ GCRef startpt; /* Starting prototype. */ MRef startpc; /* Bytecode PC of starting instruction. */ BCIns startins; /* Original bytecode of starting instruction. */ MSize szmcode; /* Size of machine code. */ MCode *mcode; /* Start of machine code. */ MSize mcloop; /* Offset of loop start in machine code. */ uint16_t nchild; /* Number of child traces (root trace only). */ uint16_t spadjust; /* Stack pointer adjustment (offset in bytes). */ TraceNo1 traceno; /* Trace number. */ TraceNo1 link; /* Linked trace (or self for loops). */ TraceNo1 root; /* Root trace of side trace (or 0 for root traces). */ TraceNo1 nextroot; /* Next root trace for same prototype. */ TraceNo1 nextside; /* Next side trace of same root trace. */ uint8_t sinktags; /* Trace has SINK tags. */ uint8_t unused1; #ifdef LUAJIT_USE_GDBJIT void *gdbjit_entry; /* GDB JIT entry. */ #endif } GCtrace; #define gco2trace(o) check_exp((o)->gch.gct == ~LJ_TTRACE, (GCtrace *)(o)) #define traceref(J, n) \ check_exp((n)>0 && (MSize)(n)sizetrace, (GCtrace *)gcref(J->trace[(n)])) LJ_STATIC_ASSERT(offsetof(GChead, gclist) == offsetof(GCtrace, gclist)); static LJ_AINLINE MSize snap_nextofs(GCtrace *T, SnapShot *snap) { if (snap+1 == &T->snap[T->nsnap]) return T->nsnapmap; else return (snap+1)->mapofs; } /* Round-robin penalty cache for bytecodes leading to aborted traces. */ typedef struct HotPenalty { MRef pc; /* Starting bytecode PC. */ uint16_t val; /* Penalty value, i.e. hotcount start. */ uint16_t reason; /* Abort reason (really TraceErr). */ } HotPenalty; #define PENALTY_SLOTS 64 /* Penalty cache slot. Must be a power of 2. */ #define PENALTY_MIN (36*2) /* Minimum penalty value. */ #define PENALTY_MAX 60000 /* Maximum penalty value. */ #define PENALTY_RNDBITS 4 /* # of random bits to add to penalty value. */ /* Round-robin backpropagation cache for narrowing conversions. */ typedef struct BPropEntry { IRRef1 key; /* Key: original reference. */ IRRef1 val; /* Value: reference after conversion. */ IRRef mode; /* Mode for this entry (currently IRCONV_*). */ } BPropEntry; /* Number of slots for the backpropagation cache. Must be a power of 2. */ #define BPROP_SLOTS 16 /* Scalar evolution analysis cache. */ typedef struct ScEvEntry { MRef pc; /* Bytecode PC of FORI. */ IRRef1 idx; /* Index reference. */ IRRef1 start; /* Constant start reference. */ IRRef1 stop; /* Constant stop reference. */ IRRef1 step; /* Constant step reference. */ IRType1 t; /* Scalar type. */ uint8_t dir; /* Direction. 1: +, 0: -. */ } ScEvEntry; /* 128 bit SIMD constants. */ enum { LJ_KSIMD_ABS, LJ_KSIMD_NEG, LJ_KSIMD__MAX }; /* Get 16 byte aligned pointer to SIMD constant. */ #define LJ_KSIMD(J, n) \ ((TValue *)(((intptr_t)&J->ksimd[2*(n)] + 15) & ~(intptr_t)15)) /* Set/reset flag to activate the SPLIT pass for the current trace. */ #if LJ_SOFTFP || (LJ_32 && LJ_HASFFI) #define lj_needsplit(J) (J->needsplit = 1) #define lj_resetsplit(J) (J->needsplit = 0) #else #define lj_needsplit(J) UNUSED(J) #define lj_resetsplit(J) UNUSED(J) #endif /* Fold state is used to fold instructions on-the-fly. */ typedef struct FoldState { IRIns ins; /* Currently emitted instruction. */ IRIns left; /* Instruction referenced by left operand. */ IRIns right; /* Instruction referenced by right operand. */ } FoldState; /* JIT compiler state. */ typedef struct jit_State { GCtrace cur; /* Current trace. */ lua_State *L; /* Current Lua state. */ const BCIns *pc; /* Current PC. */ GCfunc *fn; /* Current function. */ GCproto *pt; /* Current prototype. */ TRef *base; /* Current frame base, points into J->slots. */ uint32_t flags; /* JIT engine flags. */ BCReg maxslot; /* Relative to baseslot. */ BCReg baseslot; /* Current frame base, offset into J->slots. */ uint8_t mergesnap; /* Allowed to merge with next snapshot. */ uint8_t needsnap; /* Need snapshot before recording next bytecode. */ IRType1 guardemit; /* Accumulated IRT_GUARD for emitted instructions. */ uint8_t bcskip; /* Number of bytecode instructions to skip. */ FoldState fold; /* Fold state. */ const BCIns *bc_min; /* Start of allowed bytecode range for root trace. */ MSize bc_extent; /* Extent of the range. */ TraceState state; /* Trace compiler state. */ int32_t instunroll; /* Unroll counter for instable loops. */ int32_t loopunroll; /* Unroll counter for loop ops in side traces. */ int32_t tailcalled; /* Number of successive tailcalls. */ int32_t framedepth; /* Current frame depth. */ int32_t retdepth; /* Return frame depth (count of RETF). */ MRef k64; /* Pointer to chained array of 64 bit constants. */ TValue ksimd[LJ_KSIMD__MAX*2+1]; /* 16 byte aligned SIMD constants. */ IRIns *irbuf; /* Temp. IR instruction buffer. Biased with REF_BIAS. */ IRRef irtoplim; /* Upper limit of instuction buffer (biased). */ IRRef irbotlim; /* Lower limit of instuction buffer (biased). */ IRRef loopref; /* Last loop reference or ref of final LOOP (or 0). */ MSize sizesnap; /* Size of temp. snapshot buffer. */ SnapShot *snapbuf; /* Temp. snapshot buffer. */ SnapEntry *snapmapbuf; /* Temp. snapshot map buffer. */ MSize sizesnapmap; /* Size of temp. snapshot map buffer. */ PostProc postproc; /* Required post-processing after execution. */ #if LJ_SOFTFP || (LJ_32 && LJ_HASFFI) int needsplit; /* Need SPLIT pass. */ #endif GCRef *trace; /* Array of traces. */ TraceNo freetrace; /* Start of scan for next free trace. */ MSize sizetrace; /* Size of trace array. */ IRRef1 chain[IR__MAX]; /* IR instruction skip-list chain anchors. */ TRef slot[LJ_MAX_JSLOTS+LJ_STACK_EXTRA]; /* Stack slot map. */ int32_t param[JIT_P__MAX]; /* JIT engine parameters. */ MCode *exitstubgroup[LJ_MAX_EXITSTUBGR]; /* Exit stub group addresses. */ HotPenalty penalty[PENALTY_SLOTS]; /* Penalty slots. */ uint32_t penaltyslot; /* Round-robin index into penalty slots. */ uint32_t prngstate; /* PRNG state. */ BPropEntry bpropcache[BPROP_SLOTS]; /* Backpropagation cache slots. */ uint32_t bpropslot; /* Round-robin index into bpropcache slots. */ ScEvEntry scev; /* Scalar evolution analysis cache slots. */ const BCIns *startpc; /* Bytecode PC of starting instruction. */ TraceNo parent; /* Parent of current side trace (0 for root traces). */ ExitNo exitno; /* Exit number in parent of current side trace. */ BCIns *patchpc; /* PC for pending re-patch. */ BCIns patchins; /* Instruction for pending re-patch. */ int mcprot; /* Protection of current mcode area. */ MCode *mcarea; /* Base of current mcode area. */ MCode *mctop; /* Top of current mcode area. */ MCode *mcbot; /* Bottom of current mcode area. */ size_t szmcarea; /* Size of current mcode area. */ size_t szallmcarea; /* Total size of all allocated mcode areas. */ TValue errinfo; /* Additional info element for trace errors. */ } #if LJ_TARGET_ARM LJ_ALIGN(16) /* For DISPATCH-relative addresses in assembler part. */ #endif jit_State; /* Trivial PRNG e.g. used for penalty randomization. */ static LJ_AINLINE uint32_t LJ_PRNG_BITS(jit_State *J, int bits) { /* Yes, this LCG is very weak, but that doesn't matter for our use case. */ J->prngstate = J->prngstate * 1103515245 + 12345; return J->prngstate >> (32-bits); } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/host/0000755000175000017500000000000013122010155015646 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/src/host/genminilua.lua0000644000175000017500000002740713122010155020513 0ustar philphil---------------------------------------------------------------------------- -- Lua script to generate a customized, minified version of Lua. -- The resulting 'minilua' is used for the build process of LuaJIT. ---------------------------------------------------------------------------- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- Released under the MIT license. See Copyright Notice in luajit.h ---------------------------------------------------------------------------- local sub, match, gsub = string.sub, string.match, string.gsub local LUA_VERSION = "5.1.5" local LUA_SOURCE local function usage() io.stderr:write("Usage: ", arg and arg[0] or "genminilua", " lua-", LUA_VERSION, "-source-dir\n") os.exit(1) end local function find_sources() LUA_SOURCE = arg and arg[1] if not LUA_SOURCE then usage() end if sub(LUA_SOURCE, -1) ~= "/" then LUA_SOURCE = LUA_SOURCE.."/" end local fp = io.open(LUA_SOURCE .. "lua.h") if not fp then LUA_SOURCE = LUA_SOURCE.."src/" fp = io.open(LUA_SOURCE .. "lua.h") if not fp then usage() end end local all = fp:read("*a") fp:close() if not match(all, 'LUA_RELEASE%s*"Lua '..LUA_VERSION..'"') then io.stderr:write("Error: version mismatch\n") usage() end end local LUA_FILES = { "lmem.c", "lobject.c", "ltm.c", "lfunc.c", "ldo.c", "lstring.c", "ltable.c", "lgc.c", "lstate.c", "ldebug.c", "lzio.c", "lopcodes.c", "llex.c", "lcode.c", "lparser.c", "lvm.c", "lapi.c", "lauxlib.c", "lbaselib.c", "ltablib.c", "liolib.c", "loslib.c", "lstrlib.c", "linit.c", } local REMOVE_LIB = {} gsub([[ collectgarbage dofile gcinfo getfenv getmetatable load print rawequal rawset select tostring xpcall foreach foreachi getn maxn setn popen tmpfile seek setvbuf __tostring clock date difftime execute getenv rename setlocale time tmpname dump gfind len reverse LUA_LOADLIBNAME LUA_MATHLIBNAME LUA_DBLIBNAME ]], "%S+", function(name) REMOVE_LIB[name] = true end) local REMOVE_EXTINC = { [""] = true, [""] = true, } local CUSTOM_MAIN = [[ typedef unsigned int UB; static UB barg(lua_State *L,int idx){ union{lua_Number n;U64 b;}bn; bn.n=lua_tonumber(L,idx)+6755399441055744.0; if (bn.n==0.0&&!lua_isnumber(L,idx))luaL_typerror(L,idx,"number"); return(UB)bn.b; } #define BRET(b) lua_pushnumber(L,(lua_Number)(int)(b));return 1; static int tobit(lua_State *L){ BRET(barg(L,1))} static int bnot(lua_State *L){ BRET(~barg(L,1))} static int band(lua_State *L){ int i;UB b=barg(L,1);for(i=lua_gettop(L);i>1;i--)b&=barg(L,i);BRET(b)} static int bor(lua_State *L){ int i;UB b=barg(L,1);for(i=lua_gettop(L);i>1;i--)b|=barg(L,i);BRET(b)} static int bxor(lua_State *L){ int i;UB b=barg(L,1);for(i=lua_gettop(L);i>1;i--)b^=barg(L,i);BRET(b)} static int lshift(lua_State *L){ UB b=barg(L,1),n=barg(L,2)&31;BRET(b<>n)} static int arshift(lua_State *L){ UB b=barg(L,1),n=barg(L,2)&31;BRET((int)b>>n)} static int rol(lua_State *L){ UB b=barg(L,1),n=barg(L,2)&31;BRET((b<>(32-n)))} static int ror(lua_State *L){ UB b=barg(L,1),n=barg(L,2)&31;BRET((b>>n)|(b<<(32-n)))} static int bswap(lua_State *L){ UB b=barg(L,1);b=(b>>24)|((b>>8)&0xff00)|((b&0xff00)<<8)|(b<<24);BRET(b)} static int tohex(lua_State *L){ UB b=barg(L,1); int n=lua_isnone(L,2)?8:(int)barg(L,2); const char *hexdigits="0123456789abcdef"; char buf[8]; int i; if(n<0){n=-n;hexdigits="0123456789ABCDEF";} if(n>8)n=8; for(i=(int)n;--i>=0;){buf[i]=hexdigits[b&15];b>>=4;} lua_pushlstring(L,buf,(size_t)n); return 1; } static const struct luaL_Reg bitlib[] = { {"tobit",tobit}, {"bnot",bnot}, {"band",band}, {"bor",bor}, {"bxor",bxor}, {"lshift",lshift}, {"rshift",rshift}, {"arshift",arshift}, {"rol",rol}, {"ror",ror}, {"bswap",bswap}, {"tohex",tohex}, {NULL,NULL} }; int main(int argc, char **argv){ lua_State *L = luaL_newstate(); int i; luaL_openlibs(L); luaL_register(L, "bit", bitlib); if (argc < 2) return sizeof(void *); lua_createtable(L, 0, 1); lua_pushstring(L, argv[1]); lua_rawseti(L, -2, 0); lua_setglobal(L, "arg"); if (luaL_loadfile(L, argv[1])) goto err; for (i = 2; i < argc; i++) lua_pushstring(L, argv[i]); if (lua_pcall(L, argc - 2, 0, 0)) { err: fprintf(stderr, "Error: %s\n", lua_tostring(L, -1)); return 1; } lua_close(L); return 0; } ]] local function read_sources() local t = {} for i, name in ipairs(LUA_FILES) do local fp = assert(io.open(LUA_SOURCE..name, "r")) t[i] = fp:read("*a") assert(fp:close()) end t[#t+1] = CUSTOM_MAIN return table.concat(t) end local includes = {} local function merge_includes(src) return gsub(src, '#include%s*"([^"]*)"%s*\n', function(name) if includes[name] then return "" end includes[name] = true local fp = assert(io.open(LUA_SOURCE..name, "r")) local inc = fp:read("*a") assert(fp:close()) inc = gsub(inc, "#ifndef%s+%w+_h\n#define%s+%w+_h\n", "") inc = gsub(inc, "#endif%s*$", "") return merge_includes(inc) end) end local function get_license(src) return match(src, "/%*+\n%* Copyright %(.-%*/\n") end local function fold_lines(src) return gsub(src, "\\\n", " ") end local strings = {} local function save_str(str) local n = #strings+1 strings[n] = str return "\1"..n.."\2" end local function save_strings(src) src = gsub(src, '"[^"\n]*"', save_str) return gsub(src, "'[^'\n]*'", save_str) end local function restore_strings(src) return gsub(src, "\1(%d+)\2", function(numstr) return strings[tonumber(numstr)] end) end local function def_istrue(def) return def == "INT_MAX > 2147483640L" or def == "LUAI_BITSINT >= 32" or def == "SIZE_Bx < LUAI_BITSINT-1" or def == "cast" or def == "defined(LUA_CORE)" or def == "MINSTRTABSIZE" or def == "LUA_MINBUFFER" or def == "HARDSTACKTESTS" or def == "UNUSED" end local head, defs = {[[ #ifdef _MSC_VER typedef unsigned __int64 U64; #else typedef unsigned long long U64; #endif int _CRT_glob = 0; ]]}, {} local function preprocess(src) local t = { match(src, "^(.-)#") } local lvl, on, oldon = 0, true, {} for pp, def, txt in string.gmatch(src, "#(%w+) *([^\n]*)\n([^#]*)") do if pp == "if" or pp == "ifdef" or pp == "ifndef" then lvl = lvl + 1 oldon[lvl] = on on = def_istrue(def) elseif pp == "else" then if oldon[lvl] then if on == false then on = true else on = false end end elseif pp == "elif" then if oldon[lvl] then on = def_istrue(def) end elseif pp == "endif" then on = oldon[lvl] lvl = lvl - 1 elseif on then if pp == "include" then if not head[def] and not REMOVE_EXTINC[def] then head[def] = true head[#head+1] = "#include "..def.."\n" end elseif pp == "define" then local k, sp, v = match(def, "([%w_]+)(%s*)(.*)") if k and not (sp == "" and sub(v, 1, 1) == "(") then defs[k] = gsub(v, "%a[%w_]*", function(tok) return defs[tok] or tok end) else t[#t+1] = "#define "..def.."\n" end elseif pp ~= "undef" then error("unexpected directive: "..pp.." "..def) end end if on then t[#t+1] = txt end end return gsub(table.concat(t), "%a[%w_]*", function(tok) return defs[tok] or tok end) end local function merge_header(src, license) local hdr = string.format([[ /* This is a heavily customized and minimized copy of Lua %s. */ /* It's only used to build LuaJIT. It does NOT have all standard functions! */ ]], LUA_VERSION) return hdr..license..table.concat(head)..src end local function strip_unused1(src) return gsub(src, '( {"?([%w_]+)"?,%s+%a[%w_]*},\n)', function(line, func) return REMOVE_LIB[func] and "" or line end) end local function strip_unused2(src) return gsub(src, "Symbolic Execution.-}=", "") end local function strip_unused3(src) src = gsub(src, "extern", "static") src = gsub(src, "\nstatic([^\n]-)%(([^)]*)%)%(", "\nstatic%1 %2(") src = gsub(src, "#define lua_assert[^\n]*\n", "") src = gsub(src, "lua_assert%b();?", "") src = gsub(src, "default:\n}", "default:;\n}") src = gsub(src, "lua_lock%b();", "") src = gsub(src, "lua_unlock%b();", "") src = gsub(src, "luai_threadyield%b();", "") src = gsub(src, "luai_userstateopen%b();", "{}") src = gsub(src, "luai_userstate%w+%b();", "") src = gsub(src, "%(%(c==.*luaY_parser%)", "luaY_parser") src = gsub(src, "trydecpoint%(ls,seminfo%)", "luaX_lexerror(ls,\"malformed number\",TK_NUMBER)") src = gsub(src, "int c=luaZ_lookahead%b();", "") src = gsub(src, "luaL_register%(L,[^,]*,co_funcs%);\nreturn 2;", "return 1;") src = gsub(src, "getfuncname%b():", "NULL:") src = gsub(src, "getobjname%b():", "NULL:") src = gsub(src, "if%([^\n]*hookmask[^\n]*%)\n[^\n]*\n", "") src = gsub(src, "if%([^\n]*hookmask[^\n]*%)%b{}\n", "") src = gsub(src, "if%([^\n]*hookmask[^\n]*&&\n[^\n]*%b{}\n", "") src = gsub(src, "(twoto%b()%()", "%1(size_t)") src = gsub(src, "ifp, "\t.byte %d", p[i]); else fprintf(ctx->fp, ",%d", p[i]); if ((i & 15) == 15) putc('\n', ctx->fp); } if ((n & 15) != 0) putc('\n', ctx->fp); } /* Emit relocation */ static void emit_asm_reloc(BuildCtx *ctx, int type, const char *sym) { switch (ctx->mode) { case BUILD_elfasm: if (type) fprintf(ctx->fp, "\t.long %s-.-4\n", sym); else fprintf(ctx->fp, "\t.long %s\n", sym); break; case BUILD_coffasm: fprintf(ctx->fp, "\t.def %s; .scl 3; .type 32; .endef\n", sym); if (type) fprintf(ctx->fp, "\t.long %s-.-4\n", sym); else fprintf(ctx->fp, "\t.long %s\n", sym); break; default: /* BUILD_machasm for relative relocations handled below. */ fprintf(ctx->fp, "\t.long %s\n", sym); break; } } static const char *const jccnames[] = { "jo", "jno", "jb", "jnb", "jz", "jnz", "jbe", "ja", "js", "jns", "jpe", "jpo", "jl", "jge", "jle", "jg" }; /* Emit relocation for the incredibly stupid OSX assembler. */ static void emit_asm_reloc_mach(BuildCtx *ctx, uint8_t *cp, int n, const char *sym) { const char *opname = NULL; if (--n < 0) goto err; if (cp[n] == 0xe8) { opname = "call"; } else if (cp[n] == 0xe9) { opname = "jmp"; } else if (cp[n] >= 0x80 && cp[n] <= 0x8f && n > 0 && cp[n-1] == 0x0f) { opname = jccnames[cp[n]-0x80]; n--; } else { err: fprintf(stderr, "Error: unsupported opcode for %s symbol relocation.\n", sym); exit(1); } emit_asm_bytes(ctx, cp, n); fprintf(ctx->fp, "\t%s %s\n", opname, sym); } #else /* Emit words piecewise as assembler text. */ static void emit_asm_words(BuildCtx *ctx, uint8_t *p, int n) { int i; for (i = 0; i < n; i += 4) { if ((i & 15) == 0) fprintf(ctx->fp, "\t.long 0x%08x", *(uint32_t *)(p+i)); else fprintf(ctx->fp, ",0x%08x", *(uint32_t *)(p+i)); if ((i & 15) == 12) putc('\n', ctx->fp); } if ((n & 15) != 0) putc('\n', ctx->fp); } /* Emit relocation as part of an instruction. */ static void emit_asm_wordreloc(BuildCtx *ctx, uint8_t *p, int n, const char *sym) { uint32_t ins; emit_asm_words(ctx, p, n-4); ins = *(uint32_t *)(p+n-4); #if LJ_TARGET_ARM if ((ins & 0xff000000u) == 0xfa000000u) { fprintf(ctx->fp, "\tblx %s\n", sym); } else if ((ins & 0x0e000000u) == 0x0a000000u) { fprintf(ctx->fp, "\t%s%.2s %s\n", (ins & 0x01000000u) ? "bl" : "b", &"eqnecsccmiplvsvchilsgeltgtle"[2*(ins >> 28)], sym); } else { fprintf(stderr, "Error: unsupported opcode %08x for %s symbol relocation.\n", ins, sym); exit(1); } #elif LJ_TARGET_PPC || LJ_TARGET_PPCSPE #if LJ_TARGET_PS3 #define TOCPREFIX "." #else #define TOCPREFIX "" #endif if ((ins >> 26) == 16) { fprintf(ctx->fp, "\t%s %d, %d, " TOCPREFIX "%s\n", (ins & 1) ? "bcl" : "bc", (ins >> 21) & 31, (ins >> 16) & 31, sym); } else if ((ins >> 26) == 18) { fprintf(ctx->fp, "\t%s " TOCPREFIX "%s\n", (ins & 1) ? "bl" : "b", sym); } else { fprintf(stderr, "Error: unsupported opcode %08x for %s symbol relocation.\n", ins, sym); exit(1); } #elif LJ_TARGET_MIPS fprintf(stderr, "Error: unsupported opcode %08x for %s symbol relocation.\n", ins, sym); exit(1); #else #error "missing relocation support for this architecture" #endif } #endif #if LJ_TARGET_ARM #define ELFASM_PX "%%" #else #define ELFASM_PX "@" #endif /* Emit an assembler label. */ static void emit_asm_label(BuildCtx *ctx, const char *name, int size, int isfunc) { switch (ctx->mode) { case BUILD_elfasm: #if LJ_TARGET_PS3 if (!strncmp(name, "lj_vm_", 6) && strcmp(name, ctx->beginsym) && !strstr(name, "hook")) { fprintf(ctx->fp, "\n\t.globl %s\n" "\t.section \".opd\",\"aw\"\n" "%s:\n" "\t.long .%s,.TOC.@tocbase32\n" "\t.size %s,8\n" "\t.previous\n" "\t.globl .%s\n" "\t.hidden .%s\n" "\t.type .%s, " ELFASM_PX "function\n" "\t.size .%s, %d\n" ".%s:\n", name, name, name, name, name, name, name, name, size, name); break; } #endif fprintf(ctx->fp, "\n\t.globl %s\n" "\t.hidden %s\n" "\t.type %s, " ELFASM_PX "%s\n" "\t.size %s, %d\n" "%s:\n", name, name, name, isfunc ? "function" : "object", name, size, name); break; case BUILD_coffasm: fprintf(ctx->fp, "\n\t.globl %s\n", name); if (isfunc) fprintf(ctx->fp, "\t.def %s; .scl 3; .type 32; .endef\n", name); fprintf(ctx->fp, "%s:\n", name); break; case BUILD_machasm: fprintf(ctx->fp, "\n\t.private_extern %s\n" "%s:\n", name, name); break; default: break; } } /* Emit alignment. */ static void emit_asm_align(BuildCtx *ctx, int bits) { switch (ctx->mode) { case BUILD_elfasm: case BUILD_coffasm: fprintf(ctx->fp, "\t.p2align %d\n", bits); break; case BUILD_machasm: fprintf(ctx->fp, "\t.align %d\n", bits); break; default: break; } } /* ------------------------------------------------------------------------ */ /* Emit assembler source code. */ void emit_asm(BuildCtx *ctx) { int i, rel; fprintf(ctx->fp, "\t.file \"buildvm_%s.dasc\"\n", ctx->dasm_arch); fprintf(ctx->fp, "\t.text\n"); emit_asm_align(ctx, 4); #if LJ_TARGET_PS3 emit_asm_label(ctx, ctx->beginsym, ctx->codesz, 0); #else emit_asm_label(ctx, ctx->beginsym, 0, 0); #endif if (ctx->mode != BUILD_machasm) fprintf(ctx->fp, ".Lbegin:\n"); #if LJ_TARGET_ARM && defined(__GNUC__) && !LJ_NO_UNWIND /* This should really be moved into buildvm_arm.dasc. */ fprintf(ctx->fp, ".fnstart\n" ".save {r4, r5, r6, r7, r8, r9, r10, r11, lr}\n" ".pad #28\n"); #endif #if LJ_TARGET_MIPS fprintf(ctx->fp, ".set nomips16\n.abicalls\n.set noreorder\n.set nomacro\n"); #endif for (i = rel = 0; i < ctx->nsym; i++) { int32_t ofs = ctx->sym[i].ofs; int32_t next = ctx->sym[i+1].ofs; #if LJ_TARGET_ARM && defined(__GNUC__) && !LJ_NO_UNWIND && LJ_HASFFI if (!strcmp(ctx->sym[i].name, "lj_vm_ffi_call")) fprintf(ctx->fp, ".globl lj_err_unwind_arm\n" ".personality lj_err_unwind_arm\n" ".fnend\n" ".fnstart\n" ".save {r4, r5, r11, lr}\n" ".setfp r11, sp\n"); #endif emit_asm_label(ctx, ctx->sym[i].name, next - ofs, 1); while (rel < ctx->nreloc && ctx->reloc[rel].ofs <= next) { BuildReloc *r = &ctx->reloc[rel]; int n = r->ofs - ofs; #if LJ_TARGET_X86ORX64 if (ctx->mode == BUILD_machasm && r->type != 0) { emit_asm_reloc_mach(ctx, ctx->code+ofs, n, ctx->relocsym[r->sym]); } else { emit_asm_bytes(ctx, ctx->code+ofs, n); emit_asm_reloc(ctx, r->type, ctx->relocsym[r->sym]); } ofs += n+4; #else emit_asm_wordreloc(ctx, ctx->code+ofs, n, ctx->relocsym[r->sym]); ofs += n; #endif rel++; } #if LJ_TARGET_X86ORX64 emit_asm_bytes(ctx, ctx->code+ofs, next-ofs); #else emit_asm_words(ctx, ctx->code+ofs, next-ofs); #endif } #if LJ_TARGET_ARM && defined(__GNUC__) && !LJ_NO_UNWIND fprintf(ctx->fp, #if !LJ_HASFFI ".globl lj_err_unwind_arm\n" ".personality lj_err_unwind_arm\n" #endif ".fnend\n"); #endif fprintf(ctx->fp, "\n"); switch (ctx->mode) { case BUILD_elfasm: #if !(LJ_TARGET_PS3 || LJ_TARGET_PSVITA) fprintf(ctx->fp, "\t.section .note.GNU-stack,\"\"," ELFASM_PX "progbits\n"); #endif #if LJ_TARGET_PPCSPE /* Soft-float ABI + SPE. */ fprintf(ctx->fp, "\t.gnu_attribute 4, 2\n\t.gnu_attribute 8, 3\n"); #elif LJ_TARGET_PPC && !LJ_TARGET_PS3 /* Hard-float ABI. */ fprintf(ctx->fp, "\t.gnu_attribute 4, 1\n"); #endif /* fallthrough */ case BUILD_coffasm: fprintf(ctx->fp, "\t.ident \"%s\"\n", ctx->dasm_ident); break; case BUILD_machasm: fprintf(ctx->fp, "\t.cstring\n" "\t.ascii \"%s\\0\"\n", ctx->dasm_ident); break; default: break; } fprintf(ctx->fp, "\n"); } wcc-0.0.2/src/wsh/luajit-2.0/src/host/README0000644000175000017500000000030113122010155016520 0ustar philphilThe files in this directory are only used during the build process of LuaJIT. For cross-compilation, they must be executed on the host, not on the target. These files should NOT be installed! wcc-0.0.2/src/wsh/luajit-2.0/src/host/buildvm_peobj.c0000644000175000017500000002613513122010155020642 0ustar philphil/* ** LuaJIT VM builder: PE object emitter. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Only used for building on Windows, since we cannot assume the presence ** of a suitable assembler. The host and target byte order must match. */ #include "buildvm.h" #include "lj_bc.h" #if LJ_TARGET_X86ORX64 || LJ_TARGET_PPC /* Context for PE object emitter. */ static char *strtab; static size_t strtabofs; /* -- PE object definitions ----------------------------------------------- */ /* PE header. */ typedef struct PEheader { uint16_t arch; uint16_t nsects; uint32_t time; uint32_t symtabofs; uint32_t nsyms; uint16_t opthdrsz; uint16_t flags; } PEheader; /* PE section. */ typedef struct PEsection { char name[8]; uint32_t vsize; uint32_t vaddr; uint32_t size; uint32_t ofs; uint32_t relocofs; uint32_t lineofs; uint16_t nreloc; uint16_t nline; uint32_t flags; } PEsection; /* PE relocation. */ typedef struct PEreloc { uint32_t vaddr; uint32_t symidx; uint16_t type; } PEreloc; /* Cannot use sizeof, because it pads up to the max. alignment. */ #define PEOBJ_RELOC_SIZE (4+4+2) /* PE symbol table entry. */ typedef struct PEsym { union { char name[8]; uint32_t nameref[2]; } n; uint32_t value; int16_t sect; uint16_t type; uint8_t scl; uint8_t naux; } PEsym; /* PE symbol table auxiliary entry for a section. */ typedef struct PEsymaux { uint32_t size; uint16_t nreloc; uint16_t nline; uint32_t cksum; uint16_t assoc; uint8_t comdatsel; uint8_t unused[3]; } PEsymaux; /* Cannot use sizeof, because it pads up to the max. alignment. */ #define PEOBJ_SYM_SIZE (8+4+2+2+1+1) /* PE object CPU specific defines. */ #if LJ_TARGET_X86 #define PEOBJ_ARCH_TARGET 0x014c #define PEOBJ_RELOC_REL32 0x14 /* MS: REL32, GNU: DISP32. */ #define PEOBJ_RELOC_DIR32 0x06 #define PEOBJ_RELOC_OFS 0 #define PEOBJ_TEXT_FLAGS 0x60500020 /* 60=r+x, 50=align16, 20=code. */ #elif LJ_TARGET_X64 #define PEOBJ_ARCH_TARGET 0x8664 #define PEOBJ_RELOC_REL32 0x04 /* MS: REL32, GNU: DISP32. */ #define PEOBJ_RELOC_DIR32 0x02 #define PEOBJ_RELOC_ADDR32NB 0x03 #define PEOBJ_RELOC_OFS 0 #define PEOBJ_TEXT_FLAGS 0x60500020 /* 60=r+x, 50=align16, 20=code. */ #elif LJ_TARGET_PPC #define PEOBJ_ARCH_TARGET 0x01f2 #define PEOBJ_RELOC_REL32 0x06 #define PEOBJ_RELOC_DIR32 0x02 #define PEOBJ_RELOC_OFS (-4) #define PEOBJ_TEXT_FLAGS 0x60400020 /* 60=r+x, 40=align8, 20=code. */ #endif /* Section numbers (0-based). */ enum { PEOBJ_SECT_ABS = -2, PEOBJ_SECT_UNDEF = -1, PEOBJ_SECT_TEXT, #if LJ_TARGET_X64 PEOBJ_SECT_PDATA, PEOBJ_SECT_XDATA, #endif PEOBJ_SECT_RDATA_Z, PEOBJ_NSECTIONS }; /* Symbol types. */ #define PEOBJ_TYPE_NULL 0 #define PEOBJ_TYPE_FUNC 0x20 /* Symbol storage class. */ #define PEOBJ_SCL_EXTERN 2 #define PEOBJ_SCL_STATIC 3 /* -- PE object emitter --------------------------------------------------- */ /* Emit PE object symbol. */ static void emit_peobj_sym(BuildCtx *ctx, const char *name, uint32_t value, int sect, int type, int scl) { PEsym sym; size_t len = strlen(name); if (!strtab) { /* Pass 1: only calculate string table length. */ if (len > 8) strtabofs += len+1; return; } if (len <= 8) { memcpy(sym.n.name, name, len); memset(sym.n.name+len, 0, 8-len); } else { sym.n.nameref[0] = 0; sym.n.nameref[1] = (uint32_t)strtabofs; memcpy(strtab + strtabofs, name, len); strtab[strtabofs+len] = 0; strtabofs += len+1; } sym.value = value; sym.sect = (int16_t)(sect+1); /* 1-based section number. */ sym.type = (uint16_t)type; sym.scl = (uint8_t)scl; sym.naux = 0; owrite(ctx, &sym, PEOBJ_SYM_SIZE); } /* Emit PE object section symbol. */ static void emit_peobj_sym_sect(BuildCtx *ctx, PEsection *pesect, int sect) { PEsym sym; PEsymaux aux; if (!strtab) return; /* Pass 1: no output. */ memcpy(sym.n.name, pesect[sect].name, 8); sym.value = 0; sym.sect = (int16_t)(sect+1); /* 1-based section number. */ sym.type = PEOBJ_TYPE_NULL; sym.scl = PEOBJ_SCL_STATIC; sym.naux = 1; owrite(ctx, &sym, PEOBJ_SYM_SIZE); memset(&aux, 0, sizeof(PEsymaux)); aux.size = pesect[sect].size; aux.nreloc = pesect[sect].nreloc; owrite(ctx, &aux, PEOBJ_SYM_SIZE); } /* Emit Windows PE object file. */ void emit_peobj(BuildCtx *ctx) { PEheader pehdr; PEsection pesect[PEOBJ_NSECTIONS]; uint32_t sofs; int i, nrsym; union { uint8_t b; uint32_t u; } host_endian; sofs = sizeof(PEheader) + PEOBJ_NSECTIONS*sizeof(PEsection); /* Fill in PE sections. */ memset(&pesect, 0, PEOBJ_NSECTIONS*sizeof(PEsection)); memcpy(pesect[PEOBJ_SECT_TEXT].name, ".text", sizeof(".text")-1); pesect[PEOBJ_SECT_TEXT].ofs = sofs; sofs += (pesect[PEOBJ_SECT_TEXT].size = (uint32_t)ctx->codesz); pesect[PEOBJ_SECT_TEXT].relocofs = sofs; sofs += (pesect[PEOBJ_SECT_TEXT].nreloc = (uint16_t)ctx->nreloc) * PEOBJ_RELOC_SIZE; /* Flags: 60 = read+execute, 50 = align16, 20 = code. */ pesect[PEOBJ_SECT_TEXT].flags = PEOBJ_TEXT_FLAGS; #if LJ_TARGET_X64 memcpy(pesect[PEOBJ_SECT_PDATA].name, ".pdata", sizeof(".pdata")-1); pesect[PEOBJ_SECT_PDATA].ofs = sofs; sofs += (pesect[PEOBJ_SECT_PDATA].size = 6*4); pesect[PEOBJ_SECT_PDATA].relocofs = sofs; sofs += (pesect[PEOBJ_SECT_PDATA].nreloc = 6) * PEOBJ_RELOC_SIZE; /* Flags: 40 = read, 30 = align4, 40 = initialized data. */ pesect[PEOBJ_SECT_PDATA].flags = 0x40300040; memcpy(pesect[PEOBJ_SECT_XDATA].name, ".xdata", sizeof(".xdata")-1); pesect[PEOBJ_SECT_XDATA].ofs = sofs; sofs += (pesect[PEOBJ_SECT_XDATA].size = 8*2+4+6*2); /* See below. */ pesect[PEOBJ_SECT_XDATA].relocofs = sofs; sofs += (pesect[PEOBJ_SECT_XDATA].nreloc = 1) * PEOBJ_RELOC_SIZE; /* Flags: 40 = read, 30 = align4, 40 = initialized data. */ pesect[PEOBJ_SECT_XDATA].flags = 0x40300040; #endif memcpy(pesect[PEOBJ_SECT_RDATA_Z].name, ".rdata$Z", sizeof(".rdata$Z")-1); pesect[PEOBJ_SECT_RDATA_Z].ofs = sofs; sofs += (pesect[PEOBJ_SECT_RDATA_Z].size = (uint32_t)strlen(ctx->dasm_ident)+1); /* Flags: 40 = read, 30 = align4, 40 = initialized data. */ pesect[PEOBJ_SECT_RDATA_Z].flags = 0x40300040; /* Fill in PE header. */ pehdr.arch = PEOBJ_ARCH_TARGET; pehdr.nsects = PEOBJ_NSECTIONS; pehdr.time = 0; /* Timestamp is optional. */ pehdr.symtabofs = sofs; pehdr.opthdrsz = 0; pehdr.flags = 0; /* Compute the size of the symbol table: ** @feat.00 + nsections*2 ** + asm_start + nsym ** + nrsym */ nrsym = ctx->nrelocsym; pehdr.nsyms = 1+PEOBJ_NSECTIONS*2 + 1+ctx->nsym + nrsym; #if LJ_TARGET_X64 pehdr.nsyms += 1; /* Symbol for lj_err_unwind_win64. */ #endif /* Write PE object header and all sections. */ owrite(ctx, &pehdr, sizeof(PEheader)); owrite(ctx, &pesect, sizeof(PEsection)*PEOBJ_NSECTIONS); /* Write .text section. */ host_endian.u = 1; if (host_endian.b != LJ_ENDIAN_SELECT(1, 0)) { #if LJ_TARGET_PPC uint32_t *p = (uint32_t *)ctx->code; int n = (int)(ctx->codesz >> 2); for (i = 0; i < n; i++, p++) *p = lj_bswap(*p); /* Byteswap .text section. */ #else fprintf(stderr, "Error: different byte order for host and target\n"); exit(1); #endif } owrite(ctx, ctx->code, ctx->codesz); for (i = 0; i < ctx->nreloc; i++) { PEreloc reloc; reloc.vaddr = (uint32_t)ctx->reloc[i].ofs + PEOBJ_RELOC_OFS; reloc.symidx = 1+2+ctx->reloc[i].sym; /* Reloc syms are after .text sym. */ reloc.type = ctx->reloc[i].type ? PEOBJ_RELOC_REL32 : PEOBJ_RELOC_DIR32; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); } #if LJ_TARGET_X64 { /* Write .pdata section. */ uint32_t fcofs = (uint32_t)ctx->sym[ctx->nsym-1].ofs; uint32_t pdata[3]; /* Start of .text, end of .text and .xdata. */ PEreloc reloc; pdata[0] = 0; pdata[1] = fcofs; pdata[2] = 0; owrite(ctx, &pdata, sizeof(pdata)); pdata[0] = fcofs; pdata[1] = (uint32_t)ctx->codesz; pdata[2] = 20; owrite(ctx, &pdata, sizeof(pdata)); reloc.vaddr = 0; reloc.symidx = 1+2+nrsym+2+2+1; reloc.type = PEOBJ_RELOC_ADDR32NB; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); reloc.vaddr = 4; reloc.symidx = 1+2+nrsym+2+2+1; reloc.type = PEOBJ_RELOC_ADDR32NB; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); reloc.vaddr = 8; reloc.symidx = 1+2+nrsym+2; reloc.type = PEOBJ_RELOC_ADDR32NB; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); reloc.vaddr = 12; reloc.symidx = 1+2+nrsym+2+2+1; reloc.type = PEOBJ_RELOC_ADDR32NB; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); reloc.vaddr = 16; reloc.symidx = 1+2+nrsym+2+2+1; reloc.type = PEOBJ_RELOC_ADDR32NB; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); reloc.vaddr = 20; reloc.symidx = 1+2+nrsym+2; reloc.type = PEOBJ_RELOC_ADDR32NB; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); } { /* Write .xdata section. */ uint16_t xdata[8+2+6]; PEreloc reloc; xdata[0] = 0x01|0x08|0x10; /* Ver. 1, uhandler/ehandler, prolog size 0. */ xdata[1] = 0x0005; /* Number of unwind codes, no frame pointer. */ xdata[2] = 0x4200; /* Stack offset 4*8+8 = aword*5. */ xdata[3] = 0x3000; /* Push rbx. */ xdata[4] = 0x6000; /* Push rsi. */ xdata[5] = 0x7000; /* Push rdi. */ xdata[6] = 0x5000; /* Push rbp. */ xdata[7] = 0; /* Alignment. */ xdata[8] = xdata[9] = 0; /* Relocated address of exception handler. */ xdata[10] = 0x01; /* Ver. 1, no handler, prolog size 0. */ xdata[11] = 0x1504; /* Number of unwind codes, fp = rbp, fpofs = 16. */ xdata[12] = 0x0300; /* set_fpreg. */ xdata[13] = 0x0200; /* stack offset 0*8+8 = aword*1. */ xdata[14] = 0x3000; /* Push rbx. */ xdata[15] = 0x5000; /* Push rbp. */ owrite(ctx, &xdata, sizeof(xdata)); reloc.vaddr = 2*8; reloc.symidx = 1+2+nrsym+2+2; reloc.type = PEOBJ_RELOC_ADDR32NB; owrite(ctx, &reloc, PEOBJ_RELOC_SIZE); } #endif /* Write .rdata$Z section. */ owrite(ctx, ctx->dasm_ident, strlen(ctx->dasm_ident)+1); /* Write symbol table. */ strtab = NULL; /* 1st pass: collect string sizes. */ for (;;) { strtabofs = 4; /* Mark as SafeSEH compliant. */ emit_peobj_sym(ctx, "@feat.00", 1, PEOBJ_SECT_ABS, PEOBJ_TYPE_NULL, PEOBJ_SCL_STATIC); emit_peobj_sym_sect(ctx, pesect, PEOBJ_SECT_TEXT); for (i = 0; i < nrsym; i++) emit_peobj_sym(ctx, ctx->relocsym[i], 0, PEOBJ_SECT_UNDEF, PEOBJ_TYPE_FUNC, PEOBJ_SCL_EXTERN); #if LJ_TARGET_X64 emit_peobj_sym_sect(ctx, pesect, PEOBJ_SECT_PDATA); emit_peobj_sym_sect(ctx, pesect, PEOBJ_SECT_XDATA); emit_peobj_sym(ctx, "lj_err_unwind_win64", 0, PEOBJ_SECT_UNDEF, PEOBJ_TYPE_FUNC, PEOBJ_SCL_EXTERN); #endif emit_peobj_sym(ctx, ctx->beginsym, 0, PEOBJ_SECT_TEXT, PEOBJ_TYPE_NULL, PEOBJ_SCL_EXTERN); for (i = 0; i < ctx->nsym; i++) emit_peobj_sym(ctx, ctx->sym[i].name, (uint32_t)ctx->sym[i].ofs, PEOBJ_SECT_TEXT, PEOBJ_TYPE_FUNC, PEOBJ_SCL_EXTERN); emit_peobj_sym_sect(ctx, pesect, PEOBJ_SECT_RDATA_Z); if (strtab) break; /* 2nd pass: alloc strtab, write syms and copy strings. */ strtab = (char *)malloc(strtabofs); *(uint32_t *)strtab = (uint32_t)strtabofs; } /* Write string table. */ owrite(ctx, strtab, strtabofs); } #else void emit_peobj(BuildCtx *ctx) { UNUSED(ctx); fprintf(stderr, "Error: no PE object support for this target\n"); exit(1); } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/host/minilua.c0000644000175000017500000052443413122010155017464 0ustar philphil/* This is a heavily customized and minimized copy of Lua 5.1.5. */ /* It's only used to build LuaJIT. It does NOT have all standard functions! */ /****************************************************************************** * Copyright (C) 1994-2012 Lua.org, PUC-Rio. All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ******************************************************************************/ #ifdef _MSC_VER typedef unsigned __int64 U64; #else typedef unsigned long long U64; #endif int _CRT_glob = 0; #include #include #include #include #include #include #include #include #include #include #include typedef enum{ TM_INDEX, TM_NEWINDEX, TM_GC, TM_MODE, TM_EQ, TM_ADD, TM_SUB, TM_MUL, TM_DIV, TM_MOD, TM_POW, TM_UNM, TM_LEN, TM_LT, TM_LE, TM_CONCAT, TM_CALL, TM_N }TMS; enum OpMode{iABC,iABx,iAsBx}; typedef enum{ OP_MOVE, OP_LOADK, OP_LOADBOOL, OP_LOADNIL, OP_GETUPVAL, OP_GETGLOBAL, OP_GETTABLE, OP_SETGLOBAL, OP_SETUPVAL, OP_SETTABLE, OP_NEWTABLE, OP_SELF, OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_MOD, OP_POW, OP_UNM, OP_NOT, OP_LEN, OP_CONCAT, OP_JMP, OP_EQ, OP_LT, OP_LE, OP_TEST, OP_TESTSET, OP_CALL, OP_TAILCALL, OP_RETURN, OP_FORLOOP, OP_FORPREP, OP_TFORLOOP, OP_SETLIST, OP_CLOSE, OP_CLOSURE, OP_VARARG }OpCode; enum OpArgMask{ OpArgN, OpArgU, OpArgR, OpArgK }; typedef enum{ VVOID, VNIL, VTRUE, VFALSE, VK, VKNUM, VLOCAL, VUPVAL, VGLOBAL, VINDEXED, VJMP, VRELOCABLE, VNONRELOC, VCALL, VVARARG }expkind; enum RESERVED{ TK_AND=257,TK_BREAK, TK_DO,TK_ELSE,TK_ELSEIF,TK_END,TK_FALSE,TK_FOR,TK_FUNCTION, TK_IF,TK_IN,TK_LOCAL,TK_NIL,TK_NOT,TK_OR,TK_REPEAT, TK_RETURN,TK_THEN,TK_TRUE,TK_UNTIL,TK_WHILE, TK_CONCAT,TK_DOTS,TK_EQ,TK_GE,TK_LE,TK_NE,TK_NUMBER, TK_NAME,TK_STRING,TK_EOS }; typedef enum BinOpr{ OPR_ADD,OPR_SUB,OPR_MUL,OPR_DIV,OPR_MOD,OPR_POW, OPR_CONCAT, OPR_NE,OPR_EQ, OPR_LT,OPR_LE,OPR_GT,OPR_GE, OPR_AND,OPR_OR, OPR_NOBINOPR }BinOpr; typedef enum UnOpr{OPR_MINUS,OPR_NOT,OPR_LEN,OPR_NOUNOPR}UnOpr; #define LUA_QL(x)"'"x"'" #define luai_apicheck(L,o){(void)L;} #define lua_number2str(s,n)sprintf((s),"%.14g",(n)) #define lua_str2number(s,p)strtod((s),(p)) #define luai_numadd(a,b)((a)+(b)) #define luai_numsub(a,b)((a)-(b)) #define luai_nummul(a,b)((a)*(b)) #define luai_numdiv(a,b)((a)/(b)) #define luai_nummod(a,b)((a)-floor((a)/(b))*(b)) #define luai_numpow(a,b)(pow(a,b)) #define luai_numunm(a)(-(a)) #define luai_numeq(a,b)((a)==(b)) #define luai_numlt(a,b)((a)<(b)) #define luai_numle(a,b)((a)<=(b)) #define luai_numisnan(a)(!luai_numeq((a),(a))) #define lua_number2int(i,d)((i)=(int)(d)) #define lua_number2integer(i,d)((i)=(lua_Integer)(d)) #define LUAI_THROW(L,c)longjmp((c)->b,1) #define LUAI_TRY(L,c,a)if(setjmp((c)->b)==0){a} #define lua_pclose(L,file)((void)((void)L,file),0) #define lua_upvalueindex(i)((-10002)-(i)) typedef struct lua_State lua_State; typedef int(*lua_CFunction)(lua_State*L); typedef const char*(*lua_Reader)(lua_State*L,void*ud,size_t*sz); typedef void*(*lua_Alloc)(void*ud,void*ptr,size_t osize,size_t nsize); typedef double lua_Number; typedef ptrdiff_t lua_Integer; static void lua_settop(lua_State*L,int idx); static int lua_type(lua_State*L,int idx); static const char* lua_tolstring(lua_State*L,int idx,size_t*len); static size_t lua_objlen(lua_State*L,int idx); static void lua_pushlstring(lua_State*L,const char*s,size_t l); static void lua_pushcclosure(lua_State*L,lua_CFunction fn,int n); static void lua_createtable(lua_State*L,int narr,int nrec); static void lua_setfield(lua_State*L,int idx,const char*k); #define lua_pop(L,n)lua_settop(L,-(n)-1) #define lua_newtable(L)lua_createtable(L,0,0) #define lua_pushcfunction(L,f)lua_pushcclosure(L,(f),0) #define lua_strlen(L,i)lua_objlen(L,(i)) #define lua_isfunction(L,n)(lua_type(L,(n))==6) #define lua_istable(L,n)(lua_type(L,(n))==5) #define lua_isnil(L,n)(lua_type(L,(n))==0) #define lua_isboolean(L,n)(lua_type(L,(n))==1) #define lua_isnone(L,n)(lua_type(L,(n))==(-1)) #define lua_isnoneornil(L,n)(lua_type(L,(n))<=0) #define lua_pushliteral(L,s)lua_pushlstring(L,""s,(sizeof(s)/sizeof(char))-1) #define lua_setglobal(L,s)lua_setfield(L,(-10002),(s)) #define lua_tostring(L,i)lua_tolstring(L,(i),NULL) typedef struct lua_Debug lua_Debug; typedef void(*lua_Hook)(lua_State*L,lua_Debug*ar); struct lua_Debug{ int event; const char*name; const char*namewhat; const char*what; const char*source; int currentline; int nups; int linedefined; int lastlinedefined; char short_src[60]; int i_ci; }; typedef unsigned int lu_int32; typedef size_t lu_mem; typedef ptrdiff_t l_mem; typedef unsigned char lu_byte; #define IntPoint(p)((unsigned int)(lu_mem)(p)) typedef union{double u;void*s;long l;}L_Umaxalign; typedef double l_uacNumber; #define check_exp(c,e)(e) #define UNUSED(x)((void)(x)) #define cast(t,exp)((t)(exp)) #define cast_byte(i)cast(lu_byte,(i)) #define cast_num(i)cast(lua_Number,(i)) #define cast_int(i)cast(int,(i)) typedef lu_int32 Instruction; #define condhardstacktests(x)((void)0) typedef union GCObject GCObject; typedef struct GCheader{ GCObject*next;lu_byte tt;lu_byte marked; }GCheader; typedef union{ GCObject*gc; void*p; lua_Number n; int b; }Value; typedef struct lua_TValue{ Value value;int tt; }TValue; #define ttisnil(o)(ttype(o)==0) #define ttisnumber(o)(ttype(o)==3) #define ttisstring(o)(ttype(o)==4) #define ttistable(o)(ttype(o)==5) #define ttisfunction(o)(ttype(o)==6) #define ttisboolean(o)(ttype(o)==1) #define ttisuserdata(o)(ttype(o)==7) #define ttisthread(o)(ttype(o)==8) #define ttislightuserdata(o)(ttype(o)==2) #define ttype(o)((o)->tt) #define gcvalue(o)check_exp(iscollectable(o),(o)->value.gc) #define pvalue(o)check_exp(ttislightuserdata(o),(o)->value.p) #define nvalue(o)check_exp(ttisnumber(o),(o)->value.n) #define rawtsvalue(o)check_exp(ttisstring(o),&(o)->value.gc->ts) #define tsvalue(o)(&rawtsvalue(o)->tsv) #define rawuvalue(o)check_exp(ttisuserdata(o),&(o)->value.gc->u) #define uvalue(o)(&rawuvalue(o)->uv) #define clvalue(o)check_exp(ttisfunction(o),&(o)->value.gc->cl) #define hvalue(o)check_exp(ttistable(o),&(o)->value.gc->h) #define bvalue(o)check_exp(ttisboolean(o),(o)->value.b) #define thvalue(o)check_exp(ttisthread(o),&(o)->value.gc->th) #define l_isfalse(o)(ttisnil(o)||(ttisboolean(o)&&bvalue(o)==0)) #define checkconsistency(obj) #define checkliveness(g,obj) #define setnilvalue(obj)((obj)->tt=0) #define setnvalue(obj,x){TValue*i_o=(obj);i_o->value.n=(x);i_o->tt=3;} #define setbvalue(obj,x){TValue*i_o=(obj);i_o->value.b=(x);i_o->tt=1;} #define setsvalue(L,obj,x){TValue*i_o=(obj);i_o->value.gc=cast(GCObject*,(x));i_o->tt=4;checkliveness(G(L),i_o);} #define setuvalue(L,obj,x){TValue*i_o=(obj);i_o->value.gc=cast(GCObject*,(x));i_o->tt=7;checkliveness(G(L),i_o);} #define setthvalue(L,obj,x){TValue*i_o=(obj);i_o->value.gc=cast(GCObject*,(x));i_o->tt=8;checkliveness(G(L),i_o);} #define setclvalue(L,obj,x){TValue*i_o=(obj);i_o->value.gc=cast(GCObject*,(x));i_o->tt=6;checkliveness(G(L),i_o);} #define sethvalue(L,obj,x){TValue*i_o=(obj);i_o->value.gc=cast(GCObject*,(x));i_o->tt=5;checkliveness(G(L),i_o);} #define setptvalue(L,obj,x){TValue*i_o=(obj);i_o->value.gc=cast(GCObject*,(x));i_o->tt=(8+1);checkliveness(G(L),i_o);} #define setobj(L,obj1,obj2){const TValue*o2=(obj2);TValue*o1=(obj1);o1->value=o2->value;o1->tt=o2->tt;checkliveness(G(L),o1);} #define setttype(obj,tt)(ttype(obj)=(tt)) #define iscollectable(o)(ttype(o)>=4) typedef TValue*StkId; typedef union TString{ L_Umaxalign dummy; struct{ GCObject*next;lu_byte tt;lu_byte marked; lu_byte reserved; unsigned int hash; size_t len; }tsv; }TString; #define getstr(ts)cast(const char*,(ts)+1) #define svalue(o)getstr(rawtsvalue(o)) typedef union Udata{ L_Umaxalign dummy; struct{ GCObject*next;lu_byte tt;lu_byte marked; struct Table*metatable; struct Table*env; size_t len; }uv; }Udata; typedef struct Proto{ GCObject*next;lu_byte tt;lu_byte marked; TValue*k; Instruction*code; struct Proto**p; int*lineinfo; struct LocVar*locvars; TString**upvalues; TString*source; int sizeupvalues; int sizek; int sizecode; int sizelineinfo; int sizep; int sizelocvars; int linedefined; int lastlinedefined; GCObject*gclist; lu_byte nups; lu_byte numparams; lu_byte is_vararg; lu_byte maxstacksize; }Proto; typedef struct LocVar{ TString*varname; int startpc; int endpc; }LocVar; typedef struct UpVal{ GCObject*next;lu_byte tt;lu_byte marked; TValue*v; union{ TValue value; struct{ struct UpVal*prev; struct UpVal*next; }l; }u; }UpVal; typedef struct CClosure{ GCObject*next;lu_byte tt;lu_byte marked;lu_byte isC;lu_byte nupvalues;GCObject*gclist;struct Table*env; lua_CFunction f; TValue upvalue[1]; }CClosure; typedef struct LClosure{ GCObject*next;lu_byte tt;lu_byte marked;lu_byte isC;lu_byte nupvalues;GCObject*gclist;struct Table*env; struct Proto*p; UpVal*upvals[1]; }LClosure; typedef union Closure{ CClosure c; LClosure l; }Closure; #define iscfunction(o)(ttype(o)==6&&clvalue(o)->c.isC) typedef union TKey{ struct{ Value value;int tt; struct Node*next; }nk; TValue tvk; }TKey; typedef struct Node{ TValue i_val; TKey i_key; }Node; typedef struct Table{ GCObject*next;lu_byte tt;lu_byte marked; lu_byte flags; lu_byte lsizenode; struct Table*metatable; TValue*array; Node*node; Node*lastfree; GCObject*gclist; int sizearray; }Table; #define lmod(s,size)(check_exp((size&(size-1))==0,(cast(int,(s)&((size)-1))))) #define twoto(x)((size_t)1<<(x)) #define sizenode(t)(twoto((t)->lsizenode)) static const TValue luaO_nilobject_; #define ceillog2(x)(luaO_log2((x)-1)+1) static int luaO_log2(unsigned int x); #define gfasttm(g,et,e)((et)==NULL?NULL:((et)->flags&(1u<<(e)))?NULL:luaT_gettm(et,e,(g)->tmname[e])) #define fasttm(l,et,e)gfasttm(G(l),et,e) static const TValue*luaT_gettm(Table*events,TMS event,TString*ename); #define luaM_reallocv(L,b,on,n,e)((cast(size_t,(n)+1)<=((size_t)(~(size_t)0)-2)/(e))?luaM_realloc_(L,(b),(on)*(e),(n)*(e)):luaM_toobig(L)) #define luaM_freemem(L,b,s)luaM_realloc_(L,(b),(s),0) #define luaM_free(L,b)luaM_realloc_(L,(b),sizeof(*(b)),0) #define luaM_freearray(L,b,n,t)luaM_reallocv(L,(b),n,0,sizeof(t)) #define luaM_malloc(L,t)luaM_realloc_(L,NULL,0,(t)) #define luaM_new(L,t)cast(t*,luaM_malloc(L,sizeof(t))) #define luaM_newvector(L,n,t)cast(t*,luaM_reallocv(L,NULL,0,n,sizeof(t))) #define luaM_growvector(L,v,nelems,size,t,limit,e)if((nelems)+1>(size))((v)=cast(t*,luaM_growaux_(L,v,&(size),sizeof(t),limit,e))) #define luaM_reallocvector(L,v,oldn,n,t)((v)=cast(t*,luaM_reallocv(L,v,oldn,n,sizeof(t)))) static void*luaM_realloc_(lua_State*L,void*block,size_t oldsize, size_t size); static void*luaM_toobig(lua_State*L); static void*luaM_growaux_(lua_State*L,void*block,int*size, size_t size_elem,int limit, const char*errormsg); typedef struct Zio ZIO; #define char2int(c)cast(int,cast(unsigned char,(c))) #define zgetc(z)(((z)->n--)>0?char2int(*(z)->p++):luaZ_fill(z)) typedef struct Mbuffer{ char*buffer; size_t n; size_t buffsize; }Mbuffer; #define luaZ_initbuffer(L,buff)((buff)->buffer=NULL,(buff)->buffsize=0) #define luaZ_buffer(buff)((buff)->buffer) #define luaZ_sizebuffer(buff)((buff)->buffsize) #define luaZ_bufflen(buff)((buff)->n) #define luaZ_resetbuffer(buff)((buff)->n=0) #define luaZ_resizebuffer(L,buff,size)(luaM_reallocvector(L,(buff)->buffer,(buff)->buffsize,size,char),(buff)->buffsize=size) #define luaZ_freebuffer(L,buff)luaZ_resizebuffer(L,buff,0) struct Zio{ size_t n; const char*p; lua_Reader reader; void*data; lua_State*L; }; static int luaZ_fill(ZIO*z); struct lua_longjmp; #define gt(L)(&L->l_gt) #define registry(L)(&G(L)->l_registry) typedef struct stringtable{ GCObject**hash; lu_int32 nuse; int size; }stringtable; typedef struct CallInfo{ StkId base; StkId func; StkId top; const Instruction*savedpc; int nresults; int tailcalls; }CallInfo; #define curr_func(L)(clvalue(L->ci->func)) #define ci_func(ci)(clvalue((ci)->func)) #define f_isLua(ci)(!ci_func(ci)->c.isC) #define isLua(ci)(ttisfunction((ci)->func)&&f_isLua(ci)) typedef struct global_State{ stringtable strt; lua_Alloc frealloc; void*ud; lu_byte currentwhite; lu_byte gcstate; int sweepstrgc; GCObject*rootgc; GCObject**sweepgc; GCObject*gray; GCObject*grayagain; GCObject*weak; GCObject*tmudata; Mbuffer buff; lu_mem GCthreshold; lu_mem totalbytes; lu_mem estimate; lu_mem gcdept; int gcpause; int gcstepmul; lua_CFunction panic; TValue l_registry; struct lua_State*mainthread; UpVal uvhead; struct Table*mt[(8+1)]; TString*tmname[TM_N]; }global_State; struct lua_State{ GCObject*next;lu_byte tt;lu_byte marked; lu_byte status; StkId top; StkId base; global_State*l_G; CallInfo*ci; const Instruction*savedpc; StkId stack_last; StkId stack; CallInfo*end_ci; CallInfo*base_ci; int stacksize; int size_ci; unsigned short nCcalls; unsigned short baseCcalls; lu_byte hookmask; lu_byte allowhook; int basehookcount; int hookcount; lua_Hook hook; TValue l_gt; TValue env; GCObject*openupval; GCObject*gclist; struct lua_longjmp*errorJmp; ptrdiff_t errfunc; }; #define G(L)(L->l_G) union GCObject{ GCheader gch; union TString ts; union Udata u; union Closure cl; struct Table h; struct Proto p; struct UpVal uv; struct lua_State th; }; #define rawgco2ts(o)check_exp((o)->gch.tt==4,&((o)->ts)) #define gco2ts(o)(&rawgco2ts(o)->tsv) #define rawgco2u(o)check_exp((o)->gch.tt==7,&((o)->u)) #define gco2u(o)(&rawgco2u(o)->uv) #define gco2cl(o)check_exp((o)->gch.tt==6,&((o)->cl)) #define gco2h(o)check_exp((o)->gch.tt==5,&((o)->h)) #define gco2p(o)check_exp((o)->gch.tt==(8+1),&((o)->p)) #define gco2uv(o)check_exp((o)->gch.tt==(8+2),&((o)->uv)) #define ngcotouv(o)check_exp((o)==NULL||(o)->gch.tt==(8+2),&((o)->uv)) #define gco2th(o)check_exp((o)->gch.tt==8,&((o)->th)) #define obj2gco(v)(cast(GCObject*,(v))) static void luaE_freethread(lua_State*L,lua_State*L1); #define pcRel(pc,p)(cast(int,(pc)-(p)->code)-1) #define getline_(f,pc)(((f)->lineinfo)?(f)->lineinfo[pc]:0) #define resethookcount(L)(L->hookcount=L->basehookcount) static void luaG_typeerror(lua_State*L,const TValue*o, const char*opname); static void luaG_runerror(lua_State*L,const char*fmt,...); #define luaD_checkstack(L,n)if((char*)L->stack_last-(char*)L->top<=(n)*(int)sizeof(TValue))luaD_growstack(L,n);else condhardstacktests(luaD_reallocstack(L,L->stacksize-5-1)); #define incr_top(L){luaD_checkstack(L,1);L->top++;} #define savestack(L,p)((char*)(p)-(char*)L->stack) #define restorestack(L,n)((TValue*)((char*)L->stack+(n))) #define saveci(L,p)((char*)(p)-(char*)L->base_ci) #define restoreci(L,n)((CallInfo*)((char*)L->base_ci+(n))) typedef void(*Pfunc)(lua_State*L,void*ud); static int luaD_poscall(lua_State*L,StkId firstResult); static void luaD_reallocCI(lua_State*L,int newsize); static void luaD_reallocstack(lua_State*L,int newsize); static void luaD_growstack(lua_State*L,int n); static void luaD_throw(lua_State*L,int errcode); static void*luaM_growaux_(lua_State*L,void*block,int*size,size_t size_elems, int limit,const char*errormsg){ void*newblock; int newsize; if(*size>=limit/2){ if(*size>=limit) luaG_runerror(L,errormsg); newsize=limit; } else{ newsize=(*size)*2; if(newsize<4) newsize=4; } newblock=luaM_reallocv(L,block,*size,newsize,size_elems); *size=newsize; return newblock; } static void*luaM_toobig(lua_State*L){ luaG_runerror(L,"memory allocation error: block too big"); return NULL; } static void*luaM_realloc_(lua_State*L,void*block,size_t osize,size_t nsize){ global_State*g=G(L); block=(*g->frealloc)(g->ud,block,osize,nsize); if(block==NULL&&nsize>0) luaD_throw(L,4); g->totalbytes=(g->totalbytes-osize)+nsize; return block; } #define resetbits(x,m)((x)&=cast(lu_byte,~(m))) #define setbits(x,m)((x)|=(m)) #define testbits(x,m)((x)&(m)) #define bitmask(b)(1<<(b)) #define bit2mask(b1,b2)(bitmask(b1)|bitmask(b2)) #define l_setbit(x,b)setbits(x,bitmask(b)) #define resetbit(x,b)resetbits(x,bitmask(b)) #define testbit(x,b)testbits(x,bitmask(b)) #define set2bits(x,b1,b2)setbits(x,(bit2mask(b1,b2))) #define reset2bits(x,b1,b2)resetbits(x,(bit2mask(b1,b2))) #define test2bits(x,b1,b2)testbits(x,(bit2mask(b1,b2))) #define iswhite(x)test2bits((x)->gch.marked,0,1) #define isblack(x)testbit((x)->gch.marked,2) #define isgray(x)(!isblack(x)&&!iswhite(x)) #define otherwhite(g)(g->currentwhite^bit2mask(0,1)) #define isdead(g,v)((v)->gch.marked&otherwhite(g)&bit2mask(0,1)) #define changewhite(x)((x)->gch.marked^=bit2mask(0,1)) #define gray2black(x)l_setbit((x)->gch.marked,2) #define valiswhite(x)(iscollectable(x)&&iswhite(gcvalue(x))) #define luaC_white(g)cast(lu_byte,(g)->currentwhite&bit2mask(0,1)) #define luaC_checkGC(L){condhardstacktests(luaD_reallocstack(L,L->stacksize-5-1));if(G(L)->totalbytes>=G(L)->GCthreshold)luaC_step(L);} #define luaC_barrier(L,p,v){if(valiswhite(v)&&isblack(obj2gco(p)))luaC_barrierf(L,obj2gco(p),gcvalue(v));} #define luaC_barriert(L,t,v){if(valiswhite(v)&&isblack(obj2gco(t)))luaC_barrierback(L,t);} #define luaC_objbarrier(L,p,o){if(iswhite(obj2gco(o))&&isblack(obj2gco(p)))luaC_barrierf(L,obj2gco(p),obj2gco(o));} #define luaC_objbarriert(L,t,o){if(iswhite(obj2gco(o))&&isblack(obj2gco(t)))luaC_barrierback(L,t);} static void luaC_step(lua_State*L); static void luaC_link(lua_State*L,GCObject*o,lu_byte tt); static void luaC_linkupval(lua_State*L,UpVal*uv); static void luaC_barrierf(lua_State*L,GCObject*o,GCObject*v); static void luaC_barrierback(lua_State*L,Table*t); #define sizestring(s)(sizeof(union TString)+((s)->len+1)*sizeof(char)) #define sizeudata(u)(sizeof(union Udata)+(u)->len) #define luaS_new(L,s)(luaS_newlstr(L,s,strlen(s))) #define luaS_newliteral(L,s)(luaS_newlstr(L,""s,(sizeof(s)/sizeof(char))-1)) #define luaS_fix(s)l_setbit((s)->tsv.marked,5) static TString*luaS_newlstr(lua_State*L,const char*str,size_t l); #define tostring(L,o)((ttype(o)==4)||(luaV_tostring(L,o))) #define tonumber(o,n)(ttype(o)==3||(((o)=luaV_tonumber(o,n))!=NULL)) #define equalobj(L,o1,o2)(ttype(o1)==ttype(o2)&&luaV_equalval(L,o1,o2)) static int luaV_equalval(lua_State*L,const TValue*t1,const TValue*t2); static const TValue*luaV_tonumber(const TValue*obj,TValue*n); static int luaV_tostring(lua_State*L,StkId obj); static void luaV_execute(lua_State*L,int nexeccalls); static void luaV_concat(lua_State*L,int total,int last); static const TValue luaO_nilobject_={{NULL},0}; static int luaO_int2fb(unsigned int x){ int e=0; while(x>=16){ x=(x+1)>>1; e++; } if(x<8)return x; else return((e+1)<<3)|(cast_int(x)-8); } static int luaO_fb2int(int x){ int e=(x>>3)&31; if(e==0)return x; else return((x&7)+8)<<(e-1); } static int luaO_log2(unsigned int x){ static const lu_byte log_2[256]={ 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8 }; int l=-1; while(x>=256){l+=8;x>>=8;} return l+log_2[x]; } static int luaO_rawequalObj(const TValue*t1,const TValue*t2){ if(ttype(t1)!=ttype(t2))return 0; else switch(ttype(t1)){ case 0: return 1; case 3: return luai_numeq(nvalue(t1),nvalue(t2)); case 1: return bvalue(t1)==bvalue(t2); case 2: return pvalue(t1)==pvalue(t2); default: return gcvalue(t1)==gcvalue(t2); } } static int luaO_str2d(const char*s,lua_Number*result){ char*endptr; *result=lua_str2number(s,&endptr); if(endptr==s)return 0; if(*endptr=='x'||*endptr=='X') *result=cast_num(strtoul(s,&endptr,16)); if(*endptr=='\0')return 1; while(isspace(cast(unsigned char,*endptr)))endptr++; if(*endptr!='\0')return 0; return 1; } static void pushstr(lua_State*L,const char*str){ setsvalue(L,L->top,luaS_new(L,str)); incr_top(L); } static const char*luaO_pushvfstring(lua_State*L,const char*fmt,va_list argp){ int n=1; pushstr(L,""); for(;;){ const char*e=strchr(fmt,'%'); if(e==NULL)break; setsvalue(L,L->top,luaS_newlstr(L,fmt,e-fmt)); incr_top(L); switch(*(e+1)){ case's':{ const char*s=va_arg(argp,char*); if(s==NULL)s="(null)"; pushstr(L,s); break; } case'c':{ char buff[2]; buff[0]=cast(char,va_arg(argp,int)); buff[1]='\0'; pushstr(L,buff); break; } case'd':{ setnvalue(L->top,cast_num(va_arg(argp,int))); incr_top(L); break; } case'f':{ setnvalue(L->top,cast_num(va_arg(argp,l_uacNumber))); incr_top(L); break; } case'p':{ char buff[4*sizeof(void*)+8]; sprintf(buff,"%p",va_arg(argp,void*)); pushstr(L,buff); break; } case'%':{ pushstr(L,"%"); break; } default:{ char buff[3]; buff[0]='%'; buff[1]=*(e+1); buff[2]='\0'; pushstr(L,buff); break; } } n+=2; fmt=e+2; } pushstr(L,fmt); luaV_concat(L,n+1,cast_int(L->top-L->base)-1); L->top-=n; return svalue(L->top-1); } static const char*luaO_pushfstring(lua_State*L,const char*fmt,...){ const char*msg; va_list argp; va_start(argp,fmt); msg=luaO_pushvfstring(L,fmt,argp); va_end(argp); return msg; } static void luaO_chunkid(char*out,const char*source,size_t bufflen){ if(*source=='='){ strncpy(out,source+1,bufflen); out[bufflen-1]='\0'; } else{ if(*source=='@'){ size_t l; source++; bufflen-=sizeof(" '...' "); l=strlen(source); strcpy(out,""); if(l>bufflen){ source+=(l-bufflen); strcat(out,"..."); } strcat(out,source); } else{ size_t len=strcspn(source,"\n\r"); bufflen-=sizeof(" [string \"...\"] "); if(len>bufflen)len=bufflen; strcpy(out,"[string \""); if(source[len]!='\0'){ strncat(out,source,len); strcat(out,"..."); } else strcat(out,source); strcat(out,"\"]"); } } } #define gnode(t,i)(&(t)->node[i]) #define gkey(n)(&(n)->i_key.nk) #define gval(n)(&(n)->i_val) #define gnext(n)((n)->i_key.nk.next) #define key2tval(n)(&(n)->i_key.tvk) static TValue*luaH_setnum(lua_State*L,Table*t,int key); static const TValue*luaH_getstr(Table*t,TString*key); static TValue*luaH_set(lua_State*L,Table*t,const TValue*key); static const char*const luaT_typenames[]={ "nil","boolean","userdata","number", "string","table","function","userdata","thread", "proto","upval" }; static void luaT_init(lua_State*L){ static const char*const luaT_eventname[]={ "__index","__newindex", "__gc","__mode","__eq", "__add","__sub","__mul","__div","__mod", "__pow","__unm","__len","__lt","__le", "__concat","__call" }; int i; for(i=0;itmname[i]=luaS_new(L,luaT_eventname[i]); luaS_fix(G(L)->tmname[i]); } } static const TValue*luaT_gettm(Table*events,TMS event,TString*ename){ const TValue*tm=luaH_getstr(events,ename); if(ttisnil(tm)){ events->flags|=cast_byte(1u<metatable; break; case 7: mt=uvalue(o)->metatable; break; default: mt=G(L)->mt[ttype(o)]; } return(mt?luaH_getstr(mt,G(L)->tmname[event]):(&luaO_nilobject_)); } #define sizeCclosure(n)(cast(int,sizeof(CClosure))+cast(int,sizeof(TValue)*((n)-1))) #define sizeLclosure(n)(cast(int,sizeof(LClosure))+cast(int,sizeof(TValue*)*((n)-1))) static Closure*luaF_newCclosure(lua_State*L,int nelems,Table*e){ Closure*c=cast(Closure*,luaM_malloc(L,sizeCclosure(nelems))); luaC_link(L,obj2gco(c),6); c->c.isC=1; c->c.env=e; c->c.nupvalues=cast_byte(nelems); return c; } static Closure*luaF_newLclosure(lua_State*L,int nelems,Table*e){ Closure*c=cast(Closure*,luaM_malloc(L,sizeLclosure(nelems))); luaC_link(L,obj2gco(c),6); c->l.isC=0; c->l.env=e; c->l.nupvalues=cast_byte(nelems); while(nelems--)c->l.upvals[nelems]=NULL; return c; } static UpVal*luaF_newupval(lua_State*L){ UpVal*uv=luaM_new(L,UpVal); luaC_link(L,obj2gco(uv),(8+2)); uv->v=&uv->u.value; setnilvalue(uv->v); return uv; } static UpVal*luaF_findupval(lua_State*L,StkId level){ global_State*g=G(L); GCObject**pp=&L->openupval; UpVal*p; UpVal*uv; while(*pp!=NULL&&(p=ngcotouv(*pp))->v>=level){ if(p->v==level){ if(isdead(g,obj2gco(p))) changewhite(obj2gco(p)); return p; } pp=&p->next; } uv=luaM_new(L,UpVal); uv->tt=(8+2); uv->marked=luaC_white(g); uv->v=level; uv->next=*pp; *pp=obj2gco(uv); uv->u.l.prev=&g->uvhead; uv->u.l.next=g->uvhead.u.l.next; uv->u.l.next->u.l.prev=uv; g->uvhead.u.l.next=uv; return uv; } static void unlinkupval(UpVal*uv){ uv->u.l.next->u.l.prev=uv->u.l.prev; uv->u.l.prev->u.l.next=uv->u.l.next; } static void luaF_freeupval(lua_State*L,UpVal*uv){ if(uv->v!=&uv->u.value) unlinkupval(uv); luaM_free(L,uv); } static void luaF_close(lua_State*L,StkId level){ UpVal*uv; global_State*g=G(L); while(L->openupval!=NULL&&(uv=ngcotouv(L->openupval))->v>=level){ GCObject*o=obj2gco(uv); L->openupval=uv->next; if(isdead(g,o)) luaF_freeupval(L,uv); else{ unlinkupval(uv); setobj(L,&uv->u.value,uv->v); uv->v=&uv->u.value; luaC_linkupval(L,uv); } } } static Proto*luaF_newproto(lua_State*L){ Proto*f=luaM_new(L,Proto); luaC_link(L,obj2gco(f),(8+1)); f->k=NULL; f->sizek=0; f->p=NULL; f->sizep=0; f->code=NULL; f->sizecode=0; f->sizelineinfo=0; f->sizeupvalues=0; f->nups=0; f->upvalues=NULL; f->numparams=0; f->is_vararg=0; f->maxstacksize=0; f->lineinfo=NULL; f->sizelocvars=0; f->locvars=NULL; f->linedefined=0; f->lastlinedefined=0; f->source=NULL; return f; } static void luaF_freeproto(lua_State*L,Proto*f){ luaM_freearray(L,f->code,f->sizecode,Instruction); luaM_freearray(L,f->p,f->sizep,Proto*); luaM_freearray(L,f->k,f->sizek,TValue); luaM_freearray(L,f->lineinfo,f->sizelineinfo,int); luaM_freearray(L,f->locvars,f->sizelocvars,struct LocVar); luaM_freearray(L,f->upvalues,f->sizeupvalues,TString*); luaM_free(L,f); } static void luaF_freeclosure(lua_State*L,Closure*c){ int size=(c->c.isC)?sizeCclosure(c->c.nupvalues): sizeLclosure(c->l.nupvalues); luaM_freemem(L,c,size); } #define MASK1(n,p)((~((~(Instruction)0)<>0)&MASK1(6,0))) #define SET_OPCODE(i,o)((i)=(((i)&MASK0(6,0))|((cast(Instruction,o)<<0)&MASK1(6,0)))) #define GETARG_A(i)(cast(int,((i)>>(0+6))&MASK1(8,0))) #define SETARG_A(i,u)((i)=(((i)&MASK0(8,(0+6)))|((cast(Instruction,u)<<(0+6))&MASK1(8,(0+6))))) #define GETARG_B(i)(cast(int,((i)>>(((0+6)+8)+9))&MASK1(9,0))) #define SETARG_B(i,b)((i)=(((i)&MASK0(9,(((0+6)+8)+9)))|((cast(Instruction,b)<<(((0+6)+8)+9))&MASK1(9,(((0+6)+8)+9))))) #define GETARG_C(i)(cast(int,((i)>>((0+6)+8))&MASK1(9,0))) #define SETARG_C(i,b)((i)=(((i)&MASK0(9,((0+6)+8)))|((cast(Instruction,b)<<((0+6)+8))&MASK1(9,((0+6)+8))))) #define GETARG_Bx(i)(cast(int,((i)>>((0+6)+8))&MASK1((9+9),0))) #define SETARG_Bx(i,b)((i)=(((i)&MASK0((9+9),((0+6)+8)))|((cast(Instruction,b)<<((0+6)+8))&MASK1((9+9),((0+6)+8))))) #define GETARG_sBx(i)(GETARG_Bx(i)-(((1<<(9+9))-1)>>1)) #define SETARG_sBx(i,b)SETARG_Bx((i),cast(unsigned int,(b)+(((1<<(9+9))-1)>>1))) #define CREATE_ABC(o,a,b,c)((cast(Instruction,o)<<0)|(cast(Instruction,a)<<(0+6))|(cast(Instruction,b)<<(((0+6)+8)+9))|(cast(Instruction,c)<<((0+6)+8))) #define CREATE_ABx(o,a,bc)((cast(Instruction,o)<<0)|(cast(Instruction,a)<<(0+6))|(cast(Instruction,bc)<<((0+6)+8))) #define ISK(x)((x)&(1<<(9-1))) #define INDEXK(r)((int)(r)&~(1<<(9-1))) #define RKASK(x)((x)|(1<<(9-1))) static const lu_byte luaP_opmodes[(cast(int,OP_VARARG)+1)]; #define getBMode(m)(cast(enum OpArgMask,(luaP_opmodes[m]>>4)&3)) #define getCMode(m)(cast(enum OpArgMask,(luaP_opmodes[m]>>2)&3)) #define testTMode(m)(luaP_opmodes[m]&(1<<7)) typedef struct expdesc{ expkind k; union{ struct{int info,aux;}s; lua_Number nval; }u; int t; int f; }expdesc; typedef struct upvaldesc{ lu_byte k; lu_byte info; }upvaldesc; struct BlockCnt; typedef struct FuncState{ Proto*f; Table*h; struct FuncState*prev; struct LexState*ls; struct lua_State*L; struct BlockCnt*bl; int pc; int lasttarget; int jpc; int freereg; int nk; int np; short nlocvars; lu_byte nactvar; upvaldesc upvalues[60]; unsigned short actvar[200]; }FuncState; static Proto*luaY_parser(lua_State*L,ZIO*z,Mbuffer*buff, const char*name); struct lua_longjmp{ struct lua_longjmp*previous; jmp_buf b; volatile int status; }; static void luaD_seterrorobj(lua_State*L,int errcode,StkId oldtop){ switch(errcode){ case 4:{ setsvalue(L,oldtop,luaS_newliteral(L,"not enough memory")); break; } case 5:{ setsvalue(L,oldtop,luaS_newliteral(L,"error in error handling")); break; } case 3: case 2:{ setobj(L,oldtop,L->top-1); break; } } L->top=oldtop+1; } static void restore_stack_limit(lua_State*L){ if(L->size_ci>20000){ int inuse=cast_int(L->ci-L->base_ci); if(inuse+1<20000) luaD_reallocCI(L,20000); } } static void resetstack(lua_State*L,int status){ L->ci=L->base_ci; L->base=L->ci->base; luaF_close(L,L->base); luaD_seterrorobj(L,status,L->base); L->nCcalls=L->baseCcalls; L->allowhook=1; restore_stack_limit(L); L->errfunc=0; L->errorJmp=NULL; } static void luaD_throw(lua_State*L,int errcode){ if(L->errorJmp){ L->errorJmp->status=errcode; LUAI_THROW(L,L->errorJmp); } else{ L->status=cast_byte(errcode); if(G(L)->panic){ resetstack(L,errcode); G(L)->panic(L); } exit(EXIT_FAILURE); } } static int luaD_rawrunprotected(lua_State*L,Pfunc f,void*ud){ struct lua_longjmp lj; lj.status=0; lj.previous=L->errorJmp; L->errorJmp=&lj; LUAI_TRY(L,&lj, (*f)(L,ud); ); L->errorJmp=lj.previous; return lj.status; } static void correctstack(lua_State*L,TValue*oldstack){ CallInfo*ci; GCObject*up; L->top=(L->top-oldstack)+L->stack; for(up=L->openupval;up!=NULL;up=up->gch.next) gco2uv(up)->v=(gco2uv(up)->v-oldstack)+L->stack; for(ci=L->base_ci;ci<=L->ci;ci++){ ci->top=(ci->top-oldstack)+L->stack; ci->base=(ci->base-oldstack)+L->stack; ci->func=(ci->func-oldstack)+L->stack; } L->base=(L->base-oldstack)+L->stack; } static void luaD_reallocstack(lua_State*L,int newsize){ TValue*oldstack=L->stack; int realsize=newsize+1+5; luaM_reallocvector(L,L->stack,L->stacksize,realsize,TValue); L->stacksize=realsize; L->stack_last=L->stack+newsize; correctstack(L,oldstack); } static void luaD_reallocCI(lua_State*L,int newsize){ CallInfo*oldci=L->base_ci; luaM_reallocvector(L,L->base_ci,L->size_ci,newsize,CallInfo); L->size_ci=newsize; L->ci=(L->ci-oldci)+L->base_ci; L->end_ci=L->base_ci+L->size_ci-1; } static void luaD_growstack(lua_State*L,int n){ if(n<=L->stacksize) luaD_reallocstack(L,2*L->stacksize); else luaD_reallocstack(L,L->stacksize+n); } static CallInfo*growCI(lua_State*L){ if(L->size_ci>20000) luaD_throw(L,5); else{ luaD_reallocCI(L,2*L->size_ci); if(L->size_ci>20000) luaG_runerror(L,"stack overflow"); } return++L->ci; } static StkId adjust_varargs(lua_State*L,Proto*p,int actual){ int i; int nfixargs=p->numparams; Table*htab=NULL; StkId base,fixed; for(;actualtop++); fixed=L->top-actual; base=L->top; for(i=0;itop++,fixed+i); setnilvalue(fixed+i); } if(htab){ sethvalue(L,L->top++,htab); } return base; } static StkId tryfuncTM(lua_State*L,StkId func){ const TValue*tm=luaT_gettmbyobj(L,func,TM_CALL); StkId p; ptrdiff_t funcr=savestack(L,func); if(!ttisfunction(tm)) luaG_typeerror(L,func,"call"); for(p=L->top;p>func;p--)setobj(L,p,p-1); incr_top(L); func=restorestack(L,funcr); setobj(L,func,tm); return func; } #define inc_ci(L)((L->ci==L->end_ci)?growCI(L):(condhardstacktests(luaD_reallocCI(L,L->size_ci)),++L->ci)) static int luaD_precall(lua_State*L,StkId func,int nresults){ LClosure*cl; ptrdiff_t funcr; if(!ttisfunction(func)) func=tryfuncTM(L,func); funcr=savestack(L,func); cl=&clvalue(func)->l; L->ci->savedpc=L->savedpc; if(!cl->isC){ CallInfo*ci; StkId st,base; Proto*p=cl->p; luaD_checkstack(L,p->maxstacksize); func=restorestack(L,funcr); if(!p->is_vararg){ base=func+1; if(L->top>base+p->numparams) L->top=base+p->numparams; } else{ int nargs=cast_int(L->top-func)-1; base=adjust_varargs(L,p,nargs); func=restorestack(L,funcr); } ci=inc_ci(L); ci->func=func; L->base=ci->base=base; ci->top=L->base+p->maxstacksize; L->savedpc=p->code; ci->tailcalls=0; ci->nresults=nresults; for(st=L->top;sttop;st++) setnilvalue(st); L->top=ci->top; return 0; } else{ CallInfo*ci; int n; luaD_checkstack(L,20); ci=inc_ci(L); ci->func=restorestack(L,funcr); L->base=ci->base=ci->func+1; ci->top=L->top+20; ci->nresults=nresults; n=(*curr_func(L)->c.f)(L); if(n<0) return 2; else{ luaD_poscall(L,L->top-n); return 1; } } } static int luaD_poscall(lua_State*L,StkId firstResult){ StkId res; int wanted,i; CallInfo*ci; ci=L->ci--; res=ci->func; wanted=ci->nresults; L->base=(ci-1)->base; L->savedpc=(ci-1)->savedpc; for(i=wanted;i!=0&&firstResulttop;i--) setobj(L,res++,firstResult++); while(i-->0) setnilvalue(res++); L->top=res; return(wanted-(-1)); } static void luaD_call(lua_State*L,StkId func,int nResults){ if(++L->nCcalls>=200){ if(L->nCcalls==200) luaG_runerror(L,"C stack overflow"); else if(L->nCcalls>=(200+(200>>3))) luaD_throw(L,5); } if(luaD_precall(L,func,nResults)==0) luaV_execute(L,1); L->nCcalls--; luaC_checkGC(L); } static int luaD_pcall(lua_State*L,Pfunc func,void*u, ptrdiff_t old_top,ptrdiff_t ef){ int status; unsigned short oldnCcalls=L->nCcalls; ptrdiff_t old_ci=saveci(L,L->ci); lu_byte old_allowhooks=L->allowhook; ptrdiff_t old_errfunc=L->errfunc; L->errfunc=ef; status=luaD_rawrunprotected(L,func,u); if(status!=0){ StkId oldtop=restorestack(L,old_top); luaF_close(L,oldtop); luaD_seterrorobj(L,status,oldtop); L->nCcalls=oldnCcalls; L->ci=restoreci(L,old_ci); L->base=L->ci->base; L->savedpc=L->ci->savedpc; L->allowhook=old_allowhooks; restore_stack_limit(L); } L->errfunc=old_errfunc; return status; } struct SParser{ ZIO*z; Mbuffer buff; const char*name; }; static void f_parser(lua_State*L,void*ud){ int i; Proto*tf; Closure*cl; struct SParser*p=cast(struct SParser*,ud); luaC_checkGC(L); tf=luaY_parser(L,p->z, &p->buff,p->name); cl=luaF_newLclosure(L,tf->nups,hvalue(gt(L))); cl->l.p=tf; for(i=0;inups;i++) cl->l.upvals[i]=luaF_newupval(L); setclvalue(L,L->top,cl); incr_top(L); } static int luaD_protectedparser(lua_State*L,ZIO*z,const char*name){ struct SParser p; int status; p.z=z;p.name=name; luaZ_initbuffer(L,&p.buff); status=luaD_pcall(L,f_parser,&p,savestack(L,L->top),L->errfunc); luaZ_freebuffer(L,&p.buff); return status; } static void luaS_resize(lua_State*L,int newsize){ GCObject**newhash; stringtable*tb; int i; if(G(L)->gcstate==2) return; newhash=luaM_newvector(L,newsize,GCObject*); tb=&G(L)->strt; for(i=0;isize;i++){ GCObject*p=tb->hash[i]; while(p){ GCObject*next=p->gch.next; unsigned int h=gco2ts(p)->hash; int h1=lmod(h,newsize); p->gch.next=newhash[h1]; newhash[h1]=p; p=next; } } luaM_freearray(L,tb->hash,tb->size,TString*); tb->size=newsize; tb->hash=newhash; } static TString*newlstr(lua_State*L,const char*str,size_t l, unsigned int h){ TString*ts; stringtable*tb; if(l+1>(((size_t)(~(size_t)0)-2)-sizeof(TString))/sizeof(char)) luaM_toobig(L); ts=cast(TString*,luaM_malloc(L,(l+1)*sizeof(char)+sizeof(TString))); ts->tsv.len=l; ts->tsv.hash=h; ts->tsv.marked=luaC_white(G(L)); ts->tsv.tt=4; ts->tsv.reserved=0; memcpy(ts+1,str,l*sizeof(char)); ((char*)(ts+1))[l]='\0'; tb=&G(L)->strt; h=lmod(h,tb->size); ts->tsv.next=tb->hash[h]; tb->hash[h]=obj2gco(ts); tb->nuse++; if(tb->nuse>cast(lu_int32,tb->size)&&tb->size<=(INT_MAX-2)/2) luaS_resize(L,tb->size*2); return ts; } static TString*luaS_newlstr(lua_State*L,const char*str,size_t l){ GCObject*o; unsigned int h=cast(unsigned int,l); size_t step=(l>>5)+1; size_t l1; for(l1=l;l1>=step;l1-=step) h=h^((h<<5)+(h>>2)+cast(unsigned char,str[l1-1])); for(o=G(L)->strt.hash[lmod(h,G(L)->strt.size)]; o!=NULL; o=o->gch.next){ TString*ts=rawgco2ts(o); if(ts->tsv.len==l&&(memcmp(str,getstr(ts),l)==0)){ if(isdead(G(L),o))changewhite(o); return ts; } } return newlstr(L,str,l,h); } static Udata*luaS_newudata(lua_State*L,size_t s,Table*e){ Udata*u; if(s>((size_t)(~(size_t)0)-2)-sizeof(Udata)) luaM_toobig(L); u=cast(Udata*,luaM_malloc(L,s+sizeof(Udata))); u->uv.marked=luaC_white(G(L)); u->uv.tt=7; u->uv.len=s; u->uv.metatable=NULL; u->uv.env=e; u->uv.next=G(L)->mainthread->next; G(L)->mainthread->next=obj2gco(u); return u; } #define hashpow2(t,n)(gnode(t,lmod((n),sizenode(t)))) #define hashstr(t,str)hashpow2(t,(str)->tsv.hash) #define hashboolean(t,p)hashpow2(t,p) #define hashmod(t,n)(gnode(t,((n)%((sizenode(t)-1)|1)))) #define hashpointer(t,p)hashmod(t,IntPoint(p)) static const Node dummynode_={ {{NULL},0}, {{{NULL},0,NULL}} }; static Node*hashnum(const Table*t,lua_Number n){ unsigned int a[cast_int(sizeof(lua_Number)/sizeof(int))]; int i; if(luai_numeq(n,0)) return gnode(t,0); memcpy(a,&n,sizeof(a)); for(i=1;isizearray) return i-1; else{ Node*n=mainposition(t,key); do{ if(luaO_rawequalObj(key2tval(n),key)|| (ttype(gkey(n))==(8+3)&&iscollectable(key)&& gcvalue(gkey(n))==gcvalue(key))){ i=cast_int(n-gnode(t,0)); return i+t->sizearray; } else n=gnext(n); }while(n); luaG_runerror(L,"invalid key to "LUA_QL("next")); return 0; } } static int luaH_next(lua_State*L,Table*t,StkId key){ int i=findindex(L,t,key); for(i++;isizearray;i++){ if(!ttisnil(&t->array[i])){ setnvalue(key,cast_num(i+1)); setobj(L,key+1,&t->array[i]); return 1; } } for(i-=t->sizearray;i<(int)sizenode(t);i++){ if(!ttisnil(gval(gnode(t,i)))){ setobj(L,key,key2tval(gnode(t,i))); setobj(L,key+1,gval(gnode(t,i))); return 1; } } return 0; } static int computesizes(int nums[],int*narray){ int i; int twotoi; int a=0; int na=0; int n=0; for(i=0,twotoi=1;twotoi/2<*narray;i++,twotoi*=2){ if(nums[i]>0){ a+=nums[i]; if(a>twotoi/2){ n=twotoi; na=a; } } if(a==*narray)break; } *narray=n; return na; } static int countint(const TValue*key,int*nums){ int k=arrayindex(key); if(0t->sizearray){ lim=t->sizearray; if(i>lim) break; } for(;i<=lim;i++){ if(!ttisnil(&t->array[i-1])) lc++; } nums[lg]+=lc; ause+=lc; } return ause; } static int numusehash(const Table*t,int*nums,int*pnasize){ int totaluse=0; int ause=0; int i=sizenode(t); while(i--){ Node*n=&t->node[i]; if(!ttisnil(gval(n))){ ause+=countint(key2tval(n),nums); totaluse++; } } *pnasize+=ause; return totaluse; } static void setarrayvector(lua_State*L,Table*t,int size){ int i; luaM_reallocvector(L,t->array,t->sizearray,size,TValue); for(i=t->sizearray;iarray[i]); t->sizearray=size; } static void setnodevector(lua_State*L,Table*t,int size){ int lsize; if(size==0){ t->node=cast(Node*,(&dummynode_)); lsize=0; } else{ int i; lsize=ceillog2(size); if(lsize>(32-2)) luaG_runerror(L,"table overflow"); size=twoto(lsize); t->node=luaM_newvector(L,size,Node); for(i=0;ilsizenode=cast_byte(lsize); t->lastfree=gnode(t,size); } static void resize(lua_State*L,Table*t,int nasize,int nhsize){ int i; int oldasize=t->sizearray; int oldhsize=t->lsizenode; Node*nold=t->node; if(nasize>oldasize) setarrayvector(L,t,nasize); setnodevector(L,t,nhsize); if(nasizesizearray=nasize; for(i=nasize;iarray[i])) setobj(L,luaH_setnum(L,t,i+1),&t->array[i]); } luaM_reallocvector(L,t->array,oldasize,nasize,TValue); } for(i=twoto(oldhsize)-1;i>=0;i--){ Node*old=nold+i; if(!ttisnil(gval(old))) setobj(L,luaH_set(L,t,key2tval(old)),gval(old)); } if(nold!=(&dummynode_)) luaM_freearray(L,nold,twoto(oldhsize),Node); } static void luaH_resizearray(lua_State*L,Table*t,int nasize){ int nsize=(t->node==(&dummynode_))?0:sizenode(t); resize(L,t,nasize,nsize); } static void rehash(lua_State*L,Table*t,const TValue*ek){ int nasize,na; int nums[(32-2)+1]; int i; int totaluse; for(i=0;i<=(32-2);i++)nums[i]=0; nasize=numusearray(t,nums); totaluse=nasize; totaluse+=numusehash(t,nums,&nasize); nasize+=countint(ek,nums); totaluse++; na=computesizes(nums,&nasize); resize(L,t,nasize,totaluse-na); } static Table*luaH_new(lua_State*L,int narray,int nhash){ Table*t=luaM_new(L,Table); luaC_link(L,obj2gco(t),5); t->metatable=NULL; t->flags=cast_byte(~0); t->array=NULL; t->sizearray=0; t->lsizenode=0; t->node=cast(Node*,(&dummynode_)); setarrayvector(L,t,narray); setnodevector(L,t,nhash); return t; } static void luaH_free(lua_State*L,Table*t){ if(t->node!=(&dummynode_)) luaM_freearray(L,t->node,sizenode(t),Node); luaM_freearray(L,t->array,t->sizearray,TValue); luaM_free(L,t); } static Node*getfreepos(Table*t){ while(t->lastfree-->t->node){ if(ttisnil(gkey(t->lastfree))) return t->lastfree; } return NULL; } static TValue*newkey(lua_State*L,Table*t,const TValue*key){ Node*mp=mainposition(t,key); if(!ttisnil(gval(mp))||mp==(&dummynode_)){ Node*othern; Node*n=getfreepos(t); if(n==NULL){ rehash(L,t,key); return luaH_set(L,t,key); } othern=mainposition(t,key2tval(mp)); if(othern!=mp){ while(gnext(othern)!=mp)othern=gnext(othern); gnext(othern)=n; *n=*mp; gnext(mp)=NULL; setnilvalue(gval(mp)); } else{ gnext(n)=gnext(mp); gnext(mp)=n; mp=n; } } gkey(mp)->value=key->value;gkey(mp)->tt=key->tt; luaC_barriert(L,t,key); return gval(mp); } static const TValue*luaH_getnum(Table*t,int key){ if(cast(unsigned int,key)-1sizearray)) return&t->array[key-1]; else{ lua_Number nk=cast_num(key); Node*n=hashnum(t,nk); do{ if(ttisnumber(gkey(n))&&luai_numeq(nvalue(gkey(n)),nk)) return gval(n); else n=gnext(n); }while(n); return(&luaO_nilobject_); } } static const TValue*luaH_getstr(Table*t,TString*key){ Node*n=hashstr(t,key); do{ if(ttisstring(gkey(n))&&rawtsvalue(gkey(n))==key) return gval(n); else n=gnext(n); }while(n); return(&luaO_nilobject_); } static const TValue*luaH_get(Table*t,const TValue*key){ switch(ttype(key)){ case 0:return(&luaO_nilobject_); case 4:return luaH_getstr(t,rawtsvalue(key)); case 3:{ int k; lua_Number n=nvalue(key); lua_number2int(k,n); if(luai_numeq(cast_num(k),nvalue(key))) return luaH_getnum(t,k); } default:{ Node*n=mainposition(t,key); do{ if(luaO_rawequalObj(key2tval(n),key)) return gval(n); else n=gnext(n); }while(n); return(&luaO_nilobject_); } } } static TValue*luaH_set(lua_State*L,Table*t,const TValue*key){ const TValue*p=luaH_get(t,key); t->flags=0; if(p!=(&luaO_nilobject_)) return cast(TValue*,p); else{ if(ttisnil(key))luaG_runerror(L,"table index is nil"); else if(ttisnumber(key)&&luai_numisnan(nvalue(key))) luaG_runerror(L,"table index is NaN"); return newkey(L,t,key); } } static TValue*luaH_setnum(lua_State*L,Table*t,int key){ const TValue*p=luaH_getnum(t,key); if(p!=(&luaO_nilobject_)) return cast(TValue*,p); else{ TValue k; setnvalue(&k,cast_num(key)); return newkey(L,t,&k); } } static TValue*luaH_setstr(lua_State*L,Table*t,TString*key){ const TValue*p=luaH_getstr(t,key); if(p!=(&luaO_nilobject_)) return cast(TValue*,p); else{ TValue k; setsvalue(L,&k,key); return newkey(L,t,&k); } } static int unbound_search(Table*t,unsigned int j){ unsigned int i=j; j++; while(!ttisnil(luaH_getnum(t,j))){ i=j; j*=2; if(j>cast(unsigned int,(INT_MAX-2))){ i=1; while(!ttisnil(luaH_getnum(t,i)))i++; return i-1; } } while(j-i>1){ unsigned int m=(i+j)/2; if(ttisnil(luaH_getnum(t,m)))j=m; else i=m; } return i; } static int luaH_getn(Table*t){ unsigned int j=t->sizearray; if(j>0&&ttisnil(&t->array[j-1])){ unsigned int i=0; while(j-i>1){ unsigned int m=(i+j)/2; if(ttisnil(&t->array[m-1]))j=m; else i=m; } return i; } else if(t->node==(&dummynode_)) return j; else return unbound_search(t,j); } #define makewhite(g,x)((x)->gch.marked=cast_byte(((x)->gch.marked&cast_byte(~(bitmask(2)|bit2mask(0,1))))|luaC_white(g))) #define white2gray(x)reset2bits((x)->gch.marked,0,1) #define black2gray(x)resetbit((x)->gch.marked,2) #define stringmark(s)reset2bits((s)->tsv.marked,0,1) #define isfinalized(u)testbit((u)->marked,3) #define markfinalized(u)l_setbit((u)->marked,3) #define markvalue(g,o){checkconsistency(o);if(iscollectable(o)&&iswhite(gcvalue(o)))reallymarkobject(g,gcvalue(o));} #define markobject(g,t){if(iswhite(obj2gco(t)))reallymarkobject(g,obj2gco(t));} #define setthreshold(g)(g->GCthreshold=(g->estimate/100)*g->gcpause) static void removeentry(Node*n){ if(iscollectable(gkey(n))) setttype(gkey(n),(8+3)); } static void reallymarkobject(global_State*g,GCObject*o){ white2gray(o); switch(o->gch.tt){ case 4:{ return; } case 7:{ Table*mt=gco2u(o)->metatable; gray2black(o); if(mt)markobject(g,mt); markobject(g,gco2u(o)->env); return; } case(8+2):{ UpVal*uv=gco2uv(o); markvalue(g,uv->v); if(uv->v==&uv->u.value) gray2black(o); return; } case 6:{ gco2cl(o)->c.gclist=g->gray; g->gray=o; break; } case 5:{ gco2h(o)->gclist=g->gray; g->gray=o; break; } case 8:{ gco2th(o)->gclist=g->gray; g->gray=o; break; } case(8+1):{ gco2p(o)->gclist=g->gray; g->gray=o; break; } default:; } } static void marktmu(global_State*g){ GCObject*u=g->tmudata; if(u){ do{ u=u->gch.next; makewhite(g,u); reallymarkobject(g,u); }while(u!=g->tmudata); } } static size_t luaC_separateudata(lua_State*L,int all){ global_State*g=G(L); size_t deadmem=0; GCObject**p=&g->mainthread->next; GCObject*curr; while((curr=*p)!=NULL){ if(!(iswhite(curr)||all)||isfinalized(gco2u(curr))) p=&curr->gch.next; else if(fasttm(L,gco2u(curr)->metatable,TM_GC)==NULL){ markfinalized(gco2u(curr)); p=&curr->gch.next; } else{ deadmem+=sizeudata(gco2u(curr)); markfinalized(gco2u(curr)); *p=curr->gch.next; if(g->tmudata==NULL) g->tmudata=curr->gch.next=curr; else{ curr->gch.next=g->tmudata->gch.next; g->tmudata->gch.next=curr; g->tmudata=curr; } } } return deadmem; } static int traversetable(global_State*g,Table*h){ int i; int weakkey=0; int weakvalue=0; const TValue*mode; if(h->metatable) markobject(g,h->metatable); mode=gfasttm(g,h->metatable,TM_MODE); if(mode&&ttisstring(mode)){ weakkey=(strchr(svalue(mode),'k')!=NULL); weakvalue=(strchr(svalue(mode),'v')!=NULL); if(weakkey||weakvalue){ h->marked&=~(bitmask(3)|bitmask(4)); h->marked|=cast_byte((weakkey<<3)| (weakvalue<<4)); h->gclist=g->weak; g->weak=obj2gco(h); } } if(weakkey&&weakvalue)return 1; if(!weakvalue){ i=h->sizearray; while(i--) markvalue(g,&h->array[i]); } i=sizenode(h); while(i--){ Node*n=gnode(h,i); if(ttisnil(gval(n))) removeentry(n); else{ if(!weakkey)markvalue(g,gkey(n)); if(!weakvalue)markvalue(g,gval(n)); } } return weakkey||weakvalue; } static void traverseproto(global_State*g,Proto*f){ int i; if(f->source)stringmark(f->source); for(i=0;isizek;i++) markvalue(g,&f->k[i]); for(i=0;isizeupvalues;i++){ if(f->upvalues[i]) stringmark(f->upvalues[i]); } for(i=0;isizep;i++){ if(f->p[i]) markobject(g,f->p[i]); } for(i=0;isizelocvars;i++){ if(f->locvars[i].varname) stringmark(f->locvars[i].varname); } } static void traverseclosure(global_State*g,Closure*cl){ markobject(g,cl->c.env); if(cl->c.isC){ int i; for(i=0;ic.nupvalues;i++) markvalue(g,&cl->c.upvalue[i]); } else{ int i; markobject(g,cl->l.p); for(i=0;il.nupvalues;i++) markobject(g,cl->l.upvals[i]); } } static void checkstacksizes(lua_State*L,StkId max){ int ci_used=cast_int(L->ci-L->base_ci); int s_used=cast_int(max-L->stack); if(L->size_ci>20000) return; if(4*ci_usedsize_ci&&2*8size_ci) luaD_reallocCI(L,L->size_ci/2); condhardstacktests(luaD_reallocCI(L,ci_used+1)); if(4*s_usedstacksize&& 2*((2*20)+5)stacksize) luaD_reallocstack(L,L->stacksize/2); condhardstacktests(luaD_reallocstack(L,s_used)); } static void traversestack(global_State*g,lua_State*l){ StkId o,lim; CallInfo*ci; markvalue(g,gt(l)); lim=l->top; for(ci=l->base_ci;ci<=l->ci;ci++){ if(limtop)lim=ci->top; } for(o=l->stack;otop;o++) markvalue(g,o); for(;o<=lim;o++) setnilvalue(o); checkstacksizes(l,lim); } static l_mem propagatemark(global_State*g){ GCObject*o=g->gray; gray2black(o); switch(o->gch.tt){ case 5:{ Table*h=gco2h(o); g->gray=h->gclist; if(traversetable(g,h)) black2gray(o); return sizeof(Table)+sizeof(TValue)*h->sizearray+ sizeof(Node)*sizenode(h); } case 6:{ Closure*cl=gco2cl(o); g->gray=cl->c.gclist; traverseclosure(g,cl); return(cl->c.isC)?sizeCclosure(cl->c.nupvalues): sizeLclosure(cl->l.nupvalues); } case 8:{ lua_State*th=gco2th(o); g->gray=th->gclist; th->gclist=g->grayagain; g->grayagain=o; black2gray(o); traversestack(g,th); return sizeof(lua_State)+sizeof(TValue)*th->stacksize+ sizeof(CallInfo)*th->size_ci; } case(8+1):{ Proto*p=gco2p(o); g->gray=p->gclist; traverseproto(g,p); return sizeof(Proto)+sizeof(Instruction)*p->sizecode+ sizeof(Proto*)*p->sizep+ sizeof(TValue)*p->sizek+ sizeof(int)*p->sizelineinfo+ sizeof(LocVar)*p->sizelocvars+ sizeof(TString*)*p->sizeupvalues; } default:return 0; } } static size_t propagateall(global_State*g){ size_t m=0; while(g->gray)m+=propagatemark(g); return m; } static int iscleared(const TValue*o,int iskey){ if(!iscollectable(o))return 0; if(ttisstring(o)){ stringmark(rawtsvalue(o)); return 0; } return iswhite(gcvalue(o))|| (ttisuserdata(o)&&(!iskey&&isfinalized(uvalue(o)))); } static void cleartable(GCObject*l){ while(l){ Table*h=gco2h(l); int i=h->sizearray; if(testbit(h->marked,4)){ while(i--){ TValue*o=&h->array[i]; if(iscleared(o,0)) setnilvalue(o); } } i=sizenode(h); while(i--){ Node*n=gnode(h,i); if(!ttisnil(gval(n))&& (iscleared(key2tval(n),1)||iscleared(gval(n),0))){ setnilvalue(gval(n)); removeentry(n); } } l=h->gclist; } } static void freeobj(lua_State*L,GCObject*o){ switch(o->gch.tt){ case(8+1):luaF_freeproto(L,gco2p(o));break; case 6:luaF_freeclosure(L,gco2cl(o));break; case(8+2):luaF_freeupval(L,gco2uv(o));break; case 5:luaH_free(L,gco2h(o));break; case 8:{ luaE_freethread(L,gco2th(o)); break; } case 4:{ G(L)->strt.nuse--; luaM_freemem(L,o,sizestring(gco2ts(o))); break; } case 7:{ luaM_freemem(L,o,sizeudata(gco2u(o))); break; } default:; } } #define sweepwholelist(L,p)sweeplist(L,p,((lu_mem)(~(lu_mem)0)-2)) static GCObject**sweeplist(lua_State*L,GCObject**p,lu_mem count){ GCObject*curr; global_State*g=G(L); int deadmask=otherwhite(g); while((curr=*p)!=NULL&&count-->0){ if(curr->gch.tt==8) sweepwholelist(L,&gco2th(curr)->openupval); if((curr->gch.marked^bit2mask(0,1))&deadmask){ makewhite(g,curr); p=&curr->gch.next; } else{ *p=curr->gch.next; if(curr==g->rootgc) g->rootgc=curr->gch.next; freeobj(L,curr); } } return p; } static void checkSizes(lua_State*L){ global_State*g=G(L); if(g->strt.nusestrt.size/4)&& g->strt.size>32*2) luaS_resize(L,g->strt.size/2); if(luaZ_sizebuffer(&g->buff)>32*2){ size_t newsize=luaZ_sizebuffer(&g->buff)/2; luaZ_resizebuffer(L,&g->buff,newsize); } } static void GCTM(lua_State*L){ global_State*g=G(L); GCObject*o=g->tmudata->gch.next; Udata*udata=rawgco2u(o); const TValue*tm; if(o==g->tmudata) g->tmudata=NULL; else g->tmudata->gch.next=udata->uv.next; udata->uv.next=g->mainthread->next; g->mainthread->next=o; makewhite(g,o); tm=fasttm(L,udata->uv.metatable,TM_GC); if(tm!=NULL){ lu_byte oldah=L->allowhook; lu_mem oldt=g->GCthreshold; L->allowhook=0; g->GCthreshold=2*g->totalbytes; setobj(L,L->top,tm); setuvalue(L,L->top+1,udata); L->top+=2; luaD_call(L,L->top-2,0); L->allowhook=oldah; g->GCthreshold=oldt; } } static void luaC_callGCTM(lua_State*L){ while(G(L)->tmudata) GCTM(L); } static void luaC_freeall(lua_State*L){ global_State*g=G(L); int i; g->currentwhite=bit2mask(0,1)|bitmask(6); sweepwholelist(L,&g->rootgc); for(i=0;istrt.size;i++) sweepwholelist(L,&g->strt.hash[i]); } static void markmt(global_State*g){ int i; for(i=0;i<(8+1);i++) if(g->mt[i])markobject(g,g->mt[i]); } static void markroot(lua_State*L){ global_State*g=G(L); g->gray=NULL; g->grayagain=NULL; g->weak=NULL; markobject(g,g->mainthread); markvalue(g,gt(g->mainthread)); markvalue(g,registry(L)); markmt(g); g->gcstate=1; } static void remarkupvals(global_State*g){ UpVal*uv; for(uv=g->uvhead.u.l.next;uv!=&g->uvhead;uv=uv->u.l.next){ if(isgray(obj2gco(uv))) markvalue(g,uv->v); } } static void atomic(lua_State*L){ global_State*g=G(L); size_t udsize; remarkupvals(g); propagateall(g); g->gray=g->weak; g->weak=NULL; markobject(g,L); markmt(g); propagateall(g); g->gray=g->grayagain; g->grayagain=NULL; propagateall(g); udsize=luaC_separateudata(L,0); marktmu(g); udsize+=propagateall(g); cleartable(g->weak); g->currentwhite=cast_byte(otherwhite(g)); g->sweepstrgc=0; g->sweepgc=&g->rootgc; g->gcstate=2; g->estimate=g->totalbytes-udsize; } static l_mem singlestep(lua_State*L){ global_State*g=G(L); switch(g->gcstate){ case 0:{ markroot(L); return 0; } case 1:{ if(g->gray) return propagatemark(g); else{ atomic(L); return 0; } } case 2:{ lu_mem old=g->totalbytes; sweepwholelist(L,&g->strt.hash[g->sweepstrgc++]); if(g->sweepstrgc>=g->strt.size) g->gcstate=3; g->estimate-=old-g->totalbytes; return 10; } case 3:{ lu_mem old=g->totalbytes; g->sweepgc=sweeplist(L,g->sweepgc,40); if(*g->sweepgc==NULL){ checkSizes(L); g->gcstate=4; } g->estimate-=old-g->totalbytes; return 40*10; } case 4:{ if(g->tmudata){ GCTM(L); if(g->estimate>100) g->estimate-=100; return 100; } else{ g->gcstate=0; g->gcdept=0; return 0; } } default:return 0; } } static void luaC_step(lua_State*L){ global_State*g=G(L); l_mem lim=(1024u/100)*g->gcstepmul; if(lim==0) lim=(((lu_mem)(~(lu_mem)0)-2)-1)/2; g->gcdept+=g->totalbytes-g->GCthreshold; do{ lim-=singlestep(L); if(g->gcstate==0) break; }while(lim>0); if(g->gcstate!=0){ if(g->gcdept<1024u) g->GCthreshold=g->totalbytes+1024u; else{ g->gcdept-=1024u; g->GCthreshold=g->totalbytes; } } else{ setthreshold(g); } } static void luaC_barrierf(lua_State*L,GCObject*o,GCObject*v){ global_State*g=G(L); if(g->gcstate==1) reallymarkobject(g,v); else makewhite(g,o); } static void luaC_barrierback(lua_State*L,Table*t){ global_State*g=G(L); GCObject*o=obj2gco(t); black2gray(o); t->gclist=g->grayagain; g->grayagain=o; } static void luaC_link(lua_State*L,GCObject*o,lu_byte tt){ global_State*g=G(L); o->gch.next=g->rootgc; g->rootgc=o; o->gch.marked=luaC_white(g); o->gch.tt=tt; } static void luaC_linkupval(lua_State*L,UpVal*uv){ global_State*g=G(L); GCObject*o=obj2gco(uv); o->gch.next=g->rootgc; g->rootgc=o; if(isgray(o)){ if(g->gcstate==1){ gray2black(o); luaC_barrier(L,uv,uv->v); } else{ makewhite(g,o); } } } typedef union{ lua_Number r; TString*ts; }SemInfo; typedef struct Token{ int token; SemInfo seminfo; }Token; typedef struct LexState{ int current; int linenumber; int lastline; Token t; Token lookahead; struct FuncState*fs; struct lua_State*L; ZIO*z; Mbuffer*buff; TString*source; char decpoint; }LexState; static void luaX_init(lua_State*L); static void luaX_lexerror(LexState*ls,const char*msg,int token); #define state_size(x)(sizeof(x)+0) #define fromstate(l)(cast(lu_byte*,(l))-0) #define tostate(l)(cast(lua_State*,cast(lu_byte*,l)+0)) typedef struct LG{ lua_State l; global_State g; }LG; static void stack_init(lua_State*L1,lua_State*L){ L1->base_ci=luaM_newvector(L,8,CallInfo); L1->ci=L1->base_ci; L1->size_ci=8; L1->end_ci=L1->base_ci+L1->size_ci-1; L1->stack=luaM_newvector(L,(2*20)+5,TValue); L1->stacksize=(2*20)+5; L1->top=L1->stack; L1->stack_last=L1->stack+(L1->stacksize-5)-1; L1->ci->func=L1->top; setnilvalue(L1->top++); L1->base=L1->ci->base=L1->top; L1->ci->top=L1->top+20; } static void freestack(lua_State*L,lua_State*L1){ luaM_freearray(L,L1->base_ci,L1->size_ci,CallInfo); luaM_freearray(L,L1->stack,L1->stacksize,TValue); } static void f_luaopen(lua_State*L,void*ud){ global_State*g=G(L); UNUSED(ud); stack_init(L,L); sethvalue(L,gt(L),luaH_new(L,0,2)); sethvalue(L,registry(L),luaH_new(L,0,2)); luaS_resize(L,32); luaT_init(L); luaX_init(L); luaS_fix(luaS_newliteral(L,"not enough memory")); g->GCthreshold=4*g->totalbytes; } static void preinit_state(lua_State*L,global_State*g){ G(L)=g; L->stack=NULL; L->stacksize=0; L->errorJmp=NULL; L->hook=NULL; L->hookmask=0; L->basehookcount=0; L->allowhook=1; resethookcount(L); L->openupval=NULL; L->size_ci=0; L->nCcalls=L->baseCcalls=0; L->status=0; L->base_ci=L->ci=NULL; L->savedpc=NULL; L->errfunc=0; setnilvalue(gt(L)); } static void close_state(lua_State*L){ global_State*g=G(L); luaF_close(L,L->stack); luaC_freeall(L); luaM_freearray(L,G(L)->strt.hash,G(L)->strt.size,TString*); luaZ_freebuffer(L,&g->buff); freestack(L,L); (*g->frealloc)(g->ud,fromstate(L),state_size(LG),0); } static void luaE_freethread(lua_State*L,lua_State*L1){ luaF_close(L1,L1->stack); freestack(L,L1); luaM_freemem(L,fromstate(L1),state_size(lua_State)); } static lua_State*lua_newstate(lua_Alloc f,void*ud){ int i; lua_State*L; global_State*g; void*l=(*f)(ud,NULL,0,state_size(LG)); if(l==NULL)return NULL; L=tostate(l); g=&((LG*)L)->g; L->next=NULL; L->tt=8; g->currentwhite=bit2mask(0,5); L->marked=luaC_white(g); set2bits(L->marked,5,6); preinit_state(L,g); g->frealloc=f; g->ud=ud; g->mainthread=L; g->uvhead.u.l.prev=&g->uvhead; g->uvhead.u.l.next=&g->uvhead; g->GCthreshold=0; g->strt.size=0; g->strt.nuse=0; g->strt.hash=NULL; setnilvalue(registry(L)); luaZ_initbuffer(L,&g->buff); g->panic=NULL; g->gcstate=0; g->rootgc=obj2gco(L); g->sweepstrgc=0; g->sweepgc=&g->rootgc; g->gray=NULL; g->grayagain=NULL; g->weak=NULL; g->tmudata=NULL; g->totalbytes=sizeof(LG); g->gcpause=200; g->gcstepmul=200; g->gcdept=0; for(i=0;i<(8+1);i++)g->mt[i]=NULL; if(luaD_rawrunprotected(L,f_luaopen,NULL)!=0){ close_state(L); L=NULL; } else {} return L; } static void callallgcTM(lua_State*L,void*ud){ UNUSED(ud); luaC_callGCTM(L); } static void lua_close(lua_State*L){ L=G(L)->mainthread; luaF_close(L,L->stack); luaC_separateudata(L,1); L->errfunc=0; do{ L->ci=L->base_ci; L->base=L->top=L->ci->base; L->nCcalls=L->baseCcalls=0; }while(luaD_rawrunprotected(L,callallgcTM,NULL)!=0); close_state(L); } #define getcode(fs,e)((fs)->f->code[(e)->u.s.info]) #define luaK_codeAsBx(fs,o,A,sBx)luaK_codeABx(fs,o,A,(sBx)+(((1<<(9+9))-1)>>1)) #define luaK_setmultret(fs,e)luaK_setreturns(fs,e,(-1)) static int luaK_codeABx(FuncState*fs,OpCode o,int A,unsigned int Bx); static int luaK_codeABC(FuncState*fs,OpCode o,int A,int B,int C); static void luaK_setreturns(FuncState*fs,expdesc*e,int nresults); static void luaK_patchtohere(FuncState*fs,int list); static void luaK_concat(FuncState*fs,int*l1,int l2); static int currentpc(lua_State*L,CallInfo*ci){ if(!isLua(ci))return-1; if(ci==L->ci) ci->savedpc=L->savedpc; return pcRel(ci->savedpc,ci_func(ci)->l.p); } static int currentline(lua_State*L,CallInfo*ci){ int pc=currentpc(L,ci); if(pc<0) return-1; else return getline_(ci_func(ci)->l.p,pc); } static int lua_getstack(lua_State*L,int level,lua_Debug*ar){ int status; CallInfo*ci; for(ci=L->ci;level>0&&ci>L->base_ci;ci--){ level--; if(f_isLua(ci)) level-=ci->tailcalls; } if(level==0&&ci>L->base_ci){ status=1; ar->i_ci=cast_int(ci-L->base_ci); } else if(level<0){ status=1; ar->i_ci=0; } else status=0; return status; } static Proto*getluaproto(CallInfo*ci){ return(isLua(ci)?ci_func(ci)->l.p:NULL); } static void funcinfo(lua_Debug*ar,Closure*cl){ if(cl->c.isC){ ar->source="=[C]"; ar->linedefined=-1; ar->lastlinedefined=-1; ar->what="C"; } else{ ar->source=getstr(cl->l.p->source); ar->linedefined=cl->l.p->linedefined; ar->lastlinedefined=cl->l.p->lastlinedefined; ar->what=(ar->linedefined==0)?"main":"Lua"; } luaO_chunkid(ar->short_src,ar->source,60); } static void info_tailcall(lua_Debug*ar){ ar->name=ar->namewhat=""; ar->what="tail"; ar->lastlinedefined=ar->linedefined=ar->currentline=-1; ar->source="=(tail call)"; luaO_chunkid(ar->short_src,ar->source,60); ar->nups=0; } static void collectvalidlines(lua_State*L,Closure*f){ if(f==NULL||f->c.isC){ setnilvalue(L->top); } else{ Table*t=luaH_new(L,0,0); int*lineinfo=f->l.p->lineinfo; int i; for(i=0;il.p->sizelineinfo;i++) setbvalue(luaH_setnum(L,t,lineinfo[i]),1); sethvalue(L,L->top,t); } incr_top(L); } static int auxgetinfo(lua_State*L,const char*what,lua_Debug*ar, Closure*f,CallInfo*ci){ int status=1; if(f==NULL){ info_tailcall(ar); return status; } for(;*what;what++){ switch(*what){ case'S':{ funcinfo(ar,f); break; } case'l':{ ar->currentline=(ci)?currentline(L,ci):-1; break; } case'u':{ ar->nups=f->c.nupvalues; break; } case'n':{ ar->namewhat=(ci)?NULL:NULL; if(ar->namewhat==NULL){ ar->namewhat=""; ar->name=NULL; } break; } case'L': case'f': break; default:status=0; } } return status; } static int lua_getinfo(lua_State*L,const char*what,lua_Debug*ar){ int status; Closure*f=NULL; CallInfo*ci=NULL; if(*what=='>'){ StkId func=L->top-1; luai_apicheck(L,ttisfunction(func)); what++; f=clvalue(func); L->top--; } else if(ar->i_ci!=0){ ci=L->base_ci+ar->i_ci; f=clvalue(ci->func); } status=auxgetinfo(L,what,ar,f,ci); if(strchr(what,'f')){ if(f==NULL)setnilvalue(L->top); else setclvalue(L,L->top,f); incr_top(L); } if(strchr(what,'L')) collectvalidlines(L,f); return status; } static int isinstack(CallInfo*ci,const TValue*o){ StkId p; for(p=ci->base;ptop;p++) if(o==p)return 1; return 0; } static void luaG_typeerror(lua_State*L,const TValue*o,const char*op){ const char*name=NULL; const char*t=luaT_typenames[ttype(o)]; const char*kind=(isinstack(L->ci,o))? NULL: NULL; if(kind) luaG_runerror(L,"attempt to %s %s "LUA_QL("%s")" (a %s value)", op,kind,name,t); else luaG_runerror(L,"attempt to %s a %s value",op,t); } static void luaG_concaterror(lua_State*L,StkId p1,StkId p2){ if(ttisstring(p1)||ttisnumber(p1))p1=p2; luaG_typeerror(L,p1,"concatenate"); } static void luaG_aritherror(lua_State*L,const TValue*p1,const TValue*p2){ TValue temp; if(luaV_tonumber(p1,&temp)==NULL) p2=p1; luaG_typeerror(L,p2,"perform arithmetic on"); } static int luaG_ordererror(lua_State*L,const TValue*p1,const TValue*p2){ const char*t1=luaT_typenames[ttype(p1)]; const char*t2=luaT_typenames[ttype(p2)]; if(t1[2]==t2[2]) luaG_runerror(L,"attempt to compare two %s values",t1); else luaG_runerror(L,"attempt to compare %s with %s",t1,t2); return 0; } static void addinfo(lua_State*L,const char*msg){ CallInfo*ci=L->ci; if(isLua(ci)){ char buff[60]; int line=currentline(L,ci); luaO_chunkid(buff,getstr(getluaproto(ci)->source),60); luaO_pushfstring(L,"%s:%d: %s",buff,line,msg); } } static void luaG_errormsg(lua_State*L){ if(L->errfunc!=0){ StkId errfunc=restorestack(L,L->errfunc); if(!ttisfunction(errfunc))luaD_throw(L,5); setobj(L,L->top,L->top-1); setobj(L,L->top-1,errfunc); incr_top(L); luaD_call(L,L->top-2,1); } luaD_throw(L,2); } static void luaG_runerror(lua_State*L,const char*fmt,...){ va_list argp; va_start(argp,fmt); addinfo(L,luaO_pushvfstring(L,fmt,argp)); va_end(argp); luaG_errormsg(L); } static int luaZ_fill(ZIO*z){ size_t size; lua_State*L=z->L; const char*buff; buff=z->reader(L,z->data,&size); if(buff==NULL||size==0)return(-1); z->n=size-1; z->p=buff; return char2int(*(z->p++)); } static void luaZ_init(lua_State*L,ZIO*z,lua_Reader reader,void*data){ z->L=L; z->reader=reader; z->data=data; z->n=0; z->p=NULL; } static char*luaZ_openspace(lua_State*L,Mbuffer*buff,size_t n){ if(n>buff->buffsize){ if(n<32)n=32; luaZ_resizebuffer(L,buff,n); } return buff->buffer; } #define opmode(t,a,b,c,m)(((t)<<7)|((a)<<6)|((b)<<4)|((c)<<2)|(m)) static const lu_byte luaP_opmodes[(cast(int,OP_VARARG)+1)]={ opmode(0,1,OpArgR,OpArgN,iABC) ,opmode(0,1,OpArgK,OpArgN,iABx) ,opmode(0,1,OpArgU,OpArgU,iABC) ,opmode(0,1,OpArgR,OpArgN,iABC) ,opmode(0,1,OpArgU,OpArgN,iABC) ,opmode(0,1,OpArgK,OpArgN,iABx) ,opmode(0,1,OpArgR,OpArgK,iABC) ,opmode(0,0,OpArgK,OpArgN,iABx) ,opmode(0,0,OpArgU,OpArgN,iABC) ,opmode(0,0,OpArgK,OpArgK,iABC) ,opmode(0,1,OpArgU,OpArgU,iABC) ,opmode(0,1,OpArgR,OpArgK,iABC) ,opmode(0,1,OpArgK,OpArgK,iABC) ,opmode(0,1,OpArgK,OpArgK,iABC) ,opmode(0,1,OpArgK,OpArgK,iABC) ,opmode(0,1,OpArgK,OpArgK,iABC) ,opmode(0,1,OpArgK,OpArgK,iABC) ,opmode(0,1,OpArgK,OpArgK,iABC) ,opmode(0,1,OpArgR,OpArgN,iABC) ,opmode(0,1,OpArgR,OpArgN,iABC) ,opmode(0,1,OpArgR,OpArgN,iABC) ,opmode(0,1,OpArgR,OpArgR,iABC) ,opmode(0,0,OpArgR,OpArgN,iAsBx) ,opmode(1,0,OpArgK,OpArgK,iABC) ,opmode(1,0,OpArgK,OpArgK,iABC) ,opmode(1,0,OpArgK,OpArgK,iABC) ,opmode(1,1,OpArgR,OpArgU,iABC) ,opmode(1,1,OpArgR,OpArgU,iABC) ,opmode(0,1,OpArgU,OpArgU,iABC) ,opmode(0,1,OpArgU,OpArgU,iABC) ,opmode(0,0,OpArgU,OpArgN,iABC) ,opmode(0,1,OpArgR,OpArgN,iAsBx) ,opmode(0,1,OpArgR,OpArgN,iAsBx) ,opmode(1,0,OpArgN,OpArgU,iABC) ,opmode(0,0,OpArgU,OpArgU,iABC) ,opmode(0,0,OpArgN,OpArgN,iABC) ,opmode(0,1,OpArgU,OpArgN,iABx) ,opmode(0,1,OpArgU,OpArgN,iABC) }; #define next(ls)(ls->current=zgetc(ls->z)) #define currIsNewline(ls)(ls->current=='\n'||ls->current=='\r') static const char*const luaX_tokens[]={ "and","break","do","else","elseif", "end","false","for","function","if", "in","local","nil","not","or","repeat", "return","then","true","until","while", "..","...","==",">=","<=","~=", "","","","", NULL }; #define save_and_next(ls)(save(ls,ls->current),next(ls)) static void save(LexState*ls,int c){ Mbuffer*b=ls->buff; if(b->n+1>b->buffsize){ size_t newsize; if(b->buffsize>=((size_t)(~(size_t)0)-2)/2) luaX_lexerror(ls,"lexical element too long",0); newsize=b->buffsize*2; luaZ_resizebuffer(ls->L,b,newsize); } b->buffer[b->n++]=cast(char,c); } static void luaX_init(lua_State*L){ int i; for(i=0;i<(cast(int,TK_WHILE-257+1));i++){ TString*ts=luaS_new(L,luaX_tokens[i]); luaS_fix(ts); ts->tsv.reserved=cast_byte(i+1); } } static const char*luaX_token2str(LexState*ls,int token){ if(token<257){ return(iscntrl(token))?luaO_pushfstring(ls->L,"char(%d)",token): luaO_pushfstring(ls->L,"%c",token); } else return luaX_tokens[token-257]; } static const char*txtToken(LexState*ls,int token){ switch(token){ case TK_NAME: case TK_STRING: case TK_NUMBER: save(ls,'\0'); return luaZ_buffer(ls->buff); default: return luaX_token2str(ls,token); } } static void luaX_lexerror(LexState*ls,const char*msg,int token){ char buff[80]; luaO_chunkid(buff,getstr(ls->source),80); msg=luaO_pushfstring(ls->L,"%s:%d: %s",buff,ls->linenumber,msg); if(token) luaO_pushfstring(ls->L,"%s near "LUA_QL("%s"),msg,txtToken(ls,token)); luaD_throw(ls->L,3); } static void luaX_syntaxerror(LexState*ls,const char*msg){ luaX_lexerror(ls,msg,ls->t.token); } static TString*luaX_newstring(LexState*ls,const char*str,size_t l){ lua_State*L=ls->L; TString*ts=luaS_newlstr(L,str,l); TValue*o=luaH_setstr(L,ls->fs->h,ts); if(ttisnil(o)){ setbvalue(o,1); luaC_checkGC(L); } return ts; } static void inclinenumber(LexState*ls){ int old=ls->current; next(ls); if(currIsNewline(ls)&&ls->current!=old) next(ls); if(++ls->linenumber>=(INT_MAX-2)) luaX_syntaxerror(ls,"chunk has too many lines"); } static void luaX_setinput(lua_State*L,LexState*ls,ZIO*z,TString*source){ ls->decpoint='.'; ls->L=L; ls->lookahead.token=TK_EOS; ls->z=z; ls->fs=NULL; ls->linenumber=1; ls->lastline=1; ls->source=source; luaZ_resizebuffer(ls->L,ls->buff,32); next(ls); } static int check_next(LexState*ls,const char*set){ if(!strchr(set,ls->current)) return 0; save_and_next(ls); return 1; } static void buffreplace(LexState*ls,char from,char to){ size_t n=luaZ_bufflen(ls->buff); char*p=luaZ_buffer(ls->buff); while(n--) if(p[n]==from)p[n]=to; } static void read_numeral(LexState*ls,SemInfo*seminfo){ do{ save_and_next(ls); }while(isdigit(ls->current)||ls->current=='.'); if(check_next(ls,"Ee")) check_next(ls,"+-"); while(isalnum(ls->current)||ls->current=='_') save_and_next(ls); save(ls,'\0'); buffreplace(ls,'.',ls->decpoint); if(!luaO_str2d(luaZ_buffer(ls->buff),&seminfo->r)) luaX_lexerror(ls,"malformed number",TK_NUMBER); } static int skip_sep(LexState*ls){ int count=0; int s=ls->current; save_and_next(ls); while(ls->current=='='){ save_and_next(ls); count++; } return(ls->current==s)?count:(-count)-1; } static void read_long_string(LexState*ls,SemInfo*seminfo,int sep){ int cont=0; (void)(cont); save_and_next(ls); if(currIsNewline(ls)) inclinenumber(ls); for(;;){ switch(ls->current){ case(-1): luaX_lexerror(ls,(seminfo)?"unfinished long string": "unfinished long comment",TK_EOS); break; case']':{ if(skip_sep(ls)==sep){ save_and_next(ls); goto endloop; } break; } case'\n': case'\r':{ save(ls,'\n'); inclinenumber(ls); if(!seminfo)luaZ_resetbuffer(ls->buff); break; } default:{ if(seminfo)save_and_next(ls); else next(ls); } } }endloop: if(seminfo) seminfo->ts=luaX_newstring(ls,luaZ_buffer(ls->buff)+(2+sep), luaZ_bufflen(ls->buff)-2*(2+sep)); } static void read_string(LexState*ls,int del,SemInfo*seminfo){ save_and_next(ls); while(ls->current!=del){ switch(ls->current){ case(-1): luaX_lexerror(ls,"unfinished string",TK_EOS); continue; case'\n': case'\r': luaX_lexerror(ls,"unfinished string",TK_STRING); continue; case'\\':{ int c; next(ls); switch(ls->current){ case'a':c='\a';break; case'b':c='\b';break; case'f':c='\f';break; case'n':c='\n';break; case'r':c='\r';break; case't':c='\t';break; case'v':c='\v';break; case'\n': case'\r':save(ls,'\n');inclinenumber(ls);continue; case(-1):continue; default:{ if(!isdigit(ls->current)) save_and_next(ls); else{ int i=0; c=0; do{ c=10*c+(ls->current-'0'); next(ls); }while(++i<3&&isdigit(ls->current)); if(c>UCHAR_MAX) luaX_lexerror(ls,"escape sequence too large",TK_STRING); save(ls,c); } continue; } } save(ls,c); next(ls); continue; } default: save_and_next(ls); } } save_and_next(ls); seminfo->ts=luaX_newstring(ls,luaZ_buffer(ls->buff)+1, luaZ_bufflen(ls->buff)-2); } static int llex(LexState*ls,SemInfo*seminfo){ luaZ_resetbuffer(ls->buff); for(;;){ switch(ls->current){ case'\n': case'\r':{ inclinenumber(ls); continue; } case'-':{ next(ls); if(ls->current!='-')return'-'; next(ls); if(ls->current=='['){ int sep=skip_sep(ls); luaZ_resetbuffer(ls->buff); if(sep>=0){ read_long_string(ls,NULL,sep); luaZ_resetbuffer(ls->buff); continue; } } while(!currIsNewline(ls)&&ls->current!=(-1)) next(ls); continue; } case'[':{ int sep=skip_sep(ls); if(sep>=0){ read_long_string(ls,seminfo,sep); return TK_STRING; } else if(sep==-1)return'['; else luaX_lexerror(ls,"invalid long string delimiter",TK_STRING); } case'=':{ next(ls); if(ls->current!='=')return'='; else{next(ls);return TK_EQ;} } case'<':{ next(ls); if(ls->current!='=')return'<'; else{next(ls);return TK_LE;} } case'>':{ next(ls); if(ls->current!='=')return'>'; else{next(ls);return TK_GE;} } case'~':{ next(ls); if(ls->current!='=')return'~'; else{next(ls);return TK_NE;} } case'"': case'\'':{ read_string(ls,ls->current,seminfo); return TK_STRING; } case'.':{ save_and_next(ls); if(check_next(ls,".")){ if(check_next(ls,".")) return TK_DOTS; else return TK_CONCAT; } else if(!isdigit(ls->current))return'.'; else{ read_numeral(ls,seminfo); return TK_NUMBER; } } case(-1):{ return TK_EOS; } default:{ if(isspace(ls->current)){ next(ls); continue; } else if(isdigit(ls->current)){ read_numeral(ls,seminfo); return TK_NUMBER; } else if(isalpha(ls->current)||ls->current=='_'){ TString*ts; do{ save_and_next(ls); }while(isalnum(ls->current)||ls->current=='_'); ts=luaX_newstring(ls,luaZ_buffer(ls->buff), luaZ_bufflen(ls->buff)); if(ts->tsv.reserved>0) return ts->tsv.reserved-1+257; else{ seminfo->ts=ts; return TK_NAME; } } else{ int c=ls->current; next(ls); return c; } } } } } static void luaX_next(LexState*ls){ ls->lastline=ls->linenumber; if(ls->lookahead.token!=TK_EOS){ ls->t=ls->lookahead; ls->lookahead.token=TK_EOS; } else ls->t.token=llex(ls,&ls->t.seminfo); } static void luaX_lookahead(LexState*ls){ ls->lookahead.token=llex(ls,&ls->lookahead.seminfo); } #define hasjumps(e)((e)->t!=(e)->f) static int isnumeral(expdesc*e){ return(e->k==VKNUM&&e->t==(-1)&&e->f==(-1)); } static void luaK_nil(FuncState*fs,int from,int n){ Instruction*previous; if(fs->pc>fs->lasttarget){ if(fs->pc==0){ if(from>=fs->nactvar) return; } else{ previous=&fs->f->code[fs->pc-1]; if(GET_OPCODE(*previous)==OP_LOADNIL){ int pfrom=GETARG_A(*previous); int pto=GETARG_B(*previous); if(pfrom<=from&&from<=pto+1){ if(from+n-1>pto) SETARG_B(*previous,from+n-1); return; } } } } luaK_codeABC(fs,OP_LOADNIL,from,from+n-1,0); } static int luaK_jump(FuncState*fs){ int jpc=fs->jpc; int j; fs->jpc=(-1); j=luaK_codeAsBx(fs,OP_JMP,0,(-1)); luaK_concat(fs,&j,jpc); return j; } static void luaK_ret(FuncState*fs,int first,int nret){ luaK_codeABC(fs,OP_RETURN,first,nret+1,0); } static int condjump(FuncState*fs,OpCode op,int A,int B,int C){ luaK_codeABC(fs,op,A,B,C); return luaK_jump(fs); } static void fixjump(FuncState*fs,int pc,int dest){ Instruction*jmp=&fs->f->code[pc]; int offset=dest-(pc+1); if(abs(offset)>(((1<<(9+9))-1)>>1)) luaX_syntaxerror(fs->ls,"control structure too long"); SETARG_sBx(*jmp,offset); } static int luaK_getlabel(FuncState*fs){ fs->lasttarget=fs->pc; return fs->pc; } static int getjump(FuncState*fs,int pc){ int offset=GETARG_sBx(fs->f->code[pc]); if(offset==(-1)) return(-1); else return(pc+1)+offset; } static Instruction*getjumpcontrol(FuncState*fs,int pc){ Instruction*pi=&fs->f->code[pc]; if(pc>=1&&testTMode(GET_OPCODE(*(pi-1)))) return pi-1; else return pi; } static int need_value(FuncState*fs,int list){ for(;list!=(-1);list=getjump(fs,list)){ Instruction i=*getjumpcontrol(fs,list); if(GET_OPCODE(i)!=OP_TESTSET)return 1; } return 0; } static int patchtestreg(FuncState*fs,int node,int reg){ Instruction*i=getjumpcontrol(fs,node); if(GET_OPCODE(*i)!=OP_TESTSET) return 0; if(reg!=((1<<8)-1)&®!=GETARG_B(*i)) SETARG_A(*i,reg); else *i=CREATE_ABC(OP_TEST,GETARG_B(*i),0,GETARG_C(*i)); return 1; } static void removevalues(FuncState*fs,int list){ for(;list!=(-1);list=getjump(fs,list)) patchtestreg(fs,list,((1<<8)-1)); } static void patchlistaux(FuncState*fs,int list,int vtarget,int reg, int dtarget){ while(list!=(-1)){ int next=getjump(fs,list); if(patchtestreg(fs,list,reg)) fixjump(fs,list,vtarget); else fixjump(fs,list,dtarget); list=next; } } static void dischargejpc(FuncState*fs){ patchlistaux(fs,fs->jpc,fs->pc,((1<<8)-1),fs->pc); fs->jpc=(-1); } static void luaK_patchlist(FuncState*fs,int list,int target){ if(target==fs->pc) luaK_patchtohere(fs,list); else{ patchlistaux(fs,list,target,((1<<8)-1),target); } } static void luaK_patchtohere(FuncState*fs,int list){ luaK_getlabel(fs); luaK_concat(fs,&fs->jpc,list); } static void luaK_concat(FuncState*fs,int*l1,int l2){ if(l2==(-1))return; else if(*l1==(-1)) *l1=l2; else{ int list=*l1; int next; while((next=getjump(fs,list))!=(-1)) list=next; fixjump(fs,list,l2); } } static void luaK_checkstack(FuncState*fs,int n){ int newstack=fs->freereg+n; if(newstack>fs->f->maxstacksize){ if(newstack>=250) luaX_syntaxerror(fs->ls,"function or expression too complex"); fs->f->maxstacksize=cast_byte(newstack); } } static void luaK_reserveregs(FuncState*fs,int n){ luaK_checkstack(fs,n); fs->freereg+=n; } static void freereg(FuncState*fs,int reg){ if(!ISK(reg)&®>=fs->nactvar){ fs->freereg--; } } static void freeexp(FuncState*fs,expdesc*e){ if(e->k==VNONRELOC) freereg(fs,e->u.s.info); } static int addk(FuncState*fs,TValue*k,TValue*v){ lua_State*L=fs->L; TValue*idx=luaH_set(L,fs->h,k); Proto*f=fs->f; int oldsize=f->sizek; if(ttisnumber(idx)){ return cast_int(nvalue(idx)); } else{ setnvalue(idx,cast_num(fs->nk)); luaM_growvector(L,f->k,fs->nk,f->sizek,TValue, ((1<<(9+9))-1),"constant table overflow"); while(oldsizesizek)setnilvalue(&f->k[oldsize++]); setobj(L,&f->k[fs->nk],v); luaC_barrier(L,f,v); return fs->nk++; } } static int luaK_stringK(FuncState*fs,TString*s){ TValue o; setsvalue(fs->L,&o,s); return addk(fs,&o,&o); } static int luaK_numberK(FuncState*fs,lua_Number r){ TValue o; setnvalue(&o,r); return addk(fs,&o,&o); } static int boolK(FuncState*fs,int b){ TValue o; setbvalue(&o,b); return addk(fs,&o,&o); } static int nilK(FuncState*fs){ TValue k,v; setnilvalue(&v); sethvalue(fs->L,&k,fs->h); return addk(fs,&k,&v); } static void luaK_setreturns(FuncState*fs,expdesc*e,int nresults){ if(e->k==VCALL){ SETARG_C(getcode(fs,e),nresults+1); } else if(e->k==VVARARG){ SETARG_B(getcode(fs,e),nresults+1); SETARG_A(getcode(fs,e),fs->freereg); luaK_reserveregs(fs,1); } } static void luaK_setoneret(FuncState*fs,expdesc*e){ if(e->k==VCALL){ e->k=VNONRELOC; e->u.s.info=GETARG_A(getcode(fs,e)); } else if(e->k==VVARARG){ SETARG_B(getcode(fs,e),2); e->k=VRELOCABLE; } } static void luaK_dischargevars(FuncState*fs,expdesc*e){ switch(e->k){ case VLOCAL:{ e->k=VNONRELOC; break; } case VUPVAL:{ e->u.s.info=luaK_codeABC(fs,OP_GETUPVAL,0,e->u.s.info,0); e->k=VRELOCABLE; break; } case VGLOBAL:{ e->u.s.info=luaK_codeABx(fs,OP_GETGLOBAL,0,e->u.s.info); e->k=VRELOCABLE; break; } case VINDEXED:{ freereg(fs,e->u.s.aux); freereg(fs,e->u.s.info); e->u.s.info=luaK_codeABC(fs,OP_GETTABLE,0,e->u.s.info,e->u.s.aux); e->k=VRELOCABLE; break; } case VVARARG: case VCALL:{ luaK_setoneret(fs,e); break; } default:break; } } static int code_label(FuncState*fs,int A,int b,int jump){ luaK_getlabel(fs); return luaK_codeABC(fs,OP_LOADBOOL,A,b,jump); } static void discharge2reg(FuncState*fs,expdesc*e,int reg){ luaK_dischargevars(fs,e); switch(e->k){ case VNIL:{ luaK_nil(fs,reg,1); break; } case VFALSE:case VTRUE:{ luaK_codeABC(fs,OP_LOADBOOL,reg,e->k==VTRUE,0); break; } case VK:{ luaK_codeABx(fs,OP_LOADK,reg,e->u.s.info); break; } case VKNUM:{ luaK_codeABx(fs,OP_LOADK,reg,luaK_numberK(fs,e->u.nval)); break; } case VRELOCABLE:{ Instruction*pc=&getcode(fs,e); SETARG_A(*pc,reg); break; } case VNONRELOC:{ if(reg!=e->u.s.info) luaK_codeABC(fs,OP_MOVE,reg,e->u.s.info,0); break; } default:{ return; } } e->u.s.info=reg; e->k=VNONRELOC; } static void discharge2anyreg(FuncState*fs,expdesc*e){ if(e->k!=VNONRELOC){ luaK_reserveregs(fs,1); discharge2reg(fs,e,fs->freereg-1); } } static void exp2reg(FuncState*fs,expdesc*e,int reg){ discharge2reg(fs,e,reg); if(e->k==VJMP) luaK_concat(fs,&e->t,e->u.s.info); if(hasjumps(e)){ int final; int p_f=(-1); int p_t=(-1); if(need_value(fs,e->t)||need_value(fs,e->f)){ int fj=(e->k==VJMP)?(-1):luaK_jump(fs); p_f=code_label(fs,reg,0,1); p_t=code_label(fs,reg,1,0); luaK_patchtohere(fs,fj); } final=luaK_getlabel(fs); patchlistaux(fs,e->f,final,reg,p_f); patchlistaux(fs,e->t,final,reg,p_t); } e->f=e->t=(-1); e->u.s.info=reg; e->k=VNONRELOC; } static void luaK_exp2nextreg(FuncState*fs,expdesc*e){ luaK_dischargevars(fs,e); freeexp(fs,e); luaK_reserveregs(fs,1); exp2reg(fs,e,fs->freereg-1); } static int luaK_exp2anyreg(FuncState*fs,expdesc*e){ luaK_dischargevars(fs,e); if(e->k==VNONRELOC){ if(!hasjumps(e))return e->u.s.info; if(e->u.s.info>=fs->nactvar){ exp2reg(fs,e,e->u.s.info); return e->u.s.info; } } luaK_exp2nextreg(fs,e); return e->u.s.info; } static void luaK_exp2val(FuncState*fs,expdesc*e){ if(hasjumps(e)) luaK_exp2anyreg(fs,e); else luaK_dischargevars(fs,e); } static int luaK_exp2RK(FuncState*fs,expdesc*e){ luaK_exp2val(fs,e); switch(e->k){ case VKNUM: case VTRUE: case VFALSE: case VNIL:{ if(fs->nk<=((1<<(9-1))-1)){ e->u.s.info=(e->k==VNIL)?nilK(fs): (e->k==VKNUM)?luaK_numberK(fs,e->u.nval): boolK(fs,(e->k==VTRUE)); e->k=VK; return RKASK(e->u.s.info); } else break; } case VK:{ if(e->u.s.info<=((1<<(9-1))-1)) return RKASK(e->u.s.info); else break; } default:break; } return luaK_exp2anyreg(fs,e); } static void luaK_storevar(FuncState*fs,expdesc*var,expdesc*ex){ switch(var->k){ case VLOCAL:{ freeexp(fs,ex); exp2reg(fs,ex,var->u.s.info); return; } case VUPVAL:{ int e=luaK_exp2anyreg(fs,ex); luaK_codeABC(fs,OP_SETUPVAL,e,var->u.s.info,0); break; } case VGLOBAL:{ int e=luaK_exp2anyreg(fs,ex); luaK_codeABx(fs,OP_SETGLOBAL,e,var->u.s.info); break; } case VINDEXED:{ int e=luaK_exp2RK(fs,ex); luaK_codeABC(fs,OP_SETTABLE,var->u.s.info,var->u.s.aux,e); break; } default:{ break; } } freeexp(fs,ex); } static void luaK_self(FuncState*fs,expdesc*e,expdesc*key){ int func; luaK_exp2anyreg(fs,e); freeexp(fs,e); func=fs->freereg; luaK_reserveregs(fs,2); luaK_codeABC(fs,OP_SELF,func,e->u.s.info,luaK_exp2RK(fs,key)); freeexp(fs,key); e->u.s.info=func; e->k=VNONRELOC; } static void invertjump(FuncState*fs,expdesc*e){ Instruction*pc=getjumpcontrol(fs,e->u.s.info); SETARG_A(*pc,!(GETARG_A(*pc))); } static int jumponcond(FuncState*fs,expdesc*e,int cond){ if(e->k==VRELOCABLE){ Instruction ie=getcode(fs,e); if(GET_OPCODE(ie)==OP_NOT){ fs->pc--; return condjump(fs,OP_TEST,GETARG_B(ie),0,!cond); } } discharge2anyreg(fs,e); freeexp(fs,e); return condjump(fs,OP_TESTSET,((1<<8)-1),e->u.s.info,cond); } static void luaK_goiftrue(FuncState*fs,expdesc*e){ int pc; luaK_dischargevars(fs,e); switch(e->k){ case VK:case VKNUM:case VTRUE:{ pc=(-1); break; } case VJMP:{ invertjump(fs,e); pc=e->u.s.info; break; } default:{ pc=jumponcond(fs,e,0); break; } } luaK_concat(fs,&e->f,pc); luaK_patchtohere(fs,e->t); e->t=(-1); } static void luaK_goiffalse(FuncState*fs,expdesc*e){ int pc; luaK_dischargevars(fs,e); switch(e->k){ case VNIL:case VFALSE:{ pc=(-1); break; } case VJMP:{ pc=e->u.s.info; break; } default:{ pc=jumponcond(fs,e,1); break; } } luaK_concat(fs,&e->t,pc); luaK_patchtohere(fs,e->f); e->f=(-1); } static void codenot(FuncState*fs,expdesc*e){ luaK_dischargevars(fs,e); switch(e->k){ case VNIL:case VFALSE:{ e->k=VTRUE; break; } case VK:case VKNUM:case VTRUE:{ e->k=VFALSE; break; } case VJMP:{ invertjump(fs,e); break; } case VRELOCABLE: case VNONRELOC:{ discharge2anyreg(fs,e); freeexp(fs,e); e->u.s.info=luaK_codeABC(fs,OP_NOT,0,e->u.s.info,0); e->k=VRELOCABLE; break; } default:{ break; } } {int temp=e->f;e->f=e->t;e->t=temp;} removevalues(fs,e->f); removevalues(fs,e->t); } static void luaK_indexed(FuncState*fs,expdesc*t,expdesc*k){ t->u.s.aux=luaK_exp2RK(fs,k); t->k=VINDEXED; } static int constfolding(OpCode op,expdesc*e1,expdesc*e2){ lua_Number v1,v2,r; if(!isnumeral(e1)||!isnumeral(e2))return 0; v1=e1->u.nval; v2=e2->u.nval; switch(op){ case OP_ADD:r=luai_numadd(v1,v2);break; case OP_SUB:r=luai_numsub(v1,v2);break; case OP_MUL:r=luai_nummul(v1,v2);break; case OP_DIV: if(v2==0)return 0; r=luai_numdiv(v1,v2);break; case OP_MOD: if(v2==0)return 0; r=luai_nummod(v1,v2);break; case OP_POW:r=luai_numpow(v1,v2);break; case OP_UNM:r=luai_numunm(v1);break; case OP_LEN:return 0; default:r=0;break; } if(luai_numisnan(r))return 0; e1->u.nval=r; return 1; } static void codearith(FuncState*fs,OpCode op,expdesc*e1,expdesc*e2){ if(constfolding(op,e1,e2)) return; else{ int o2=(op!=OP_UNM&&op!=OP_LEN)?luaK_exp2RK(fs,e2):0; int o1=luaK_exp2RK(fs,e1); if(o1>o2){ freeexp(fs,e1); freeexp(fs,e2); } else{ freeexp(fs,e2); freeexp(fs,e1); } e1->u.s.info=luaK_codeABC(fs,op,0,o1,o2); e1->k=VRELOCABLE; } } static void codecomp(FuncState*fs,OpCode op,int cond,expdesc*e1, expdesc*e2){ int o1=luaK_exp2RK(fs,e1); int o2=luaK_exp2RK(fs,e2); freeexp(fs,e2); freeexp(fs,e1); if(cond==0&&op!=OP_EQ){ int temp; temp=o1;o1=o2;o2=temp; cond=1; } e1->u.s.info=condjump(fs,op,cond,o1,o2); e1->k=VJMP; } static void luaK_prefix(FuncState*fs,UnOpr op,expdesc*e){ expdesc e2; e2.t=e2.f=(-1);e2.k=VKNUM;e2.u.nval=0; switch(op){ case OPR_MINUS:{ if(!isnumeral(e)) luaK_exp2anyreg(fs,e); codearith(fs,OP_UNM,e,&e2); break; } case OPR_NOT:codenot(fs,e);break; case OPR_LEN:{ luaK_exp2anyreg(fs,e); codearith(fs,OP_LEN,e,&e2); break; } default:; } } static void luaK_infix(FuncState*fs,BinOpr op,expdesc*v){ switch(op){ case OPR_AND:{ luaK_goiftrue(fs,v); break; } case OPR_OR:{ luaK_goiffalse(fs,v); break; } case OPR_CONCAT:{ luaK_exp2nextreg(fs,v); break; } case OPR_ADD:case OPR_SUB:case OPR_MUL:case OPR_DIV: case OPR_MOD:case OPR_POW:{ if(!isnumeral(v))luaK_exp2RK(fs,v); break; } default:{ luaK_exp2RK(fs,v); break; } } } static void luaK_posfix(FuncState*fs,BinOpr op,expdesc*e1,expdesc*e2){ switch(op){ case OPR_AND:{ luaK_dischargevars(fs,e2); luaK_concat(fs,&e2->f,e1->f); *e1=*e2; break; } case OPR_OR:{ luaK_dischargevars(fs,e2); luaK_concat(fs,&e2->t,e1->t); *e1=*e2; break; } case OPR_CONCAT:{ luaK_exp2val(fs,e2); if(e2->k==VRELOCABLE&&GET_OPCODE(getcode(fs,e2))==OP_CONCAT){ freeexp(fs,e1); SETARG_B(getcode(fs,e2),e1->u.s.info); e1->k=VRELOCABLE;e1->u.s.info=e2->u.s.info; } else{ luaK_exp2nextreg(fs,e2); codearith(fs,OP_CONCAT,e1,e2); } break; } case OPR_ADD:codearith(fs,OP_ADD,e1,e2);break; case OPR_SUB:codearith(fs,OP_SUB,e1,e2);break; case OPR_MUL:codearith(fs,OP_MUL,e1,e2);break; case OPR_DIV:codearith(fs,OP_DIV,e1,e2);break; case OPR_MOD:codearith(fs,OP_MOD,e1,e2);break; case OPR_POW:codearith(fs,OP_POW,e1,e2);break; case OPR_EQ:codecomp(fs,OP_EQ,1,e1,e2);break; case OPR_NE:codecomp(fs,OP_EQ,0,e1,e2);break; case OPR_LT:codecomp(fs,OP_LT,1,e1,e2);break; case OPR_LE:codecomp(fs,OP_LE,1,e1,e2);break; case OPR_GT:codecomp(fs,OP_LT,0,e1,e2);break; case OPR_GE:codecomp(fs,OP_LE,0,e1,e2);break; default:; } } static void luaK_fixline(FuncState*fs,int line){ fs->f->lineinfo[fs->pc-1]=line; } static int luaK_code(FuncState*fs,Instruction i,int line){ Proto*f=fs->f; dischargejpc(fs); luaM_growvector(fs->L,f->code,fs->pc,f->sizecode,Instruction, (INT_MAX-2),"code size overflow"); f->code[fs->pc]=i; luaM_growvector(fs->L,f->lineinfo,fs->pc,f->sizelineinfo,int, (INT_MAX-2),"code size overflow"); f->lineinfo[fs->pc]=line; return fs->pc++; } static int luaK_codeABC(FuncState*fs,OpCode o,int a,int b,int c){ return luaK_code(fs,CREATE_ABC(o,a,b,c),fs->ls->lastline); } static int luaK_codeABx(FuncState*fs,OpCode o,int a,unsigned int bc){ return luaK_code(fs,CREATE_ABx(o,a,bc),fs->ls->lastline); } static void luaK_setlist(FuncState*fs,int base,int nelems,int tostore){ int c=(nelems-1)/50+1; int b=(tostore==(-1))?0:tostore; if(c<=((1<<9)-1)) luaK_codeABC(fs,OP_SETLIST,base,b,c); else{ luaK_codeABC(fs,OP_SETLIST,base,b,0); luaK_code(fs,cast(Instruction,c),fs->ls->lastline); } fs->freereg=base+1; } #define hasmultret(k)((k)==VCALL||(k)==VVARARG) #define getlocvar(fs,i)((fs)->f->locvars[(fs)->actvar[i]]) #define luaY_checklimit(fs,v,l,m)if((v)>(l))errorlimit(fs,l,m) typedef struct BlockCnt{ struct BlockCnt*previous; int breaklist; lu_byte nactvar; lu_byte upval; lu_byte isbreakable; }BlockCnt; static void chunk(LexState*ls); static void expr(LexState*ls,expdesc*v); static void anchor_token(LexState*ls){ if(ls->t.token==TK_NAME||ls->t.token==TK_STRING){ TString*ts=ls->t.seminfo.ts; luaX_newstring(ls,getstr(ts),ts->tsv.len); } } static void error_expected(LexState*ls,int token){ luaX_syntaxerror(ls, luaO_pushfstring(ls->L,LUA_QL("%s")" expected",luaX_token2str(ls,token))); } static void errorlimit(FuncState*fs,int limit,const char*what){ const char*msg=(fs->f->linedefined==0)? luaO_pushfstring(fs->L,"main function has more than %d %s",limit,what): luaO_pushfstring(fs->L,"function at line %d has more than %d %s", fs->f->linedefined,limit,what); luaX_lexerror(fs->ls,msg,0); } static int testnext(LexState*ls,int c){ if(ls->t.token==c){ luaX_next(ls); return 1; } else return 0; } static void check(LexState*ls,int c){ if(ls->t.token!=c) error_expected(ls,c); } static void checknext(LexState*ls,int c){ check(ls,c); luaX_next(ls); } #define check_condition(ls,c,msg){if(!(c))luaX_syntaxerror(ls,msg);} static void check_match(LexState*ls,int what,int who,int where){ if(!testnext(ls,what)){ if(where==ls->linenumber) error_expected(ls,what); else{ luaX_syntaxerror(ls,luaO_pushfstring(ls->L, LUA_QL("%s")" expected (to close "LUA_QL("%s")" at line %d)", luaX_token2str(ls,what),luaX_token2str(ls,who),where)); } } } static TString*str_checkname(LexState*ls){ TString*ts; check(ls,TK_NAME); ts=ls->t.seminfo.ts; luaX_next(ls); return ts; } static void init_exp(expdesc*e,expkind k,int i){ e->f=e->t=(-1); e->k=k; e->u.s.info=i; } static void codestring(LexState*ls,expdesc*e,TString*s){ init_exp(e,VK,luaK_stringK(ls->fs,s)); } static void checkname(LexState*ls,expdesc*e){ codestring(ls,e,str_checkname(ls)); } static int registerlocalvar(LexState*ls,TString*varname){ FuncState*fs=ls->fs; Proto*f=fs->f; int oldsize=f->sizelocvars; luaM_growvector(ls->L,f->locvars,fs->nlocvars,f->sizelocvars, LocVar,SHRT_MAX,"too many local variables"); while(oldsizesizelocvars)f->locvars[oldsize++].varname=NULL; f->locvars[fs->nlocvars].varname=varname; luaC_objbarrier(ls->L,f,varname); return fs->nlocvars++; } #define new_localvarliteral(ls,v,n)new_localvar(ls,luaX_newstring(ls,""v,(sizeof(v)/sizeof(char))-1),n) static void new_localvar(LexState*ls,TString*name,int n){ FuncState*fs=ls->fs; luaY_checklimit(fs,fs->nactvar+n+1,200,"local variables"); fs->actvar[fs->nactvar+n]=cast(unsigned short,registerlocalvar(ls,name)); } static void adjustlocalvars(LexState*ls,int nvars){ FuncState*fs=ls->fs; fs->nactvar=cast_byte(fs->nactvar+nvars); for(;nvars;nvars--){ getlocvar(fs,fs->nactvar-nvars).startpc=fs->pc; } } static void removevars(LexState*ls,int tolevel){ FuncState*fs=ls->fs; while(fs->nactvar>tolevel) getlocvar(fs,--fs->nactvar).endpc=fs->pc; } static int indexupvalue(FuncState*fs,TString*name,expdesc*v){ int i; Proto*f=fs->f; int oldsize=f->sizeupvalues; for(i=0;inups;i++){ if(fs->upvalues[i].k==v->k&&fs->upvalues[i].info==v->u.s.info){ return i; } } luaY_checklimit(fs,f->nups+1,60,"upvalues"); luaM_growvector(fs->L,f->upvalues,f->nups,f->sizeupvalues, TString*,(INT_MAX-2),""); while(oldsizesizeupvalues)f->upvalues[oldsize++]=NULL; f->upvalues[f->nups]=name; luaC_objbarrier(fs->L,f,name); fs->upvalues[f->nups].k=cast_byte(v->k); fs->upvalues[f->nups].info=cast_byte(v->u.s.info); return f->nups++; } static int searchvar(FuncState*fs,TString*n){ int i; for(i=fs->nactvar-1;i>=0;i--){ if(n==getlocvar(fs,i).varname) return i; } return-1; } static void markupval(FuncState*fs,int level){ BlockCnt*bl=fs->bl; while(bl&&bl->nactvar>level)bl=bl->previous; if(bl)bl->upval=1; } static int singlevaraux(FuncState*fs,TString*n,expdesc*var,int base){ if(fs==NULL){ init_exp(var,VGLOBAL,((1<<8)-1)); return VGLOBAL; } else{ int v=searchvar(fs,n); if(v>=0){ init_exp(var,VLOCAL,v); if(!base) markupval(fs,v); return VLOCAL; } else{ if(singlevaraux(fs->prev,n,var,0)==VGLOBAL) return VGLOBAL; var->u.s.info=indexupvalue(fs,n,var); var->k=VUPVAL; return VUPVAL; } } } static void singlevar(LexState*ls,expdesc*var){ TString*varname=str_checkname(ls); FuncState*fs=ls->fs; if(singlevaraux(fs,varname,var,1)==VGLOBAL) var->u.s.info=luaK_stringK(fs,varname); } static void adjust_assign(LexState*ls,int nvars,int nexps,expdesc*e){ FuncState*fs=ls->fs; int extra=nvars-nexps; if(hasmultret(e->k)){ extra++; if(extra<0)extra=0; luaK_setreturns(fs,e,extra); if(extra>1)luaK_reserveregs(fs,extra-1); } else{ if(e->k!=VVOID)luaK_exp2nextreg(fs,e); if(extra>0){ int reg=fs->freereg; luaK_reserveregs(fs,extra); luaK_nil(fs,reg,extra); } } } static void enterlevel(LexState*ls){ if(++ls->L->nCcalls>200) luaX_lexerror(ls,"chunk has too many syntax levels",0); } #define leavelevel(ls)((ls)->L->nCcalls--) static void enterblock(FuncState*fs,BlockCnt*bl,lu_byte isbreakable){ bl->breaklist=(-1); bl->isbreakable=isbreakable; bl->nactvar=fs->nactvar; bl->upval=0; bl->previous=fs->bl; fs->bl=bl; } static void leaveblock(FuncState*fs){ BlockCnt*bl=fs->bl; fs->bl=bl->previous; removevars(fs->ls,bl->nactvar); if(bl->upval) luaK_codeABC(fs,OP_CLOSE,bl->nactvar,0,0); fs->freereg=fs->nactvar; luaK_patchtohere(fs,bl->breaklist); } static void pushclosure(LexState*ls,FuncState*func,expdesc*v){ FuncState*fs=ls->fs; Proto*f=fs->f; int oldsize=f->sizep; int i; luaM_growvector(ls->L,f->p,fs->np,f->sizep,Proto*, ((1<<(9+9))-1),"constant table overflow"); while(oldsizesizep)f->p[oldsize++]=NULL; f->p[fs->np++]=func->f; luaC_objbarrier(ls->L,f,func->f); init_exp(v,VRELOCABLE,luaK_codeABx(fs,OP_CLOSURE,0,fs->np-1)); for(i=0;if->nups;i++){ OpCode o=(func->upvalues[i].k==VLOCAL)?OP_MOVE:OP_GETUPVAL; luaK_codeABC(fs,o,0,func->upvalues[i].info,0); } } static void open_func(LexState*ls,FuncState*fs){ lua_State*L=ls->L; Proto*f=luaF_newproto(L); fs->f=f; fs->prev=ls->fs; fs->ls=ls; fs->L=L; ls->fs=fs; fs->pc=0; fs->lasttarget=-1; fs->jpc=(-1); fs->freereg=0; fs->nk=0; fs->np=0; fs->nlocvars=0; fs->nactvar=0; fs->bl=NULL; f->source=ls->source; f->maxstacksize=2; fs->h=luaH_new(L,0,0); sethvalue(L,L->top,fs->h); incr_top(L); setptvalue(L,L->top,f); incr_top(L); } static void close_func(LexState*ls){ lua_State*L=ls->L; FuncState*fs=ls->fs; Proto*f=fs->f; removevars(ls,0); luaK_ret(fs,0,0); luaM_reallocvector(L,f->code,f->sizecode,fs->pc,Instruction); f->sizecode=fs->pc; luaM_reallocvector(L,f->lineinfo,f->sizelineinfo,fs->pc,int); f->sizelineinfo=fs->pc; luaM_reallocvector(L,f->k,f->sizek,fs->nk,TValue); f->sizek=fs->nk; luaM_reallocvector(L,f->p,f->sizep,fs->np,Proto*); f->sizep=fs->np; luaM_reallocvector(L,f->locvars,f->sizelocvars,fs->nlocvars,LocVar); f->sizelocvars=fs->nlocvars; luaM_reallocvector(L,f->upvalues,f->sizeupvalues,f->nups,TString*); f->sizeupvalues=f->nups; ls->fs=fs->prev; if(fs)anchor_token(ls); L->top-=2; } static Proto*luaY_parser(lua_State*L,ZIO*z,Mbuffer*buff,const char*name){ struct LexState lexstate; struct FuncState funcstate; lexstate.buff=buff; luaX_setinput(L,&lexstate,z,luaS_new(L,name)); open_func(&lexstate,&funcstate); funcstate.f->is_vararg=2; luaX_next(&lexstate); chunk(&lexstate); check(&lexstate,TK_EOS); close_func(&lexstate); return funcstate.f; } static void field(LexState*ls,expdesc*v){ FuncState*fs=ls->fs; expdesc key; luaK_exp2anyreg(fs,v); luaX_next(ls); checkname(ls,&key); luaK_indexed(fs,v,&key); } static void yindex(LexState*ls,expdesc*v){ luaX_next(ls); expr(ls,v); luaK_exp2val(ls->fs,v); checknext(ls,']'); } struct ConsControl{ expdesc v; expdesc*t; int nh; int na; int tostore; }; static void recfield(LexState*ls,struct ConsControl*cc){ FuncState*fs=ls->fs; int reg=ls->fs->freereg; expdesc key,val; int rkkey; if(ls->t.token==TK_NAME){ luaY_checklimit(fs,cc->nh,(INT_MAX-2),"items in a constructor"); checkname(ls,&key); } else yindex(ls,&key); cc->nh++; checknext(ls,'='); rkkey=luaK_exp2RK(fs,&key); expr(ls,&val); luaK_codeABC(fs,OP_SETTABLE,cc->t->u.s.info,rkkey,luaK_exp2RK(fs,&val)); fs->freereg=reg; } static void closelistfield(FuncState*fs,struct ConsControl*cc){ if(cc->v.k==VVOID)return; luaK_exp2nextreg(fs,&cc->v); cc->v.k=VVOID; if(cc->tostore==50){ luaK_setlist(fs,cc->t->u.s.info,cc->na,cc->tostore); cc->tostore=0; } } static void lastlistfield(FuncState*fs,struct ConsControl*cc){ if(cc->tostore==0)return; if(hasmultret(cc->v.k)){ luaK_setmultret(fs,&cc->v); luaK_setlist(fs,cc->t->u.s.info,cc->na,(-1)); cc->na--; } else{ if(cc->v.k!=VVOID) luaK_exp2nextreg(fs,&cc->v); luaK_setlist(fs,cc->t->u.s.info,cc->na,cc->tostore); } } static void listfield(LexState*ls,struct ConsControl*cc){ expr(ls,&cc->v); luaY_checklimit(ls->fs,cc->na,(INT_MAX-2),"items in a constructor"); cc->na++; cc->tostore++; } static void constructor(LexState*ls,expdesc*t){ FuncState*fs=ls->fs; int line=ls->linenumber; int pc=luaK_codeABC(fs,OP_NEWTABLE,0,0,0); struct ConsControl cc; cc.na=cc.nh=cc.tostore=0; cc.t=t; init_exp(t,VRELOCABLE,pc); init_exp(&cc.v,VVOID,0); luaK_exp2nextreg(ls->fs,t); checknext(ls,'{'); do{ if(ls->t.token=='}')break; closelistfield(fs,&cc); switch(ls->t.token){ case TK_NAME:{ luaX_lookahead(ls); if(ls->lookahead.token!='=') listfield(ls,&cc); else recfield(ls,&cc); break; } case'[':{ recfield(ls,&cc); break; } default:{ listfield(ls,&cc); break; } } }while(testnext(ls,',')||testnext(ls,';')); check_match(ls,'}','{',line); lastlistfield(fs,&cc); SETARG_B(fs->f->code[pc],luaO_int2fb(cc.na)); SETARG_C(fs->f->code[pc],luaO_int2fb(cc.nh)); } static void parlist(LexState*ls){ FuncState*fs=ls->fs; Proto*f=fs->f; int nparams=0; f->is_vararg=0; if(ls->t.token!=')'){ do{ switch(ls->t.token){ case TK_NAME:{ new_localvar(ls,str_checkname(ls),nparams++); break; } case TK_DOTS:{ luaX_next(ls); f->is_vararg|=2; break; } default:luaX_syntaxerror(ls," or "LUA_QL("...")" expected"); } }while(!f->is_vararg&&testnext(ls,',')); } adjustlocalvars(ls,nparams); f->numparams=cast_byte(fs->nactvar-(f->is_vararg&1)); luaK_reserveregs(fs,fs->nactvar); } static void body(LexState*ls,expdesc*e,int needself,int line){ FuncState new_fs; open_func(ls,&new_fs); new_fs.f->linedefined=line; checknext(ls,'('); if(needself){ new_localvarliteral(ls,"self",0); adjustlocalvars(ls,1); } parlist(ls); checknext(ls,')'); chunk(ls); new_fs.f->lastlinedefined=ls->linenumber; check_match(ls,TK_END,TK_FUNCTION,line); close_func(ls); pushclosure(ls,&new_fs,e); } static int explist1(LexState*ls,expdesc*v){ int n=1; expr(ls,v); while(testnext(ls,',')){ luaK_exp2nextreg(ls->fs,v); expr(ls,v); n++; } return n; } static void funcargs(LexState*ls,expdesc*f){ FuncState*fs=ls->fs; expdesc args; int base,nparams; int line=ls->linenumber; switch(ls->t.token){ case'(':{ if(line!=ls->lastline) luaX_syntaxerror(ls,"ambiguous syntax (function call x new statement)"); luaX_next(ls); if(ls->t.token==')') args.k=VVOID; else{ explist1(ls,&args); luaK_setmultret(fs,&args); } check_match(ls,')','(',line); break; } case'{':{ constructor(ls,&args); break; } case TK_STRING:{ codestring(ls,&args,ls->t.seminfo.ts); luaX_next(ls); break; } default:{ luaX_syntaxerror(ls,"function arguments expected"); return; } } base=f->u.s.info; if(hasmultret(args.k)) nparams=(-1); else{ if(args.k!=VVOID) luaK_exp2nextreg(fs,&args); nparams=fs->freereg-(base+1); } init_exp(f,VCALL,luaK_codeABC(fs,OP_CALL,base,nparams+1,2)); luaK_fixline(fs,line); fs->freereg=base+1; } static void prefixexp(LexState*ls,expdesc*v){ switch(ls->t.token){ case'(':{ int line=ls->linenumber; luaX_next(ls); expr(ls,v); check_match(ls,')','(',line); luaK_dischargevars(ls->fs,v); return; } case TK_NAME:{ singlevar(ls,v); return; } default:{ luaX_syntaxerror(ls,"unexpected symbol"); return; } } } static void primaryexp(LexState*ls,expdesc*v){ FuncState*fs=ls->fs; prefixexp(ls,v); for(;;){ switch(ls->t.token){ case'.':{ field(ls,v); break; } case'[':{ expdesc key; luaK_exp2anyreg(fs,v); yindex(ls,&key); luaK_indexed(fs,v,&key); break; } case':':{ expdesc key; luaX_next(ls); checkname(ls,&key); luaK_self(fs,v,&key); funcargs(ls,v); break; } case'(':case TK_STRING:case'{':{ luaK_exp2nextreg(fs,v); funcargs(ls,v); break; } default:return; } } } static void simpleexp(LexState*ls,expdesc*v){ switch(ls->t.token){ case TK_NUMBER:{ init_exp(v,VKNUM,0); v->u.nval=ls->t.seminfo.r; break; } case TK_STRING:{ codestring(ls,v,ls->t.seminfo.ts); break; } case TK_NIL:{ init_exp(v,VNIL,0); break; } case TK_TRUE:{ init_exp(v,VTRUE,0); break; } case TK_FALSE:{ init_exp(v,VFALSE,0); break; } case TK_DOTS:{ FuncState*fs=ls->fs; check_condition(ls,fs->f->is_vararg, "cannot use "LUA_QL("...")" outside a vararg function"); fs->f->is_vararg&=~4; init_exp(v,VVARARG,luaK_codeABC(fs,OP_VARARG,0,1,0)); break; } case'{':{ constructor(ls,v); return; } case TK_FUNCTION:{ luaX_next(ls); body(ls,v,0,ls->linenumber); return; } default:{ primaryexp(ls,v); return; } } luaX_next(ls); } static UnOpr getunopr(int op){ switch(op){ case TK_NOT:return OPR_NOT; case'-':return OPR_MINUS; case'#':return OPR_LEN; default:return OPR_NOUNOPR; } } static BinOpr getbinopr(int op){ switch(op){ case'+':return OPR_ADD; case'-':return OPR_SUB; case'*':return OPR_MUL; case'/':return OPR_DIV; case'%':return OPR_MOD; case'^':return OPR_POW; case TK_CONCAT:return OPR_CONCAT; case TK_NE:return OPR_NE; case TK_EQ:return OPR_EQ; case'<':return OPR_LT; case TK_LE:return OPR_LE; case'>':return OPR_GT; case TK_GE:return OPR_GE; case TK_AND:return OPR_AND; case TK_OR:return OPR_OR; default:return OPR_NOBINOPR; } } static const struct{ lu_byte left; lu_byte right; }priority[]={ {6,6},{6,6},{7,7},{7,7},{7,7}, {10,9},{5,4}, {3,3},{3,3}, {3,3},{3,3},{3,3},{3,3}, {2,2},{1,1} }; static BinOpr subexpr(LexState*ls,expdesc*v,unsigned int limit){ BinOpr op; UnOpr uop; enterlevel(ls); uop=getunopr(ls->t.token); if(uop!=OPR_NOUNOPR){ luaX_next(ls); subexpr(ls,v,8); luaK_prefix(ls->fs,uop,v); } else simpleexp(ls,v); op=getbinopr(ls->t.token); while(op!=OPR_NOBINOPR&&priority[op].left>limit){ expdesc v2; BinOpr nextop; luaX_next(ls); luaK_infix(ls->fs,op,v); nextop=subexpr(ls,&v2,priority[op].right); luaK_posfix(ls->fs,op,v,&v2); op=nextop; } leavelevel(ls); return op; } static void expr(LexState*ls,expdesc*v){ subexpr(ls,v,0); } static int block_follow(int token){ switch(token){ case TK_ELSE:case TK_ELSEIF:case TK_END: case TK_UNTIL:case TK_EOS: return 1; default:return 0; } } static void block(LexState*ls){ FuncState*fs=ls->fs; BlockCnt bl; enterblock(fs,&bl,0); chunk(ls); leaveblock(fs); } struct LHS_assign{ struct LHS_assign*prev; expdesc v; }; static void check_conflict(LexState*ls,struct LHS_assign*lh,expdesc*v){ FuncState*fs=ls->fs; int extra=fs->freereg; int conflict=0; for(;lh;lh=lh->prev){ if(lh->v.k==VINDEXED){ if(lh->v.u.s.info==v->u.s.info){ conflict=1; lh->v.u.s.info=extra; } if(lh->v.u.s.aux==v->u.s.info){ conflict=1; lh->v.u.s.aux=extra; } } } if(conflict){ luaK_codeABC(fs,OP_MOVE,fs->freereg,v->u.s.info,0); luaK_reserveregs(fs,1); } } static void assignment(LexState*ls,struct LHS_assign*lh,int nvars){ expdesc e; check_condition(ls,VLOCAL<=lh->v.k&&lh->v.k<=VINDEXED, "syntax error"); if(testnext(ls,',')){ struct LHS_assign nv; nv.prev=lh; primaryexp(ls,&nv.v); if(nv.v.k==VLOCAL) check_conflict(ls,lh,&nv.v); luaY_checklimit(ls->fs,nvars,200-ls->L->nCcalls, "variables in assignment"); assignment(ls,&nv,nvars+1); } else{ int nexps; checknext(ls,'='); nexps=explist1(ls,&e); if(nexps!=nvars){ adjust_assign(ls,nvars,nexps,&e); if(nexps>nvars) ls->fs->freereg-=nexps-nvars; } else{ luaK_setoneret(ls->fs,&e); luaK_storevar(ls->fs,&lh->v,&e); return; } } init_exp(&e,VNONRELOC,ls->fs->freereg-1); luaK_storevar(ls->fs,&lh->v,&e); } static int cond(LexState*ls){ expdesc v; expr(ls,&v); if(v.k==VNIL)v.k=VFALSE; luaK_goiftrue(ls->fs,&v); return v.f; } static void breakstat(LexState*ls){ FuncState*fs=ls->fs; BlockCnt*bl=fs->bl; int upval=0; while(bl&&!bl->isbreakable){ upval|=bl->upval; bl=bl->previous; } if(!bl) luaX_syntaxerror(ls,"no loop to break"); if(upval) luaK_codeABC(fs,OP_CLOSE,bl->nactvar,0,0); luaK_concat(fs,&bl->breaklist,luaK_jump(fs)); } static void whilestat(LexState*ls,int line){ FuncState*fs=ls->fs; int whileinit; int condexit; BlockCnt bl; luaX_next(ls); whileinit=luaK_getlabel(fs); condexit=cond(ls); enterblock(fs,&bl,1); checknext(ls,TK_DO); block(ls); luaK_patchlist(fs,luaK_jump(fs),whileinit); check_match(ls,TK_END,TK_WHILE,line); leaveblock(fs); luaK_patchtohere(fs,condexit); } static void repeatstat(LexState*ls,int line){ int condexit; FuncState*fs=ls->fs; int repeat_init=luaK_getlabel(fs); BlockCnt bl1,bl2; enterblock(fs,&bl1,1); enterblock(fs,&bl2,0); luaX_next(ls); chunk(ls); check_match(ls,TK_UNTIL,TK_REPEAT,line); condexit=cond(ls); if(!bl2.upval){ leaveblock(fs); luaK_patchlist(ls->fs,condexit,repeat_init); } else{ breakstat(ls); luaK_patchtohere(ls->fs,condexit); leaveblock(fs); luaK_patchlist(ls->fs,luaK_jump(fs),repeat_init); } leaveblock(fs); } static int exp1(LexState*ls){ expdesc e; int k; expr(ls,&e); k=e.k; luaK_exp2nextreg(ls->fs,&e); return k; } static void forbody(LexState*ls,int base,int line,int nvars,int isnum){ BlockCnt bl; FuncState*fs=ls->fs; int prep,endfor; adjustlocalvars(ls,3); checknext(ls,TK_DO); prep=isnum?luaK_codeAsBx(fs,OP_FORPREP,base,(-1)):luaK_jump(fs); enterblock(fs,&bl,0); adjustlocalvars(ls,nvars); luaK_reserveregs(fs,nvars); block(ls); leaveblock(fs); luaK_patchtohere(fs,prep); endfor=(isnum)?luaK_codeAsBx(fs,OP_FORLOOP,base,(-1)): luaK_codeABC(fs,OP_TFORLOOP,base,0,nvars); luaK_fixline(fs,line); luaK_patchlist(fs,(isnum?endfor:luaK_jump(fs)),prep+1); } static void fornum(LexState*ls,TString*varname,int line){ FuncState*fs=ls->fs; int base=fs->freereg; new_localvarliteral(ls,"(for index)",0); new_localvarliteral(ls,"(for limit)",1); new_localvarliteral(ls,"(for step)",2); new_localvar(ls,varname,3); checknext(ls,'='); exp1(ls); checknext(ls,','); exp1(ls); if(testnext(ls,',')) exp1(ls); else{ luaK_codeABx(fs,OP_LOADK,fs->freereg,luaK_numberK(fs,1)); luaK_reserveregs(fs,1); } forbody(ls,base,line,1,1); } static void forlist(LexState*ls,TString*indexname){ FuncState*fs=ls->fs; expdesc e; int nvars=0; int line; int base=fs->freereg; new_localvarliteral(ls,"(for generator)",nvars++); new_localvarliteral(ls,"(for state)",nvars++); new_localvarliteral(ls,"(for control)",nvars++); new_localvar(ls,indexname,nvars++); while(testnext(ls,',')) new_localvar(ls,str_checkname(ls),nvars++); checknext(ls,TK_IN); line=ls->linenumber; adjust_assign(ls,3,explist1(ls,&e),&e); luaK_checkstack(fs,3); forbody(ls,base,line,nvars-3,0); } static void forstat(LexState*ls,int line){ FuncState*fs=ls->fs; TString*varname; BlockCnt bl; enterblock(fs,&bl,1); luaX_next(ls); varname=str_checkname(ls); switch(ls->t.token){ case'=':fornum(ls,varname,line);break; case',':case TK_IN:forlist(ls,varname);break; default:luaX_syntaxerror(ls,LUA_QL("=")" or "LUA_QL("in")" expected"); } check_match(ls,TK_END,TK_FOR,line); leaveblock(fs); } static int test_then_block(LexState*ls){ int condexit; luaX_next(ls); condexit=cond(ls); checknext(ls,TK_THEN); block(ls); return condexit; } static void ifstat(LexState*ls,int line){ FuncState*fs=ls->fs; int flist; int escapelist=(-1); flist=test_then_block(ls); while(ls->t.token==TK_ELSEIF){ luaK_concat(fs,&escapelist,luaK_jump(fs)); luaK_patchtohere(fs,flist); flist=test_then_block(ls); } if(ls->t.token==TK_ELSE){ luaK_concat(fs,&escapelist,luaK_jump(fs)); luaK_patchtohere(fs,flist); luaX_next(ls); block(ls); } else luaK_concat(fs,&escapelist,flist); luaK_patchtohere(fs,escapelist); check_match(ls,TK_END,TK_IF,line); } static void localfunc(LexState*ls){ expdesc v,b; FuncState*fs=ls->fs; new_localvar(ls,str_checkname(ls),0); init_exp(&v,VLOCAL,fs->freereg); luaK_reserveregs(fs,1); adjustlocalvars(ls,1); body(ls,&b,0,ls->linenumber); luaK_storevar(fs,&v,&b); getlocvar(fs,fs->nactvar-1).startpc=fs->pc; } static void localstat(LexState*ls){ int nvars=0; int nexps; expdesc e; do{ new_localvar(ls,str_checkname(ls),nvars++); }while(testnext(ls,',')); if(testnext(ls,'=')) nexps=explist1(ls,&e); else{ e.k=VVOID; nexps=0; } adjust_assign(ls,nvars,nexps,&e); adjustlocalvars(ls,nvars); } static int funcname(LexState*ls,expdesc*v){ int needself=0; singlevar(ls,v); while(ls->t.token=='.') field(ls,v); if(ls->t.token==':'){ needself=1; field(ls,v); } return needself; } static void funcstat(LexState*ls,int line){ int needself; expdesc v,b; luaX_next(ls); needself=funcname(ls,&v); body(ls,&b,needself,line); luaK_storevar(ls->fs,&v,&b); luaK_fixline(ls->fs,line); } static void exprstat(LexState*ls){ FuncState*fs=ls->fs; struct LHS_assign v; primaryexp(ls,&v.v); if(v.v.k==VCALL) SETARG_C(getcode(fs,&v.v),1); else{ v.prev=NULL; assignment(ls,&v,1); } } static void retstat(LexState*ls){ FuncState*fs=ls->fs; expdesc e; int first,nret; luaX_next(ls); if(block_follow(ls->t.token)||ls->t.token==';') first=nret=0; else{ nret=explist1(ls,&e); if(hasmultret(e.k)){ luaK_setmultret(fs,&e); if(e.k==VCALL&&nret==1){ SET_OPCODE(getcode(fs,&e),OP_TAILCALL); } first=fs->nactvar; nret=(-1); } else{ if(nret==1) first=luaK_exp2anyreg(fs,&e); else{ luaK_exp2nextreg(fs,&e); first=fs->nactvar; } } } luaK_ret(fs,first,nret); } static int statement(LexState*ls){ int line=ls->linenumber; switch(ls->t.token){ case TK_IF:{ ifstat(ls,line); return 0; } case TK_WHILE:{ whilestat(ls,line); return 0; } case TK_DO:{ luaX_next(ls); block(ls); check_match(ls,TK_END,TK_DO,line); return 0; } case TK_FOR:{ forstat(ls,line); return 0; } case TK_REPEAT:{ repeatstat(ls,line); return 0; } case TK_FUNCTION:{ funcstat(ls,line); return 0; } case TK_LOCAL:{ luaX_next(ls); if(testnext(ls,TK_FUNCTION)) localfunc(ls); else localstat(ls); return 0; } case TK_RETURN:{ retstat(ls); return 1; } case TK_BREAK:{ luaX_next(ls); breakstat(ls); return 1; } default:{ exprstat(ls); return 0; } } } static void chunk(LexState*ls){ int islast=0; enterlevel(ls); while(!islast&&!block_follow(ls->t.token)){ islast=statement(ls); testnext(ls,';'); ls->fs->freereg=ls->fs->nactvar; } leavelevel(ls); } static const TValue*luaV_tonumber(const TValue*obj,TValue*n){ lua_Number num; if(ttisnumber(obj))return obj; if(ttisstring(obj)&&luaO_str2d(svalue(obj),&num)){ setnvalue(n,num); return n; } else return NULL; } static int luaV_tostring(lua_State*L,StkId obj){ if(!ttisnumber(obj)) return 0; else{ char s[32]; lua_Number n=nvalue(obj); lua_number2str(s,n); setsvalue(L,obj,luaS_new(L,s)); return 1; } } static void callTMres(lua_State*L,StkId res,const TValue*f, const TValue*p1,const TValue*p2){ ptrdiff_t result=savestack(L,res); setobj(L,L->top,f); setobj(L,L->top+1,p1); setobj(L,L->top+2,p2); luaD_checkstack(L,3); L->top+=3; luaD_call(L,L->top-3,1); res=restorestack(L,result); L->top--; setobj(L,res,L->top); } static void callTM(lua_State*L,const TValue*f,const TValue*p1, const TValue*p2,const TValue*p3){ setobj(L,L->top,f); setobj(L,L->top+1,p1); setobj(L,L->top+2,p2); setobj(L,L->top+3,p3); luaD_checkstack(L,4); L->top+=4; luaD_call(L,L->top-4,0); } static void luaV_gettable(lua_State*L,const TValue*t,TValue*key,StkId val){ int loop; for(loop=0;loop<100;loop++){ const TValue*tm; if(ttistable(t)){ Table*h=hvalue(t); const TValue*res=luaH_get(h,key); if(!ttisnil(res)|| (tm=fasttm(L,h->metatable,TM_INDEX))==NULL){ setobj(L,val,res); return; } } else if(ttisnil(tm=luaT_gettmbyobj(L,t,TM_INDEX))) luaG_typeerror(L,t,"index"); if(ttisfunction(tm)){ callTMres(L,val,tm,t,key); return; } t=tm; } luaG_runerror(L,"loop in gettable"); } static void luaV_settable(lua_State*L,const TValue*t,TValue*key,StkId val){ int loop; TValue temp; for(loop=0;loop<100;loop++){ const TValue*tm; if(ttistable(t)){ Table*h=hvalue(t); TValue*oldval=luaH_set(L,h,key); if(!ttisnil(oldval)|| (tm=fasttm(L,h->metatable,TM_NEWINDEX))==NULL){ setobj(L,oldval,val); h->flags=0; luaC_barriert(L,h,val); return; } } else if(ttisnil(tm=luaT_gettmbyobj(L,t,TM_NEWINDEX))) luaG_typeerror(L,t,"index"); if(ttisfunction(tm)){ callTM(L,tm,t,key,val); return; } setobj(L,&temp,tm); t=&temp; } luaG_runerror(L,"loop in settable"); } static int call_binTM(lua_State*L,const TValue*p1,const TValue*p2, StkId res,TMS event){ const TValue*tm=luaT_gettmbyobj(L,p1,event); if(ttisnil(tm)) tm=luaT_gettmbyobj(L,p2,event); if(ttisnil(tm))return 0; callTMres(L,res,tm,p1,p2); return 1; } static const TValue*get_compTM(lua_State*L,Table*mt1,Table*mt2, TMS event){ const TValue*tm1=fasttm(L,mt1,event); const TValue*tm2; if(tm1==NULL)return NULL; if(mt1==mt2)return tm1; tm2=fasttm(L,mt2,event); if(tm2==NULL)return NULL; if(luaO_rawequalObj(tm1,tm2)) return tm1; return NULL; } static int call_orderTM(lua_State*L,const TValue*p1,const TValue*p2, TMS event){ const TValue*tm1=luaT_gettmbyobj(L,p1,event); const TValue*tm2; if(ttisnil(tm1))return-1; tm2=luaT_gettmbyobj(L,p2,event); if(!luaO_rawequalObj(tm1,tm2)) return-1; callTMres(L,L->top,tm1,p1,p2); return!l_isfalse(L->top); } static int l_strcmp(const TString*ls,const TString*rs){ const char*l=getstr(ls); size_t ll=ls->tsv.len; const char*r=getstr(rs); size_t lr=rs->tsv.len; for(;;){ int temp=strcoll(l,r); if(temp!=0)return temp; else{ size_t len=strlen(l); if(len==lr) return(len==ll)?0:1; else if(len==ll) return-1; len++; l+=len;ll-=len;r+=len;lr-=len; } } } static int luaV_lessthan(lua_State*L,const TValue*l,const TValue*r){ int res; if(ttype(l)!=ttype(r)) return luaG_ordererror(L,l,r); else if(ttisnumber(l)) return luai_numlt(nvalue(l),nvalue(r)); else if(ttisstring(l)) return l_strcmp(rawtsvalue(l),rawtsvalue(r))<0; else if((res=call_orderTM(L,l,r,TM_LT))!=-1) return res; return luaG_ordererror(L,l,r); } static int lessequal(lua_State*L,const TValue*l,const TValue*r){ int res; if(ttype(l)!=ttype(r)) return luaG_ordererror(L,l,r); else if(ttisnumber(l)) return luai_numle(nvalue(l),nvalue(r)); else if(ttisstring(l)) return l_strcmp(rawtsvalue(l),rawtsvalue(r))<=0; else if((res=call_orderTM(L,l,r,TM_LE))!=-1) return res; else if((res=call_orderTM(L,r,l,TM_LT))!=-1) return!res; return luaG_ordererror(L,l,r); } static int luaV_equalval(lua_State*L,const TValue*t1,const TValue*t2){ const TValue*tm; switch(ttype(t1)){ case 0:return 1; case 3:return luai_numeq(nvalue(t1),nvalue(t2)); case 1:return bvalue(t1)==bvalue(t2); case 2:return pvalue(t1)==pvalue(t2); case 7:{ if(uvalue(t1)==uvalue(t2))return 1; tm=get_compTM(L,uvalue(t1)->metatable,uvalue(t2)->metatable, TM_EQ); break; } case 5:{ if(hvalue(t1)==hvalue(t2))return 1; tm=get_compTM(L,hvalue(t1)->metatable,hvalue(t2)->metatable,TM_EQ); break; } default:return gcvalue(t1)==gcvalue(t2); } if(tm==NULL)return 0; callTMres(L,L->top,tm,t1,t2); return!l_isfalse(L->top); } static void luaV_concat(lua_State*L,int total,int last){ do{ StkId top=L->base+last+1; int n=2; if(!(ttisstring(top-2)||ttisnumber(top-2))||!tostring(L,top-1)){ if(!call_binTM(L,top-2,top-1,top-2,TM_CONCAT)) luaG_concaterror(L,top-2,top-1); }else if(tsvalue(top-1)->len==0) (void)tostring(L,top-2); else{ size_t tl=tsvalue(top-1)->len; char*buffer; int i; for(n=1;nlen; if(l>=((size_t)(~(size_t)0)-2)-tl)luaG_runerror(L,"string length overflow"); tl+=l; } buffer=luaZ_openspace(L,&G(L)->buff,tl); tl=0; for(i=n;i>0;i--){ size_t l=tsvalue(top-i)->len; memcpy(buffer+tl,svalue(top-i),l); tl+=l; } setsvalue(L,top-n,luaS_newlstr(L,buffer,tl)); } total-=n-1; last-=n-1; }while(total>1); } static void Arith(lua_State*L,StkId ra,const TValue*rb, const TValue*rc,TMS op){ TValue tempb,tempc; const TValue*b,*c; if((b=luaV_tonumber(rb,&tempb))!=NULL&& (c=luaV_tonumber(rc,&tempc))!=NULL){ lua_Number nb=nvalue(b),nc=nvalue(c); switch(op){ case TM_ADD:setnvalue(ra,luai_numadd(nb,nc));break; case TM_SUB:setnvalue(ra,luai_numsub(nb,nc));break; case TM_MUL:setnvalue(ra,luai_nummul(nb,nc));break; case TM_DIV:setnvalue(ra,luai_numdiv(nb,nc));break; case TM_MOD:setnvalue(ra,luai_nummod(nb,nc));break; case TM_POW:setnvalue(ra,luai_numpow(nb,nc));break; case TM_UNM:setnvalue(ra,luai_numunm(nb));break; default:break; } } else if(!call_binTM(L,rb,rc,ra,op)) luaG_aritherror(L,rb,rc); } #define runtime_check(L,c){if(!(c))break;} #define RA(i)(base+GETARG_A(i)) #define RB(i)check_exp(getBMode(GET_OPCODE(i))==OpArgR,base+GETARG_B(i)) #define RKB(i)check_exp(getBMode(GET_OPCODE(i))==OpArgK,ISK(GETARG_B(i))?k+INDEXK(GETARG_B(i)):base+GETARG_B(i)) #define RKC(i)check_exp(getCMode(GET_OPCODE(i))==OpArgK,ISK(GETARG_C(i))?k+INDEXK(GETARG_C(i)):base+GETARG_C(i)) #define KBx(i)check_exp(getBMode(GET_OPCODE(i))==OpArgK,k+GETARG_Bx(i)) #define dojump(L,pc,i){(pc)+=(i);} #define Protect(x){L->savedpc=pc;{x;};base=L->base;} #define arith_op(op,tm){TValue*rb=RKB(i);TValue*rc=RKC(i);if(ttisnumber(rb)&&ttisnumber(rc)){lua_Number nb=nvalue(rb),nc=nvalue(rc);setnvalue(ra,op(nb,nc));}else Protect(Arith(L,ra,rb,rc,tm));} static void luaV_execute(lua_State*L,int nexeccalls){ LClosure*cl; StkId base; TValue*k; const Instruction*pc; reentry: pc=L->savedpc; cl=&clvalue(L->ci->func)->l; base=L->base; k=cl->p->k; for(;;){ const Instruction i=*pc++; StkId ra; ra=RA(i); switch(GET_OPCODE(i)){ case OP_MOVE:{ setobj(L,ra,RB(i)); continue; } case OP_LOADK:{ setobj(L,ra,KBx(i)); continue; } case OP_LOADBOOL:{ setbvalue(ra,GETARG_B(i)); if(GETARG_C(i))pc++; continue; } case OP_LOADNIL:{ TValue*rb=RB(i); do{ setnilvalue(rb--); }while(rb>=ra); continue; } case OP_GETUPVAL:{ int b=GETARG_B(i); setobj(L,ra,cl->upvals[b]->v); continue; } case OP_GETGLOBAL:{ TValue g; TValue*rb=KBx(i); sethvalue(L,&g,cl->env); Protect(luaV_gettable(L,&g,rb,ra)); continue; } case OP_GETTABLE:{ Protect(luaV_gettable(L,RB(i),RKC(i),ra)); continue; } case OP_SETGLOBAL:{ TValue g; sethvalue(L,&g,cl->env); Protect(luaV_settable(L,&g,KBx(i),ra)); continue; } case OP_SETUPVAL:{ UpVal*uv=cl->upvals[GETARG_B(i)]; setobj(L,uv->v,ra); luaC_barrier(L,uv,ra); continue; } case OP_SETTABLE:{ Protect(luaV_settable(L,ra,RKB(i),RKC(i))); continue; } case OP_NEWTABLE:{ int b=GETARG_B(i); int c=GETARG_C(i); sethvalue(L,ra,luaH_new(L,luaO_fb2int(b),luaO_fb2int(c))); Protect(luaC_checkGC(L)); continue; } case OP_SELF:{ StkId rb=RB(i); setobj(L,ra+1,rb); Protect(luaV_gettable(L,rb,RKC(i),ra)); continue; } case OP_ADD:{ arith_op(luai_numadd,TM_ADD); continue; } case OP_SUB:{ arith_op(luai_numsub,TM_SUB); continue; } case OP_MUL:{ arith_op(luai_nummul,TM_MUL); continue; } case OP_DIV:{ arith_op(luai_numdiv,TM_DIV); continue; } case OP_MOD:{ arith_op(luai_nummod,TM_MOD); continue; } case OP_POW:{ arith_op(luai_numpow,TM_POW); continue; } case OP_UNM:{ TValue*rb=RB(i); if(ttisnumber(rb)){ lua_Number nb=nvalue(rb); setnvalue(ra,luai_numunm(nb)); } else{ Protect(Arith(L,ra,rb,rb,TM_UNM)); } continue; } case OP_NOT:{ int res=l_isfalse(RB(i)); setbvalue(ra,res); continue; } case OP_LEN:{ const TValue*rb=RB(i); switch(ttype(rb)){ case 5:{ setnvalue(ra,cast_num(luaH_getn(hvalue(rb)))); break; } case 4:{ setnvalue(ra,cast_num(tsvalue(rb)->len)); break; } default:{ Protect( if(!call_binTM(L,rb,(&luaO_nilobject_),ra,TM_LEN)) luaG_typeerror(L,rb,"get length of"); ) } } continue; } case OP_CONCAT:{ int b=GETARG_B(i); int c=GETARG_C(i); Protect(luaV_concat(L,c-b+1,c);luaC_checkGC(L)); setobj(L,RA(i),base+b); continue; } case OP_JMP:{ dojump(L,pc,GETARG_sBx(i)); continue; } case OP_EQ:{ TValue*rb=RKB(i); TValue*rc=RKC(i); Protect( if(equalobj(L,rb,rc)==GETARG_A(i)) dojump(L,pc,GETARG_sBx(*pc)); ) pc++; continue; } case OP_LT:{ Protect( if(luaV_lessthan(L,RKB(i),RKC(i))==GETARG_A(i)) dojump(L,pc,GETARG_sBx(*pc)); ) pc++; continue; } case OP_LE:{ Protect( if(lessequal(L,RKB(i),RKC(i))==GETARG_A(i)) dojump(L,pc,GETARG_sBx(*pc)); ) pc++; continue; } case OP_TEST:{ if(l_isfalse(ra)!=GETARG_C(i)) dojump(L,pc,GETARG_sBx(*pc)); pc++; continue; } case OP_TESTSET:{ TValue*rb=RB(i); if(l_isfalse(rb)!=GETARG_C(i)){ setobj(L,ra,rb); dojump(L,pc,GETARG_sBx(*pc)); } pc++; continue; } case OP_CALL:{ int b=GETARG_B(i); int nresults=GETARG_C(i)-1; if(b!=0)L->top=ra+b; L->savedpc=pc; switch(luaD_precall(L,ra,nresults)){ case 0:{ nexeccalls++; goto reentry; } case 1:{ if(nresults>=0)L->top=L->ci->top; base=L->base; continue; } default:{ return; } } } case OP_TAILCALL:{ int b=GETARG_B(i); if(b!=0)L->top=ra+b; L->savedpc=pc; switch(luaD_precall(L,ra,(-1))){ case 0:{ CallInfo*ci=L->ci-1; int aux; StkId func=ci->func; StkId pfunc=(ci+1)->func; if(L->openupval)luaF_close(L,ci->base); L->base=ci->base=ci->func+((ci+1)->base-pfunc); for(aux=0;pfunc+auxtop;aux++) setobj(L,func+aux,pfunc+aux); ci->top=L->top=func+aux; ci->savedpc=L->savedpc; ci->tailcalls++; L->ci--; goto reentry; } case 1:{ base=L->base; continue; } default:{ return; } } } case OP_RETURN:{ int b=GETARG_B(i); if(b!=0)L->top=ra+b-1; if(L->openupval)luaF_close(L,base); L->savedpc=pc; b=luaD_poscall(L,ra); if(--nexeccalls==0) return; else{ if(b)L->top=L->ci->top; goto reentry; } } case OP_FORLOOP:{ lua_Number step=nvalue(ra+2); lua_Number idx=luai_numadd(nvalue(ra),step); lua_Number limit=nvalue(ra+1); if(luai_numlt(0,step)?luai_numle(idx,limit) :luai_numle(limit,idx)){ dojump(L,pc,GETARG_sBx(i)); setnvalue(ra,idx); setnvalue(ra+3,idx); } continue; } case OP_FORPREP:{ const TValue*init=ra; const TValue*plimit=ra+1; const TValue*pstep=ra+2; L->savedpc=pc; if(!tonumber(init,ra)) luaG_runerror(L,LUA_QL("for")" initial value must be a number"); else if(!tonumber(plimit,ra+1)) luaG_runerror(L,LUA_QL("for")" limit must be a number"); else if(!tonumber(pstep,ra+2)) luaG_runerror(L,LUA_QL("for")" step must be a number"); setnvalue(ra,luai_numsub(nvalue(ra),nvalue(pstep))); dojump(L,pc,GETARG_sBx(i)); continue; } case OP_TFORLOOP:{ StkId cb=ra+3; setobj(L,cb+2,ra+2); setobj(L,cb+1,ra+1); setobj(L,cb,ra); L->top=cb+3; Protect(luaD_call(L,cb,GETARG_C(i))); L->top=L->ci->top; cb=RA(i)+3; if(!ttisnil(cb)){ setobj(L,cb-1,cb); dojump(L,pc,GETARG_sBx(*pc)); } pc++; continue; } case OP_SETLIST:{ int n=GETARG_B(i); int c=GETARG_C(i); int last; Table*h; if(n==0){ n=cast_int(L->top-ra)-1; L->top=L->ci->top; } if(c==0)c=cast_int(*pc++); runtime_check(L,ttistable(ra)); h=hvalue(ra); last=((c-1)*50)+n; if(last>h->sizearray) luaH_resizearray(L,h,last); for(;n>0;n--){ TValue*val=ra+n; setobj(L,luaH_setnum(L,h,last--),val); luaC_barriert(L,h,val); } continue; } case OP_CLOSE:{ luaF_close(L,ra); continue; } case OP_CLOSURE:{ Proto*p; Closure*ncl; int nup,j; p=cl->p->p[GETARG_Bx(i)]; nup=p->nups; ncl=luaF_newLclosure(L,nup,cl->env); ncl->l.p=p; for(j=0;jl.upvals[j]=cl->upvals[GETARG_B(*pc)]; else{ ncl->l.upvals[j]=luaF_findupval(L,base+GETARG_B(*pc)); } } setclvalue(L,ra,ncl); Protect(luaC_checkGC(L)); continue; } case OP_VARARG:{ int b=GETARG_B(i)-1; int j; CallInfo*ci=L->ci; int n=cast_int(ci->base-ci->func)-cl->p->numparams-1; if(b==(-1)){ Protect(luaD_checkstack(L,n)); ra=RA(i); b=n; L->top=ra+n; } for(j=0;jbase-n+j); } else{ setnilvalue(ra+j); } } continue; } } } } #define api_checknelems(L,n)luai_apicheck(L,(n)<=(L->top-L->base)) #define api_checkvalidindex(L,i)luai_apicheck(L,(i)!=(&luaO_nilobject_)) #define api_incr_top(L){luai_apicheck(L,L->topci->top);L->top++;} static TValue*index2adr(lua_State*L,int idx){ if(idx>0){ TValue*o=L->base+(idx-1); luai_apicheck(L,idx<=L->ci->top-L->base); if(o>=L->top)return cast(TValue*,(&luaO_nilobject_)); else return o; } else if(idx>(-10000)){ luai_apicheck(L,idx!=0&&-idx<=L->top-L->base); return L->top+idx; } else switch(idx){ case(-10000):return registry(L); case(-10001):{ Closure*func=curr_func(L); sethvalue(L,&L->env,func->c.env); return&L->env; } case(-10002):return gt(L); default:{ Closure*func=curr_func(L); idx=(-10002)-idx; return(idx<=func->c.nupvalues) ?&func->c.upvalue[idx-1] :cast(TValue*,(&luaO_nilobject_)); } } } static Table*getcurrenv(lua_State*L){ if(L->ci==L->base_ci) return hvalue(gt(L)); else{ Closure*func=curr_func(L); return func->c.env; } } static int lua_checkstack(lua_State*L,int size){ int res=1; if(size>8000||(L->top-L->base+size)>8000) res=0; else if(size>0){ luaD_checkstack(L,size); if(L->ci->toptop+size) L->ci->top=L->top+size; } return res; } static lua_CFunction lua_atpanic(lua_State*L,lua_CFunction panicf){ lua_CFunction old; old=G(L)->panic; G(L)->panic=panicf; return old; } static int lua_gettop(lua_State*L){ return cast_int(L->top-L->base); } static void lua_settop(lua_State*L,int idx){ if(idx>=0){ luai_apicheck(L,idx<=L->stack_last-L->base); while(L->topbase+idx) setnilvalue(L->top++); L->top=L->base+idx; } else{ luai_apicheck(L,-(idx+1)<=(L->top-L->base)); L->top+=idx+1; } } static void lua_remove(lua_State*L,int idx){ StkId p; p=index2adr(L,idx); api_checkvalidindex(L,p); while(++ptop)setobj(L,p-1,p); L->top--; } static void lua_insert(lua_State*L,int idx){ StkId p; StkId q; p=index2adr(L,idx); api_checkvalidindex(L,p); for(q=L->top;q>p;q--)setobj(L,q,q-1); setobj(L,p,L->top); } static void lua_replace(lua_State*L,int idx){ StkId o; if(idx==(-10001)&&L->ci==L->base_ci) luaG_runerror(L,"no calling environment"); api_checknelems(L,1); o=index2adr(L,idx); api_checkvalidindex(L,o); if(idx==(-10001)){ Closure*func=curr_func(L); luai_apicheck(L,ttistable(L->top-1)); func->c.env=hvalue(L->top-1); luaC_barrier(L,func,L->top-1); } else{ setobj(L,o,L->top-1); if(idx<(-10002)) luaC_barrier(L,curr_func(L),L->top-1); } L->top--; } static void lua_pushvalue(lua_State*L,int idx){ setobj(L,L->top,index2adr(L,idx)); api_incr_top(L); } static int lua_type(lua_State*L,int idx){ StkId o=index2adr(L,idx); return(o==(&luaO_nilobject_))?(-1):ttype(o); } static const char*lua_typename(lua_State*L,int t){ UNUSED(L); return(t==(-1))?"no value":luaT_typenames[t]; } static int lua_iscfunction(lua_State*L,int idx){ StkId o=index2adr(L,idx); return iscfunction(o); } static int lua_isnumber(lua_State*L,int idx){ TValue n; const TValue*o=index2adr(L,idx); return tonumber(o,&n); } static int lua_isstring(lua_State*L,int idx){ int t=lua_type(L,idx); return(t==4||t==3); } static int lua_rawequal(lua_State*L,int index1,int index2){ StkId o1=index2adr(L,index1); StkId o2=index2adr(L,index2); return(o1==(&luaO_nilobject_)||o2==(&luaO_nilobject_))?0 :luaO_rawequalObj(o1,o2); } static int lua_lessthan(lua_State*L,int index1,int index2){ StkId o1,o2; int i; o1=index2adr(L,index1); o2=index2adr(L,index2); i=(o1==(&luaO_nilobject_)||o2==(&luaO_nilobject_))?0 :luaV_lessthan(L,o1,o2); return i; } static lua_Number lua_tonumber(lua_State*L,int idx){ TValue n; const TValue*o=index2adr(L,idx); if(tonumber(o,&n)) return nvalue(o); else return 0; } static lua_Integer lua_tointeger(lua_State*L,int idx){ TValue n; const TValue*o=index2adr(L,idx); if(tonumber(o,&n)){ lua_Integer res; lua_Number num=nvalue(o); lua_number2integer(res,num); return res; } else return 0; } static int lua_toboolean(lua_State*L,int idx){ const TValue*o=index2adr(L,idx); return!l_isfalse(o); } static const char*lua_tolstring(lua_State*L,int idx,size_t*len){ StkId o=index2adr(L,idx); if(!ttisstring(o)){ if(!luaV_tostring(L,o)){ if(len!=NULL)*len=0; return NULL; } luaC_checkGC(L); o=index2adr(L,idx); } if(len!=NULL)*len=tsvalue(o)->len; return svalue(o); } static size_t lua_objlen(lua_State*L,int idx){ StkId o=index2adr(L,idx); switch(ttype(o)){ case 4:return tsvalue(o)->len; case 7:return uvalue(o)->len; case 5:return luaH_getn(hvalue(o)); case 3:{ size_t l; l=(luaV_tostring(L,o)?tsvalue(o)->len:0); return l; } default:return 0; } } static lua_CFunction lua_tocfunction(lua_State*L,int idx){ StkId o=index2adr(L,idx); return(!iscfunction(o))?NULL:clvalue(o)->c.f; } static void*lua_touserdata(lua_State*L,int idx){ StkId o=index2adr(L,idx); switch(ttype(o)){ case 7:return(rawuvalue(o)+1); case 2:return pvalue(o); default:return NULL; } } static void lua_pushnil(lua_State*L){ setnilvalue(L->top); api_incr_top(L); } static void lua_pushnumber(lua_State*L,lua_Number n){ setnvalue(L->top,n); api_incr_top(L); } static void lua_pushinteger(lua_State*L,lua_Integer n){ setnvalue(L->top,cast_num(n)); api_incr_top(L); } static void lua_pushlstring(lua_State*L,const char*s,size_t len){ luaC_checkGC(L); setsvalue(L,L->top,luaS_newlstr(L,s,len)); api_incr_top(L); } static void lua_pushstring(lua_State*L,const char*s){ if(s==NULL) lua_pushnil(L); else lua_pushlstring(L,s,strlen(s)); } static const char*lua_pushvfstring(lua_State*L,const char*fmt, va_list argp){ const char*ret; luaC_checkGC(L); ret=luaO_pushvfstring(L,fmt,argp); return ret; } static const char*lua_pushfstring(lua_State*L,const char*fmt,...){ const char*ret; va_list argp; luaC_checkGC(L); va_start(argp,fmt); ret=luaO_pushvfstring(L,fmt,argp); va_end(argp); return ret; } static void lua_pushcclosure(lua_State*L,lua_CFunction fn,int n){ Closure*cl; luaC_checkGC(L); api_checknelems(L,n); cl=luaF_newCclosure(L,n,getcurrenv(L)); cl->c.f=fn; L->top-=n; while(n--) setobj(L,&cl->c.upvalue[n],L->top+n); setclvalue(L,L->top,cl); api_incr_top(L); } static void lua_pushboolean(lua_State*L,int b){ setbvalue(L->top,(b!=0)); api_incr_top(L); } static int lua_pushthread(lua_State*L){ setthvalue(L,L->top,L); api_incr_top(L); return(G(L)->mainthread==L); } static void lua_gettable(lua_State*L,int idx){ StkId t; t=index2adr(L,idx); api_checkvalidindex(L,t); luaV_gettable(L,t,L->top-1,L->top-1); } static void lua_getfield(lua_State*L,int idx,const char*k){ StkId t; TValue key; t=index2adr(L,idx); api_checkvalidindex(L,t); setsvalue(L,&key,luaS_new(L,k)); luaV_gettable(L,t,&key,L->top); api_incr_top(L); } static void lua_rawget(lua_State*L,int idx){ StkId t; t=index2adr(L,idx); luai_apicheck(L,ttistable(t)); setobj(L,L->top-1,luaH_get(hvalue(t),L->top-1)); } static void lua_rawgeti(lua_State*L,int idx,int n){ StkId o; o=index2adr(L,idx); luai_apicheck(L,ttistable(o)); setobj(L,L->top,luaH_getnum(hvalue(o),n)); api_incr_top(L); } static void lua_createtable(lua_State*L,int narray,int nrec){ luaC_checkGC(L); sethvalue(L,L->top,luaH_new(L,narray,nrec)); api_incr_top(L); } static int lua_getmetatable(lua_State*L,int objindex){ const TValue*obj; Table*mt=NULL; int res; obj=index2adr(L,objindex); switch(ttype(obj)){ case 5: mt=hvalue(obj)->metatable; break; case 7: mt=uvalue(obj)->metatable; break; default: mt=G(L)->mt[ttype(obj)]; break; } if(mt==NULL) res=0; else{ sethvalue(L,L->top,mt); api_incr_top(L); res=1; } return res; } static void lua_getfenv(lua_State*L,int idx){ StkId o; o=index2adr(L,idx); api_checkvalidindex(L,o); switch(ttype(o)){ case 6: sethvalue(L,L->top,clvalue(o)->c.env); break; case 7: sethvalue(L,L->top,uvalue(o)->env); break; case 8: setobj(L,L->top,gt(thvalue(o))); break; default: setnilvalue(L->top); break; } api_incr_top(L); } static void lua_settable(lua_State*L,int idx){ StkId t; api_checknelems(L,2); t=index2adr(L,idx); api_checkvalidindex(L,t); luaV_settable(L,t,L->top-2,L->top-1); L->top-=2; } static void lua_setfield(lua_State*L,int idx,const char*k){ StkId t; TValue key; api_checknelems(L,1); t=index2adr(L,idx); api_checkvalidindex(L,t); setsvalue(L,&key,luaS_new(L,k)); luaV_settable(L,t,&key,L->top-1); L->top--; } static void lua_rawset(lua_State*L,int idx){ StkId t; api_checknelems(L,2); t=index2adr(L,idx); luai_apicheck(L,ttistable(t)); setobj(L,luaH_set(L,hvalue(t),L->top-2),L->top-1); luaC_barriert(L,hvalue(t),L->top-1); L->top-=2; } static void lua_rawseti(lua_State*L,int idx,int n){ StkId o; api_checknelems(L,1); o=index2adr(L,idx); luai_apicheck(L,ttistable(o)); setobj(L,luaH_setnum(L,hvalue(o),n),L->top-1); luaC_barriert(L,hvalue(o),L->top-1); L->top--; } static int lua_setmetatable(lua_State*L,int objindex){ TValue*obj; Table*mt; api_checknelems(L,1); obj=index2adr(L,objindex); api_checkvalidindex(L,obj); if(ttisnil(L->top-1)) mt=NULL; else{ luai_apicheck(L,ttistable(L->top-1)); mt=hvalue(L->top-1); } switch(ttype(obj)){ case 5:{ hvalue(obj)->metatable=mt; if(mt) luaC_objbarriert(L,hvalue(obj),mt); break; } case 7:{ uvalue(obj)->metatable=mt; if(mt) luaC_objbarrier(L,rawuvalue(obj),mt); break; } default:{ G(L)->mt[ttype(obj)]=mt; break; } } L->top--; return 1; } static int lua_setfenv(lua_State*L,int idx){ StkId o; int res=1; api_checknelems(L,1); o=index2adr(L,idx); api_checkvalidindex(L,o); luai_apicheck(L,ttistable(L->top-1)); switch(ttype(o)){ case 6: clvalue(o)->c.env=hvalue(L->top-1); break; case 7: uvalue(o)->env=hvalue(L->top-1); break; case 8: sethvalue(L,gt(thvalue(o)),hvalue(L->top-1)); break; default: res=0; break; } if(res)luaC_objbarrier(L,gcvalue(o),hvalue(L->top-1)); L->top--; return res; } #define adjustresults(L,nres){if(nres==(-1)&&L->top>=L->ci->top)L->ci->top=L->top;} #define checkresults(L,na,nr)luai_apicheck(L,(nr)==(-1)||(L->ci->top-L->top>=(nr)-(na))) static void lua_call(lua_State*L,int nargs,int nresults){ StkId func; api_checknelems(L,nargs+1); checkresults(L,nargs,nresults); func=L->top-(nargs+1); luaD_call(L,func,nresults); adjustresults(L,nresults); } struct CallS{ StkId func; int nresults; }; static void f_call(lua_State*L,void*ud){ struct CallS*c=cast(struct CallS*,ud); luaD_call(L,c->func,c->nresults); } static int lua_pcall(lua_State*L,int nargs,int nresults,int errfunc){ struct CallS c; int status; ptrdiff_t func; api_checknelems(L,nargs+1); checkresults(L,nargs,nresults); if(errfunc==0) func=0; else{ StkId o=index2adr(L,errfunc); api_checkvalidindex(L,o); func=savestack(L,o); } c.func=L->top-(nargs+1); c.nresults=nresults; status=luaD_pcall(L,f_call,&c,savestack(L,c.func),func); adjustresults(L,nresults); return status; } static int lua_load(lua_State*L,lua_Reader reader,void*data, const char*chunkname){ ZIO z; int status; if(!chunkname)chunkname="?"; luaZ_init(L,&z,reader,data); status=luaD_protectedparser(L,&z,chunkname); return status; } static int lua_error(lua_State*L){ api_checknelems(L,1); luaG_errormsg(L); return 0; } static int lua_next(lua_State*L,int idx){ StkId t; int more; t=index2adr(L,idx); luai_apicheck(L,ttistable(t)); more=luaH_next(L,hvalue(t),L->top-1); if(more){ api_incr_top(L); } else L->top-=1; return more; } static void lua_concat(lua_State*L,int n){ api_checknelems(L,n); if(n>=2){ luaC_checkGC(L); luaV_concat(L,n,cast_int(L->top-L->base)-1); L->top-=(n-1); } else if(n==0){ setsvalue(L,L->top,luaS_newlstr(L,"",0)); api_incr_top(L); } } static void*lua_newuserdata(lua_State*L,size_t size){ Udata*u; luaC_checkGC(L); u=luaS_newudata(L,size,getcurrenv(L)); setuvalue(L,L->top,u); api_incr_top(L); return u+1; } #define luaL_getn(L,i)((int)lua_objlen(L,i)) #define luaL_setn(L,i,j)((void)0) typedef struct luaL_Reg{ const char*name; lua_CFunction func; }luaL_Reg; static void luaI_openlib(lua_State*L,const char*libname, const luaL_Reg*l,int nup); static int luaL_argerror(lua_State*L,int numarg,const char*extramsg); static const char* luaL_checklstring(lua_State*L,int numArg, size_t*l); static const char* luaL_optlstring(lua_State*L,int numArg, const char*def,size_t*l); static lua_Integer luaL_checkinteger(lua_State*L,int numArg); static lua_Integer luaL_optinteger(lua_State*L,int nArg, lua_Integer def); static int luaL_error(lua_State*L,const char*fmt,...); static const char* luaL_findtable(lua_State*L,int idx, const char*fname,int szhint); #define luaL_argcheck(L,cond,numarg,extramsg)((void)((cond)||luaL_argerror(L,(numarg),(extramsg)))) #define luaL_checkstring(L,n)(luaL_checklstring(L,(n),NULL)) #define luaL_optstring(L,n,d)(luaL_optlstring(L,(n),(d),NULL)) #define luaL_checkint(L,n)((int)luaL_checkinteger(L,(n))) #define luaL_optint(L,n,d)((int)luaL_optinteger(L,(n),(d))) #define luaL_typename(L,i)lua_typename(L,lua_type(L,(i))) #define luaL_getmetatable(L,n)(lua_getfield(L,(-10000),(n))) #define luaL_opt(L,f,n,d)(lua_isnoneornil(L,(n))?(d):f(L,(n))) typedef struct luaL_Buffer{ char*p; int lvl; lua_State*L; char buffer[BUFSIZ]; }luaL_Buffer; #define luaL_addchar(B,c)((void)((B)->p<((B)->buffer+BUFSIZ)||luaL_prepbuffer(B)),(*(B)->p++=(char)(c))) #define luaL_addsize(B,n)((B)->p+=(n)) static char* luaL_prepbuffer(luaL_Buffer*B); static int luaL_argerror(lua_State*L,int narg,const char*extramsg){ lua_Debug ar; if(!lua_getstack(L,0,&ar)) return luaL_error(L,"bad argument #%d (%s)",narg,extramsg); lua_getinfo(L,"n",&ar); if(strcmp(ar.namewhat,"method")==0){ narg--; if(narg==0) return luaL_error(L,"calling "LUA_QL("%s")" on bad self (%s)", ar.name,extramsg); } if(ar.name==NULL) ar.name="?"; return luaL_error(L,"bad argument #%d to "LUA_QL("%s")" (%s)", narg,ar.name,extramsg); } static int luaL_typerror(lua_State*L,int narg,const char*tname){ const char*msg=lua_pushfstring(L,"%s expected, got %s", tname,luaL_typename(L,narg)); return luaL_argerror(L,narg,msg); } static void tag_error(lua_State*L,int narg,int tag){ luaL_typerror(L,narg,lua_typename(L,tag)); } static void luaL_where(lua_State*L,int level){ lua_Debug ar; if(lua_getstack(L,level,&ar)){ lua_getinfo(L,"Sl",&ar); if(ar.currentline>0){ lua_pushfstring(L,"%s:%d: ",ar.short_src,ar.currentline); return; } } lua_pushliteral(L,""); } static int luaL_error(lua_State*L,const char*fmt,...){ va_list argp; va_start(argp,fmt); luaL_where(L,1); lua_pushvfstring(L,fmt,argp); va_end(argp); lua_concat(L,2); return lua_error(L); } static int luaL_newmetatable(lua_State*L,const char*tname){ lua_getfield(L,(-10000),tname); if(!lua_isnil(L,-1)) return 0; lua_pop(L,1); lua_newtable(L); lua_pushvalue(L,-1); lua_setfield(L,(-10000),tname); return 1; } static void*luaL_checkudata(lua_State*L,int ud,const char*tname){ void*p=lua_touserdata(L,ud); if(p!=NULL){ if(lua_getmetatable(L,ud)){ lua_getfield(L,(-10000),tname); if(lua_rawequal(L,-1,-2)){ lua_pop(L,2); return p; } } } luaL_typerror(L,ud,tname); return NULL; } static void luaL_checkstack(lua_State*L,int space,const char*mes){ if(!lua_checkstack(L,space)) luaL_error(L,"stack overflow (%s)",mes); } static void luaL_checktype(lua_State*L,int narg,int t){ if(lua_type(L,narg)!=t) tag_error(L,narg,t); } static void luaL_checkany(lua_State*L,int narg){ if(lua_type(L,narg)==(-1)) luaL_argerror(L,narg,"value expected"); } static const char*luaL_checklstring(lua_State*L,int narg,size_t*len){ const char*s=lua_tolstring(L,narg,len); if(!s)tag_error(L,narg,4); return s; } static const char*luaL_optlstring(lua_State*L,int narg, const char*def,size_t*len){ if(lua_isnoneornil(L,narg)){ if(len) *len=(def?strlen(def):0); return def; } else return luaL_checklstring(L,narg,len); } static lua_Number luaL_checknumber(lua_State*L,int narg){ lua_Number d=lua_tonumber(L,narg); if(d==0&&!lua_isnumber(L,narg)) tag_error(L,narg,3); return d; } static lua_Integer luaL_checkinteger(lua_State*L,int narg){ lua_Integer d=lua_tointeger(L,narg); if(d==0&&!lua_isnumber(L,narg)) tag_error(L,narg,3); return d; } static lua_Integer luaL_optinteger(lua_State*L,int narg, lua_Integer def){ return luaL_opt(L,luaL_checkinteger,narg,def); } static int luaL_getmetafield(lua_State*L,int obj,const char*event){ if(!lua_getmetatable(L,obj)) return 0; lua_pushstring(L,event); lua_rawget(L,-2); if(lua_isnil(L,-1)){ lua_pop(L,2); return 0; } else{ lua_remove(L,-2); return 1; } } static void luaL_register(lua_State*L,const char*libname, const luaL_Reg*l){ luaI_openlib(L,libname,l,0); } static int libsize(const luaL_Reg*l){ int size=0; for(;l->name;l++)size++; return size; } static void luaI_openlib(lua_State*L,const char*libname, const luaL_Reg*l,int nup){ if(libname){ int size=libsize(l); luaL_findtable(L,(-10000),"_LOADED",1); lua_getfield(L,-1,libname); if(!lua_istable(L,-1)){ lua_pop(L,1); if(luaL_findtable(L,(-10002),libname,size)!=NULL) luaL_error(L,"name conflict for module "LUA_QL("%s"),libname); lua_pushvalue(L,-1); lua_setfield(L,-3,libname); } lua_remove(L,-2); lua_insert(L,-(nup+1)); } for(;l->name;l++){ int i; for(i=0;ifunc,nup); lua_setfield(L,-(nup+2),l->name); } lua_pop(L,nup); } static const char*luaL_findtable(lua_State*L,int idx, const char*fname,int szhint){ const char*e; lua_pushvalue(L,idx); do{ e=strchr(fname,'.'); if(e==NULL)e=fname+strlen(fname); lua_pushlstring(L,fname,e-fname); lua_rawget(L,-2); if(lua_isnil(L,-1)){ lua_pop(L,1); lua_createtable(L,0,(*e=='.'?1:szhint)); lua_pushlstring(L,fname,e-fname); lua_pushvalue(L,-2); lua_settable(L,-4); } else if(!lua_istable(L,-1)){ lua_pop(L,2); return fname; } lua_remove(L,-2); fname=e+1; }while(*e=='.'); return NULL; } #define bufflen(B)((B)->p-(B)->buffer) #define bufffree(B)((size_t)(BUFSIZ-bufflen(B))) static int emptybuffer(luaL_Buffer*B){ size_t l=bufflen(B); if(l==0)return 0; else{ lua_pushlstring(B->L,B->buffer,l); B->p=B->buffer; B->lvl++; return 1; } } static void adjuststack(luaL_Buffer*B){ if(B->lvl>1){ lua_State*L=B->L; int toget=1; size_t toplen=lua_strlen(L,-1); do{ size_t l=lua_strlen(L,-(toget+1)); if(B->lvl-toget+1>=(20/2)||toplen>l){ toplen+=l; toget++; } else break; }while(togetlvl); lua_concat(L,toget); B->lvl=B->lvl-toget+1; } } static char*luaL_prepbuffer(luaL_Buffer*B){ if(emptybuffer(B)) adjuststack(B); return B->buffer; } static void luaL_addlstring(luaL_Buffer*B,const char*s,size_t l){ while(l--) luaL_addchar(B,*s++); } static void luaL_pushresult(luaL_Buffer*B){ emptybuffer(B); lua_concat(B->L,B->lvl); B->lvl=1; } static void luaL_addvalue(luaL_Buffer*B){ lua_State*L=B->L; size_t vl; const char*s=lua_tolstring(L,-1,&vl); if(vl<=bufffree(B)){ memcpy(B->p,s,vl); B->p+=vl; lua_pop(L,1); } else{ if(emptybuffer(B)) lua_insert(L,-2); B->lvl++; adjuststack(B); } } static void luaL_buffinit(lua_State*L,luaL_Buffer*B){ B->L=L; B->p=B->buffer; B->lvl=0; } typedef struct LoadF{ int extraline; FILE*f; char buff[BUFSIZ]; }LoadF; static const char*getF(lua_State*L,void*ud,size_t*size){ LoadF*lf=(LoadF*)ud; (void)L; if(lf->extraline){ lf->extraline=0; *size=1; return"\n"; } if(feof(lf->f))return NULL; *size=fread(lf->buff,1,sizeof(lf->buff),lf->f); return(*size>0)?lf->buff:NULL; } static int errfile(lua_State*L,const char*what,int fnameindex){ const char*serr=strerror(errno); const char*filename=lua_tostring(L,fnameindex)+1; lua_pushfstring(L,"cannot %s %s: %s",what,filename,serr); lua_remove(L,fnameindex); return(5+1); } static int luaL_loadfile(lua_State*L,const char*filename){ LoadF lf; int status,readstatus; int c; int fnameindex=lua_gettop(L)+1; lf.extraline=0; if(filename==NULL){ lua_pushliteral(L,"=stdin"); lf.f=stdin; } else{ lua_pushfstring(L,"@%s",filename); lf.f=fopen(filename,"r"); if(lf.f==NULL)return errfile(L,"open",fnameindex); } c=getc(lf.f); if(c=='#'){ lf.extraline=1; while((c=getc(lf.f))!=EOF&&c!='\n'); if(c=='\n')c=getc(lf.f); } if(c=="\033Lua"[0]&&filename){ lf.f=freopen(filename,"rb",lf.f); if(lf.f==NULL)return errfile(L,"reopen",fnameindex); while((c=getc(lf.f))!=EOF&&c!="\033Lua"[0]); lf.extraline=0; } ungetc(c,lf.f); status=lua_load(L,getF,&lf,lua_tostring(L,-1)); readstatus=ferror(lf.f); if(filename)fclose(lf.f); if(readstatus){ lua_settop(L,fnameindex); return errfile(L,"read",fnameindex); } lua_remove(L,fnameindex); return status; } typedef struct LoadS{ const char*s; size_t size; }LoadS; static const char*getS(lua_State*L,void*ud,size_t*size){ LoadS*ls=(LoadS*)ud; (void)L; if(ls->size==0)return NULL; *size=ls->size; ls->size=0; return ls->s; } static int luaL_loadbuffer(lua_State*L,const char*buff,size_t size, const char*name){ LoadS ls; ls.s=buff; ls.size=size; return lua_load(L,getS,&ls,name); } static void*l_alloc(void*ud,void*ptr,size_t osize,size_t nsize){ (void)ud; (void)osize; if(nsize==0){ free(ptr); return NULL; } else return realloc(ptr,nsize); } static int panic(lua_State*L){ (void)L; fprintf(stderr,"PANIC: unprotected error in call to Lua API (%s)\n", lua_tostring(L,-1)); return 0; } static lua_State*luaL_newstate(void){ lua_State*L=lua_newstate(l_alloc,NULL); if(L)lua_atpanic(L,&panic); return L; } static int luaB_tonumber(lua_State*L){ int base=luaL_optint(L,2,10); if(base==10){ luaL_checkany(L,1); if(lua_isnumber(L,1)){ lua_pushnumber(L,lua_tonumber(L,1)); return 1; } } else{ const char*s1=luaL_checkstring(L,1); char*s2; unsigned long n; luaL_argcheck(L,2<=base&&base<=36,2,"base out of range"); n=strtoul(s1,&s2,base); if(s1!=s2){ while(isspace((unsigned char)(*s2)))s2++; if(*s2=='\0'){ lua_pushnumber(L,(lua_Number)n); return 1; } } } lua_pushnil(L); return 1; } static int luaB_error(lua_State*L){ int level=luaL_optint(L,2,1); lua_settop(L,1); if(lua_isstring(L,1)&&level>0){ luaL_where(L,level); lua_pushvalue(L,1); lua_concat(L,2); } return lua_error(L); } static int luaB_setmetatable(lua_State*L){ int t=lua_type(L,2); luaL_checktype(L,1,5); luaL_argcheck(L,t==0||t==5,2, "nil or table expected"); if(luaL_getmetafield(L,1,"__metatable")) luaL_error(L,"cannot change a protected metatable"); lua_settop(L,2); lua_setmetatable(L,1); return 1; } static void getfunc(lua_State*L,int opt){ if(lua_isfunction(L,1))lua_pushvalue(L,1); else{ lua_Debug ar; int level=opt?luaL_optint(L,1,1):luaL_checkint(L,1); luaL_argcheck(L,level>=0,1,"level must be non-negative"); if(lua_getstack(L,level,&ar)==0) luaL_argerror(L,1,"invalid level"); lua_getinfo(L,"f",&ar); if(lua_isnil(L,-1)) luaL_error(L,"no function environment for tail call at level %d", level); } } static int luaB_setfenv(lua_State*L){ luaL_checktype(L,2,5); getfunc(L,0); lua_pushvalue(L,2); if(lua_isnumber(L,1)&&lua_tonumber(L,1)==0){ lua_pushthread(L); lua_insert(L,-2); lua_setfenv(L,-2); return 0; } else if(lua_iscfunction(L,-2)||lua_setfenv(L,-2)==0) luaL_error(L, LUA_QL("setfenv")" cannot change environment of given object"); return 1; } static int luaB_rawget(lua_State*L){ luaL_checktype(L,1,5); luaL_checkany(L,2); lua_settop(L,2); lua_rawget(L,1); return 1; } static int luaB_type(lua_State*L){ luaL_checkany(L,1); lua_pushstring(L,luaL_typename(L,1)); return 1; } static int luaB_next(lua_State*L){ luaL_checktype(L,1,5); lua_settop(L,2); if(lua_next(L,1)) return 2; else{ lua_pushnil(L); return 1; } } static int luaB_pairs(lua_State*L){ luaL_checktype(L,1,5); lua_pushvalue(L,lua_upvalueindex(1)); lua_pushvalue(L,1); lua_pushnil(L); return 3; } static int ipairsaux(lua_State*L){ int i=luaL_checkint(L,2); luaL_checktype(L,1,5); i++; lua_pushinteger(L,i); lua_rawgeti(L,1,i); return(lua_isnil(L,-1))?0:2; } static int luaB_ipairs(lua_State*L){ luaL_checktype(L,1,5); lua_pushvalue(L,lua_upvalueindex(1)); lua_pushvalue(L,1); lua_pushinteger(L,0); return 3; } static int load_aux(lua_State*L,int status){ if(status==0) return 1; else{ lua_pushnil(L); lua_insert(L,-2); return 2; } } static int luaB_loadstring(lua_State*L){ size_t l; const char*s=luaL_checklstring(L,1,&l); const char*chunkname=luaL_optstring(L,2,s); return load_aux(L,luaL_loadbuffer(L,s,l,chunkname)); } static int luaB_loadfile(lua_State*L){ const char*fname=luaL_optstring(L,1,NULL); return load_aux(L,luaL_loadfile(L,fname)); } static int luaB_assert(lua_State*L){ luaL_checkany(L,1); if(!lua_toboolean(L,1)) return luaL_error(L,"%s",luaL_optstring(L,2,"assertion failed!")); return lua_gettop(L); } static int luaB_unpack(lua_State*L){ int i,e,n; luaL_checktype(L,1,5); i=luaL_optint(L,2,1); e=luaL_opt(L,luaL_checkint,3,luaL_getn(L,1)); if(i>e)return 0; n=e-i+1; if(n<=0||!lua_checkstack(L,n)) return luaL_error(L,"too many results to unpack"); lua_rawgeti(L,1,i); while(i++e)e=pos; for(i=e;i>pos;i--){ lua_rawgeti(L,1,i-1); lua_rawseti(L,1,i); } break; } default:{ return luaL_error(L,"wrong number of arguments to "LUA_QL("insert")); } } luaL_setn(L,1,e); lua_rawseti(L,1,pos); return 0; } static int tremove(lua_State*L){ int e=aux_getn(L,1); int pos=luaL_optint(L,2,e); if(!(1<=pos&&pos<=e)) return 0; luaL_setn(L,1,e-1); lua_rawgeti(L,1,pos); for(;posu)luaL_error(L,"invalid order function for sorting"); lua_pop(L,1); } while(lua_rawgeti(L,1,--j),sort_comp(L,-3,-1)){ if(j0); } l=strlen(p); if(l==0||p[l-1]!='\n') luaL_addsize(&b,l); else{ luaL_addsize(&b,l-1); luaL_pushresult(&b); return 1; } } } static int read_chars(lua_State*L,FILE*f,size_t n){ size_t rlen; size_t nr; luaL_Buffer b; luaL_buffinit(L,&b); rlen=BUFSIZ; do{ char*p=luaL_prepbuffer(&b); if(rlen>n)rlen=n; nr=fread(p,sizeof(char),rlen,f); luaL_addsize(&b,nr); n-=nr; }while(n>0&&nr==rlen); luaL_pushresult(&b); return(n==0||lua_objlen(L,-1)>0); } static int g_read(lua_State*L,FILE*f,int first){ int nargs=lua_gettop(L)-1; int success; int n; clearerr(f); if(nargs==0){ success=read_line(L,f); n=first+1; } else{ luaL_checkstack(L,nargs+20,"too many arguments"); success=1; for(n=first;nargs--&&success;n++){ if(lua_type(L,n)==3){ size_t l=(size_t)lua_tointeger(L,n); success=(l==0)?test_eof(L,f):read_chars(L,f,l); } else{ const char*p=lua_tostring(L,n); luaL_argcheck(L,p&&p[0]=='*',n,"invalid option"); switch(p[1]){ case'n': success=read_number(L,f); break; case'l': success=read_line(L,f); break; case'a': read_chars(L,f,~((size_t)0)); success=1; break; default: return luaL_argerror(L,n,"invalid format"); } } } } if(ferror(f)) return pushresult(L,0,NULL); if(!success){ lua_pop(L,1); lua_pushnil(L); } return n-first; } static int io_read(lua_State*L){ return g_read(L,getiofile(L,1),1); } static int f_read(lua_State*L){ return g_read(L,tofile(L),2); } static int io_readline(lua_State*L){ FILE*f=*(FILE**)lua_touserdata(L,lua_upvalueindex(1)); int sucess; if(f==NULL) luaL_error(L,"file is already closed"); sucess=read_line(L,f); if(ferror(f)) return luaL_error(L,"%s",strerror(errno)); if(sucess)return 1; else{ if(lua_toboolean(L,lua_upvalueindex(2))){ lua_settop(L,0); lua_pushvalue(L,lua_upvalueindex(1)); aux_close(L); } return 0; } } static int g_write(lua_State*L,FILE*f,int arg){ int nargs=lua_gettop(L)-1; int status=1; for(;nargs--;arg++){ if(lua_type(L,arg)==3){ status=status&& fprintf(f,"%.14g",lua_tonumber(L,arg))>0; } else{ size_t l; const char*s=luaL_checklstring(L,arg,&l); status=status&&(fwrite(s,sizeof(char),l,f)==l); } } return pushresult(L,status,NULL); } static int io_write(lua_State*L){ return g_write(L,getiofile(L,2),1); } static int f_write(lua_State*L){ return g_write(L,tofile(L),2); } static int io_flush(lua_State*L){ return pushresult(L,fflush(getiofile(L,2))==0,NULL); } static int f_flush(lua_State*L){ return pushresult(L,fflush(tofile(L))==0,NULL); } static const luaL_Reg iolib[]={ {"close",io_close}, {"flush",io_flush}, {"input",io_input}, {"lines",io_lines}, {"open",io_open}, {"output",io_output}, {"read",io_read}, {"type",io_type}, {"write",io_write}, {NULL,NULL} }; static const luaL_Reg flib[]={ {"close",io_close}, {"flush",f_flush}, {"lines",f_lines}, {"read",f_read}, {"write",f_write}, {"__gc",io_gc}, {NULL,NULL} }; static void createmeta(lua_State*L){ luaL_newmetatable(L,"FILE*"); lua_pushvalue(L,-1); lua_setfield(L,-2,"__index"); luaL_register(L,NULL,flib); } static void createstdfile(lua_State*L,FILE*f,int k,const char*fname){ *newfile(L)=f; if(k>0){ lua_pushvalue(L,-1); lua_rawseti(L,(-10001),k); } lua_pushvalue(L,-2); lua_setfenv(L,-2); lua_setfield(L,-3,fname); } static void newfenv(lua_State*L,lua_CFunction cls){ lua_createtable(L,0,1); lua_pushcfunction(L,cls); lua_setfield(L,-2,"__close"); } static int luaopen_io(lua_State*L){ createmeta(L); newfenv(L,io_fclose); lua_replace(L,(-10001)); luaL_register(L,"io",iolib); newfenv(L,io_noclose); createstdfile(L,stdin,1,"stdin"); createstdfile(L,stdout,2,"stdout"); createstdfile(L,stderr,0,"stderr"); lua_pop(L,1); lua_getfield(L,-1,"popen"); newfenv(L,io_pclose); lua_setfenv(L,-2); lua_pop(L,1); return 1; } static int os_pushresult(lua_State*L,int i,const char*filename){ int en=errno; if(i){ lua_pushboolean(L,1); return 1; } else{ lua_pushnil(L); lua_pushfstring(L,"%s: %s",filename,strerror(en)); lua_pushinteger(L,en); return 3; } } static int os_remove(lua_State*L){ const char*filename=luaL_checkstring(L,1); return os_pushresult(L,remove(filename)==0,filename); } static int os_exit(lua_State*L){ exit(luaL_optint(L,1,EXIT_SUCCESS)); } static const luaL_Reg syslib[]={ {"exit",os_exit}, {"remove",os_remove}, {NULL,NULL} }; static int luaopen_os(lua_State*L){ luaL_register(L,"os",syslib); return 1; } #define uchar(c)((unsigned char)(c)) static ptrdiff_t posrelat(ptrdiff_t pos,size_t len){ if(pos<0)pos+=(ptrdiff_t)len+1; return(pos>=0)?pos:0; } static int str_sub(lua_State*L){ size_t l; const char*s=luaL_checklstring(L,1,&l); ptrdiff_t start=posrelat(luaL_checkinteger(L,2),l); ptrdiff_t end=posrelat(luaL_optinteger(L,3,-1),l); if(start<1)start=1; if(end>(ptrdiff_t)l)end=(ptrdiff_t)l; if(start<=end) lua_pushlstring(L,s+start-1,end-start+1); else lua_pushliteral(L,""); return 1; } static int str_lower(lua_State*L){ size_t l; size_t i; luaL_Buffer b; const char*s=luaL_checklstring(L,1,&l); luaL_buffinit(L,&b); for(i=0;i0) luaL_addlstring(&b,s,l); luaL_pushresult(&b); return 1; } static int str_byte(lua_State*L){ size_t l; const char*s=luaL_checklstring(L,1,&l); ptrdiff_t posi=posrelat(luaL_optinteger(L,2,1),l); ptrdiff_t pose=posrelat(luaL_optinteger(L,3,posi),l); int n,i; if(posi<=0)posi=1; if((size_t)pose>l)pose=l; if(posi>pose)return 0; n=(int)(pose-posi+1); if(posi+n<=pose) luaL_error(L,"string slice too long"); luaL_checkstack(L,n,"string slice too long"); for(i=0;i=ms->level||ms->capture[l].len==(-1)) return luaL_error(ms->L,"invalid capture index"); return l; } static int capture_to_close(MatchState*ms){ int level=ms->level; for(level--;level>=0;level--) if(ms->capture[level].len==(-1))return level; return luaL_error(ms->L,"invalid pattern capture"); } static const char*classend(MatchState*ms,const char*p){ switch(*p++){ case'%':{ if(*p=='\0') luaL_error(ms->L,"malformed pattern (ends with "LUA_QL("%%")")"); return p+1; } case'[':{ if(*p=='^')p++; do{ if(*p=='\0') luaL_error(ms->L,"malformed pattern (missing "LUA_QL("]")")"); if(*(p++)=='%'&&*p!='\0') p++; }while(*p!=']'); return p+1; } default:{ return p; } } } static int match_class(int c,int cl){ int res; switch(tolower(cl)){ case'a':res=isalpha(c);break; case'c':res=iscntrl(c);break; case'd':res=isdigit(c);break; case'l':res=islower(c);break; case'p':res=ispunct(c);break; case's':res=isspace(c);break; case'u':res=isupper(c);break; case'w':res=isalnum(c);break; case'x':res=isxdigit(c);break; case'z':res=(c==0);break; default:return(cl==c); } return(islower(cl)?res:!res); } static int matchbracketclass(int c,const char*p,const char*ec){ int sig=1; if(*(p+1)=='^'){ sig=0; p++; } while(++pL,"unbalanced pattern"); if(*s!=*p)return NULL; else{ int b=*p; int e=*(p+1); int cont=1; while(++ssrc_end){ if(*s==e){ if(--cont==0)return s+1; } else if(*s==b)cont++; } } return NULL; } static const char*max_expand(MatchState*ms,const char*s, const char*p,const char*ep){ ptrdiff_t i=0; while((s+i)src_end&&singlematch(uchar(*(s+i)),p,ep)) i++; while(i>=0){ const char*res=match(ms,(s+i),ep+1); if(res)return res; i--; } return NULL; } static const char*min_expand(MatchState*ms,const char*s, const char*p,const char*ep){ for(;;){ const char*res=match(ms,s,ep+1); if(res!=NULL) return res; else if(ssrc_end&&singlematch(uchar(*s),p,ep)) s++; else return NULL; } } static const char*start_capture(MatchState*ms,const char*s, const char*p,int what){ const char*res; int level=ms->level; if(level>=32)luaL_error(ms->L,"too many captures"); ms->capture[level].init=s; ms->capture[level].len=what; ms->level=level+1; if((res=match(ms,s,p))==NULL) ms->level--; return res; } static const char*end_capture(MatchState*ms,const char*s, const char*p){ int l=capture_to_close(ms); const char*res; ms->capture[l].len=s-ms->capture[l].init; if((res=match(ms,s,p))==NULL) ms->capture[l].len=(-1); return res; } static const char*match_capture(MatchState*ms,const char*s,int l){ size_t len; l=check_capture(ms,l); len=ms->capture[l].len; if((size_t)(ms->src_end-s)>=len&& memcmp(ms->capture[l].init,s,len)==0) return s+len; else return NULL; } static const char*match(MatchState*ms,const char*s,const char*p){ init: switch(*p){ case'(':{ if(*(p+1)==')') return start_capture(ms,s,p+2,(-2)); else return start_capture(ms,s,p+1,(-1)); } case')':{ return end_capture(ms,s,p+1); } case'%':{ switch(*(p+1)){ case'b':{ s=matchbalance(ms,s,p+2); if(s==NULL)return NULL; p+=4;goto init; } case'f':{ const char*ep;char previous; p+=2; if(*p!='[') luaL_error(ms->L,"missing "LUA_QL("[")" after " LUA_QL("%%f")" in pattern"); ep=classend(ms,p); previous=(s==ms->src_init)?'\0':*(s-1); if(matchbracketclass(uchar(previous),p,ep-1)|| !matchbracketclass(uchar(*s),p,ep-1))return NULL; p=ep;goto init; } default:{ if(isdigit(uchar(*(p+1)))){ s=match_capture(ms,s,uchar(*(p+1))); if(s==NULL)return NULL; p+=2;goto init; } goto dflt; } } } case'\0':{ return s; } case'$':{ if(*(p+1)=='\0') return(s==ms->src_end)?s:NULL; else goto dflt; } default:dflt:{ const char*ep=classend(ms,p); int m=ssrc_end&&singlematch(uchar(*s),p,ep); switch(*ep){ case'?':{ const char*res; if(m&&((res=match(ms,s+1,ep+1))!=NULL)) return res; p=ep+1;goto init; } case'*':{ return max_expand(ms,s,p,ep); } case'+':{ return(m?max_expand(ms,s+1,p,ep):NULL); } case'-':{ return min_expand(ms,s,p,ep); } default:{ if(!m)return NULL; s++;p=ep;goto init; } } } } } static const char*lmemfind(const char*s1,size_t l1, const char*s2,size_t l2){ if(l2==0)return s1; else if(l2>l1)return NULL; else{ const char*init; l2--; l1=l1-l2; while(l1>0&&(init=(const char*)memchr(s1,*s2,l1))!=NULL){ init++; if(memcmp(init,s2+1,l2)==0) return init-1; else{ l1-=init-s1; s1=init; } } return NULL; } } static void push_onecapture(MatchState*ms,int i,const char*s, const char*e){ if(i>=ms->level){ if(i==0) lua_pushlstring(ms->L,s,e-s); else luaL_error(ms->L,"invalid capture index"); } else{ ptrdiff_t l=ms->capture[i].len; if(l==(-1))luaL_error(ms->L,"unfinished capture"); if(l==(-2)) lua_pushinteger(ms->L,ms->capture[i].init-ms->src_init+1); else lua_pushlstring(ms->L,ms->capture[i].init,l); } } static int push_captures(MatchState*ms,const char*s,const char*e){ int i; int nlevels=(ms->level==0&&s)?1:ms->level; luaL_checkstack(ms->L,nlevels,"too many captures"); for(i=0;il1)init=(ptrdiff_t)l1; if(find&&(lua_toboolean(L,4)|| strpbrk(p,"^$*+?.([%-")==NULL)){ const char*s2=lmemfind(s+init,l1-init,p,l2); if(s2){ lua_pushinteger(L,s2-s+1); lua_pushinteger(L,s2-s+l2); return 2; } } else{ MatchState ms; int anchor=(*p=='^')?(p++,1):0; const char*s1=s+init; ms.L=L; ms.src_init=s; ms.src_end=s+l1; do{ const char*res; ms.level=0; if((res=match(&ms,s1,p))!=NULL){ if(find){ lua_pushinteger(L,s1-s+1); lua_pushinteger(L,res-s); return push_captures(&ms,NULL,0)+2; } else return push_captures(&ms,s1,res); } }while(s1++L,3,&l); for(i=0;iL; switch(lua_type(L,3)){ case 3: case 4:{ add_s(ms,b,s,e); return; } case 6:{ int n; lua_pushvalue(L,3); n=push_captures(ms,s,e); lua_call(L,n,1); break; } case 5:{ push_onecapture(ms,0,s,e); lua_gettable(L,3); break; } } if(!lua_toboolean(L,-1)){ lua_pop(L,1); lua_pushlstring(L,s,e-s); } else if(!lua_isstring(L,-1)) luaL_error(L,"invalid replacement value (a %s)",luaL_typename(L,-1)); luaL_addvalue(b); } static int str_gsub(lua_State*L){ size_t srcl; const char*src=luaL_checklstring(L,1,&srcl); const char*p=luaL_checkstring(L,2); int tr=lua_type(L,3); int max_s=luaL_optint(L,4,srcl+1); int anchor=(*p=='^')?(p++,1):0; int n=0; MatchState ms; luaL_Buffer b; luaL_argcheck(L,tr==3||tr==4|| tr==6||tr==5,3, "string/function/table expected"); luaL_buffinit(L,&b); ms.L=L; ms.src_init=src; ms.src_end=src+srcl; while(nsrc) src=e; else if(src=sizeof("-+ #0")) luaL_error(L,"invalid format (repeated flags)"); if(isdigit(uchar(*p)))p++; if(isdigit(uchar(*p)))p++; if(*p=='.'){ p++; if(isdigit(uchar(*p)))p++; if(isdigit(uchar(*p)))p++; } if(isdigit(uchar(*p))) luaL_error(L,"invalid format (width or precision too long)"); *(form++)='%'; strncpy(form,strfrmt,p-strfrmt+1); form+=p-strfrmt+1; *form='\0'; return p; } static void addintlen(char*form){ size_t l=strlen(form); char spec=form[l-1]; strcpy(form+l-1,"l"); form[l+sizeof("l")-2]=spec; form[l+sizeof("l")-1]='\0'; } static int str_format(lua_State*L){ int top=lua_gettop(L); int arg=1; size_t sfl; const char*strfrmt=luaL_checklstring(L,arg,&sfl); const char*strfrmt_end=strfrmt+sfl; luaL_Buffer b; luaL_buffinit(L,&b); while(strfrmttop) luaL_argerror(L,arg,"no value"); strfrmt=scanformat(L,strfrmt,form); switch(*strfrmt++){ case'c':{ sprintf(buff,form,(int)luaL_checknumber(L,arg)); break; } case'd':case'i':{ addintlen(form); sprintf(buff,form,(long)luaL_checknumber(L,arg)); break; } case'o':case'u':case'x':case'X':{ addintlen(form); sprintf(buff,form,(unsigned long)luaL_checknumber(L,arg)); break; } case'e':case'E':case'f': case'g':case'G':{ sprintf(buff,form,(double)luaL_checknumber(L,arg)); break; } case'q':{ addquoted(L,&b,arg); continue; } case's':{ size_t l; const char*s=luaL_checklstring(L,arg,&l); if(!strchr(form,'.')&&l>=100){ lua_pushvalue(L,arg); luaL_addvalue(&b); continue; } else{ sprintf(buff,form,s); break; } } default:{ return luaL_error(L,"invalid option "LUA_QL("%%%c")" to " LUA_QL("format"),*(strfrmt-1)); } } luaL_addlstring(&b,buff,strlen(buff)); } } luaL_pushresult(&b); return 1; } static const luaL_Reg strlib[]={ {"byte",str_byte}, {"char",str_char}, {"find",str_find}, {"format",str_format}, {"gmatch",gmatch}, {"gsub",str_gsub}, {"lower",str_lower}, {"match",str_match}, {"rep",str_rep}, {"sub",str_sub}, {"upper",str_upper}, {NULL,NULL} }; static void createmetatable(lua_State*L){ lua_createtable(L,0,1); lua_pushliteral(L,""); lua_pushvalue(L,-2); lua_setmetatable(L,-2); lua_pop(L,1); lua_pushvalue(L,-2); lua_setfield(L,-2,"__index"); lua_pop(L,1); } static int luaopen_string(lua_State*L){ luaL_register(L,"string",strlib); createmetatable(L); return 1; } static const luaL_Reg lualibs[]={ {"",luaopen_base}, {"table",luaopen_table}, {"io",luaopen_io}, {"os",luaopen_os}, {"string",luaopen_string}, {NULL,NULL} }; static void luaL_openlibs(lua_State*L){ const luaL_Reg*lib=lualibs; for(;lib->func;lib++){ lua_pushcfunction(L,lib->func); lua_pushstring(L,lib->name); lua_call(L,1,0); } } typedef unsigned int UB; static UB barg(lua_State*L,int idx){ union{lua_Number n;U64 b;}bn; bn.n=lua_tonumber(L,idx)+6755399441055744.0; if(bn.n==0.0&&!lua_isnumber(L,idx))luaL_typerror(L,idx,"number"); return(UB)bn.b; } #define BRET(b)lua_pushnumber(L,(lua_Number)(int)(b));return 1; static int tobit(lua_State*L){ BRET(barg(L,1))} static int bnot(lua_State*L){ BRET(~barg(L,1))} static int band(lua_State*L){ int i;UB b=barg(L,1);for(i=lua_gettop(L);i>1;i--)b&=barg(L,i);BRET(b)} static int bor(lua_State*L){ int i;UB b=barg(L,1);for(i=lua_gettop(L);i>1;i--)b|=barg(L,i);BRET(b)} static int bxor(lua_State*L){ int i;UB b=barg(L,1);for(i=lua_gettop(L);i>1;i--)b^=barg(L,i);BRET(b)} static int lshift(lua_State*L){ UB b=barg(L,1),n=barg(L,2)&31;BRET(b<>n)} static int arshift(lua_State*L){ UB b=barg(L,1),n=barg(L,2)&31;BRET((int)b>>n)} static int rol(lua_State*L){ UB b=barg(L,1),n=barg(L,2)&31;BRET((b<>(32-n)))} static int ror(lua_State*L){ UB b=barg(L,1),n=barg(L,2)&31;BRET((b>>n)|(b<<(32-n)))} static int bswap(lua_State*L){ UB b=barg(L,1);b=(b>>24)|((b>>8)&0xff00)|((b&0xff00)<<8)|(b<<24);BRET(b)} static int tohex(lua_State*L){ UB b=barg(L,1); int n=lua_isnone(L,2)?8:(int)barg(L,2); const char*hexdigits="0123456789abcdef"; char buf[8]; int i; if(n<0){n=-n;hexdigits="0123456789ABCDEF";} if(n>8)n=8; for(i=(int)n;--i>=0;){buf[i]=hexdigits[b&15];b>>=4;} lua_pushlstring(L,buf,(size_t)n); return 1; } static const struct luaL_Reg bitlib[]={ {"tobit",tobit}, {"bnot",bnot}, {"band",band}, {"bor",bor}, {"bxor",bxor}, {"lshift",lshift}, {"rshift",rshift}, {"arshift",arshift}, {"rol",rol}, {"ror",ror}, {"bswap",bswap}, {"tohex",tohex}, {NULL,NULL} }; int main(int argc,char**argv){ lua_State*L=luaL_newstate(); int i; luaL_openlibs(L); luaL_register(L,"bit",bitlib); if(argc<2)return sizeof(void*); lua_createtable(L,0,1); lua_pushstring(L,argv[1]); lua_rawseti(L,-2,0); lua_setglobal(L,"arg"); if(luaL_loadfile(L,argv[1])) goto err; for(i=2;i #include #include #include #include #include "lj_def.h" #include "lj_arch.h" /* Hardcoded limits. Increase as needed. */ #define BUILD_MAX_RELOC 200 /* Max. number of relocations. */ #define BUILD_MAX_FOLD 4096 /* Max. number of fold rules. */ /* Prefix for scanned library definitions. */ #define LIBDEF_PREFIX "LJLIB_" /* Prefix for scanned fold definitions. */ #define FOLDDEF_PREFIX "LJFOLD" /* Prefixes for generated labels. */ #define LABEL_PREFIX "lj_" #define LABEL_PREFIX_BC LABEL_PREFIX "BC_" #define LABEL_PREFIX_FF LABEL_PREFIX "ff_" #define LABEL_PREFIX_CF LABEL_PREFIX "cf_" #define LABEL_PREFIX_FFH LABEL_PREFIX "ffh_" #define LABEL_PREFIX_LIBCF LABEL_PREFIX "lib_cf_" #define LABEL_PREFIX_LIBINIT LABEL_PREFIX "lib_init_" /* Forward declaration. */ struct dasm_State; /* Build modes. */ #define BUILDDEF(_) \ _(elfasm) _(coffasm) _(machasm) _(peobj) _(raw) \ _(bcdef) _(ffdef) _(libdef) _(recdef) _(vmdef) \ _(folddef) typedef enum { #define BUILDENUM(name) BUILD_##name, BUILDDEF(BUILDENUM) #undef BUILDENUM BUILD__MAX } BuildMode; /* Code relocation. */ typedef struct BuildReloc { int32_t ofs; int sym; int type; } BuildReloc; typedef struct BuildSym { const char *name; int32_t ofs; } BuildSym; /* Build context structure. */ typedef struct BuildCtx { /* DynASM state pointer. Should be first member. */ struct dasm_State *D; /* Parsed command line. */ BuildMode mode; FILE *fp; const char *outname; char **args; /* Code and symbols generated by DynASM. */ uint8_t *code; size_t codesz; int npc, nglob, nsym, nreloc, nrelocsym; void **glob; BuildSym *sym; const char **relocsym; int32_t *bc_ofs; const char *beginsym; /* Strings generated by DynASM. */ const char *const *globnames; const char *dasm_ident; const char *dasm_arch; /* Relocations. */ BuildReloc reloc[BUILD_MAX_RELOC]; } BuildCtx; extern void owrite(BuildCtx *ctx, const void *ptr, size_t sz); extern void emit_asm(BuildCtx *ctx); extern void emit_peobj(BuildCtx *ctx); extern void emit_lib(BuildCtx *ctx); extern void emit_fold(BuildCtx *ctx); extern const char *const bc_names[]; extern const char *const ir_names[]; extern const char *const irt_names[]; extern const char *const irfpm_names[]; extern const char *const irfield_names[]; extern const char *const ircall_names[]; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/host/buildvm_lib.c0000644000175000017500000002463613122010155020315 0ustar philphil/* ** LuaJIT VM builder: library definition compiler. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "buildvm.h" #include "lj_obj.h" #include "lj_lib.h" /* Context for library definitions. */ static uint8_t obuf[8192]; static uint8_t *optr; static char modname[80]; static size_t modnamelen; static char funcname[80]; static int modstate, regfunc; static int ffid, recffid, ffasmfunc; enum { REGFUNC_OK, REGFUNC_NOREG, REGFUNC_NOREGUV }; static void libdef_name(const char *p, int kind) { size_t n = strlen(p); if (kind != LIBINIT_STRING) { if (n > modnamelen && p[modnamelen] == '_' && !strncmp(p, modname, modnamelen)) { p += modnamelen+1; n -= modnamelen+1; } } if (n > LIBINIT_MAXSTR) { fprintf(stderr, "Error: string too long: '%s'\n", p); exit(1); } if (optr+1+n+2 > obuf+sizeof(obuf)) { /* +2 for caller. */ fprintf(stderr, "Error: output buffer overflow\n"); exit(1); } *optr++ = (uint8_t)(n | kind); memcpy(optr, p, n); optr += n; } static void libdef_endmodule(BuildCtx *ctx) { if (modstate != 0) { char line[80]; const uint8_t *p; int n; if (modstate == 1) fprintf(ctx->fp, " (lua_CFunction)0"); fprintf(ctx->fp, "\n};\n"); fprintf(ctx->fp, "static const uint8_t %s%s[] = {\n", LABEL_PREFIX_LIBINIT, modname); line[0] = '\0'; for (n = 0, p = obuf; p < optr; p++) { n += sprintf(line+n, "%d,", *p); if (n >= 75) { fprintf(ctx->fp, "%s\n", line); n = 0; line[0] = '\0'; } } fprintf(ctx->fp, "%s%d\n};\n#endif\n\n", line, LIBINIT_END); } } static void libdef_module(BuildCtx *ctx, char *p, int arg) { UNUSED(arg); if (ctx->mode == BUILD_libdef) { libdef_endmodule(ctx); optr = obuf; *optr++ = (uint8_t)ffid; *optr++ = (uint8_t)ffasmfunc; *optr++ = 0; /* Hash table size. */ modstate = 1; fprintf(ctx->fp, "#ifdef %sMODULE_%s\n", LIBDEF_PREFIX, p); fprintf(ctx->fp, "#undef %sMODULE_%s\n", LIBDEF_PREFIX, p); fprintf(ctx->fp, "static const lua_CFunction %s%s[] = {\n", LABEL_PREFIX_LIBCF, p); } modnamelen = strlen(p); if (modnamelen > sizeof(modname)-1) { fprintf(stderr, "Error: module name too long: '%s'\n", p); exit(1); } strcpy(modname, p); } static int find_ffofs(BuildCtx *ctx, const char *name) { int i; for (i = 0; i < ctx->nglob; i++) { const char *gl = ctx->globnames[i]; if (gl[0] == 'f' && gl[1] == 'f' && gl[2] == '_' && !strcmp(gl+3, name)) { return (int)((uint8_t *)ctx->glob[i] - ctx->code); } } fprintf(stderr, "Error: undefined fast function %s%s\n", LABEL_PREFIX_FF, name); exit(1); } static void libdef_func(BuildCtx *ctx, char *p, int arg) { if (arg != LIBINIT_CF) ffasmfunc++; if (ctx->mode == BUILD_libdef) { if (modstate == 0) { fprintf(stderr, "Error: no module for function definition %s\n", p); exit(1); } if (regfunc == REGFUNC_NOREG) { if (optr+1 > obuf+sizeof(obuf)) { fprintf(stderr, "Error: output buffer overflow\n"); exit(1); } *optr++ = LIBINIT_FFID; } else { if (arg != LIBINIT_ASM_) { if (modstate != 1) fprintf(ctx->fp, ",\n"); modstate = 2; fprintf(ctx->fp, " %s%s", arg ? LABEL_PREFIX_FFH : LABEL_PREFIX_CF, p); } if (regfunc != REGFUNC_NOREGUV) obuf[2]++; /* Bump hash table size. */ libdef_name(regfunc == REGFUNC_NOREGUV ? "" : p, arg); } } else if (ctx->mode == BUILD_ffdef) { fprintf(ctx->fp, "FFDEF(%s)\n", p); } else if (ctx->mode == BUILD_recdef) { if (strlen(p) > sizeof(funcname)-1) { fprintf(stderr, "Error: function name too long: '%s'\n", p); exit(1); } strcpy(funcname, p); } else if (ctx->mode == BUILD_vmdef) { int i; for (i = 1; p[i] && modname[i-1]; i++) if (p[i] == '_') p[i] = '.'; fprintf(ctx->fp, "\"%s\",\n", p); } else if (ctx->mode == BUILD_bcdef) { if (arg != LIBINIT_CF) fprintf(ctx->fp, ",\n%d", find_ffofs(ctx, p)); } ffid++; regfunc = REGFUNC_OK; } static uint32_t find_rec(char *name) { char *p = (char *)obuf; uint32_t n; for (n = 2; *p; n++) { if (strcmp(p, name) == 0) return n; p += strlen(p)+1; } if (p+strlen(name)+1 >= (char *)obuf+sizeof(obuf)) { fprintf(stderr, "Error: output buffer overflow\n"); exit(1); } strcpy(p, name); return n; } static void libdef_rec(BuildCtx *ctx, char *p, int arg) { UNUSED(arg); if (ctx->mode == BUILD_recdef) { char *q; uint32_t n; for (; recffid+1 < ffid; recffid++) fprintf(ctx->fp, ",\n0"); recffid = ffid; if (*p == '.') p = funcname; q = strchr(p, ' '); if (q) *q++ = '\0'; n = find_rec(p); if (q) fprintf(ctx->fp, ",\n0x%02x00+(%s)", n, q); else fprintf(ctx->fp, ",\n0x%02x00", n); } } static void memcpy_endian(void *dst, void *src, size_t n) { union { uint8_t b; uint32_t u; } host_endian; host_endian.u = 1; if (host_endian.b == LJ_ENDIAN_SELECT(1, 0)) { memcpy(dst, src, n); } else { size_t i; for (i = 0; i < n; i++) ((uint8_t *)dst)[i] = ((uint8_t *)src)[n-i-1]; } } static void libdef_push(BuildCtx *ctx, char *p, int arg) { UNUSED(arg); if (ctx->mode == BUILD_libdef) { int len = (int)strlen(p); if (*p == '"') { if (len > 1 && p[len-1] == '"') { p[len-1] = '\0'; libdef_name(p+1, LIBINIT_STRING); return; } } else if (*p >= '0' && *p <= '9') { char *ep; double d = strtod(p, &ep); if (*ep == '\0') { if (optr+1+sizeof(double) > obuf+sizeof(obuf)) { fprintf(stderr, "Error: output buffer overflow\n"); exit(1); } *optr++ = LIBINIT_NUMBER; memcpy_endian(optr, &d, sizeof(double)); optr += sizeof(double); return; } } else if (!strcmp(p, "lastcl")) { if (optr+1 > obuf+sizeof(obuf)) { fprintf(stderr, "Error: output buffer overflow\n"); exit(1); } *optr++ = LIBINIT_LASTCL; return; } else if (len > 4 && !strncmp(p, "top-", 4)) { if (optr+2 > obuf+sizeof(obuf)) { fprintf(stderr, "Error: output buffer overflow\n"); exit(1); } *optr++ = LIBINIT_COPY; *optr++ = (uint8_t)atoi(p+4); return; } fprintf(stderr, "Error: bad value for %sPUSH(%s)\n", LIBDEF_PREFIX, p); exit(1); } } static void libdef_set(BuildCtx *ctx, char *p, int arg) { UNUSED(arg); if (ctx->mode == BUILD_libdef) { if (p[0] == '!' && p[1] == '\0') p[0] = '\0'; /* Set env. */ libdef_name(p, LIBINIT_STRING); *optr++ = LIBINIT_SET; obuf[2]++; /* Bump hash table size. */ } } static void libdef_regfunc(BuildCtx *ctx, char *p, int arg) { UNUSED(ctx); UNUSED(p); regfunc = arg; } typedef void (*LibDefFunc)(BuildCtx *ctx, char *p, int arg); typedef struct LibDefHandler { const char *suffix; const char *stop; const LibDefFunc func; const int arg; } LibDefHandler; static const LibDefHandler libdef_handlers[] = { { "MODULE_", " \t\r\n", libdef_module, 0 }, { "CF(", ")", libdef_func, LIBINIT_CF }, { "ASM(", ")", libdef_func, LIBINIT_ASM }, { "ASM_(", ")", libdef_func, LIBINIT_ASM_ }, { "REC(", ")", libdef_rec, 0 }, { "PUSH(", ")", libdef_push, 0 }, { "SET(", ")", libdef_set, 0 }, { "NOREGUV", NULL, libdef_regfunc, REGFUNC_NOREGUV }, { "NOREG", NULL, libdef_regfunc, REGFUNC_NOREG }, { NULL, NULL, (LibDefFunc)0, 0 } }; /* Emit C source code for library function definitions. */ void emit_lib(BuildCtx *ctx) { const char *fname; if (ctx->mode == BUILD_ffdef || ctx->mode == BUILD_libdef || ctx->mode == BUILD_recdef) fprintf(ctx->fp, "/* This is a generated file. DO NOT EDIT! */\n\n"); else if (ctx->mode == BUILD_vmdef) fprintf(ctx->fp, "ffnames = {\n[0]=\"Lua\",\n\"C\",\n"); if (ctx->mode == BUILD_recdef) fprintf(ctx->fp, "static const uint16_t recff_idmap[] = {\n0,\n0x0100"); recffid = ffid = FF_C+1; ffasmfunc = 0; while ((fname = *ctx->args++)) { char buf[256]; /* We don't care about analyzing lines longer than that. */ FILE *fp; if (fname[0] == '-' && fname[1] == '\0') { fp = stdin; } else { fp = fopen(fname, "r"); if (!fp) { fprintf(stderr, "Error: cannot open input file '%s': %s\n", fname, strerror(errno)); exit(1); } } modstate = 0; regfunc = REGFUNC_OK; while (fgets(buf, sizeof(buf), fp) != NULL) { char *p; /* Simplistic pre-processor. Only handles top-level #if/#endif. */ if (buf[0] == '#' && buf[1] == 'i' && buf[2] == 'f') { int ok = 1; if (!strcmp(buf, "#if LJ_52\n")) ok = LJ_52; else if (!strcmp(buf, "#if LJ_HASJIT\n")) ok = LJ_HASJIT; else if (!strcmp(buf, "#if LJ_HASFFI\n")) ok = LJ_HASFFI; if (!ok) { int lvl = 1; while (fgets(buf, sizeof(buf), fp) != NULL) { if (buf[0] == '#' && buf[1] == 'e' && buf[2] == 'n') { if (--lvl == 0) break; } else if (buf[0] == '#' && buf[1] == 'i' && buf[2] == 'f') { lvl++; } } continue; } } for (p = buf; (p = strstr(p, LIBDEF_PREFIX)) != NULL; ) { const LibDefHandler *ldh; p += sizeof(LIBDEF_PREFIX)-1; for (ldh = libdef_handlers; ldh->suffix != NULL; ldh++) { size_t n, len = strlen(ldh->suffix); if (!strncmp(p, ldh->suffix, len)) { p += len; n = ldh->stop ? strcspn(p, ldh->stop) : 0; if (!p[n]) break; p[n] = '\0'; ldh->func(ctx, p, ldh->arg); p += n+1; break; } } if (ldh->suffix == NULL) { buf[strlen(buf)-1] = '\0'; fprintf(stderr, "Error: unknown library definition tag %s%s\n", LIBDEF_PREFIX, p); exit(1); } } } fclose(fp); if (ctx->mode == BUILD_libdef) { libdef_endmodule(ctx); } } if (ctx->mode == BUILD_ffdef) { fprintf(ctx->fp, "\n#undef FFDEF\n\n"); fprintf(ctx->fp, "#ifndef FF_NUM_ASMFUNC\n#define FF_NUM_ASMFUNC %d\n#endif\n\n", ffasmfunc); } else if (ctx->mode == BUILD_vmdef) { fprintf(ctx->fp, "}\n\n"); } else if (ctx->mode == BUILD_bcdef) { int i; fprintf(ctx->fp, "\n};\n\n"); fprintf(ctx->fp, "LJ_DATADEF const uint16_t lj_bc_mode[] = {\n"); fprintf(ctx->fp, "BCDEF(BCMODE)\n"); for (i = ffasmfunc-1; i > 0; i--) fprintf(ctx->fp, "BCMODE_FF,\n"); fprintf(ctx->fp, "BCMODE_FF\n};\n\n"); } else if (ctx->mode == BUILD_recdef) { char *p = (char *)obuf; fprintf(ctx->fp, "\n};\n\n"); fprintf(ctx->fp, "static const RecordFunc recff_func[] = {\n" "recff_nyi,\n" "recff_c"); while (*p) { fprintf(ctx->fp, ",\nrecff_%s", p); p += strlen(p)+1; } fprintf(ctx->fp, "\n};\n\n"); } } wcc-0.0.2/src/wsh/luajit-2.0/src/host/.gitignore0000644000175000017500000000003713122010155017636 0ustar philphilminilua buildvm buildvm_arch.h wcc-0.0.2/src/wsh/luajit-2.0/src/host/buildvm_fold.c0000644000175000017500000001451613122010155020467 0ustar philphil/* ** LuaJIT VM builder: IR folding hash table generator. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "buildvm.h" #include "lj_obj.h" #include "lj_ir.h" /* Context for the folding hash table generator. */ static int lineno; static uint32_t funcidx; static uint32_t foldkeys[BUILD_MAX_FOLD]; static uint32_t nkeys; /* Try to fill the hash table with keys using the hash parameters. */ static int tryhash(uint32_t *htab, uint32_t sz, uint32_t r, int dorol) { uint32_t i; if (dorol && ((r & 31) == 0 || (r>>5) == 0)) return 0; /* Avoid zero rotates. */ memset(htab, 0xff, (sz+1)*sizeof(uint32_t)); for (i = 0; i < nkeys; i++) { uint32_t key = foldkeys[i]; uint32_t k = key & 0xffffff; uint32_t h = (dorol ? lj_rol(lj_rol(k, r>>5) - k, r&31) : (((k << (r>>5)) - k) << (r&31))) % sz; if (htab[h] != 0xffffffff) { /* Collision on primary slot. */ if (htab[h+1] != 0xffffffff) { /* Collision on secondary slot. */ /* Try to move the colliding key, if possible. */ if (h < sz-1 && htab[h+2] == 0xffffffff) { uint32_t k2 = htab[h+1] & 0xffffff; uint32_t h2 = (dorol ? lj_rol(lj_rol(k2, r>>5) - k2, r&31) : (((k2 << (r>>5)) - k2) << (r&31))) % sz; if (h2 != h+1) return 0; /* Cannot resolve collision. */ htab[h+2] = htab[h+1]; /* Move colliding key to secondary slot. */ } else { return 0; /* Collision. */ } } htab[h+1] = key; } else { htab[h] = key; } } return 1; /* Success, all keys could be stored. */ } /* Print the generated hash table. */ static void printhash(BuildCtx *ctx, uint32_t *htab, uint32_t sz) { uint32_t i; fprintf(ctx->fp, "static const uint32_t fold_hash[%d] = {\n0x%08x", sz+1, htab[0]); for (i = 1; i < sz+1; i++) fprintf(ctx->fp, ",\n0x%08x", htab[i]); fprintf(ctx->fp, "\n};\n\n"); } /* Exhaustive search for the shortest semi-perfect hash table. */ static void makehash(BuildCtx *ctx) { uint32_t htab[BUILD_MAX_FOLD*2+1]; uint32_t sz, r; /* Search for the smallest hash table with an odd size. */ for (sz = (nkeys|1); sz < BUILD_MAX_FOLD*2; sz += 2) { /* First try all shift hash combinations. */ for (r = 0; r < 32*32; r++) { if (tryhash(htab, sz, r, 0)) { printhash(ctx, htab, sz); fprintf(ctx->fp, "#define fold_hashkey(k)\t(((((k)<<%u)-(k))<<%u)%%%u)\n\n", r>>5, r&31, sz); return; } } /* Then try all rotate hash combinations. */ for (r = 0; r < 32*32; r++) { if (tryhash(htab, sz, r, 1)) { printhash(ctx, htab, sz); fprintf(ctx->fp, "#define fold_hashkey(k)\t(lj_rol(lj_rol((k),%u)-(k),%u)%%%u)\n\n", r>>5, r&31, sz); return; } } } fprintf(stderr, "Error: search for perfect hash failed\n"); exit(1); } /* Parse one token of a fold rule. */ static uint32_t nexttoken(char **pp, int allowlit, int allowany) { char *p = *pp; if (p) { uint32_t i; char *q = strchr(p, ' '); if (q) *q++ = '\0'; *pp = q; if (allowlit && !strncmp(p, "IRFPM_", 6)) { for (i = 0; irfpm_names[i]; i++) if (!strcmp(irfpm_names[i], p+6)) return i; } else if (allowlit && !strncmp(p, "IRFL_", 5)) { for (i = 0; irfield_names[i]; i++) if (!strcmp(irfield_names[i], p+5)) return i; } else if (allowlit && !strncmp(p, "IRCALL_", 7)) { for (i = 0; ircall_names[i]; i++) if (!strcmp(ircall_names[i], p+7)) return i; } else if (allowlit && !strncmp(p, "IRCONV_", 7)) { for (i = 0; irt_names[i]; i++) { const char *r = strchr(p+7, '_'); if (r && !strncmp(irt_names[i], p+7, r-(p+7))) { uint32_t j; for (j = 0; irt_names[j]; j++) if (!strcmp(irt_names[j], r+1)) return (i << 5) + j; } } } else if (allowlit && *p >= '0' && *p <= '9') { for (i = 0; *p >= '0' && *p <= '9'; p++) i = i*10 + (*p - '0'); if (*p == '\0') return i; } else if (allowany && !strcmp("any", p)) { return allowany; } else { for (i = 0; ir_names[i]; i++) if (!strcmp(ir_names[i], p)) return i; } fprintf(stderr, "Error: bad fold definition token \"%s\" at line %d\n", p, lineno); exit(1); } return 0; } /* Parse a fold rule. */ static void foldrule(char *p) { uint32_t op = nexttoken(&p, 0, 0); uint32_t left = nexttoken(&p, 0, 0x7f); uint32_t right = nexttoken(&p, 1, 0x3ff); uint32_t key = (funcidx << 24) | (op << 17) | (left << 10) | right; uint32_t i; if (nkeys >= BUILD_MAX_FOLD) { fprintf(stderr, "Error: too many fold rules, increase BUILD_MAX_FOLD.\n"); exit(1); } /* Simple insertion sort to detect duplicates. */ for (i = nkeys; i > 0; i--) { if ((foldkeys[i-1]&0xffffff) < (key & 0xffffff)) break; if ((foldkeys[i-1]&0xffffff) == (key & 0xffffff)) { fprintf(stderr, "Error: duplicate fold definition at line %d\n", lineno); exit(1); } foldkeys[i] = foldkeys[i-1]; } foldkeys[i] = key; nkeys++; } /* Emit C source code for IR folding hash table. */ void emit_fold(BuildCtx *ctx) { char buf[256]; /* We don't care about analyzing lines longer than that. */ const char *fname = ctx->args[0]; FILE *fp; if (fname == NULL) { fprintf(stderr, "Error: missing input filename\n"); exit(1); } if (fname[0] == '-' && fname[1] == '\0') { fp = stdin; } else { fp = fopen(fname, "r"); if (!fp) { fprintf(stderr, "Error: cannot open input file '%s': %s\n", fname, strerror(errno)); exit(1); } } fprintf(ctx->fp, "/* This is a generated file. DO NOT EDIT! */\n\n"); fprintf(ctx->fp, "static const FoldFunc fold_func[] = {\n"); lineno = 0; funcidx = 0; nkeys = 0; while (fgets(buf, sizeof(buf), fp) != NULL) { lineno++; /* The prefix must be at the start of a line, otherwise it's ignored. */ if (!strncmp(buf, FOLDDEF_PREFIX, sizeof(FOLDDEF_PREFIX)-1)) { char *p = buf+sizeof(FOLDDEF_PREFIX)-1; char *q = strchr(p, ')'); if (p[0] == '(' && q) { p++; *q = '\0'; foldrule(p); } else if ((p[0] == 'F' || p[0] == 'X') && p[1] == '(' && q) { p += 2; *q = '\0'; if (funcidx) fprintf(ctx->fp, ",\n"); if (p[-2] == 'X') fprintf(ctx->fp, " %s", p); else fprintf(ctx->fp, " fold_%s", p); funcidx++; } else { buf[strlen(buf)-1] = '\0'; fprintf(stderr, "Error: unknown fold definition tag %s%s at line %d\n", FOLDDEF_PREFIX, p, lineno); exit(1); } } } fclose(fp); fprintf(ctx->fp, "\n};\n\n"); makehash(ctx); } wcc-0.0.2/src/wsh/luajit-2.0/src/host/buildvm.c0000644000175000017500000003121013122010155017451 0ustar philphil/* ** LuaJIT VM builder. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** This is a tool to build the hand-tuned assembler code required for ** LuaJIT's bytecode interpreter. It supports a variety of output formats ** to feed different toolchains (see usage() below). ** ** This tool is not particularly optimized because it's only used while ** _building_ LuaJIT. There's no point in distributing or installing it. ** Only the object code generated by this tool is linked into LuaJIT. ** ** Caveat: some memory is not free'd, error handling is lazy. ** It's a one-shot tool -- any effort fixing this would be wasted. */ #include "buildvm.h" #include "lj_obj.h" #include "lj_gc.h" #include "lj_bc.h" #include "lj_ir.h" #include "lj_ircall.h" #include "lj_frame.h" #include "lj_dispatch.h" #if LJ_HASFFI #include "lj_ctype.h" #include "lj_ccall.h" #endif #include "luajit.h" #if defined(_WIN32) #include #include #endif /* ------------------------------------------------------------------------ */ /* DynASM glue definitions. */ #define Dst ctx #define Dst_DECL BuildCtx *ctx #define Dst_REF (ctx->D) #define DASM_CHECKS 1 #include "../dynasm/dasm_proto.h" /* Glue macros for DynASM. */ static int collect_reloc(BuildCtx *ctx, uint8_t *addr, int idx, int type); #define DASM_EXTERN(ctx, addr, idx, type) \ collect_reloc(ctx, addr, idx, type) /* ------------------------------------------------------------------------ */ /* Avoid trouble if cross-compiling for an x86 target. Speed doesn't matter. */ #define DASM_ALIGNED_WRITES 1 /* Embed architecture-specific DynASM encoder. */ #if LJ_TARGET_X86ORX64 #include "../dynasm/dasm_x86.h" #elif LJ_TARGET_ARM #include "../dynasm/dasm_arm.h" #elif LJ_TARGET_PPC #include "../dynasm/dasm_ppc.h" #elif LJ_TARGET_PPCSPE #include "../dynasm/dasm_ppc.h" #elif LJ_TARGET_MIPS #include "../dynasm/dasm_mips.h" #else #error "No support for this architecture (yet)" #endif /* Embed generated architecture-specific backend. */ #include "buildvm_arch.h" /* ------------------------------------------------------------------------ */ void owrite(BuildCtx *ctx, const void *ptr, size_t sz) { if (fwrite(ptr, 1, sz, ctx->fp) != sz) { fprintf(stderr, "Error: cannot write to output file: %s\n", strerror(errno)); exit(1); } } /* ------------------------------------------------------------------------ */ /* Emit code as raw bytes. Only used for DynASM debugging. */ static void emit_raw(BuildCtx *ctx) { owrite(ctx, ctx->code, ctx->codesz); } /* -- Build machine code -------------------------------------------------- */ static const char *sym_decorate(BuildCtx *ctx, const char *prefix, const char *suffix) { char name[256]; char *p; #if LJ_64 const char *symprefix = ctx->mode == BUILD_machasm ? "_" : ""; #elif LJ_TARGET_XBOX360 const char *symprefix = ""; #else const char *symprefix = ctx->mode != BUILD_elfasm ? "_" : ""; #endif sprintf(name, "%s%s%s", symprefix, prefix, suffix); p = strchr(name, '@'); if (p) { #if LJ_TARGET_X86ORX64 if (!LJ_64 && (ctx->mode == BUILD_coffasm || ctx->mode == BUILD_peobj)) name[0] = '@'; else *p = '\0'; #elif (LJ_TARGET_PPC || LJ_TARGET_PPCSPE) && !LJ_TARGET_CONSOLE /* Keep @plt. */ #else *p = '\0'; #endif } p = (char *)malloc(strlen(name)+1); /* MSVC doesn't like strdup. */ strcpy(p, name); return p; } #define NRELOCSYM (sizeof(extnames)/sizeof(extnames[0])-1) static int relocmap[NRELOCSYM]; /* Collect external relocations. */ static int collect_reloc(BuildCtx *ctx, uint8_t *addr, int idx, int type) { if (ctx->nreloc >= BUILD_MAX_RELOC) { fprintf(stderr, "Error: too many relocations, increase BUILD_MAX_RELOC.\n"); exit(1); } if (relocmap[idx] < 0) { relocmap[idx] = ctx->nrelocsym; ctx->relocsym[ctx->nrelocsym] = sym_decorate(ctx, "", extnames[idx]); ctx->nrelocsym++; } ctx->reloc[ctx->nreloc].ofs = (int32_t)(addr - ctx->code); ctx->reloc[ctx->nreloc].sym = relocmap[idx]; ctx->reloc[ctx->nreloc].type = type; ctx->nreloc++; #if LJ_TARGET_XBOX360 return (int)(ctx->code - addr) + 4; /* Encode symbol offset of .text. */ #else return 0; /* Encode symbol offset of 0. */ #endif } /* Naive insertion sort. Performance doesn't matter here. */ static void sym_insert(BuildCtx *ctx, int32_t ofs, const char *prefix, const char *suffix) { ptrdiff_t i = ctx->nsym++; while (i > 0) { if (ctx->sym[i-1].ofs <= ofs) break; ctx->sym[i] = ctx->sym[i-1]; i--; } ctx->sym[i].ofs = ofs; ctx->sym[i].name = sym_decorate(ctx, prefix, suffix); } /* Build the machine code. */ static int build_code(BuildCtx *ctx) { int status; int i; /* Initialize DynASM structures. */ ctx->nglob = GLOB__MAX; ctx->glob = (void **)malloc(ctx->nglob*sizeof(void *)); memset(ctx->glob, 0, ctx->nglob*sizeof(void *)); ctx->nreloc = 0; ctx->globnames = globnames; ctx->relocsym = (const char **)malloc(NRELOCSYM*sizeof(const char *)); ctx->nrelocsym = 0; for (i = 0; i < (int)NRELOCSYM; i++) relocmap[i] = -1; ctx->dasm_ident = DASM_IDENT; ctx->dasm_arch = DASM_ARCH; dasm_init(Dst, DASM_MAXSECTION); dasm_setupglobal(Dst, ctx->glob, ctx->nglob); dasm_setup(Dst, build_actionlist); /* Call arch-specific backend to emit the code. */ ctx->npc = build_backend(ctx); /* Finalize the code. */ (void)dasm_checkstep(Dst, -1); if ((status = dasm_link(Dst, &ctx->codesz))) return status; ctx->code = (uint8_t *)malloc(ctx->codesz); if ((status = dasm_encode(Dst, (void *)ctx->code))) return status; /* Allocate symbol table and bytecode offsets. */ ctx->beginsym = sym_decorate(ctx, "", LABEL_PREFIX "vm_asm_begin"); ctx->sym = (BuildSym *)malloc((ctx->npc+ctx->nglob+1)*sizeof(BuildSym)); ctx->nsym = 0; ctx->bc_ofs = (int32_t *)malloc(ctx->npc*sizeof(int32_t)); /* Collect the opcodes (PC labels). */ for (i = 0; i < ctx->npc; i++) { int32_t ofs = dasm_getpclabel(Dst, i); if (ofs < 0) return 0x22000000|i; ctx->bc_ofs[i] = ofs; if ((LJ_HASJIT || !(i == BC_JFORI || i == BC_JFORL || i == BC_JITERL || i == BC_JLOOP || i == BC_IFORL || i == BC_IITERL || i == BC_ILOOP)) && (LJ_HASFFI || i != BC_KCDATA)) sym_insert(ctx, ofs, LABEL_PREFIX_BC, bc_names[i]); } /* Collect the globals (named labels). */ for (i = 0; i < ctx->nglob; i++) { const char *gl = globnames[i]; int len = (int)strlen(gl); if (!ctx->glob[i]) { fprintf(stderr, "Error: undefined global %s\n", gl); exit(2); } /* Skip the _Z symbols. */ if (!(len >= 2 && gl[len-2] == '_' && gl[len-1] == 'Z')) sym_insert(ctx, (int32_t)((uint8_t *)(ctx->glob[i]) - ctx->code), LABEL_PREFIX, globnames[i]); } /* Close the address range. */ sym_insert(ctx, (int32_t)ctx->codesz, "", ""); ctx->nsym--; dasm_free(Dst); return 0; } /* -- Generate VM enums --------------------------------------------------- */ const char *const bc_names[] = { #define BCNAME(name, ma, mb, mc, mt) #name, BCDEF(BCNAME) #undef BCNAME NULL }; const char *const ir_names[] = { #define IRNAME(name, m, m1, m2) #name, IRDEF(IRNAME) #undef IRNAME NULL }; const char *const irt_names[] = { #define IRTNAME(name, size) #name, IRTDEF(IRTNAME) #undef IRTNAME NULL }; const char *const irfpm_names[] = { #define FPMNAME(name) #name, IRFPMDEF(FPMNAME) #undef FPMNAME NULL }; const char *const irfield_names[] = { #define FLNAME(name, ofs) #name, IRFLDEF(FLNAME) #undef FLNAME NULL }; const char *const ircall_names[] = { #define IRCALLNAME(cond, name, nargs, kind, type, flags) #name, IRCALLDEF(IRCALLNAME) #undef IRCALLNAME NULL }; static const char *const trace_errors[] = { #define TREDEF(name, msg) msg, #include "lj_traceerr.h" NULL }; static const char *lower(char *buf, const char *s) { char *p = buf; while (*s) { *p++ = (*s >= 'A' && *s <= 'Z') ? *s+0x20 : *s; s++; } *p = '\0'; return buf; } /* Emit C source code for bytecode-related definitions. */ static void emit_bcdef(BuildCtx *ctx) { int i; fprintf(ctx->fp, "/* This is a generated file. DO NOT EDIT! */\n\n"); fprintf(ctx->fp, "LJ_DATADEF const uint16_t lj_bc_ofs[] = {\n"); for (i = 0; i < ctx->npc; i++) { if (i != 0) fprintf(ctx->fp, ",\n"); fprintf(ctx->fp, "%d", ctx->bc_ofs[i]); } } /* Emit VM definitions as Lua code for debug modules. */ static void emit_vmdef(BuildCtx *ctx) { char buf[80]; int i; fprintf(ctx->fp, "-- This is a generated file. DO NOT EDIT!\n\n"); fprintf(ctx->fp, "module(...)\n\n"); fprintf(ctx->fp, "bcnames = \""); for (i = 0; bc_names[i]; i++) fprintf(ctx->fp, "%-6s", bc_names[i]); fprintf(ctx->fp, "\"\n\n"); fprintf(ctx->fp, "irnames = \""); for (i = 0; ir_names[i]; i++) fprintf(ctx->fp, "%-6s", ir_names[i]); fprintf(ctx->fp, "\"\n\n"); fprintf(ctx->fp, "irfpm = { [0]="); for (i = 0; irfpm_names[i]; i++) fprintf(ctx->fp, "\"%s\", ", lower(buf, irfpm_names[i])); fprintf(ctx->fp, "}\n\n"); fprintf(ctx->fp, "irfield = { [0]="); for (i = 0; irfield_names[i]; i++) { char *p; lower(buf, irfield_names[i]); p = strchr(buf, '_'); if (p) *p = '.'; fprintf(ctx->fp, "\"%s\", ", buf); } fprintf(ctx->fp, "}\n\n"); fprintf(ctx->fp, "ircall = {\n[0]="); for (i = 0; ircall_names[i]; i++) fprintf(ctx->fp, "\"%s\",\n", ircall_names[i]); fprintf(ctx->fp, "}\n\n"); fprintf(ctx->fp, "traceerr = {\n[0]="); for (i = 0; trace_errors[i]; i++) fprintf(ctx->fp, "\"%s\",\n", trace_errors[i]); fprintf(ctx->fp, "}\n\n"); } /* -- Argument parsing ---------------------------------------------------- */ /* Build mode names. */ static const char *const modenames[] = { #define BUILDNAME(name) #name, BUILDDEF(BUILDNAME) #undef BUILDNAME NULL }; /* Print usage information and exit. */ static void usage(void) { int i; fprintf(stderr, LUAJIT_VERSION " VM builder.\n"); fprintf(stderr, LUAJIT_COPYRIGHT ", " LUAJIT_URL "\n"); fprintf(stderr, "Target architecture: " LJ_ARCH_NAME "\n\n"); fprintf(stderr, "Usage: buildvm -m mode [-o outfile] [infiles...]\n\n"); fprintf(stderr, "Available modes:\n"); for (i = 0; i < BUILD__MAX; i++) fprintf(stderr, " %s\n", modenames[i]); exit(1); } /* Parse the output mode name. */ static BuildMode parsemode(const char *mode) { int i; for (i = 0; modenames[i]; i++) if (!strcmp(mode, modenames[i])) return (BuildMode)i; usage(); return (BuildMode)-1; } /* Parse arguments. */ static void parseargs(BuildCtx *ctx, char **argv) { const char *a; int i; ctx->mode = (BuildMode)-1; ctx->outname = "-"; for (i = 1; (a = argv[i]) != NULL; i++) { if (a[0] != '-') break; switch (a[1]) { case '-': if (a[2]) goto err; i++; goto ok; case '\0': goto ok; case 'm': i++; if (a[2] || argv[i] == NULL) goto err; ctx->mode = parsemode(argv[i]); break; case 'o': i++; if (a[2] || argv[i] == NULL) goto err; ctx->outname = argv[i]; break; default: err: usage(); break; } } ok: ctx->args = argv+i; if (ctx->mode == (BuildMode)-1) goto err; } int main(int argc, char **argv) { BuildCtx ctx_; BuildCtx *ctx = &ctx_; int status, binmode; if (sizeof(void *) != 4*LJ_32+8*LJ_64) { fprintf(stderr,"Error: pointer size mismatch in cross-build.\n"); fprintf(stderr,"Try: make HOST_CC=\"gcc -m32\" CROSS=...\n\n"); return 1; } UNUSED(argc); parseargs(ctx, argv); if ((status = build_code(ctx))) { fprintf(stderr,"Error: DASM error %08x\n", status); return 1; } switch (ctx->mode) { case BUILD_peobj: case BUILD_raw: binmode = 1; break; default: binmode = 0; break; } if (ctx->outname[0] == '-' && ctx->outname[1] == '\0') { ctx->fp = stdout; #if defined(_WIN32) if (binmode) _setmode(_fileno(stdout), _O_BINARY); /* Yuck. */ #endif } else if (!(ctx->fp = fopen(ctx->outname, binmode ? "wb" : "w"))) { fprintf(stderr, "Error: cannot open output file '%s': %s\n", ctx->outname, strerror(errno)); exit(1); } switch (ctx->mode) { case BUILD_elfasm: case BUILD_coffasm: case BUILD_machasm: emit_asm(ctx); emit_asm_debug(ctx); break; case BUILD_peobj: emit_peobj(ctx); break; case BUILD_raw: emit_raw(ctx); break; case BUILD_bcdef: emit_bcdef(ctx); emit_lib(ctx); break; case BUILD_vmdef: emit_vmdef(ctx); emit_lib(ctx); break; case BUILD_ffdef: case BUILD_libdef: case BUILD_recdef: emit_lib(ctx); break; case BUILD_folddef: emit_fold(ctx); break; default: break; } fflush(ctx->fp); if (ferror(ctx->fp)) { fprintf(stderr, "Error: cannot write to output file: %s\n", strerror(errno)); exit(1); } fclose(ctx->fp); return 0; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_carith.h0000644000175000017500000000124213122010155017000 0ustar philphil/* ** C data arithmetic. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CARITH_H #define _LJ_CARITH_H #include "lj_obj.h" #if LJ_HASFFI LJ_FUNC int lj_carith_op(lua_State *L, MMS mm); #if LJ_32 && LJ_HASJIT LJ_FUNC int64_t lj_carith_mul64(int64_t x, int64_t k); #endif LJ_FUNC uint64_t lj_carith_divu64(uint64_t a, uint64_t b); LJ_FUNC int64_t lj_carith_divi64(int64_t a, int64_t b); LJ_FUNC uint64_t lj_carith_modu64(uint64_t a, uint64_t b); LJ_FUNC int64_t lj_carith_modi64(int64_t a, int64_t b); LJ_FUNC uint64_t lj_carith_powu64(uint64_t x, uint64_t k); LJ_FUNC int64_t lj_carith_powi64(int64_t x, int64_t k); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_alloc.h0000644000175000017500000000051213122010155016617 0ustar philphil/* ** Bundled memory allocator. ** Donated to the public domain. */ #ifndef _LJ_ALLOC_H #define _LJ_ALLOC_H #include "lj_def.h" #ifndef LUAJIT_USE_SYSMALLOC LJ_FUNC void *lj_alloc_create(void); LJ_FUNC void lj_alloc_destroy(void *msp); LJ_FUNC void *lj_alloc_f(void *msp, void *ptr, size_t osize, size_t nsize); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lualib.h0000644000175000017500000000213113122010155016307 0ustar philphil/* ** Standard library header. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LUALIB_H #define _LUALIB_H #include "lua.h" #define LUA_FILEHANDLE "FILE*" #define LUA_COLIBNAME "coroutine" #define LUA_MATHLIBNAME "math" #define LUA_STRLIBNAME "string" #define LUA_TABLIBNAME "table" #define LUA_IOLIBNAME "io" #define LUA_OSLIBNAME "os" #define LUA_LOADLIBNAME "package" #define LUA_DBLIBNAME "debug" #define LUA_BITLIBNAME "bit" #define LUA_JITLIBNAME "jit" #define LUA_FFILIBNAME "ffi" LUALIB_API int luaopen_base(lua_State *L); LUALIB_API int luaopen_math(lua_State *L); LUALIB_API int luaopen_string(lua_State *L); LUALIB_API int luaopen_table(lua_State *L); LUALIB_API int luaopen_io(lua_State *L); LUALIB_API int luaopen_os(lua_State *L); LUALIB_API int luaopen_package(lua_State *L); LUALIB_API int luaopen_debug(lua_State *L); LUALIB_API int luaopen_bit(lua_State *L); LUALIB_API int luaopen_jit(lua_State *L); LUALIB_API int luaopen_ffi(lua_State *L); LUALIB_API void luaL_openlibs(lua_State *L); #ifndef lua_assert #define lua_assert(x) ((void)0) #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_char.h0000644000175000017500000000263513122010155016452 0ustar philphil/* ** Character types. ** Donated to the public domain. */ #ifndef _LJ_CHAR_H #define _LJ_CHAR_H #include "lj_def.h" #define LJ_CHAR_CNTRL 0x01 #define LJ_CHAR_SPACE 0x02 #define LJ_CHAR_PUNCT 0x04 #define LJ_CHAR_DIGIT 0x08 #define LJ_CHAR_XDIGIT 0x10 #define LJ_CHAR_UPPER 0x20 #define LJ_CHAR_LOWER 0x40 #define LJ_CHAR_IDENT 0x80 #define LJ_CHAR_ALPHA (LJ_CHAR_LOWER|LJ_CHAR_UPPER) #define LJ_CHAR_ALNUM (LJ_CHAR_ALPHA|LJ_CHAR_DIGIT) #define LJ_CHAR_GRAPH (LJ_CHAR_ALNUM|LJ_CHAR_PUNCT) /* Only pass -1 or 0..255 to these macros. Never pass a signed char! */ #define lj_char_isa(c, t) ((lj_char_bits+1)[(c)] & t) #define lj_char_iscntrl(c) lj_char_isa((c), LJ_CHAR_CNTRL) #define lj_char_isspace(c) lj_char_isa((c), LJ_CHAR_SPACE) #define lj_char_ispunct(c) lj_char_isa((c), LJ_CHAR_PUNCT) #define lj_char_isdigit(c) lj_char_isa((c), LJ_CHAR_DIGIT) #define lj_char_isxdigit(c) lj_char_isa((c), LJ_CHAR_XDIGIT) #define lj_char_isupper(c) lj_char_isa((c), LJ_CHAR_UPPER) #define lj_char_islower(c) lj_char_isa((c), LJ_CHAR_LOWER) #define lj_char_isident(c) lj_char_isa((c), LJ_CHAR_IDENT) #define lj_char_isalpha(c) lj_char_isa((c), LJ_CHAR_ALPHA) #define lj_char_isalnum(c) lj_char_isa((c), LJ_CHAR_ALNUM) #define lj_char_isgraph(c) lj_char_isa((c), LJ_CHAR_GRAPH) #define lj_char_toupper(c) ((c) - (lj_char_islower(c) >> 1)) #define lj_char_tolower(c) ((c) + lj_char_isupper(c)) LJ_DATA const uint8_t lj_char_bits[257]; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_dispatch.c0000644000175000017500000003534313122010155017331 0ustar philphil/* ** Instruction dispatch handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_dispatch_c #define LUA_CORE #include "lj_obj.h" #include "lj_err.h" #include "lj_func.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_meta.h" #include "lj_debug.h" #include "lj_state.h" #include "lj_frame.h" #include "lj_bc.h" #include "lj_ff.h" #if LJ_HASJIT #include "lj_jit.h" #endif #if LJ_HASFFI #include "lj_ccallback.h" #endif #include "lj_trace.h" #include "lj_dispatch.h" #include "lj_vm.h" #include "luajit.h" /* Bump GG_NUM_ASMFF in lj_dispatch.h as needed. Ugly. */ LJ_STATIC_ASSERT(GG_NUM_ASMFF == FF_NUM_ASMFUNC); /* -- Dispatch table management ------------------------------------------- */ #if LJ_TARGET_MIPS #include LJ_FUNCA_NORET void LJ_FASTCALL lj_ffh_coroutine_wrap_err(lua_State *L, lua_State *co); #define GOTFUNC(name) (ASMFunction)name, static const ASMFunction dispatch_got[] = { GOTDEF(GOTFUNC) }; #undef GOTFUNC #endif /* Initialize instruction dispatch table and hot counters. */ void lj_dispatch_init(GG_State *GG) { uint32_t i; ASMFunction *disp = GG->dispatch; for (i = 0; i < GG_LEN_SDISP; i++) disp[GG_LEN_DDISP+i] = disp[i] = makeasmfunc(lj_bc_ofs[i]); for (i = GG_LEN_SDISP; i < GG_LEN_DDISP; i++) disp[i] = makeasmfunc(lj_bc_ofs[i]); /* The JIT engine is off by default. luaopen_jit() turns it on. */ disp[BC_FORL] = disp[BC_IFORL]; disp[BC_ITERL] = disp[BC_IITERL]; disp[BC_LOOP] = disp[BC_ILOOP]; disp[BC_FUNCF] = disp[BC_IFUNCF]; disp[BC_FUNCV] = disp[BC_IFUNCV]; GG->g.bc_cfunc_ext = GG->g.bc_cfunc_int = BCINS_AD(BC_FUNCC, LUA_MINSTACK, 0); for (i = 0; i < GG_NUM_ASMFF; i++) GG->bcff[i] = BCINS_AD(BC__MAX+i, 0, 0); #if LJ_TARGET_MIPS memcpy(GG->got, dispatch_got, LJ_GOT__MAX*4); #endif } #if LJ_HASJIT /* Initialize hotcount table. */ void lj_dispatch_init_hotcount(global_State *g) { int32_t hotloop = G2J(g)->param[JIT_P_hotloop]; HotCount start = (HotCount)(hotloop*HOTCOUNT_LOOP - 1); HotCount *hotcount = G2GG(g)->hotcount; uint32_t i; for (i = 0; i < HOTCOUNT_SIZE; i++) hotcount[i] = start; } #endif /* Internal dispatch mode bits. */ #define DISPMODE_JIT 0x01 /* JIT compiler on. */ #define DISPMODE_REC 0x02 /* Recording active. */ #define DISPMODE_INS 0x04 /* Override instruction dispatch. */ #define DISPMODE_CALL 0x08 /* Override call dispatch. */ #define DISPMODE_RET 0x10 /* Override return dispatch. */ /* Update dispatch table depending on various flags. */ void lj_dispatch_update(global_State *g) { uint8_t oldmode = g->dispatchmode; uint8_t mode = 0; #if LJ_HASJIT mode |= (G2J(g)->flags & JIT_F_ON) ? DISPMODE_JIT : 0; mode |= G2J(g)->state != LJ_TRACE_IDLE ? (DISPMODE_REC|DISPMODE_INS|DISPMODE_CALL) : 0; #endif mode |= (g->hookmask & (LUA_MASKLINE|LUA_MASKCOUNT)) ? DISPMODE_INS : 0; mode |= (g->hookmask & LUA_MASKCALL) ? DISPMODE_CALL : 0; mode |= (g->hookmask & LUA_MASKRET) ? DISPMODE_RET : 0; if (oldmode != mode) { /* Mode changed? */ ASMFunction *disp = G2GG(g)->dispatch; ASMFunction f_forl, f_iterl, f_loop, f_funcf, f_funcv; g->dispatchmode = mode; /* Hotcount if JIT is on, but not while recording. */ if ((mode & (DISPMODE_JIT|DISPMODE_REC)) == DISPMODE_JIT) { f_forl = makeasmfunc(lj_bc_ofs[BC_FORL]); f_iterl = makeasmfunc(lj_bc_ofs[BC_ITERL]); f_loop = makeasmfunc(lj_bc_ofs[BC_LOOP]); f_funcf = makeasmfunc(lj_bc_ofs[BC_FUNCF]); f_funcv = makeasmfunc(lj_bc_ofs[BC_FUNCV]); } else { /* Otherwise use the non-hotcounting instructions. */ f_forl = disp[GG_LEN_DDISP+BC_IFORL]; f_iterl = disp[GG_LEN_DDISP+BC_IITERL]; f_loop = disp[GG_LEN_DDISP+BC_ILOOP]; f_funcf = makeasmfunc(lj_bc_ofs[BC_IFUNCF]); f_funcv = makeasmfunc(lj_bc_ofs[BC_IFUNCV]); } /* Init static counting instruction dispatch first (may be copied below). */ disp[GG_LEN_DDISP+BC_FORL] = f_forl; disp[GG_LEN_DDISP+BC_ITERL] = f_iterl; disp[GG_LEN_DDISP+BC_LOOP] = f_loop; /* Set dynamic instruction dispatch. */ if ((oldmode ^ mode) & (DISPMODE_REC|DISPMODE_INS)) { /* Need to update the whole table. */ if (!(mode & (DISPMODE_REC|DISPMODE_INS))) { /* No ins dispatch? */ /* Copy static dispatch table to dynamic dispatch table. */ memcpy(&disp[0], &disp[GG_LEN_DDISP], GG_LEN_SDISP*sizeof(ASMFunction)); /* Overwrite with dynamic return dispatch. */ if ((mode & DISPMODE_RET)) { disp[BC_RETM] = lj_vm_rethook; disp[BC_RET] = lj_vm_rethook; disp[BC_RET0] = lj_vm_rethook; disp[BC_RET1] = lj_vm_rethook; } } else { /* The recording dispatch also checks for hooks. */ ASMFunction f = (mode & DISPMODE_REC) ? lj_vm_record : lj_vm_inshook; uint32_t i; for (i = 0; i < GG_LEN_SDISP; i++) disp[i] = f; } } else if (!(mode & (DISPMODE_REC|DISPMODE_INS))) { /* Otherwise set dynamic counting ins. */ disp[BC_FORL] = f_forl; disp[BC_ITERL] = f_iterl; disp[BC_LOOP] = f_loop; /* Set dynamic return dispatch. */ if ((mode & DISPMODE_RET)) { disp[BC_RETM] = lj_vm_rethook; disp[BC_RET] = lj_vm_rethook; disp[BC_RET0] = lj_vm_rethook; disp[BC_RET1] = lj_vm_rethook; } else { disp[BC_RETM] = disp[GG_LEN_DDISP+BC_RETM]; disp[BC_RET] = disp[GG_LEN_DDISP+BC_RET]; disp[BC_RET0] = disp[GG_LEN_DDISP+BC_RET0]; disp[BC_RET1] = disp[GG_LEN_DDISP+BC_RET1]; } } /* Set dynamic call dispatch. */ if ((oldmode ^ mode) & DISPMODE_CALL) { /* Update the whole table? */ uint32_t i; if ((mode & DISPMODE_CALL) == 0) { /* No call hooks? */ for (i = GG_LEN_SDISP; i < GG_LEN_DDISP; i++) disp[i] = makeasmfunc(lj_bc_ofs[i]); } else { for (i = GG_LEN_SDISP; i < GG_LEN_DDISP; i++) disp[i] = lj_vm_callhook; } } if (!(mode & DISPMODE_CALL)) { /* Overwrite dynamic counting ins. */ disp[BC_FUNCF] = f_funcf; disp[BC_FUNCV] = f_funcv; } #if LJ_HASJIT /* Reset hotcounts for JIT off to on transition. */ if ((mode & DISPMODE_JIT) && !(oldmode & DISPMODE_JIT)) lj_dispatch_init_hotcount(g); #endif } } /* -- JIT mode setting ---------------------------------------------------- */ #if LJ_HASJIT /* Set JIT mode for a single prototype. */ static void setptmode(global_State *g, GCproto *pt, int mode) { if ((mode & LUAJIT_MODE_ON)) { /* (Re-)enable JIT compilation. */ pt->flags &= ~PROTO_NOJIT; lj_trace_reenableproto(pt); /* Unpatch all ILOOP etc. bytecodes. */ } else { /* Flush and/or disable JIT compilation. */ if (!(mode & LUAJIT_MODE_FLUSH)) pt->flags |= PROTO_NOJIT; lj_trace_flushproto(g, pt); /* Flush all traces of prototype. */ } } /* Recursively set the JIT mode for all children of a prototype. */ static void setptmode_all(global_State *g, GCproto *pt, int mode) { ptrdiff_t i; if (!(pt->flags & PROTO_CHILD)) return; for (i = -(ptrdiff_t)pt->sizekgc; i < 0; i++) { GCobj *o = proto_kgc(pt, i); if (o->gch.gct == ~LJ_TPROTO) { setptmode(g, gco2pt(o), mode); setptmode_all(g, gco2pt(o), mode); } } } #endif /* Public API function: control the JIT engine. */ int luaJIT_setmode(lua_State *L, int idx, int mode) { global_State *g = G(L); int mm = mode & LUAJIT_MODE_MASK; lj_trace_abort(g); /* Abort recording on any state change. */ /* Avoid pulling the rug from under our own feet. */ if ((g->hookmask & HOOK_GC)) lj_err_caller(L, LJ_ERR_NOGCMM); switch (mm) { #if LJ_HASJIT case LUAJIT_MODE_ENGINE: if ((mode & LUAJIT_MODE_FLUSH)) { lj_trace_flushall(L); } else { if (!(mode & LUAJIT_MODE_ON)) G2J(g)->flags &= ~(uint32_t)JIT_F_ON; #if LJ_TARGET_X86ORX64 else if ((G2J(g)->flags & JIT_F_SSE2)) G2J(g)->flags |= (uint32_t)JIT_F_ON; else return 0; /* Don't turn on JIT compiler without SSE2 support. */ #else else G2J(g)->flags |= (uint32_t)JIT_F_ON; #endif lj_dispatch_update(g); } break; case LUAJIT_MODE_FUNC: case LUAJIT_MODE_ALLFUNC: case LUAJIT_MODE_ALLSUBFUNC: { cTValue *tv = idx == 0 ? frame_prev(L->base-1) : idx > 0 ? L->base + (idx-1) : L->top + idx; GCproto *pt; if ((idx == 0 || tvisfunc(tv)) && isluafunc(&gcval(tv)->fn)) pt = funcproto(&gcval(tv)->fn); /* Cannot use funcV() for frame slot. */ else if (tvisproto(tv)) pt = protoV(tv); else return 0; /* Failed. */ if (mm != LUAJIT_MODE_ALLSUBFUNC) setptmode(g, pt, mode); if (mm != LUAJIT_MODE_FUNC) setptmode_all(g, pt, mode); break; } case LUAJIT_MODE_TRACE: if (!(mode & LUAJIT_MODE_FLUSH)) return 0; /* Failed. */ lj_trace_flush(G2J(g), idx); break; #else case LUAJIT_MODE_ENGINE: case LUAJIT_MODE_FUNC: case LUAJIT_MODE_ALLFUNC: case LUAJIT_MODE_ALLSUBFUNC: UNUSED(idx); if ((mode & LUAJIT_MODE_ON)) return 0; /* Failed. */ break; #endif case LUAJIT_MODE_WRAPCFUNC: if ((mode & LUAJIT_MODE_ON)) { if (idx != 0) { cTValue *tv = idx > 0 ? L->base + (idx-1) : L->top + idx; if (tvislightud(tv)) g->wrapf = (lua_CFunction)lightudV(tv); else return 0; /* Failed. */ } else { return 0; /* Failed. */ } g->bc_cfunc_ext = BCINS_AD(BC_FUNCCW, 0, 0); } else { g->bc_cfunc_ext = BCINS_AD(BC_FUNCC, 0, 0); } break; default: return 0; /* Failed. */ } return 1; /* OK. */ } /* Enforce (dynamic) linker error for version mismatches. See luajit.c. */ LUA_API void LUAJIT_VERSION_SYM(void) { } /* -- Hooks --------------------------------------------------------------- */ /* This function can be called asynchronously (e.g. during a signal). */ LUA_API int lua_sethook(lua_State *L, lua_Hook func, int mask, int count) { global_State *g = G(L); mask &= HOOK_EVENTMASK; if (func == NULL || mask == 0) { mask = 0; func = NULL; } /* Consistency. */ g->hookf = func; g->hookcount = g->hookcstart = (int32_t)count; g->hookmask = (uint8_t)((g->hookmask & ~HOOK_EVENTMASK) | mask); lj_trace_abort(g); /* Abort recording on any hook change. */ lj_dispatch_update(g); return 1; } LUA_API lua_Hook lua_gethook(lua_State *L) { return G(L)->hookf; } LUA_API int lua_gethookmask(lua_State *L) { return G(L)->hookmask & HOOK_EVENTMASK; } LUA_API int lua_gethookcount(lua_State *L) { return (int)G(L)->hookcstart; } /* Call a hook. */ static void callhook(lua_State *L, int event, BCLine line) { global_State *g = G(L); lua_Hook hookf = g->hookf; if (hookf && !hook_active(g)) { lua_Debug ar; lj_trace_abort(g); /* Abort recording on any hook call. */ ar.event = event; ar.currentline = line; /* Top frame, nextframe = NULL. */ ar.i_ci = (int)((L->base-1) - tvref(L->stack)); lj_state_checkstack(L, 1+LUA_MINSTACK); hook_enter(g); hookf(L, &ar); lua_assert(hook_active(g)); hook_leave(g); } } /* -- Dispatch callbacks -------------------------------------------------- */ /* Calculate number of used stack slots in the current frame. */ static BCReg cur_topslot(GCproto *pt, const BCIns *pc, uint32_t nres) { BCIns ins = pc[-1]; if (bc_op(ins) == BC_UCLO) ins = pc[bc_j(ins)]; switch (bc_op(ins)) { case BC_CALLM: case BC_CALLMT: return bc_a(ins) + bc_c(ins) + nres-1+1; case BC_RETM: return bc_a(ins) + bc_d(ins) + nres-1; case BC_TSETM: return bc_a(ins) + nres-1; default: return pt->framesize; } } /* Instruction dispatch. Used by instr/line/return hooks or when recording. */ void LJ_FASTCALL lj_dispatch_ins(lua_State *L, const BCIns *pc) { ERRNO_SAVE GCfunc *fn = curr_func(L); GCproto *pt = funcproto(fn); void *cf = cframe_raw(L->cframe); const BCIns *oldpc = cframe_pc(cf); global_State *g = G(L); BCReg slots; setcframe_pc(cf, pc); slots = cur_topslot(pt, pc, cframe_multres_n(cf)); L->top = L->base + slots; /* Fix top. */ #if LJ_HASJIT { jit_State *J = G2J(g); if (J->state != LJ_TRACE_IDLE) { #ifdef LUA_USE_ASSERT ptrdiff_t delta = L->top - L->base; #endif J->L = L; lj_trace_ins(J, pc-1); /* The interpreter bytecode PC is offset by 1. */ lua_assert(L->top - L->base == delta); } } #endif if ((g->hookmask & LUA_MASKCOUNT) && g->hookcount == 0) { g->hookcount = g->hookcstart; callhook(L, LUA_HOOKCOUNT, -1); L->top = L->base + slots; /* Fix top again. */ } if ((g->hookmask & LUA_MASKLINE)) { BCPos npc = proto_bcpos(pt, pc) - 1; BCPos opc = proto_bcpos(pt, oldpc) - 1; BCLine line = lj_debug_line(pt, npc); if (pc <= oldpc || opc >= pt->sizebc || line != lj_debug_line(pt, opc)) { callhook(L, LUA_HOOKLINE, line); L->top = L->base + slots; /* Fix top again. */ } } if ((g->hookmask & LUA_MASKRET) && bc_isret(bc_op(pc[-1]))) callhook(L, LUA_HOOKRET, -1); ERRNO_RESTORE } /* Initialize call. Ensure stack space and return # of missing parameters. */ static int call_init(lua_State *L, GCfunc *fn) { if (isluafunc(fn)) { GCproto *pt = funcproto(fn); int numparams = pt->numparams; int gotparams = (int)(L->top - L->base); int need = pt->framesize; if ((pt->flags & PROTO_VARARG)) need += 1+gotparams; lj_state_checkstack(L, (MSize)need); numparams -= gotparams; return numparams >= 0 ? numparams : 0; } else { lj_state_checkstack(L, LUA_MINSTACK); return 0; } } /* Call dispatch. Used by call hooks, hot calls or when recording. */ ASMFunction LJ_FASTCALL lj_dispatch_call(lua_State *L, const BCIns *pc) { ERRNO_SAVE GCfunc *fn = curr_func(L); BCOp op; global_State *g = G(L); #if LJ_HASJIT jit_State *J = G2J(g); #endif int missing = call_init(L, fn); #if LJ_HASJIT J->L = L; if ((uintptr_t)pc & 1) { /* Marker for hot call. */ #ifdef LUA_USE_ASSERT ptrdiff_t delta = L->top - L->base; #endif pc = (const BCIns *)((uintptr_t)pc & ~(uintptr_t)1); lj_trace_hot(J, pc); lua_assert(L->top - L->base == delta); goto out; } else if (J->state != LJ_TRACE_IDLE && !(g->hookmask & (HOOK_GC|HOOK_VMEVENT))) { #ifdef LUA_USE_ASSERT ptrdiff_t delta = L->top - L->base; #endif /* Record the FUNC* bytecodes, too. */ lj_trace_ins(J, pc-1); /* The interpreter bytecode PC is offset by 1. */ lua_assert(L->top - L->base == delta); } #endif if ((g->hookmask & LUA_MASKCALL)) { int i; for (i = 0; i < missing; i++) /* Add missing parameters. */ setnilV(L->top++); callhook(L, LUA_HOOKCALL, -1); /* Preserve modifications of missing parameters by lua_setlocal(). */ while (missing-- > 0 && tvisnil(L->top - 1)) L->top--; } #if LJ_HASJIT out: #endif op = bc_op(pc[-1]); /* Get FUNC* op. */ #if LJ_HASJIT /* Use the non-hotcounting variants if JIT is off or while recording. */ if ((!(J->flags & JIT_F_ON) || J->state != LJ_TRACE_IDLE) && (op == BC_FUNCF || op == BC_FUNCV)) op = (BCOp)((int)op+(int)BC_IFUNCF-(int)BC_FUNCF); #endif ERRNO_RESTORE return makeasmfunc(lj_bc_ofs[op]); /* Return static dispatch target. */ } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_gdbjit.c0000644000175000017500000005205613122010155016775 0ustar philphil/* ** Client for the GDB JIT API. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_gdbjit_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_gc.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_frame.h" #include "lj_jit.h" #include "lj_dispatch.h" /* This is not compiled in by default. ** Enable with -DLUAJIT_USE_GDBJIT in the Makefile and recompile everything. */ #ifdef LUAJIT_USE_GDBJIT /* The GDB JIT API allows JIT compilers to pass debug information about ** JIT-compiled code back to GDB. You need at least GDB 7.0 or higher ** to see it in action. ** ** This is a passive API, so it works even when not running under GDB ** or when attaching to an already running process. Alas, this implies ** enabling it always has a non-negligible overhead -- do not use in ** release mode! ** ** The LuaJIT GDB JIT client is rather minimal at the moment. It gives ** each trace a symbol name and adds a source location and frame unwind ** information. Obviously LuaJIT itself and any embedding C application ** should be compiled with debug symbols, too (see the Makefile). ** ** Traces are named TRACE_1, TRACE_2, ... these correspond to the trace ** numbers from -jv or -jdump. Use "break TRACE_1" or "tbreak TRACE_1" etc. ** to set breakpoints on specific traces (even ahead of their creation). ** ** The source location for each trace allows listing the corresponding ** source lines with the GDB command "list" (but only if the Lua source ** has been loaded from a file). Currently this is always set to the ** location where the trace has been started. ** ** Frame unwind information can be inspected with the GDB command ** "info frame". This also allows proper backtraces across JIT-compiled ** code with the GDB command "bt". ** ** You probably want to add the following settings to a .gdbinit file ** (or add them to ~/.gdbinit): ** set disassembly-flavor intel ** set breakpoint pending on ** ** Here's a sample GDB session: ** ------------------------------------------------------------------------ $ cat >x.lua for outer=1,100 do for inner=1,100 do end end ^D $ luajit -jv x.lua [TRACE 1 x.lua:2] [TRACE 2 (1/3) x.lua:1 -> 1] $ gdb --quiet --args luajit x.lua (gdb) tbreak TRACE_1 Function "TRACE_1" not defined. Temporary breakpoint 1 (TRACE_1) pending. (gdb) run Starting program: luajit x.lua Temporary breakpoint 1, TRACE_1 () at x.lua:2 2 for inner=1,100 do end (gdb) list 1 for outer=1,100 do 2 for inner=1,100 do end 3 end (gdb) bt #0 TRACE_1 () at x.lua:2 #1 0x08053690 in lua_pcall [...] [...] #7 0x0806ff90 in main [...] (gdb) disass TRACE_1 Dump of assembler code for function TRACE_1: 0xf7fd9fba : mov DWORD PTR ds:0xf7e0e2a0,0x1 0xf7fd9fc4 : movsd xmm7,QWORD PTR [edx+0x20] [...] 0xf7fd9ff8 : jmp 0xf7fd2014 End of assembler dump. (gdb) tbreak TRACE_2 Function "TRACE_2" not defined. Temporary breakpoint 2 (TRACE_2) pending. (gdb) cont Continuing. Temporary breakpoint 2, TRACE_2 () at x.lua:1 1 for outer=1,100 do (gdb) info frame Stack level 0, frame at 0xffffd7c0: eip = 0xf7fd9f60 in TRACE_2 (x.lua:1); saved eip 0x8053690 called by frame at 0xffffd7e0 source language unknown. Arglist at 0xffffd78c, args: Locals at 0xffffd78c, Previous frame's sp is 0xffffd7c0 Saved registers: ebx at 0xffffd7ac, ebp at 0xffffd7b8, esi at 0xffffd7b0, edi at 0xffffd7b4, eip at 0xffffd7bc (gdb) ** ------------------------------------------------------------------------ */ /* -- GDB JIT API --------------------------------------------------------- */ /* GDB JIT actions. */ enum { GDBJIT_NOACTION = 0, GDBJIT_REGISTER, GDBJIT_UNREGISTER }; /* GDB JIT entry. */ typedef struct GDBJITentry { struct GDBJITentry *next_entry; struct GDBJITentry *prev_entry; const char *symfile_addr; uint64_t symfile_size; } GDBJITentry; /* GDB JIT descriptor. */ typedef struct GDBJITdesc { uint32_t version; uint32_t action_flag; GDBJITentry *relevant_entry; GDBJITentry *first_entry; } GDBJITdesc; GDBJITdesc __jit_debug_descriptor = { 1, GDBJIT_NOACTION, NULL, NULL }; /* GDB sets a breakpoint at this function. */ void LJ_NOINLINE __jit_debug_register_code() { __asm__ __volatile__(""); }; /* -- In-memory ELF object definitions ------------------------------------ */ /* ELF definitions. */ typedef struct ELFheader { uint8_t emagic[4]; uint8_t eclass; uint8_t eendian; uint8_t eversion; uint8_t eosabi; uint8_t eabiversion; uint8_t epad[7]; uint16_t type; uint16_t machine; uint32_t version; uintptr_t entry; uintptr_t phofs; uintptr_t shofs; uint32_t flags; uint16_t ehsize; uint16_t phentsize; uint16_t phnum; uint16_t shentsize; uint16_t shnum; uint16_t shstridx; } ELFheader; typedef struct ELFsectheader { uint32_t name; uint32_t type; uintptr_t flags; uintptr_t addr; uintptr_t ofs; uintptr_t size; uint32_t link; uint32_t info; uintptr_t align; uintptr_t entsize; } ELFsectheader; #define ELFSECT_IDX_ABS 0xfff1 enum { ELFSECT_TYPE_PROGBITS = 1, ELFSECT_TYPE_SYMTAB = 2, ELFSECT_TYPE_STRTAB = 3, ELFSECT_TYPE_NOBITS = 8 }; #define ELFSECT_FLAGS_WRITE 1 #define ELFSECT_FLAGS_ALLOC 2 #define ELFSECT_FLAGS_EXEC 4 typedef struct ELFsymbol { #if LJ_64 uint32_t name; uint8_t info; uint8_t other; uint16_t sectidx; uintptr_t value; uint64_t size; #else uint32_t name; uintptr_t value; uint32_t size; uint8_t info; uint8_t other; uint16_t sectidx; #endif } ELFsymbol; enum { ELFSYM_TYPE_FUNC = 2, ELFSYM_TYPE_FILE = 4, ELFSYM_BIND_LOCAL = 0 << 4, ELFSYM_BIND_GLOBAL = 1 << 4, }; /* DWARF definitions. */ #define DW_CIE_VERSION 1 enum { DW_CFA_nop = 0x0, DW_CFA_offset_extended = 0x5, DW_CFA_def_cfa = 0xc, DW_CFA_def_cfa_offset = 0xe, DW_CFA_offset_extended_sf = 0x11, DW_CFA_advance_loc = 0x40, DW_CFA_offset = 0x80 }; enum { DW_EH_PE_udata4 = 3, DW_EH_PE_textrel = 0x20 }; enum { DW_TAG_compile_unit = 0x11 }; enum { DW_children_no = 0, DW_children_yes = 1 }; enum { DW_AT_name = 0x03, DW_AT_stmt_list = 0x10, DW_AT_low_pc = 0x11, DW_AT_high_pc = 0x12 }; enum { DW_FORM_addr = 0x01, DW_FORM_data4 = 0x06, DW_FORM_string = 0x08 }; enum { DW_LNS_extended_op = 0, DW_LNS_copy = 1, DW_LNS_advance_pc = 2, DW_LNS_advance_line = 3 }; enum { DW_LNE_end_sequence = 1, DW_LNE_set_address = 2 }; enum { #if LJ_TARGET_X86 DW_REG_AX, DW_REG_CX, DW_REG_DX, DW_REG_BX, DW_REG_SP, DW_REG_BP, DW_REG_SI, DW_REG_DI, DW_REG_RA, #elif LJ_TARGET_X64 /* Yes, the order is strange, but correct. */ DW_REG_AX, DW_REG_DX, DW_REG_CX, DW_REG_BX, DW_REG_SI, DW_REG_DI, DW_REG_BP, DW_REG_SP, DW_REG_8, DW_REG_9, DW_REG_10, DW_REG_11, DW_REG_12, DW_REG_13, DW_REG_14, DW_REG_15, DW_REG_RA, #elif LJ_TARGET_ARM DW_REG_SP = 13, DW_REG_RA = 14, #elif LJ_TARGET_PPC DW_REG_SP = 1, DW_REG_RA = 65, DW_REG_CR = 70, #elif LJ_TARGET_MIPS DW_REG_SP = 29, DW_REG_RA = 31, #else #error "Unsupported target architecture" #endif }; /* Minimal list of sections for the in-memory ELF object. */ enum { GDBJIT_SECT_NULL, GDBJIT_SECT_text, GDBJIT_SECT_eh_frame, GDBJIT_SECT_shstrtab, GDBJIT_SECT_strtab, GDBJIT_SECT_symtab, GDBJIT_SECT_debug_info, GDBJIT_SECT_debug_abbrev, GDBJIT_SECT_debug_line, GDBJIT_SECT__MAX }; enum { GDBJIT_SYM_UNDEF, GDBJIT_SYM_FILE, GDBJIT_SYM_FUNC, GDBJIT_SYM__MAX }; /* In-memory ELF object. */ typedef struct GDBJITobj { ELFheader hdr; /* ELF header. */ ELFsectheader sect[GDBJIT_SECT__MAX]; /* ELF sections. */ ELFsymbol sym[GDBJIT_SYM__MAX]; /* ELF symbol table. */ uint8_t space[4096]; /* Space for various section data. */ } GDBJITobj; /* Combined structure for GDB JIT entry and ELF object. */ typedef struct GDBJITentryobj { GDBJITentry entry; size_t sz; GDBJITobj obj; } GDBJITentryobj; /* Template for in-memory ELF header. */ static const ELFheader elfhdr_template = { .emagic = { 0x7f, 'E', 'L', 'F' }, .eclass = LJ_64 ? 2 : 1, .eendian = LJ_ENDIAN_SELECT(1, 2), .eversion = 1, #if LJ_TARGET_LINUX .eosabi = 0, /* Nope, it's not 3. */ #elif defined(__FreeBSD__) .eosabi = 9, #elif defined(__NetBSD__) .eosabi = 2, #elif defined(__OpenBSD__) .eosabi = 12, #elif defined(__DragonFly__) .eosabi = 0, #elif (defined(__sun__) && defined(__svr4__)) .eosabi = 6, #else .eosabi = 0, #endif .eabiversion = 0, .epad = { 0, 0, 0, 0, 0, 0, 0 }, .type = 1, #if LJ_TARGET_X86 .machine = 3, #elif LJ_TARGET_X64 .machine = 62, #elif LJ_TARGET_ARM .machine = 40, #elif LJ_TARGET_PPC .machine = 20, #elif LJ_TARGET_MIPS .machine = 8, #else #error "Unsupported target architecture" #endif .version = 1, .entry = 0, .phofs = 0, .shofs = offsetof(GDBJITobj, sect), .flags = 0, .ehsize = sizeof(ELFheader), .phentsize = 0, .phnum = 0, .shentsize = sizeof(ELFsectheader), .shnum = GDBJIT_SECT__MAX, .shstridx = GDBJIT_SECT_shstrtab }; /* -- In-memory ELF object generation ------------------------------------- */ /* Context for generating the ELF object for the GDB JIT API. */ typedef struct GDBJITctx { uint8_t *p; /* Pointer to next address in obj.space. */ uint8_t *startp; /* Pointer to start address in obj.space. */ GCtrace *T; /* Generate symbols for this trace. */ uintptr_t mcaddr; /* Machine code address. */ MSize szmcode; /* Size of machine code. */ MSize spadjp; /* Stack adjustment for parent trace or interpreter. */ MSize spadj; /* Stack adjustment for trace itself. */ BCLine lineno; /* Starting line number. */ const char *filename; /* Starting file name. */ size_t objsize; /* Final size of ELF object. */ GDBJITobj obj; /* In-memory ELF object. */ } GDBJITctx; /* Add a zero-terminated string. */ static uint32_t gdbjit_strz(GDBJITctx *ctx, const char *str) { uint8_t *p = ctx->p; uint32_t ofs = (uint32_t)(p - ctx->startp); do { *p++ = (uint8_t)*str; } while (*str++); ctx->p = p; return ofs; } /* Append a decimal number. */ static void gdbjit_catnum(GDBJITctx *ctx, uint32_t n) { if (n >= 10) { uint32_t m = n / 10; n = n % 10; gdbjit_catnum(ctx, m); } *ctx->p++ = '0' + n; } /* Add a ULEB128 value. */ static void gdbjit_uleb128(GDBJITctx *ctx, uint32_t v) { uint8_t *p = ctx->p; for (; v >= 0x80; v >>= 7) *p++ = (uint8_t)((v & 0x7f) | 0x80); *p++ = (uint8_t)v; ctx->p = p; } /* Add a SLEB128 value. */ static void gdbjit_sleb128(GDBJITctx *ctx, int32_t v) { uint8_t *p = ctx->p; for (; (uint32_t)(v+0x40) >= 0x80; v >>= 7) *p++ = (uint8_t)((v & 0x7f) | 0x80); *p++ = (uint8_t)(v & 0x7f); ctx->p = p; } /* Shortcuts to generate DWARF structures. */ #define DB(x) (*p++ = (x)) #define DI8(x) (*(int8_t *)p = (x), p++) #define DU16(x) (*(uint16_t *)p = (x), p += 2) #define DU32(x) (*(uint32_t *)p = (x), p += 4) #define DADDR(x) (*(uintptr_t *)p = (x), p += sizeof(uintptr_t)) #define DUV(x) (ctx->p = p, gdbjit_uleb128(ctx, (x)), p = ctx->p) #define DSV(x) (ctx->p = p, gdbjit_sleb128(ctx, (x)), p = ctx->p) #define DSTR(str) (ctx->p = p, gdbjit_strz(ctx, (str)), p = ctx->p) #define DALIGNNOP(s) while ((uintptr_t)p & ((s)-1)) *p++ = DW_CFA_nop #define DSECT(name, stmt) \ { uint32_t *szp_##name = (uint32_t *)p; p += 4; stmt \ *szp_##name = (uint32_t)((p-(uint8_t *)szp_##name)-4); } \ /* Initialize ELF section headers. */ static void LJ_FASTCALL gdbjit_secthdr(GDBJITctx *ctx) { ELFsectheader *sect; *ctx->p++ = '\0'; /* Empty string at start of string table. */ #define SECTDEF(id, tp, al) \ sect = &ctx->obj.sect[GDBJIT_SECT_##id]; \ sect->name = gdbjit_strz(ctx, "." #id); \ sect->type = ELFSECT_TYPE_##tp; \ sect->align = (al) SECTDEF(text, NOBITS, 16); sect->flags = ELFSECT_FLAGS_ALLOC|ELFSECT_FLAGS_EXEC; sect->addr = ctx->mcaddr; sect->ofs = 0; sect->size = ctx->szmcode; SECTDEF(eh_frame, PROGBITS, sizeof(uintptr_t)); sect->flags = ELFSECT_FLAGS_ALLOC; SECTDEF(shstrtab, STRTAB, 1); SECTDEF(strtab, STRTAB, 1); SECTDEF(symtab, SYMTAB, sizeof(uintptr_t)); sect->ofs = offsetof(GDBJITobj, sym); sect->size = sizeof(ctx->obj.sym); sect->link = GDBJIT_SECT_strtab; sect->entsize = sizeof(ELFsymbol); sect->info = GDBJIT_SYM_FUNC; SECTDEF(debug_info, PROGBITS, 1); SECTDEF(debug_abbrev, PROGBITS, 1); SECTDEF(debug_line, PROGBITS, 1); #undef SECTDEF } /* Initialize symbol table. */ static void LJ_FASTCALL gdbjit_symtab(GDBJITctx *ctx) { ELFsymbol *sym; *ctx->p++ = '\0'; /* Empty string at start of string table. */ sym = &ctx->obj.sym[GDBJIT_SYM_FILE]; sym->name = gdbjit_strz(ctx, "JIT mcode"); sym->sectidx = ELFSECT_IDX_ABS; sym->info = ELFSYM_TYPE_FILE|ELFSYM_BIND_LOCAL; sym = &ctx->obj.sym[GDBJIT_SYM_FUNC]; sym->name = gdbjit_strz(ctx, "TRACE_"); ctx->p--; gdbjit_catnum(ctx, ctx->T->traceno); *ctx->p++ = '\0'; sym->sectidx = GDBJIT_SECT_text; sym->value = 0; sym->size = ctx->szmcode; sym->info = ELFSYM_TYPE_FUNC|ELFSYM_BIND_GLOBAL; } /* Initialize .eh_frame section. */ static void LJ_FASTCALL gdbjit_ehframe(GDBJITctx *ctx) { uint8_t *p = ctx->p; uint8_t *framep = p; /* Emit DWARF EH CIE. */ DSECT(CIE, DU32(0); /* Offset to CIE itself. */ DB(DW_CIE_VERSION); DSTR("zR"); /* Augmentation. */ DUV(1); /* Code alignment factor. */ DSV(-(int32_t)sizeof(uintptr_t)); /* Data alignment factor. */ DB(DW_REG_RA); /* Return address register. */ DB(1); DB(DW_EH_PE_textrel|DW_EH_PE_udata4); /* Augmentation data. */ DB(DW_CFA_def_cfa); DUV(DW_REG_SP); DUV(sizeof(uintptr_t)); #if LJ_TARGET_PPC DB(DW_CFA_offset_extended_sf); DB(DW_REG_RA); DSV(-1); #else DB(DW_CFA_offset|DW_REG_RA); DUV(1); #endif DALIGNNOP(sizeof(uintptr_t)); ) /* Emit DWARF EH FDE. */ DSECT(FDE, DU32((uint32_t)(p-framep)); /* Offset to CIE. */ DU32(0); /* Machine code offset relative to .text. */ DU32(ctx->szmcode); /* Machine code length. */ DB(0); /* Augmentation data. */ /* Registers saved in CFRAME. */ #if LJ_TARGET_X86 DB(DW_CFA_offset|DW_REG_BP); DUV(2); DB(DW_CFA_offset|DW_REG_DI); DUV(3); DB(DW_CFA_offset|DW_REG_SI); DUV(4); DB(DW_CFA_offset|DW_REG_BX); DUV(5); #elif LJ_TARGET_X64 DB(DW_CFA_offset|DW_REG_BP); DUV(2); DB(DW_CFA_offset|DW_REG_BX); DUV(3); DB(DW_CFA_offset|DW_REG_15); DUV(4); DB(DW_CFA_offset|DW_REG_14); DUV(5); /* Extra registers saved for JIT-compiled code. */ DB(DW_CFA_offset|DW_REG_13); DUV(9); DB(DW_CFA_offset|DW_REG_12); DUV(10); #elif LJ_TARGET_ARM { int i; for (i = 11; i >= 4; i--) { DB(DW_CFA_offset|i); DUV(2+(11-i)); } } #elif LJ_TARGET_PPC { int i; DB(DW_CFA_offset_extended); DB(DW_REG_CR); DUV(55); for (i = 14; i <= 31; i++) { DB(DW_CFA_offset|i); DUV(37+(31-i)); DB(DW_CFA_offset|32|i); DUV(2+2*(31-i)); } } #elif LJ_TARGET_MIPS { int i; DB(DW_CFA_offset|30); DUV(2); for (i = 23; i >= 16; i--) { DB(DW_CFA_offset|i); DUV(26-i); } for (i = 30; i >= 20; i -= 2) { DB(DW_CFA_offset|32|i); DUV(42-i); } } #else #error "Unsupported target architecture" #endif if (ctx->spadjp != ctx->spadj) { /* Parent/interpreter stack frame size. */ DB(DW_CFA_def_cfa_offset); DUV(ctx->spadjp); DB(DW_CFA_advance_loc|1); /* Only an approximation. */ } DB(DW_CFA_def_cfa_offset); DUV(ctx->spadj); /* Trace stack frame size. */ DALIGNNOP(sizeof(uintptr_t)); ) ctx->p = p; } /* Initialize .debug_info section. */ static void LJ_FASTCALL gdbjit_debuginfo(GDBJITctx *ctx) { uint8_t *p = ctx->p; DSECT(info, DU16(2); /* DWARF version. */ DU32(0); /* Abbrev offset. */ DB(sizeof(uintptr_t)); /* Pointer size. */ DUV(1); /* Abbrev #1: DW_TAG_compile_unit. */ DSTR(ctx->filename); /* DW_AT_name. */ DADDR(ctx->mcaddr); /* DW_AT_low_pc. */ DADDR(ctx->mcaddr + ctx->szmcode); /* DW_AT_high_pc. */ DU32(0); /* DW_AT_stmt_list. */ ) ctx->p = p; } /* Initialize .debug_abbrev section. */ static void LJ_FASTCALL gdbjit_debugabbrev(GDBJITctx *ctx) { uint8_t *p = ctx->p; /* Abbrev #1: DW_TAG_compile_unit. */ DUV(1); DUV(DW_TAG_compile_unit); DB(DW_children_no); DUV(DW_AT_name); DUV(DW_FORM_string); DUV(DW_AT_low_pc); DUV(DW_FORM_addr); DUV(DW_AT_high_pc); DUV(DW_FORM_addr); DUV(DW_AT_stmt_list); DUV(DW_FORM_data4); DB(0); DB(0); ctx->p = p; } #define DLNE(op, s) (DB(DW_LNS_extended_op), DUV(1+(s)), DB((op))) /* Initialize .debug_line section. */ static void LJ_FASTCALL gdbjit_debugline(GDBJITctx *ctx) { uint8_t *p = ctx->p; DSECT(line, DU16(2); /* DWARF version. */ DSECT(header, DB(1); /* Minimum instruction length. */ DB(1); /* is_stmt. */ DI8(0); /* Line base for special opcodes. */ DB(2); /* Line range for special opcodes. */ DB(3+1); /* Opcode base at DW_LNS_advance_line+1. */ DB(0); DB(1); DB(1); /* Standard opcode lengths. */ /* Directory table. */ DB(0); /* File name table. */ DSTR(ctx->filename); DUV(0); DUV(0); DUV(0); DB(0); ) DLNE(DW_LNE_set_address, sizeof(uintptr_t)); DADDR(ctx->mcaddr); if (ctx->lineno) { DB(DW_LNS_advance_line); DSV(ctx->lineno-1); } DB(DW_LNS_copy); DB(DW_LNS_advance_pc); DUV(ctx->szmcode); DLNE(DW_LNE_end_sequence, 0); ) ctx->p = p; } #undef DLNE /* Undef shortcuts. */ #undef DB #undef DI8 #undef DU16 #undef DU32 #undef DADDR #undef DUV #undef DSV #undef DSTR #undef DALIGNNOP #undef DSECT /* Type of a section initializer callback. */ typedef void (LJ_FASTCALL *GDBJITinitf)(GDBJITctx *ctx); /* Call section initializer and set the section offset and size. */ static void gdbjit_initsect(GDBJITctx *ctx, int sect, GDBJITinitf initf) { ctx->startp = ctx->p; ctx->obj.sect[sect].ofs = (uintptr_t)((char *)ctx->p - (char *)&ctx->obj); initf(ctx); ctx->obj.sect[sect].size = (uintptr_t)(ctx->p - ctx->startp); } #define SECTALIGN(p, a) \ ((p) = (uint8_t *)(((uintptr_t)(p) + ((a)-1)) & ~(uintptr_t)((a)-1))) /* Build in-memory ELF object. */ static void gdbjit_buildobj(GDBJITctx *ctx) { GDBJITobj *obj = &ctx->obj; /* Fill in ELF header and clear structures. */ memcpy(&obj->hdr, &elfhdr_template, sizeof(ELFheader)); memset(&obj->sect, 0, sizeof(ELFsectheader)*GDBJIT_SECT__MAX); memset(&obj->sym, 0, sizeof(ELFsymbol)*GDBJIT_SYM__MAX); /* Initialize sections. */ ctx->p = obj->space; gdbjit_initsect(ctx, GDBJIT_SECT_shstrtab, gdbjit_secthdr); gdbjit_initsect(ctx, GDBJIT_SECT_strtab, gdbjit_symtab); gdbjit_initsect(ctx, GDBJIT_SECT_debug_info, gdbjit_debuginfo); gdbjit_initsect(ctx, GDBJIT_SECT_debug_abbrev, gdbjit_debugabbrev); gdbjit_initsect(ctx, GDBJIT_SECT_debug_line, gdbjit_debugline); SECTALIGN(ctx->p, sizeof(uintptr_t)); gdbjit_initsect(ctx, GDBJIT_SECT_eh_frame, gdbjit_ehframe); ctx->objsize = (size_t)((char *)ctx->p - (char *)obj); lua_assert(ctx->objsize < sizeof(GDBJITobj)); } #undef SECTALIGN /* -- Interface to GDB JIT API -------------------------------------------- */ /* Add new entry to GDB JIT symbol chain. */ static void gdbjit_newentry(lua_State *L, GDBJITctx *ctx) { /* Allocate memory for GDB JIT entry and ELF object. */ MSize sz = (MSize)(sizeof(GDBJITentryobj) - sizeof(GDBJITobj) + ctx->objsize); GDBJITentryobj *eo = lj_mem_newt(L, sz, GDBJITentryobj); memcpy(&eo->obj, &ctx->obj, ctx->objsize); /* Copy ELF object. */ eo->sz = sz; ctx->T->gdbjit_entry = (void *)eo; /* Link new entry to chain and register it. */ eo->entry.prev_entry = NULL; eo->entry.next_entry = __jit_debug_descriptor.first_entry; if (eo->entry.next_entry) eo->entry.next_entry->prev_entry = &eo->entry; eo->entry.symfile_addr = (const char *)&eo->obj; eo->entry.symfile_size = ctx->objsize; __jit_debug_descriptor.first_entry = &eo->entry; __jit_debug_descriptor.relevant_entry = &eo->entry; __jit_debug_descriptor.action_flag = GDBJIT_REGISTER; __jit_debug_register_code(); } /* Add debug info for newly compiled trace and notify GDB. */ void lj_gdbjit_addtrace(jit_State *J, GCtrace *T) { GDBJITctx ctx; GCproto *pt = &gcref(T->startpt)->pt; TraceNo parent = T->ir[REF_BASE].op1; const BCIns *startpc = mref(T->startpc, const BCIns); ctx.T = T; ctx.mcaddr = (uintptr_t)T->mcode; ctx.szmcode = T->szmcode; ctx.spadjp = CFRAME_SIZE_JIT + (MSize)(parent ? traceref(J, parent)->spadjust : 0); ctx.spadj = CFRAME_SIZE_JIT + T->spadjust; lua_assert(startpc >= proto_bc(pt) && startpc < proto_bc(pt) + pt->sizebc); ctx.lineno = lj_debug_line(pt, proto_bcpos(pt, startpc)); ctx.filename = proto_chunknamestr(pt); if (*ctx.filename == '@' || *ctx.filename == '=') ctx.filename++; else ctx.filename = "(string)"; gdbjit_buildobj(&ctx); gdbjit_newentry(J->L, &ctx); } /* Delete debug info for trace and notify GDB. */ void lj_gdbjit_deltrace(jit_State *J, GCtrace *T) { GDBJITentryobj *eo = (GDBJITentryobj *)T->gdbjit_entry; if (eo) { if (eo->entry.prev_entry) eo->entry.prev_entry->next_entry = eo->entry.next_entry; else __jit_debug_descriptor.first_entry = eo->entry.next_entry; if (eo->entry.next_entry) eo->entry.next_entry->prev_entry = eo->entry.prev_entry; __jit_debug_descriptor.relevant_entry = &eo->entry; __jit_debug_descriptor.action_flag = GDBJIT_UNREGISTER; __jit_debug_register_code(); lj_mem_free(J2G(J), eo, eo->sz); } } #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_obj.h0000644000175000017500000007345413122010155016316 0ustar philphil/* ** LuaJIT VM tags, values and objects. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #ifndef _LJ_OBJ_H #define _LJ_OBJ_H #include "lua.h" #include "lj_def.h" #include "lj_arch.h" /* -- Memory references (32 bit address space) ---------------------------- */ /* Memory size. */ typedef uint32_t MSize; /* Memory reference */ typedef struct MRef { uint32_t ptr32; /* Pseudo 32 bit pointer. */ } MRef; #define mref(r, t) ((t *)(void *)(uintptr_t)(r).ptr32) #define setmref(r, p) ((r).ptr32 = (uint32_t)(uintptr_t)(void *)(p)) #define setmrefr(r, v) ((r).ptr32 = (v).ptr32) /* -- GC object references (32 bit address space) ------------------------- */ /* GCobj reference */ typedef struct GCRef { uint32_t gcptr32; /* Pseudo 32 bit pointer. */ } GCRef; /* Common GC header for all collectable objects. */ #define GCHeader GCRef nextgc; uint8_t marked; uint8_t gct /* This occupies 6 bytes, so use the next 2 bytes for non-32 bit fields. */ #define gcref(r) ((GCobj *)(uintptr_t)(r).gcptr32) #define gcrefp(r, t) ((t *)(void *)(uintptr_t)(r).gcptr32) #define gcrefu(r) ((r).gcptr32) #define gcrefi(r) ((int32_t)(r).gcptr32) #define gcrefeq(r1, r2) ((r1).gcptr32 == (r2).gcptr32) #define gcnext(gc) (gcref((gc)->gch.nextgc)) #define setgcref(r, gc) ((r).gcptr32 = (uint32_t)(uintptr_t)&(gc)->gch) #define setgcrefi(r, i) ((r).gcptr32 = (uint32_t)(i)) #define setgcrefp(r, p) ((r).gcptr32 = (uint32_t)(uintptr_t)(p)) #define setgcrefnull(r) ((r).gcptr32 = 0) #define setgcrefr(r, v) ((r).gcptr32 = (v).gcptr32) /* IMPORTANT NOTE: ** ** All uses of the setgcref* macros MUST be accompanied with a write barrier. ** ** This is to ensure the integrity of the incremental GC. The invariant ** to preserve is that a black object never points to a white object. ** I.e. never store a white object into a field of a black object. ** ** It's ok to LEAVE OUT the write barrier ONLY in the following cases: ** - The source is not a GC object (NULL). ** - The target is a GC root. I.e. everything in global_State. ** - The target is a lua_State field (threads are never black). ** - The target is a stack slot, see setgcV et al. ** - The target is an open upvalue, i.e. pointing to a stack slot. ** - The target is a newly created object (i.e. marked white). But make ** sure nothing invokes the GC inbetween. ** - The target and the source are the same object (self-reference). ** - The target already contains the object (e.g. moving elements around). ** ** The most common case is a store to a stack slot. All other cases where ** a barrier has been omitted are annotated with a NOBARRIER comment. ** ** The same logic applies for stores to table slots (array part or hash ** part). ALL uses of lj_tab_set* require a barrier for the stored value ** *and* the stored key, based on the above rules. In practice this means ** a barrier is needed if *either* of the key or value are a GC object. ** ** It's ok to LEAVE OUT the write barrier in the following special cases: ** - The stored value is nil. The key doesn't matter because it's either ** not resurrected or lj_tab_newkey() will take care of the key barrier. ** - The key doesn't matter if the *previously* stored value is guaranteed ** to be non-nil (because the key is kept alive in the table). ** - The key doesn't matter if it's guaranteed not to be part of the table, ** since lj_tab_newkey() takes care of the key barrier. This applies ** trivially to new tables, but watch out for resurrected keys. Storing ** a nil value leaves the key in the table! ** ** In case of doubt use lj_gc_anybarriert() as it's rather cheap. It's used ** by the interpreter for all table stores. ** ** Note: In contrast to Lua's GC, LuaJIT's GC does *not* specially mark ** dead keys in tables. The reference is left in, but it's guaranteed to ** be never dereferenced as long as the value is nil. It's ok if the key is ** freed or if any object subsequently gets the same address. ** ** Not destroying dead keys helps to keep key hash slots stable. This avoids ** specialization back-off for HREFK when a value flips between nil and ** non-nil and the GC gets in the way. It also allows safely hoisting ** HREF/HREFK across GC steps. Dead keys are only removed if a table is ** resized (i.e. by NEWREF) and xREF must not be CSEd across a resize. ** ** The trade-off is that a write barrier for tables must take the key into ** account, too. Implicitly resurrecting the key by storing a non-nil value ** may invalidate the incremental GC invariant. */ /* -- Common type definitions --------------------------------------------- */ /* Types for handling bytecodes. Need this here, details in lj_bc.h. */ typedef uint32_t BCIns; /* Bytecode instruction. */ typedef uint32_t BCPos; /* Bytecode position. */ typedef uint32_t BCReg; /* Bytecode register. */ typedef int32_t BCLine; /* Bytecode line number. */ /* Internal assembler functions. Never call these directly from C. */ typedef void (*ASMFunction)(void); /* Resizable string buffer. Need this here, details in lj_str.h. */ typedef struct SBuf { char *buf; /* String buffer base. */ MSize n; /* String buffer length. */ MSize sz; /* String buffer size. */ } SBuf; /* -- Tags and values ----------------------------------------------------- */ /* Frame link. */ typedef union { int32_t ftsz; /* Frame type and size of previous frame. */ MRef pcr; /* Overlaps PC for Lua frames. */ } FrameLink; /* Tagged value. */ typedef LJ_ALIGN(8) union TValue { uint64_t u64; /* 64 bit pattern overlaps number. */ lua_Number n; /* Number object overlaps split tag/value object. */ struct { LJ_ENDIAN_LOHI( union { GCRef gcr; /* GCobj reference (if any). */ int32_t i; /* Integer value. */ }; , uint32_t it; /* Internal object tag. Must overlap MSW of number. */ ) }; struct { LJ_ENDIAN_LOHI( GCRef func; /* Function for next frame (or dummy L). */ , FrameLink tp; /* Link to previous frame. */ ) } fr; struct { LJ_ENDIAN_LOHI( uint32_t lo; /* Lower 32 bits of number. */ , uint32_t hi; /* Upper 32 bits of number. */ ) } u32; } TValue; typedef const TValue cTValue; #define tvref(r) (mref(r, TValue)) /* More external and GCobj tags for internal objects. */ #define LAST_TT LUA_TTHREAD #define LUA_TPROTO (LAST_TT+1) #define LUA_TCDATA (LAST_TT+2) /* Internal object tags. ** ** Internal tags overlap the MSW of a number object (must be a double). ** Interpreted as a double these are special NaNs. The FPU only generates ** one type of NaN (0xfff8_0000_0000_0000). So MSWs > 0xfff80000 are available ** for use as internal tags. Small negative numbers are used to shorten the ** encoding of type comparisons (reg/mem against sign-ext. 8 bit immediate). ** ** ---MSW---.---LSW--- ** primitive types | itype | | ** lightuserdata | itype | void * | (32 bit platforms) ** lightuserdata |ffff| void * | (64 bit platforms, 47 bit pointers) ** GC objects | itype | GCRef | ** int (LJ_DUALNUM)| itype | int | ** number -------double------ ** ** ORDER LJ_T ** Primitive types nil/false/true must be first, lightuserdata next. ** GC objects are at the end, table/userdata must be lowest. ** Also check lj_ir.h for similar ordering constraints. */ #define LJ_TNIL (~0u) #define LJ_TFALSE (~1u) #define LJ_TTRUE (~2u) #define LJ_TLIGHTUD (~3u) #define LJ_TSTR (~4u) #define LJ_TUPVAL (~5u) #define LJ_TTHREAD (~6u) #define LJ_TPROTO (~7u) #define LJ_TFUNC (~8u) #define LJ_TTRACE (~9u) #define LJ_TCDATA (~10u) #define LJ_TTAB (~11u) #define LJ_TUDATA (~12u) /* This is just the canonical number type used in some places. */ #define LJ_TNUMX (~13u) /* Integers have itype == LJ_TISNUM doubles have itype < LJ_TISNUM */ #if LJ_64 #define LJ_TISNUM 0xfffeffffu #else #define LJ_TISNUM LJ_TNUMX #endif #define LJ_TISTRUECOND LJ_TFALSE #define LJ_TISPRI LJ_TTRUE #define LJ_TISGCV (LJ_TSTR+1) #define LJ_TISTABUD LJ_TTAB /* -- String object ------------------------------------------------------- */ /* String object header. String payload follows. */ typedef struct GCstr { GCHeader; uint8_t reserved; /* Used by lexer for fast lookup of reserved words. */ uint8_t unused; MSize hash; /* Hash of string. */ MSize len; /* Size of string. */ } GCstr; #define strref(r) (&gcref((r))->str) #define strdata(s) ((const char *)((s)+1)) #define strdatawr(s) ((char *)((s)+1)) #define strVdata(o) strdata(strV(o)) #define sizestring(s) (sizeof(struct GCstr)+(s)->len+1) /* -- Userdata object ----------------------------------------------------- */ /* Userdata object. Payload follows. */ typedef struct GCudata { GCHeader; uint8_t udtype; /* Userdata type. */ uint8_t unused2; GCRef env; /* Should be at same offset in GCfunc. */ MSize len; /* Size of payload. */ GCRef metatable; /* Must be at same offset in GCtab. */ uint32_t align1; /* To force 8 byte alignment of the payload. */ } GCudata; /* Userdata types. */ enum { UDTYPE_USERDATA, /* Regular userdata. */ UDTYPE_IO_FILE, /* I/O library FILE. */ UDTYPE_FFI_CLIB, /* FFI C library namespace. */ UDTYPE__MAX }; #define uddata(u) ((void *)((u)+1)) #define sizeudata(u) (sizeof(struct GCudata)+(u)->len) /* -- C data object ------------------------------------------------------- */ /* C data object. Payload follows. */ typedef struct GCcdata { GCHeader; uint16_t ctypeid; /* C type ID. */ } GCcdata; /* Prepended to variable-sized or realigned C data objects. */ typedef struct GCcdataVar { uint16_t offset; /* Offset to allocated memory (relative to GCcdata). */ uint16_t extra; /* Extra space allocated (incl. GCcdata + GCcdatav). */ MSize len; /* Size of payload. */ } GCcdataVar; #define cdataptr(cd) ((void *)((cd)+1)) #define cdataisv(cd) ((cd)->marked & 0x80) #define cdatav(cd) ((GCcdataVar *)((char *)(cd) - sizeof(GCcdataVar))) #define cdatavlen(cd) check_exp(cdataisv(cd), cdatav(cd)->len) #define sizecdatav(cd) (cdatavlen(cd) + cdatav(cd)->extra) #define memcdatav(cd) ((void *)((char *)(cd) - cdatav(cd)->offset)) /* -- Prototype object ---------------------------------------------------- */ #define SCALE_NUM_GCO ((int32_t)sizeof(lua_Number)/sizeof(GCRef)) #define round_nkgc(n) (((n) + SCALE_NUM_GCO-1) & ~(SCALE_NUM_GCO-1)) typedef struct GCproto { GCHeader; uint8_t numparams; /* Number of parameters. */ uint8_t framesize; /* Fixed frame size. */ MSize sizebc; /* Number of bytecode instructions. */ GCRef gclist; MRef k; /* Split constant array (points to the middle). */ MRef uv; /* Upvalue list. local slot|0x8000 or parent uv idx. */ MSize sizekgc; /* Number of collectable constants. */ MSize sizekn; /* Number of lua_Number constants. */ MSize sizept; /* Total size including colocated arrays. */ uint8_t sizeuv; /* Number of upvalues. */ uint8_t flags; /* Miscellaneous flags (see below). */ uint16_t trace; /* Anchor for chain of root traces. */ /* ------ The following fields are for debugging/tracebacks only ------ */ GCRef chunkname; /* Name of the chunk this function was defined in. */ BCLine firstline; /* First line of the function definition. */ BCLine numline; /* Number of lines for the function definition. */ MRef lineinfo; /* Compressed map from bytecode ins. to source line. */ MRef uvinfo; /* Upvalue names. */ MRef varinfo; /* Names and compressed extents of local variables. */ } GCproto; /* Flags for prototype. */ #define PROTO_CHILD 0x01 /* Has child prototypes. */ #define PROTO_VARARG 0x02 /* Vararg function. */ #define PROTO_FFI 0x04 /* Uses BC_KCDATA for FFI datatypes. */ #define PROTO_NOJIT 0x08 /* JIT disabled for this function. */ #define PROTO_ILOOP 0x10 /* Patched bytecode with ILOOP etc. */ /* Only used during parsing. */ #define PROTO_HAS_RETURN 0x20 /* Already emitted a return. */ #define PROTO_FIXUP_RETURN 0x40 /* Need to fixup emitted returns. */ /* Top bits used for counting created closures. */ #define PROTO_CLCOUNT 0x20 /* Base of saturating 3 bit counter. */ #define PROTO_CLC_BITS 3 #define PROTO_CLC_POLY (3*PROTO_CLCOUNT) /* Polymorphic threshold. */ #define PROTO_UV_LOCAL 0x8000 /* Upvalue for local slot. */ #define PROTO_UV_IMMUTABLE 0x4000 /* Immutable upvalue. */ #define proto_kgc(pt, idx) \ check_exp((uintptr_t)(intptr_t)(idx) >= (uintptr_t)-(intptr_t)(pt)->sizekgc, \ gcref(mref((pt)->k, GCRef)[(idx)])) #define proto_knumtv(pt, idx) \ check_exp((uintptr_t)(idx) < (pt)->sizekn, &mref((pt)->k, TValue)[(idx)]) #define proto_bc(pt) ((BCIns *)((char *)(pt) + sizeof(GCproto))) #define proto_bcpos(pt, pc) ((BCPos)((pc) - proto_bc(pt))) #define proto_uv(pt) (mref((pt)->uv, uint16_t)) #define proto_chunkname(pt) (strref((pt)->chunkname)) #define proto_chunknamestr(pt) (strdata(proto_chunkname((pt)))) #define proto_lineinfo(pt) (mref((pt)->lineinfo, const void)) #define proto_uvinfo(pt) (mref((pt)->uvinfo, const uint8_t)) #define proto_varinfo(pt) (mref((pt)->varinfo, const uint8_t)) /* -- Upvalue object ------------------------------------------------------ */ typedef struct GCupval { GCHeader; uint8_t closed; /* Set if closed (i.e. uv->v == &uv->u.value). */ uint8_t immutable; /* Immutable value. */ union { TValue tv; /* If closed: the value itself. */ struct { /* If open: double linked list, anchored at thread. */ GCRef prev; GCRef next; }; }; MRef v; /* Points to stack slot (open) or above (closed). */ uint32_t dhash; /* Disambiguation hash: dh1 != dh2 => cannot alias. */ } GCupval; #define uvprev(uv_) (&gcref((uv_)->prev)->uv) #define uvnext(uv_) (&gcref((uv_)->next)->uv) #define uvval(uv_) (mref((uv_)->v, TValue)) /* -- Function object (closures) ------------------------------------------ */ /* Common header for functions. env should be at same offset in GCudata. */ #define GCfuncHeader \ GCHeader; uint8_t ffid; uint8_t nupvalues; \ GCRef env; GCRef gclist; MRef pc typedef struct GCfuncC { GCfuncHeader; lua_CFunction f; /* C function to be called. */ TValue upvalue[1]; /* Array of upvalues (TValue). */ } GCfuncC; typedef struct GCfuncL { GCfuncHeader; GCRef uvptr[1]; /* Array of _pointers_ to upvalue objects (GCupval). */ } GCfuncL; typedef union GCfunc { GCfuncC c; GCfuncL l; } GCfunc; #define FF_LUA 0 #define FF_C 1 #define isluafunc(fn) ((fn)->c.ffid == FF_LUA) #define iscfunc(fn) ((fn)->c.ffid == FF_C) #define isffunc(fn) ((fn)->c.ffid > FF_C) #define funcproto(fn) \ check_exp(isluafunc(fn), (GCproto *)(mref((fn)->l.pc, char)-sizeof(GCproto))) #define sizeCfunc(n) (sizeof(GCfuncC)-sizeof(TValue)+sizeof(TValue)*(n)) #define sizeLfunc(n) (sizeof(GCfuncL)-sizeof(GCRef)+sizeof(GCRef)*(n)) /* -- Table object -------------------------------------------------------- */ /* Hash node. */ typedef struct Node { TValue val; /* Value object. Must be first field. */ TValue key; /* Key object. */ MRef next; /* Hash chain. */ MRef freetop; /* Top of free elements (stored in t->node[0]). */ } Node; LJ_STATIC_ASSERT(offsetof(Node, val) == 0); typedef struct GCtab { GCHeader; uint8_t nomm; /* Negative cache for fast metamethods. */ int8_t colo; /* Array colocation. */ MRef array; /* Array part. */ GCRef gclist; GCRef metatable; /* Must be at same offset in GCudata. */ MRef node; /* Hash part. */ uint32_t asize; /* Size of array part (keys [0, asize-1]). */ uint32_t hmask; /* Hash part mask (size of hash part - 1). */ } GCtab; #define sizetabcolo(n) ((n)*sizeof(TValue) + sizeof(GCtab)) #define tabref(r) (&gcref((r))->tab) #define noderef(r) (mref((r), Node)) #define nextnode(n) (mref((n)->next, Node)) /* -- State objects ------------------------------------------------------- */ /* VM states. */ enum { LJ_VMST_INTERP, /* Interpreter. */ LJ_VMST_C, /* C function. */ LJ_VMST_GC, /* Garbage collector. */ LJ_VMST_EXIT, /* Trace exit handler. */ LJ_VMST_RECORD, /* Trace recorder. */ LJ_VMST_OPT, /* Optimizer. */ LJ_VMST_ASM, /* Assembler. */ LJ_VMST__MAX }; #define setvmstate(g, st) ((g)->vmstate = ~LJ_VMST_##st) /* Metamethods. ORDER MM */ #ifdef LJ_HASFFI #define MMDEF_FFI(_) _(new) #else #define MMDEF_FFI(_) #endif #if LJ_52 || LJ_HASFFI #define MMDEF_PAIRS(_) _(pairs) _(ipairs) #else #define MMDEF_PAIRS(_) #define MM_pairs 255 #define MM_ipairs 255 #endif #define MMDEF(_) \ _(index) _(newindex) _(gc) _(mode) _(eq) _(len) \ /* Only the above (fast) metamethods are negative cached (max. 8). */ \ _(lt) _(le) _(concat) _(call) \ /* The following must be in ORDER ARITH. */ \ _(add) _(sub) _(mul) _(div) _(mod) _(pow) _(unm) \ /* The following are used in the standard libraries. */ \ _(metatable) _(tostring) MMDEF_FFI(_) MMDEF_PAIRS(_) typedef enum { #define MMENUM(name) MM_##name, MMDEF(MMENUM) #undef MMENUM MM__MAX, MM____ = MM__MAX, MM_FAST = MM_len } MMS; /* GC root IDs. */ typedef enum { GCROOT_MMNAME, /* Metamethod names. */ GCROOT_MMNAME_LAST = GCROOT_MMNAME + MM__MAX-1, GCROOT_BASEMT, /* Metatables for base types. */ GCROOT_BASEMT_NUM = GCROOT_BASEMT + ~LJ_TNUMX, GCROOT_IO_INPUT, /* Userdata for default I/O input file. */ GCROOT_IO_OUTPUT, /* Userdata for default I/O output file. */ GCROOT_MAX } GCRootID; #define basemt_it(g, it) ((g)->gcroot[GCROOT_BASEMT+~(it)]) #define basemt_obj(g, o) ((g)->gcroot[GCROOT_BASEMT+itypemap(o)]) #define mmname_str(g, mm) (strref((g)->gcroot[GCROOT_MMNAME+(mm)])) typedef struct GCState { MSize total; /* Memory currently allocated. */ MSize threshold; /* Memory threshold. */ uint8_t currentwhite; /* Current white color. */ uint8_t state; /* GC state. */ uint8_t nocdatafin; /* No cdata finalizer called. */ uint8_t unused2; MSize sweepstr; /* Sweep position in string table. */ GCRef root; /* List of all collectable objects. */ MRef sweep; /* Sweep position in root list. */ GCRef gray; /* List of gray objects. */ GCRef grayagain; /* List of objects for atomic traversal. */ GCRef weak; /* List of weak tables (to be cleared). */ GCRef mmudata; /* List of userdata (to be finalized). */ MSize stepmul; /* Incremental GC step granularity. */ MSize debt; /* Debt (how much GC is behind schedule). */ MSize estimate; /* Estimate of memory actually in use. */ MSize pause; /* Pause between successive GC cycles. */ } GCState; /* Global state, shared by all threads of a Lua universe. */ typedef struct global_State { GCRef *strhash; /* String hash table (hash chain anchors). */ MSize strmask; /* String hash mask (size of hash table - 1). */ MSize strnum; /* Number of strings in hash table. */ lua_Alloc allocf; /* Memory allocator. */ void *allocd; /* Memory allocator data. */ GCState gc; /* Garbage collector. */ SBuf tmpbuf; /* Temporary buffer for string concatenation. */ Node nilnode; /* Fallback 1-element hash part (nil key and value). */ GCstr strempty; /* Empty string. */ uint8_t stremptyz; /* Zero terminator of empty string. */ uint8_t hookmask; /* Hook mask. */ uint8_t dispatchmode; /* Dispatch mode. */ uint8_t vmevmask; /* VM event mask. */ GCRef mainthref; /* Link to main thread. */ TValue registrytv; /* Anchor for registry. */ TValue tmptv, tmptv2; /* Temporary TValues. */ GCupval uvhead; /* Head of double-linked list of all open upvalues. */ int32_t hookcount; /* Instruction hook countdown. */ int32_t hookcstart; /* Start count for instruction hook counter. */ lua_Hook hookf; /* Hook function. */ lua_CFunction wrapf; /* Wrapper for C function calls. */ lua_CFunction panic; /* Called as a last resort for errors. */ volatile int32_t vmstate; /* VM state or current JIT code trace number. */ BCIns bc_cfunc_int; /* Bytecode for internal C function calls. */ BCIns bc_cfunc_ext; /* Bytecode for external C function calls. */ GCRef jit_L; /* Current JIT code lua_State or NULL. */ MRef jit_base; /* Current JIT code L->base. */ MRef ctype_state; /* Pointer to C type state. */ GCRef gcroot[GCROOT_MAX]; /* GC roots. */ } global_State; #define mainthread(g) (&gcref(g->mainthref)->th) #define niltv(L) \ check_exp(tvisnil(&G(L)->nilnode.val), &G(L)->nilnode.val) #define niltvg(g) \ check_exp(tvisnil(&(g)->nilnode.val), &(g)->nilnode.val) /* Hook management. Hook event masks are defined in lua.h. */ #define HOOK_EVENTMASK 0x0f #define HOOK_ACTIVE 0x10 #define HOOK_ACTIVE_SHIFT 4 #define HOOK_VMEVENT 0x20 #define HOOK_GC 0x40 #define hook_active(g) ((g)->hookmask & HOOK_ACTIVE) #define hook_enter(g) ((g)->hookmask |= HOOK_ACTIVE) #define hook_entergc(g) ((g)->hookmask |= (HOOK_ACTIVE|HOOK_GC)) #define hook_vmevent(g) ((g)->hookmask |= (HOOK_ACTIVE|HOOK_VMEVENT)) #define hook_leave(g) ((g)->hookmask &= ~HOOK_ACTIVE) #define hook_save(g) ((g)->hookmask & ~HOOK_EVENTMASK) #define hook_restore(g, h) \ ((g)->hookmask = ((g)->hookmask & HOOK_EVENTMASK) | (h)) /* Per-thread state object. */ struct lua_State { GCHeader; uint8_t dummy_ffid; /* Fake FF_C for curr_funcisL() on dummy frames. */ uint8_t status; /* Thread status. */ MRef glref; /* Link to global state. */ GCRef gclist; /* GC chain. */ TValue *base; /* Base of currently executing function. */ TValue *top; /* First free slot in the stack. */ MRef maxstack; /* Last free slot in the stack. */ MRef stack; /* Stack base. */ GCRef openupval; /* List of open upvalues in the stack. */ GCRef env; /* Thread environment (table of globals). */ void *cframe; /* End of C stack frame chain. */ MSize stacksize; /* True stack size (incl. LJ_STACK_EXTRA). */ }; #define G(L) (mref(L->glref, global_State)) #define registry(L) (&G(L)->registrytv) /* Macros to access the currently executing (Lua) function. */ #define curr_func(L) (&gcref((L->base-1)->fr.func)->fn) #define curr_funcisL(L) (isluafunc(curr_func(L))) #define curr_proto(L) (funcproto(curr_func(L))) #define curr_topL(L) (L->base + curr_proto(L)->framesize) #define curr_top(L) (curr_funcisL(L) ? curr_topL(L) : L->top) /* -- GC object definition and conversions -------------------------------- */ /* GC header for generic access to common fields of GC objects. */ typedef struct GChead { GCHeader; uint8_t unused1; uint8_t unused2; GCRef env; GCRef gclist; GCRef metatable; } GChead; /* The env field SHOULD be at the same offset for all GC objects. */ LJ_STATIC_ASSERT(offsetof(GChead, env) == offsetof(GCfuncL, env)); LJ_STATIC_ASSERT(offsetof(GChead, env) == offsetof(GCudata, env)); /* The metatable field MUST be at the same offset for all GC objects. */ LJ_STATIC_ASSERT(offsetof(GChead, metatable) == offsetof(GCtab, metatable)); LJ_STATIC_ASSERT(offsetof(GChead, metatable) == offsetof(GCudata, metatable)); /* The gclist field MUST be at the same offset for all GC objects. */ LJ_STATIC_ASSERT(offsetof(GChead, gclist) == offsetof(lua_State, gclist)); LJ_STATIC_ASSERT(offsetof(GChead, gclist) == offsetof(GCproto, gclist)); LJ_STATIC_ASSERT(offsetof(GChead, gclist) == offsetof(GCfuncL, gclist)); LJ_STATIC_ASSERT(offsetof(GChead, gclist) == offsetof(GCtab, gclist)); typedef union GCobj { GChead gch; GCstr str; GCupval uv; lua_State th; GCproto pt; GCfunc fn; GCcdata cd; GCtab tab; GCudata ud; } GCobj; /* Macros to convert a GCobj pointer into a specific value. */ #define gco2str(o) check_exp((o)->gch.gct == ~LJ_TSTR, &(o)->str) #define gco2uv(o) check_exp((o)->gch.gct == ~LJ_TUPVAL, &(o)->uv) #define gco2th(o) check_exp((o)->gch.gct == ~LJ_TTHREAD, &(o)->th) #define gco2pt(o) check_exp((o)->gch.gct == ~LJ_TPROTO, &(o)->pt) #define gco2func(o) check_exp((o)->gch.gct == ~LJ_TFUNC, &(o)->fn) #define gco2cd(o) check_exp((o)->gch.gct == ~LJ_TCDATA, &(o)->cd) #define gco2tab(o) check_exp((o)->gch.gct == ~LJ_TTAB, &(o)->tab) #define gco2ud(o) check_exp((o)->gch.gct == ~LJ_TUDATA, &(o)->ud) /* Macro to convert any collectable object into a GCobj pointer. */ #define obj2gco(v) ((GCobj *)(v)) /* -- TValue getters/setters ---------------------------------------------- */ #ifdef LUA_USE_ASSERT #include "lj_gc.h" #endif /* Macros to test types. */ #define itype(o) ((o)->it) #define tvisnil(o) (itype(o) == LJ_TNIL) #define tvisfalse(o) (itype(o) == LJ_TFALSE) #define tvistrue(o) (itype(o) == LJ_TTRUE) #define tvisbool(o) (tvisfalse(o) || tvistrue(o)) #if LJ_64 #define tvislightud(o) (((int32_t)itype(o) >> 15) == -2) #else #define tvislightud(o) (itype(o) == LJ_TLIGHTUD) #endif #define tvisstr(o) (itype(o) == LJ_TSTR) #define tvisfunc(o) (itype(o) == LJ_TFUNC) #define tvisthread(o) (itype(o) == LJ_TTHREAD) #define tvisproto(o) (itype(o) == LJ_TPROTO) #define tviscdata(o) (itype(o) == LJ_TCDATA) #define tvistab(o) (itype(o) == LJ_TTAB) #define tvisudata(o) (itype(o) == LJ_TUDATA) #define tvisnumber(o) (itype(o) <= LJ_TISNUM) #define tvisint(o) (LJ_DUALNUM && itype(o) == LJ_TISNUM) #define tvisnum(o) (itype(o) < LJ_TISNUM) #define tvistruecond(o) (itype(o) < LJ_TISTRUECOND) #define tvispri(o) (itype(o) >= LJ_TISPRI) #define tvistabud(o) (itype(o) <= LJ_TISTABUD) /* && !tvisnum() */ #define tvisgcv(o) ((itype(o) - LJ_TISGCV) > (LJ_TNUMX - LJ_TISGCV)) /* Special macros to test numbers for NaN, +0, -0, +1 and raw equality. */ #define tvisnan(o) ((o)->n != (o)->n) #if LJ_64 #define tviszero(o) (((o)->u64 << 1) == 0) #else #define tviszero(o) (((o)->u32.lo | ((o)->u32.hi << 1)) == 0) #endif #define tvispzero(o) ((o)->u64 == 0) #define tvismzero(o) ((o)->u64 == U64x(80000000,00000000)) #define tvispone(o) ((o)->u64 == U64x(3ff00000,00000000)) #define rawnumequal(o1, o2) ((o1)->u64 == (o2)->u64) /* Macros to convert type ids. */ #if LJ_64 #define itypemap(o) \ (tvisnumber(o) ? ~LJ_TNUMX : tvislightud(o) ? ~LJ_TLIGHTUD : ~itype(o)) #else #define itypemap(o) (tvisnumber(o) ? ~LJ_TNUMX : ~itype(o)) #endif /* Macros to get tagged values. */ #define gcval(o) (gcref((o)->gcr)) #define boolV(o) check_exp(tvisbool(o), (LJ_TFALSE - (o)->it)) #if LJ_64 #define lightudV(o) \ check_exp(tvislightud(o), (void *)((o)->u64 & U64x(00007fff,ffffffff))) #else #define lightudV(o) check_exp(tvislightud(o), gcrefp((o)->gcr, void)) #endif #define gcV(o) check_exp(tvisgcv(o), gcval(o)) #define strV(o) check_exp(tvisstr(o), &gcval(o)->str) #define funcV(o) check_exp(tvisfunc(o), &gcval(o)->fn) #define threadV(o) check_exp(tvisthread(o), &gcval(o)->th) #define protoV(o) check_exp(tvisproto(o), &gcval(o)->pt) #define cdataV(o) check_exp(tviscdata(o), &gcval(o)->cd) #define tabV(o) check_exp(tvistab(o), &gcval(o)->tab) #define udataV(o) check_exp(tvisudata(o), &gcval(o)->ud) #define numV(o) check_exp(tvisnum(o), (o)->n) #define intV(o) check_exp(tvisint(o), (int32_t)(o)->i) /* Macros to set tagged values. */ #define setitype(o, i) ((o)->it = (i)) #define setnilV(o) ((o)->it = LJ_TNIL) #define setboolV(o, x) ((o)->it = LJ_TFALSE-(uint32_t)(x)) static LJ_AINLINE void setlightudV(TValue *o, void *p) { #if LJ_64 o->u64 = (uint64_t)p | (((uint64_t)0xffff) << 48); #else setgcrefp(o->gcr, p); setitype(o, LJ_TLIGHTUD); #endif } #if LJ_64 #define checklightudptr(L, p) \ (((uint64_t)(p) >> 47) ? (lj_err_msg(L, LJ_ERR_BADLU), NULL) : (p)) #define setcont(o, f) \ ((o)->u64 = (uint64_t)(void *)(f) - (uint64_t)lj_vm_asm_begin) #else #define checklightudptr(L, p) (p) #define setcont(o, f) setlightudV((o), (void *)(f)) #endif #define tvchecklive(L, o) \ UNUSED(L), lua_assert(!tvisgcv(o) || \ ((~itype(o) == gcval(o)->gch.gct) && !isdead(G(L), gcval(o)))) static LJ_AINLINE void setgcV(lua_State *L, TValue *o, GCobj *v, uint32_t itype) { setgcref(o->gcr, v); setitype(o, itype); tvchecklive(L, o); } #define define_setV(name, type, tag) \ static LJ_AINLINE void name(lua_State *L, TValue *o, type *v) \ { \ setgcV(L, o, obj2gco(v), tag); \ } define_setV(setstrV, GCstr, LJ_TSTR) define_setV(setthreadV, lua_State, LJ_TTHREAD) define_setV(setprotoV, GCproto, LJ_TPROTO) define_setV(setfuncV, GCfunc, LJ_TFUNC) define_setV(setcdataV, GCcdata, LJ_TCDATA) define_setV(settabV, GCtab, LJ_TTAB) define_setV(setudataV, GCudata, LJ_TUDATA) #define setnumV(o, x) ((o)->n = (x)) #define setnanV(o) ((o)->u64 = U64x(fff80000,00000000)) #define setpinfV(o) ((o)->u64 = U64x(7ff00000,00000000)) #define setminfV(o) ((o)->u64 = U64x(fff00000,00000000)) static LJ_AINLINE void setintV(TValue *o, int32_t i) { #if LJ_DUALNUM o->i = (uint32_t)i; setitype(o, LJ_TISNUM); #else o->n = (lua_Number)i; #endif } static LJ_AINLINE void setint64V(TValue *o, int64_t i) { if (LJ_DUALNUM && LJ_LIKELY(i == (int64_t)(int32_t)i)) setintV(o, (int32_t)i); else setnumV(o, (lua_Number)i); } #if LJ_64 #define setintptrV(o, i) setint64V((o), (i)) #else #define setintptrV(o, i) setintV((o), (i)) #endif /* Copy tagged values. */ static LJ_AINLINE void copyTV(lua_State *L, TValue *o1, const TValue *o2) { *o1 = *o2; tvchecklive(L, o1); } /* -- Number to integer conversion ---------------------------------------- */ #if LJ_SOFTFP LJ_ASMF int32_t lj_vm_tobit(double x); #endif static LJ_AINLINE int32_t lj_num2bit(lua_Number n) { #if LJ_SOFTFP return lj_vm_tobit(n); #else TValue o; o.n = n + 6755399441055744.0; /* 2^52 + 2^51 */ return (int32_t)o.u32.lo; #endif } #if LJ_TARGET_X86 && !defined(__SSE2__) #define lj_num2int(n) lj_num2bit((n)) #else #define lj_num2int(n) ((int32_t)(n)) #endif static LJ_AINLINE uint64_t lj_num2u64(lua_Number n) { #ifdef _MSC_VER if (n >= 9223372036854775808.0) /* They think it's a feature. */ return (uint64_t)(int64_t)(n - 18446744073709551616.0); else #endif return (uint64_t)n; } static LJ_AINLINE int32_t numberVint(cTValue *o) { if (LJ_LIKELY(tvisint(o))) return intV(o); else return lj_num2int(numV(o)); } static LJ_AINLINE lua_Number numberVnum(cTValue *o) { if (LJ_UNLIKELY(tvisint(o))) return (lua_Number)intV(o); else return numV(o); } /* -- Miscellaneous object handling --------------------------------------- */ /* Names and maps for internal and external object tags. */ LJ_DATA const char *const lj_obj_typename[1+LUA_TCDATA+1]; LJ_DATA const char *const lj_obj_itypename[~LJ_TNUMX+1]; #define lj_typename(o) (lj_obj_itypename[itypemap(o)]) /* Compare two objects without calling metamethods. */ LJ_FUNC int lj_obj_equal(cTValue *o1, cTValue *o2); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_char.c0000644000175000017500000000367413122010155016451 0ustar philphil/* ** Character types. ** Donated to the public domain. ** ** This is intended to replace the problematic libc single-byte NLS functions. ** These just don't make sense anymore with UTF-8 locales becoming the norm ** on POSIX systems. It never worked too well on Windows systems since hardly ** anyone bothered to call setlocale(). ** ** This table is hardcoded for ASCII. Identifiers include the characters ** 128-255, too. This allows for the use of all non-ASCII chars as identifiers ** in the lexer. This is a broad definition, but works well in practice ** for both UTF-8 locales and most single-byte locales (such as ISO-8859-*). ** ** If you really need proper character types for UTF-8 strings, please use ** an add-on library such as slnunicode: http://luaforge.net/projects/sln/ */ #define lj_char_c #define LUA_CORE #include "lj_char.h" LJ_DATADEF const uint8_t lj_char_bits[257] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 152,152,152,152,152,152,152,152,152,152, 4, 4, 4, 4, 4, 4, 4,176,176,176,176,176,176,160,160,160,160,160,160,160,160,160, 160,160,160,160,160,160,160,160,160,160,160, 4, 4, 4, 4,132, 4,208,208,208,208,208,208,192,192,192,192,192,192,192,192,192, 192,192,192,192,192,192,192,192,192,192,192, 4, 4, 4, 4, 1, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128 }; wcc-0.0.2/src/wsh/luajit-2.0/src/lj_snap.c0000644000175000017500000006616713122010155016503 0ustar philphil/* ** Snapshot handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_snap_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_gc.h" #include "lj_tab.h" #include "lj_state.h" #include "lj_frame.h" #include "lj_bc.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" #include "lj_trace.h" #include "lj_snap.h" #include "lj_target.h" #if LJ_HASFFI #include "lj_ctype.h" #include "lj_cdata.h" #endif /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) /* Emit raw IR without passing through optimizations. */ #define emitir_raw(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_ir_emit(J)) /* -- Snapshot buffer allocation ------------------------------------------ */ /* Grow snapshot buffer. */ void lj_snap_grow_buf_(jit_State *J, MSize need) { MSize maxsnap = (MSize)J->param[JIT_P_maxsnap]; if (need > maxsnap) lj_trace_err(J, LJ_TRERR_SNAPOV); lj_mem_growvec(J->L, J->snapbuf, J->sizesnap, maxsnap, SnapShot); J->cur.snap = J->snapbuf; } /* Grow snapshot map buffer. */ void lj_snap_grow_map_(jit_State *J, MSize need) { if (need < 2*J->sizesnapmap) need = 2*J->sizesnapmap; else if (need < 64) need = 64; J->snapmapbuf = (SnapEntry *)lj_mem_realloc(J->L, J->snapmapbuf, J->sizesnapmap*sizeof(SnapEntry), need*sizeof(SnapEntry)); J->cur.snapmap = J->snapmapbuf; J->sizesnapmap = need; } /* -- Snapshot generation ------------------------------------------------- */ /* Add all modified slots to the snapshot. */ static MSize snapshot_slots(jit_State *J, SnapEntry *map, BCReg nslots) { IRRef retf = J->chain[IR_RETF]; /* Limits SLOAD restore elimination. */ BCReg s; MSize n = 0; for (s = 0; s < nslots; s++) { TRef tr = J->slot[s]; IRRef ref = tref_ref(tr); if (ref) { SnapEntry sn = SNAP_TR(s, tr); IRIns *ir = &J->cur.ir[ref]; if (!(sn & (SNAP_CONT|SNAP_FRAME)) && ir->o == IR_SLOAD && ir->op1 == s && ref > retf) { /* No need to snapshot unmodified non-inherited slots. */ if (!(ir->op2 & IRSLOAD_INHERIT)) continue; /* No need to restore readonly slots and unmodified non-parent slots. */ if (!(LJ_DUALNUM && (ir->op2 & IRSLOAD_CONVERT)) && (ir->op2 & (IRSLOAD_READONLY|IRSLOAD_PARENT)) != IRSLOAD_PARENT) sn |= SNAP_NORESTORE; } if (LJ_SOFTFP && irt_isnum(ir->t)) sn |= SNAP_SOFTFPNUM; map[n++] = sn; } } return n; } /* Add frame links at the end of the snapshot. */ static BCReg snapshot_framelinks(jit_State *J, SnapEntry *map) { cTValue *frame = J->L->base - 1; cTValue *lim = J->L->base - J->baseslot; cTValue *ftop = frame + funcproto(frame_func(frame))->framesize; MSize f = 0; map[f++] = SNAP_MKPC(J->pc); /* The current PC is always the first entry. */ while (frame > lim) { /* Backwards traversal of all frames above base. */ if (frame_islua(frame)) { map[f++] = SNAP_MKPC(frame_pc(frame)); frame = frame_prevl(frame); } else if (frame_iscont(frame)) { map[f++] = SNAP_MKFTSZ(frame_ftsz(frame)); map[f++] = SNAP_MKPC(frame_contpc(frame)); frame = frame_prevd(frame); } else { lua_assert(!frame_isc(frame)); map[f++] = SNAP_MKFTSZ(frame_ftsz(frame)); frame = frame_prevd(frame); continue; } if (frame + funcproto(frame_func(frame))->framesize > ftop) ftop = frame + funcproto(frame_func(frame))->framesize; } lua_assert(f == (MSize)(1 + J->framedepth)); return (BCReg)(ftop - lim); } /* Take a snapshot of the current stack. */ static void snapshot_stack(jit_State *J, SnapShot *snap, MSize nsnapmap) { BCReg nslots = J->baseslot + J->maxslot; MSize nent; SnapEntry *p; /* Conservative estimate. */ lj_snap_grow_map(J, nsnapmap + nslots + (MSize)J->framedepth+1); p = &J->cur.snapmap[nsnapmap]; nent = snapshot_slots(J, p, nslots); snap->topslot = (uint8_t)snapshot_framelinks(J, p + nent); snap->mapofs = (uint16_t)nsnapmap; snap->ref = (IRRef1)J->cur.nins; snap->nent = (uint8_t)nent; snap->nslots = (uint8_t)nslots; snap->count = 0; J->cur.nsnapmap = (uint16_t)(nsnapmap + nent + 1 + J->framedepth); } /* Add or merge a snapshot. */ void lj_snap_add(jit_State *J) { MSize nsnap = J->cur.nsnap; MSize nsnapmap = J->cur.nsnapmap; /* Merge if no ins. inbetween or if requested and no guard inbetween. */ if (J->mergesnap ? !irt_isguard(J->guardemit) : (nsnap > 0 && J->cur.snap[nsnap-1].ref == J->cur.nins)) { if (nsnap == 1) { /* But preserve snap #0 PC. */ emitir_raw(IRT(IR_NOP, IRT_NIL), 0, 0); goto nomerge; } nsnapmap = J->cur.snap[--nsnap].mapofs; } else { nomerge: lj_snap_grow_buf(J, nsnap+1); J->cur.nsnap = (uint16_t)(nsnap+1); } J->mergesnap = 0; J->guardemit.irt = 0; snapshot_stack(J, &J->cur.snap[nsnap], nsnapmap); } /* -- Snapshot modification ----------------------------------------------- */ #define SNAP_USEDEF_SLOTS (LJ_MAX_JSLOTS+LJ_STACK_EXTRA) /* Find unused slots with reaching-definitions bytecode data-flow analysis. */ static BCReg snap_usedef(jit_State *J, uint8_t *udf, const BCIns *pc, BCReg maxslot) { BCReg s; GCobj *o; if (maxslot == 0) return 0; #ifdef LUAJIT_USE_VALGRIND /* Avoid errors for harmless reads beyond maxslot. */ memset(udf, 1, SNAP_USEDEF_SLOTS); #else memset(udf, 1, maxslot); #endif /* Treat open upvalues as used. */ o = gcref(J->L->openupval); while (o) { if (uvval(gco2uv(o)) < J->L->base) break; udf[uvval(gco2uv(o)) - J->L->base] = 0; o = gcref(o->gch.nextgc); } #define USE_SLOT(s) udf[(s)] &= ~1 #define DEF_SLOT(s) udf[(s)] *= 3 /* Scan through following bytecode and check for uses/defs. */ lua_assert(pc >= proto_bc(J->pt) && pc < proto_bc(J->pt) + J->pt->sizebc); for (;;) { BCIns ins = *pc++; BCOp op = bc_op(ins); switch (bcmode_b(op)) { case BCMvar: USE_SLOT(bc_b(ins)); break; default: break; } switch (bcmode_c(op)) { case BCMvar: USE_SLOT(bc_c(ins)); break; case BCMrbase: lua_assert(op == BC_CAT); for (s = bc_b(ins); s <= bc_c(ins); s++) USE_SLOT(s); for (; s < maxslot; s++) DEF_SLOT(s); break; case BCMjump: handle_jump: { BCReg minslot = bc_a(ins); if (op >= BC_FORI && op <= BC_JFORL) minslot += FORL_EXT; else if (op >= BC_ITERL && op <= BC_JITERL) minslot += bc_b(pc[-2])-1; else if (op == BC_UCLO) { pc += bc_j(ins); break; } for (s = minslot; s < maxslot; s++) DEF_SLOT(s); return minslot < maxslot ? minslot : maxslot; } case BCMlit: if (op == BC_JFORL || op == BC_JITERL || op == BC_JLOOP) { goto handle_jump; } else if (bc_isret(op)) { BCReg top = op == BC_RETM ? maxslot : (bc_a(ins) + bc_d(ins)-1); for (s = 0; s < bc_a(ins); s++) DEF_SLOT(s); for (; s < top; s++) USE_SLOT(s); for (; s < maxslot; s++) DEF_SLOT(s); return 0; } break; case BCMfunc: return maxslot; /* NYI: will abort, anyway. */ default: break; } switch (bcmode_a(op)) { case BCMvar: USE_SLOT(bc_a(ins)); break; case BCMdst: if (!(op == BC_ISTC || op == BC_ISFC)) DEF_SLOT(bc_a(ins)); break; case BCMbase: if (op >= BC_CALLM && op <= BC_VARG) { BCReg top = (op == BC_CALLM || op == BC_CALLMT || bc_c(ins) == 0) ? maxslot : (bc_a(ins) + bc_c(ins)); s = bc_a(ins) - ((op == BC_ITERC || op == BC_ITERN) ? 3 : 0); for (; s < top; s++) USE_SLOT(s); for (; s < maxslot; s++) DEF_SLOT(s); if (op == BC_CALLT || op == BC_CALLMT) { for (s = 0; s < bc_a(ins); s++) DEF_SLOT(s); return 0; } } else if (op == BC_KNIL) { for (s = bc_a(ins); s <= bc_d(ins); s++) DEF_SLOT(s); } else if (op == BC_TSETM) { for (s = bc_a(ins)-1; s < maxslot; s++) USE_SLOT(s); } break; default: break; } lua_assert(pc >= proto_bc(J->pt) && pc < proto_bc(J->pt) + J->pt->sizebc); } #undef USE_SLOT #undef DEF_SLOT return 0; /* unreachable */ } /* Purge dead slots before the next snapshot. */ void lj_snap_purge(jit_State *J) { uint8_t udf[SNAP_USEDEF_SLOTS]; BCReg maxslot = J->maxslot; BCReg s = snap_usedef(J, udf, J->pc, maxslot); for (; s < maxslot; s++) if (udf[s] != 0) J->base[s] = 0; /* Purge dead slots. */ } /* Shrink last snapshot. */ void lj_snap_shrink(jit_State *J) { SnapShot *snap = &J->cur.snap[J->cur.nsnap-1]; SnapEntry *map = &J->cur.snapmap[snap->mapofs]; MSize n, m, nlim, nent = snap->nent; uint8_t udf[SNAP_USEDEF_SLOTS]; BCReg maxslot = J->maxslot; BCReg minslot = snap_usedef(J, udf, snap_pc(map[nent]), maxslot); BCReg baseslot = J->baseslot; maxslot += baseslot; minslot += baseslot; snap->nslots = (uint8_t)maxslot; for (n = m = 0; n < nent; n++) { /* Remove unused slots from snapshot. */ BCReg s = snap_slot(map[n]); if (s < minslot || (s < maxslot && udf[s-baseslot] == 0)) map[m++] = map[n]; /* Only copy used slots. */ } snap->nent = (uint8_t)m; nlim = J->cur.nsnapmap - snap->mapofs - 1; while (n <= nlim) map[m++] = map[n++]; /* Move PC + frame links down. */ J->cur.nsnapmap = (uint16_t)(snap->mapofs + m); /* Free up space in map. */ } /* -- Snapshot access ----------------------------------------------------- */ /* Initialize a Bloom Filter with all renamed refs. ** There are very few renames (often none), so the filter has ** very few bits set. This makes it suitable for negative filtering. */ static BloomFilter snap_renamefilter(GCtrace *T, SnapNo lim) { BloomFilter rfilt = 0; IRIns *ir; for (ir = &T->ir[T->nins-1]; ir->o == IR_RENAME; ir--) if (ir->op2 <= lim) bloomset(rfilt, ir->op1); return rfilt; } /* Process matching renames to find the original RegSP. */ static RegSP snap_renameref(GCtrace *T, SnapNo lim, IRRef ref, RegSP rs) { IRIns *ir; for (ir = &T->ir[T->nins-1]; ir->o == IR_RENAME; ir--) if (ir->op1 == ref && ir->op2 <= lim) rs = ir->prev; return rs; } /* Copy RegSP from parent snapshot to the parent links of the IR. */ IRIns *lj_snap_regspmap(GCtrace *T, SnapNo snapno, IRIns *ir) { SnapShot *snap = &T->snap[snapno]; SnapEntry *map = &T->snapmap[snap->mapofs]; BloomFilter rfilt = snap_renamefilter(T, snapno); MSize n = 0; IRRef ref = 0; for ( ; ; ir++) { uint32_t rs; if (ir->o == IR_SLOAD) { if (!(ir->op2 & IRSLOAD_PARENT)) break; for ( ; ; n++) { lua_assert(n < snap->nent); if (snap_slot(map[n]) == ir->op1) { ref = snap_ref(map[n++]); break; } } } else if (LJ_SOFTFP && ir->o == IR_HIOP) { ref++; } else if (ir->o == IR_PVAL) { ref = ir->op1 + REF_BIAS; } else { break; } rs = T->ir[ref].prev; if (bloomtest(rfilt, ref)) rs = snap_renameref(T, snapno, ref, rs); ir->prev = (uint16_t)rs; lua_assert(regsp_used(rs)); } return ir; } /* -- Snapshot replay ----------------------------------------------------- */ /* Replay constant from parent trace. */ static TRef snap_replay_const(jit_State *J, IRIns *ir) { /* Only have to deal with constants that can occur in stack slots. */ switch ((IROp)ir->o) { case IR_KPRI: return TREF_PRI(irt_type(ir->t)); case IR_KINT: return lj_ir_kint(J, ir->i); case IR_KGC: return lj_ir_kgc(J, ir_kgc(ir), irt_t(ir->t)); case IR_KNUM: return lj_ir_k64(J, IR_KNUM, ir_knum(ir)); case IR_KINT64: return lj_ir_k64(J, IR_KINT64, ir_kint64(ir)); case IR_KPTR: return lj_ir_kptr(J, ir_kptr(ir)); /* Continuation. */ default: lua_assert(0); return TREF_NIL; break; } } /* De-duplicate parent reference. */ static TRef snap_dedup(jit_State *J, SnapEntry *map, MSize nmax, IRRef ref) { MSize j; for (j = 0; j < nmax; j++) if (snap_ref(map[j]) == ref) return J->slot[snap_slot(map[j])] & ~(SNAP_CONT|SNAP_FRAME); return 0; } /* Emit parent reference with de-duplication. */ static TRef snap_pref(jit_State *J, GCtrace *T, SnapEntry *map, MSize nmax, BloomFilter seen, IRRef ref) { IRIns *ir = &T->ir[ref]; TRef tr; if (irref_isk(ref)) tr = snap_replay_const(J, ir); else if (!regsp_used(ir->prev)) tr = 0; else if (!bloomtest(seen, ref) || (tr = snap_dedup(J, map, nmax, ref)) == 0) tr = emitir(IRT(IR_PVAL, irt_type(ir->t)), ref - REF_BIAS, 0); return tr; } /* Check whether a sunk store corresponds to an allocation. Slow path. */ static int snap_sunk_store2(GCtrace *T, IRIns *ira, IRIns *irs) { if (irs->o == IR_ASTORE || irs->o == IR_HSTORE || irs->o == IR_FSTORE || irs->o == IR_XSTORE) { IRIns *irk = &T->ir[irs->op1]; if (irk->o == IR_AREF || irk->o == IR_HREFK) irk = &T->ir[irk->op1]; return (&T->ir[irk->op1] == ira); } return 0; } /* Check whether a sunk store corresponds to an allocation. Fast path. */ static LJ_AINLINE int snap_sunk_store(GCtrace *T, IRIns *ira, IRIns *irs) { if (irs->s != 255) return (ira + irs->s == irs); /* Fast check. */ return snap_sunk_store2(T, ira, irs); } /* Replay snapshot state to setup side trace. */ void lj_snap_replay(jit_State *J, GCtrace *T) { SnapShot *snap = &T->snap[J->exitno]; SnapEntry *map = &T->snapmap[snap->mapofs]; MSize n, nent = snap->nent; BloomFilter seen = 0; int pass23 = 0; J->framedepth = 0; /* Emit IR for slots inherited from parent snapshot. */ for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; BCReg s = snap_slot(sn); IRRef ref = snap_ref(sn); IRIns *ir = &T->ir[ref]; TRef tr; /* The bloom filter avoids O(nent^2) overhead for de-duping slots. */ if (bloomtest(seen, ref) && (tr = snap_dedup(J, map, n, ref)) != 0) goto setslot; bloomset(seen, ref); if (irref_isk(ref)) { tr = snap_replay_const(J, ir); } else if (!regsp_used(ir->prev)) { pass23 = 1; lua_assert(s != 0); tr = s; } else { IRType t = irt_type(ir->t); uint32_t mode = IRSLOAD_INHERIT|IRSLOAD_PARENT; if (LJ_SOFTFP && (sn & SNAP_SOFTFPNUM)) t = IRT_NUM; if (ir->o == IR_SLOAD) mode |= (ir->op2 & IRSLOAD_READONLY); tr = emitir_raw(IRT(IR_SLOAD, t), s, mode); } setslot: J->slot[s] = tr | (sn&(SNAP_CONT|SNAP_FRAME)); /* Same as TREF_* flags. */ J->framedepth += ((sn & (SNAP_CONT|SNAP_FRAME)) && s); if ((sn & SNAP_FRAME)) J->baseslot = s+1; } if (pass23) { IRIns *irlast = &T->ir[snap->ref]; pass23 = 0; /* Emit dependent PVALs. */ for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; IRRef refp = snap_ref(sn); IRIns *ir = &T->ir[refp]; if (regsp_reg(ir->r) == RID_SUNK) { if (J->slot[snap_slot(sn)] != snap_slot(sn)) continue; pass23 = 1; lua_assert(ir->o == IR_TNEW || ir->o == IR_TDUP || ir->o == IR_CNEW || ir->o == IR_CNEWI); if (ir->op1 >= T->nk) snap_pref(J, T, map, nent, seen, ir->op1); if (ir->op2 >= T->nk) snap_pref(J, T, map, nent, seen, ir->op2); if (LJ_HASFFI && ir->o == IR_CNEWI) { if (LJ_32 && refp+1 < T->nins && (ir+1)->o == IR_HIOP) snap_pref(J, T, map, nent, seen, (ir+1)->op2); } else { IRIns *irs; for (irs = ir+1; irs < irlast; irs++) if (irs->r == RID_SINK && snap_sunk_store(T, ir, irs)) { if (snap_pref(J, T, map, nent, seen, irs->op2) == 0) snap_pref(J, T, map, nent, seen, T->ir[irs->op2].op1); else if ((LJ_SOFTFP || (LJ_32 && LJ_HASFFI)) && irs+1 < irlast && (irs+1)->o == IR_HIOP) snap_pref(J, T, map, nent, seen, (irs+1)->op2); } } } else if (!irref_isk(refp) && !regsp_used(ir->prev)) { lua_assert(ir->o == IR_CONV && ir->op2 == IRCONV_NUM_INT); J->slot[snap_slot(sn)] = snap_pref(J, T, map, nent, seen, ir->op1); } } /* Replay sunk instructions. */ for (n = 0; pass23 && n < nent; n++) { SnapEntry sn = map[n]; IRRef refp = snap_ref(sn); IRIns *ir = &T->ir[refp]; if (regsp_reg(ir->r) == RID_SUNK) { TRef op1, op2; if (J->slot[snap_slot(sn)] != snap_slot(sn)) { /* De-dup allocs. */ J->slot[snap_slot(sn)] = J->slot[J->slot[snap_slot(sn)]]; continue; } op1 = ir->op1; if (op1 >= T->nk) op1 = snap_pref(J, T, map, nent, seen, op1); op2 = ir->op2; if (op2 >= T->nk) op2 = snap_pref(J, T, map, nent, seen, op2); if (LJ_HASFFI && ir->o == IR_CNEWI) { if (LJ_32 && refp+1 < T->nins && (ir+1)->o == IR_HIOP) { lj_needsplit(J); /* Emit joining HIOP. */ op2 = emitir_raw(IRT(IR_HIOP, IRT_I64), op2, snap_pref(J, T, map, nent, seen, (ir+1)->op2)); } J->slot[snap_slot(sn)] = emitir(ir->ot & ~(IRT_MARK|IRT_ISPHI), op1, op2); } else { IRIns *irs; TRef tr = emitir(ir->ot, op1, op2); J->slot[snap_slot(sn)] = tr; for (irs = ir+1; irs < irlast; irs++) if (irs->r == RID_SINK && snap_sunk_store(T, ir, irs)) { IRIns *irr = &T->ir[irs->op1]; TRef val, key = irr->op2, tmp = tr; if (irr->o != IR_FREF) { IRIns *irk = &T->ir[key]; if (irr->o == IR_HREFK) key = lj_ir_kslot(J, snap_replay_const(J, &T->ir[irk->op1]), irk->op2); else key = snap_replay_const(J, irk); if (irr->o == IR_HREFK || irr->o == IR_AREF) { IRIns *irf = &T->ir[irr->op1]; tmp = emitir(irf->ot, tmp, irf->op2); } } tmp = emitir(irr->ot, tmp, key); val = snap_pref(J, T, map, nent, seen, irs->op2); if (val == 0) { IRIns *irc = &T->ir[irs->op2]; lua_assert(irc->o == IR_CONV && irc->op2 == IRCONV_NUM_INT); val = snap_pref(J, T, map, nent, seen, irc->op1); val = emitir(IRTN(IR_CONV), val, IRCONV_NUM_INT); } else if ((LJ_SOFTFP || (LJ_32 && LJ_HASFFI)) && irs+1 < irlast && (irs+1)->o == IR_HIOP) { IRType t = IRT_I64; if (LJ_SOFTFP && irt_type((irs+1)->t) == IRT_SOFTFP) t = IRT_NUM; lj_needsplit(J); if (irref_isk(irs->op2) && irref_isk((irs+1)->op2)) { uint64_t k = (uint32_t)T->ir[irs->op2].i + ((uint64_t)T->ir[(irs+1)->op2].i << 32); val = lj_ir_k64(J, t == IRT_I64 ? IR_KINT64 : IR_KNUM, lj_ir_k64_find(J, k)); } else { val = emitir_raw(IRT(IR_HIOP, t), val, snap_pref(J, T, map, nent, seen, (irs+1)->op2)); } tmp = emitir(IRT(irs->o, t), tmp, val); continue; } tmp = emitir(irs->ot, tmp, val); } else if (LJ_HASFFI && irs->o == IR_XBAR && ir->o == IR_CNEW) { emitir(IRT(IR_XBAR, IRT_NIL), 0, 0); } } } } } J->base = J->slot + J->baseslot; J->maxslot = snap->nslots - J->baseslot; lj_snap_add(J); if (pass23) /* Need explicit GC step _after_ initial snapshot. */ emitir_raw(IRTG(IR_GCSTEP, IRT_NIL), 0, 0); } /* -- Snapshot restore ---------------------------------------------------- */ static void snap_unsink(jit_State *J, GCtrace *T, ExitState *ex, SnapNo snapno, BloomFilter rfilt, IRIns *ir, TValue *o); /* Restore a value from the trace exit state. */ static void snap_restoreval(jit_State *J, GCtrace *T, ExitState *ex, SnapNo snapno, BloomFilter rfilt, IRRef ref, TValue *o) { IRIns *ir = &T->ir[ref]; IRType1 t = ir->t; RegSP rs = ir->prev; if (irref_isk(ref)) { /* Restore constant slot. */ lj_ir_kvalue(J->L, o, ir); return; } if (LJ_UNLIKELY(bloomtest(rfilt, ref))) rs = snap_renameref(T, snapno, ref, rs); if (ra_hasspill(regsp_spill(rs))) { /* Restore from spill slot. */ int32_t *sps = &ex->spill[regsp_spill(rs)]; if (irt_isinteger(t)) { setintV(o, *sps); #if !LJ_SOFTFP } else if (irt_isnum(t)) { o->u64 = *(uint64_t *)sps; #endif } else if (LJ_64 && irt_islightud(t)) { /* 64 bit lightuserdata which may escape already has the tag bits. */ o->u64 = *(uint64_t *)sps; } else { lua_assert(!irt_ispri(t)); /* PRI refs never have a spill slot. */ setgcrefi(o->gcr, *sps); setitype(o, irt_toitype(t)); } } else { /* Restore from register. */ Reg r = regsp_reg(rs); if (ra_noreg(r)) { lua_assert(ir->o == IR_CONV && ir->op2 == IRCONV_NUM_INT); snap_restoreval(J, T, ex, snapno, rfilt, ir->op1, o); if (LJ_DUALNUM) setnumV(o, (lua_Number)intV(o)); return; } else if (irt_isinteger(t)) { setintV(o, (int32_t)ex->gpr[r-RID_MIN_GPR]); #if !LJ_SOFTFP } else if (irt_isnum(t)) { setnumV(o, ex->fpr[r-RID_MIN_FPR]); #endif } else if (LJ_64 && irt_islightud(t)) { /* 64 bit lightuserdata which may escape already has the tag bits. */ o->u64 = ex->gpr[r-RID_MIN_GPR]; } else { if (!irt_ispri(t)) setgcrefi(o->gcr, ex->gpr[r-RID_MIN_GPR]); setitype(o, irt_toitype(t)); } } } #if LJ_HASFFI /* Restore raw data from the trace exit state. */ static void snap_restoredata(GCtrace *T, ExitState *ex, SnapNo snapno, BloomFilter rfilt, IRRef ref, void *dst, CTSize sz) { IRIns *ir = &T->ir[ref]; RegSP rs = ir->prev; int32_t *src; uint64_t tmp; if (irref_isk(ref)) { if (ir->o == IR_KNUM || ir->o == IR_KINT64) { src = mref(ir->ptr, int32_t); } else if (sz == 8) { tmp = (uint64_t)(uint32_t)ir->i; src = (int32_t *)&tmp; } else { src = &ir->i; } } else { if (LJ_UNLIKELY(bloomtest(rfilt, ref))) rs = snap_renameref(T, snapno, ref, rs); if (ra_hasspill(regsp_spill(rs))) { src = &ex->spill[regsp_spill(rs)]; if (sz == 8 && !irt_is64(ir->t)) { tmp = (uint64_t)(uint32_t)*src; src = (int32_t *)&tmp; } } else { Reg r = regsp_reg(rs); if (ra_noreg(r)) { /* Note: this assumes CNEWI is never used for SOFTFP split numbers. */ lua_assert(sz == 8 && ir->o == IR_CONV && ir->op2 == IRCONV_NUM_INT); snap_restoredata(T, ex, snapno, rfilt, ir->op1, dst, 4); *(lua_Number *)dst = (lua_Number)*(int32_t *)dst; return; } src = (int32_t *)&ex->gpr[r-RID_MIN_GPR]; #if !LJ_SOFTFP if (r >= RID_MAX_GPR) { src = (int32_t *)&ex->fpr[r-RID_MIN_FPR]; #if LJ_TARGET_PPC if (sz == 4) { /* PPC FPRs are always doubles. */ *(float *)dst = (float)*(double *)src; return; } #else if (LJ_BE && sz == 4) src++; #endif } #endif } } lua_assert(sz == 1 || sz == 2 || sz == 4 || sz == 8); if (sz == 4) *(int32_t *)dst = *src; else if (sz == 8) *(int64_t *)dst = *(int64_t *)src; else if (sz == 1) *(int8_t *)dst = (int8_t)*src; else *(int16_t *)dst = (int16_t)*src; } #endif /* Unsink allocation from the trace exit state. Unsink sunk stores. */ static void snap_unsink(jit_State *J, GCtrace *T, ExitState *ex, SnapNo snapno, BloomFilter rfilt, IRIns *ir, TValue *o) { lua_assert(ir->o == IR_TNEW || ir->o == IR_TDUP || ir->o == IR_CNEW || ir->o == IR_CNEWI); #if LJ_HASFFI if (ir->o == IR_CNEW || ir->o == IR_CNEWI) { CTState *cts = ctype_cts(J->L); CTypeID id = (CTypeID)T->ir[ir->op1].i; CTSize sz = lj_ctype_size(cts, id); GCcdata *cd = lj_cdata_new(cts, id, sz); setcdataV(J->L, o, cd); if (ir->o == IR_CNEWI) { uint8_t *p = (uint8_t *)cdataptr(cd); lua_assert(sz == 4 || sz == 8); if (LJ_32 && sz == 8 && ir+1 < T->ir + T->nins && (ir+1)->o == IR_HIOP) { snap_restoredata(T, ex, snapno, rfilt, (ir+1)->op2, LJ_LE?p+4:p, 4); if (LJ_BE) p += 4; sz = 4; } snap_restoredata(T, ex, snapno, rfilt, ir->op2, p, sz); } else { IRIns *irs, *irlast = &T->ir[T->snap[snapno].ref]; for (irs = ir+1; irs < irlast; irs++) if (irs->r == RID_SINK && snap_sunk_store(T, ir, irs)) { IRIns *iro = &T->ir[T->ir[irs->op1].op2]; uint8_t *p = (uint8_t *)cd; CTSize szs; lua_assert(irs->o == IR_XSTORE && T->ir[irs->op1].o == IR_ADD); lua_assert(iro->o == IR_KINT || iro->o == IR_KINT64); if (irt_is64(irs->t)) szs = 8; else if (irt_isi8(irs->t) || irt_isu8(irs->t)) szs = 1; else if (irt_isi16(irs->t) || irt_isu16(irs->t)) szs = 2; else szs = 4; if (LJ_64 && iro->o == IR_KINT64) p += (int64_t)ir_k64(iro)->u64; else p += iro->i; lua_assert(p >= (uint8_t *)cdataptr(cd) && p + szs <= (uint8_t *)cdataptr(cd) + sz); if (LJ_32 && irs+1 < T->ir + T->nins && (irs+1)->o == IR_HIOP) { lua_assert(szs == 4); snap_restoredata(T, ex, snapno, rfilt, (irs+1)->op2, LJ_LE?p+4:p,4); if (LJ_BE) p += 4; } snap_restoredata(T, ex, snapno, rfilt, irs->op2, p, szs); } } } else #endif { IRIns *irs, *irlast; GCtab *t = ir->o == IR_TNEW ? lj_tab_new(J->L, ir->op1, ir->op2) : lj_tab_dup(J->L, ir_ktab(&T->ir[ir->op1])); settabV(J->L, o, t); irlast = &T->ir[T->snap[snapno].ref]; for (irs = ir+1; irs < irlast; irs++) if (irs->r == RID_SINK && snap_sunk_store(T, ir, irs)) { IRIns *irk = &T->ir[irs->op1]; TValue tmp, *val; lua_assert(irs->o == IR_ASTORE || irs->o == IR_HSTORE || irs->o == IR_FSTORE); if (irk->o == IR_FREF) { lua_assert(irk->op2 == IRFL_TAB_META); snap_restoreval(J, T, ex, snapno, rfilt, irs->op2, &tmp); /* NOBARRIER: The table is new (marked white). */ setgcref(t->metatable, obj2gco(tabV(&tmp))); } else { irk = &T->ir[irk->op2]; if (irk->o == IR_KSLOT) irk = &T->ir[irk->op1]; lj_ir_kvalue(J->L, &tmp, irk); val = lj_tab_set(J->L, t, &tmp); /* NOBARRIER: The table is new (marked white). */ snap_restoreval(J, T, ex, snapno, rfilt, irs->op2, val); if (LJ_SOFTFP && irs+1 < T->ir + T->nins && (irs+1)->o == IR_HIOP) { snap_restoreval(J, T, ex, snapno, rfilt, (irs+1)->op2, &tmp); val->u32.hi = tmp.u32.lo; } } } } } /* Restore interpreter state from exit state with the help of a snapshot. */ const BCIns *lj_snap_restore(jit_State *J, void *exptr) { ExitState *ex = (ExitState *)exptr; SnapNo snapno = J->exitno; /* For now, snapno == exitno. */ GCtrace *T = traceref(J, J->parent); SnapShot *snap = &T->snap[snapno]; MSize n, nent = snap->nent; SnapEntry *map = &T->snapmap[snap->mapofs]; SnapEntry *flinks = &T->snapmap[snap_nextofs(T, snap)-1]; int32_t ftsz0; TValue *frame; BloomFilter rfilt = snap_renamefilter(T, snapno); const BCIns *pc = snap_pc(map[nent]); lua_State *L = J->L; /* Set interpreter PC to the next PC to get correct error messages. */ setcframe_pc(cframe_raw(L->cframe), pc+1); /* Make sure the stack is big enough for the slots from the snapshot. */ if (LJ_UNLIKELY(L->base + snap->topslot >= tvref(L->maxstack))) { L->top = curr_topL(L); lj_state_growstack(L, snap->topslot - curr_proto(L)->framesize); } /* Fill stack slots with data from the registers and spill slots. */ frame = L->base-1; ftsz0 = frame_ftsz(frame); /* Preserve link to previous frame in slot #0. */ for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; if (!(sn & SNAP_NORESTORE)) { TValue *o = &frame[snap_slot(sn)]; IRRef ref = snap_ref(sn); IRIns *ir = &T->ir[ref]; if (ir->r == RID_SUNK) { MSize j; for (j = 0; j < n; j++) if (snap_ref(map[j]) == ref) { /* De-duplicate sunk allocations. */ copyTV(L, o, &frame[snap_slot(map[j])]); goto dupslot; } snap_unsink(J, T, ex, snapno, rfilt, ir, o); dupslot: continue; } snap_restoreval(J, T, ex, snapno, rfilt, ref, o); if (LJ_SOFTFP && (sn & SNAP_SOFTFPNUM) && tvisint(o)) { TValue tmp; snap_restoreval(J, T, ex, snapno, rfilt, ref+1, &tmp); o->u32.hi = tmp.u32.lo; } else if ((sn & (SNAP_CONT|SNAP_FRAME))) { /* Overwrite tag with frame link. */ o->fr.tp.ftsz = snap_slot(sn) != 0 ? (int32_t)*flinks-- : ftsz0; L->base = o+1; } } } lua_assert(map + nent == flinks); /* Compute current stack top. */ switch (bc_op(*pc)) { default: if (bc_op(*pc) < BC_FUNCF) { L->top = curr_topL(L); break; } /* fallthrough */ case BC_CALLM: case BC_CALLMT: case BC_RETM: case BC_TSETM: L->top = frame + snap->nslots; break; } return pc; } #undef emitir_raw #undef emitir #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_strscan.c0000644000175000017500000003601413122010155017203 0ustar philphil/* ** String scanning. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include #define lj_strscan_c #define LUA_CORE #include "lj_obj.h" #include "lj_char.h" #include "lj_strscan.h" /* -- Scanning numbers ---------------------------------------------------- */ /* ** Rationale for the builtin string to number conversion library: ** ** It removes a dependency on libc's strtod(), which is a true portability ** nightmare. Mainly due to the plethora of supported OS and toolchain ** combinations. Sadly, the various implementations ** a) are often buggy, incomplete (no hex floats) and/or imprecise, ** b) sometimes crash or hang on certain inputs, ** c) return non-standard NaNs that need to be filtered out, and ** d) fail if the locale-specific decimal separator is not a dot, ** which can only be fixed with atrocious workarounds. ** ** Also, most of the strtod() implementations are hopelessly bloated, ** which is not just an I-cache hog, but a problem for static linkage ** on embedded systems, too. ** ** OTOH the builtin conversion function is very compact. Even though it ** does a lot more, like parsing long longs, octal or imaginary numbers ** and returning the result in different formats: ** a) It needs less than 3 KB (!) of machine code (on x64 with -Os), ** b) it doesn't perform any dynamic allocation and, ** c) it needs only around 600 bytes of stack space. ** ** The builtin function is faster than strtod() for typical inputs, e.g. ** "123", "1.5" or "1e6". Arguably, it's slower for very large exponents, ** which are not very common (this could be fixed, if needed). ** ** And most importantly, the builtin function is equally precise on all ** platforms. It correctly converts and rounds any input to a double. ** If this is not the case, please send a bug report -- but PLEASE verify ** that the implementation you're comparing to is not the culprit! ** ** The implementation quickly pre-scans the entire string first and ** handles simple integers on-the-fly. Otherwise, it dispatches to the ** base-specific parser. Hex and octal is straightforward. ** ** Decimal to binary conversion uses a fixed-length circular buffer in ** base 100. Some simple cases are handled directly. For other cases, the ** number in the buffer is up-scaled or down-scaled until the integer part ** is in the proper range. Then the integer part is rounded and converted ** to a double which is finally rescaled to the result. Denormals need ** special treatment to prevent incorrect 'double rounding'. */ /* Definitions for circular decimal digit buffer (base 100 = 2 digits/byte). */ #define STRSCAN_DIG 1024 #define STRSCAN_MAXDIG 800 /* 772 + extra are sufficient. */ #define STRSCAN_DDIG (STRSCAN_DIG/2) #define STRSCAN_DMASK (STRSCAN_DDIG-1) /* Helpers for circular buffer. */ #define DNEXT(a) (((a)+1) & STRSCAN_DMASK) #define DPREV(a) (((a)-1) & STRSCAN_DMASK) #define DLEN(lo, hi) ((int32_t)(((lo)-(hi)) & STRSCAN_DMASK)) #define casecmp(c, k) (((c) | 0x20) == k) /* Final conversion to double. */ static void strscan_double(uint64_t x, TValue *o, int32_t ex2, int32_t neg) { double n; /* Avoid double rounding for denormals. */ if (LJ_UNLIKELY(ex2 <= -1075 && x != 0)) { /* NYI: all of this generates way too much code on 32 bit CPUs. */ #if defined(__GNUC__) && LJ_64 int32_t b = (int32_t)(__builtin_clzll(x)^63); #else int32_t b = (x>>32) ? 32+(int32_t)lj_fls((uint32_t)(x>>32)) : (int32_t)lj_fls((uint32_t)x); #endif if ((int32_t)b + ex2 <= -1023 && (int32_t)b + ex2 >= -1075) { uint64_t rb = (uint64_t)1 << (-1075-ex2); if ((x & rb) && ((x & (rb+rb+rb-1)))) x += rb+rb; x = (x & ~(rb+rb-1)); } } /* Convert to double using a signed int64_t conversion, then rescale. */ lua_assert((int64_t)x >= 0); n = (double)(int64_t)x; if (neg) n = -n; if (ex2) n = ldexp(n, ex2); o->n = n; } /* Parse hexadecimal number. */ static StrScanFmt strscan_hex(const uint8_t *p, TValue *o, StrScanFmt fmt, uint32_t opt, int32_t ex2, int32_t neg, uint32_t dig) { uint64_t x = 0; uint32_t i; /* Scan hex digits. */ for (i = dig > 16 ? 16 : dig ; i; i--, p++) { uint32_t d = (*p != '.' ? *p : *++p); if (d > '9') d += 9; x = (x << 4) + (d & 15); } /* Summarize rounding-effect of excess digits. */ for (i = 16; i < dig; i++, p++) x |= ((*p != '.' ? *p : *++p) != '0'), ex2 += 4; /* Format-specific handling. */ switch (fmt) { case STRSCAN_INT: if (!(opt & STRSCAN_OPT_TONUM) && x < 0x80000000u+neg) { o->i = neg ? -(int32_t)x : (int32_t)x; return STRSCAN_INT; /* Fast path for 32 bit integers. */ } if (!(opt & STRSCAN_OPT_C)) { fmt = STRSCAN_NUM; break; } /* fallthrough */ case STRSCAN_U32: if (dig > 8) return STRSCAN_ERROR; o->i = neg ? -(int32_t)x : (int32_t)x; return STRSCAN_U32; case STRSCAN_I64: case STRSCAN_U64: if (dig > 16) return STRSCAN_ERROR; o->u64 = neg ? (uint64_t)-(int64_t)x : x; return fmt; default: break; } /* Reduce range then convert to double. */ if ((x & U64x(c0000000,0000000))) { x = (x >> 2) | (x & 3); ex2 += 2; } strscan_double(x, o, ex2, neg); return fmt; } /* Parse octal number. */ static StrScanFmt strscan_oct(const uint8_t *p, TValue *o, StrScanFmt fmt, int32_t neg, uint32_t dig) { uint64_t x = 0; /* Scan octal digits. */ if (dig > 22 || (dig == 22 && *p > '1')) return STRSCAN_ERROR; while (dig-- > 0) { if (!(*p >= '0' && *p <= '7')) return STRSCAN_ERROR; x = (x << 3) + (*p++ & 7); } /* Format-specific handling. */ switch (fmt) { case STRSCAN_INT: if (x >= 0x80000000u+neg) fmt = STRSCAN_U32; /* fallthrough */ case STRSCAN_U32: if ((x >> 32)) return STRSCAN_ERROR; o->i = neg ? -(int32_t)x : (int32_t)x; break; default: case STRSCAN_I64: case STRSCAN_U64: o->u64 = neg ? (uint64_t)-(int64_t)x : x; break; } return fmt; } /* Parse decimal number. */ static StrScanFmt strscan_dec(const uint8_t *p, TValue *o, StrScanFmt fmt, uint32_t opt, int32_t ex10, int32_t neg, uint32_t dig) { uint8_t xi[STRSCAN_DDIG], *xip = xi; if (dig) { uint32_t i = dig; if (i > STRSCAN_MAXDIG) { ex10 += (int32_t)(i - STRSCAN_MAXDIG); i = STRSCAN_MAXDIG; } /* Scan unaligned leading digit. */ if (((ex10^i) & 1)) *xip++ = ((*p != '.' ? *p : *++p) & 15), i--, p++; /* Scan aligned double-digits. */ for ( ; i > 1; i -= 2) { uint32_t d = 10 * ((*p != '.' ? *p : *++p) & 15); p++; *xip++ = d + ((*p != '.' ? *p : *++p) & 15); p++; } /* Scan and realign trailing digit. */ if (i) *xip++ = 10 * ((*p != '.' ? *p : *++p) & 15), ex10--, dig++, p++; /* Summarize rounding-effect of excess digits. */ if (dig > STRSCAN_MAXDIG) { do { if ((*p != '.' ? *p : *++p) != '0') { xip[-1] |= 1; break; } p++; } while (--dig > STRSCAN_MAXDIG); dig = STRSCAN_MAXDIG; } else { /* Simplify exponent. */ while (ex10 > 0 && dig <= 18) *xip++ = 0, ex10 -= 2, dig += 2; } } else { /* Only got zeros. */ ex10 = 0; xi[0] = 0; } /* Fast path for numbers in integer format (but handles e.g. 1e6, too). */ if (dig <= 20 && ex10 == 0) { uint8_t *xis; uint64_t x = xi[0]; double n; for (xis = xi+1; xis < xip; xis++) x = x * 100 + *xis; if (!(dig == 20 && (xi[0] > 18 || (int64_t)x >= 0))) { /* No overflow? */ /* Format-specific handling. */ switch (fmt) { case STRSCAN_INT: if (!(opt & STRSCAN_OPT_TONUM) && x < 0x80000000u+neg) { o->i = neg ? -(int32_t)x : (int32_t)x; return STRSCAN_INT; /* Fast path for 32 bit integers. */ } if (!(opt & STRSCAN_OPT_C)) { fmt = STRSCAN_NUM; goto plainnumber; } /* fallthrough */ case STRSCAN_U32: if ((x >> 32) != 0) return STRSCAN_ERROR; o->i = neg ? -(int32_t)x : (int32_t)x; return STRSCAN_U32; case STRSCAN_I64: case STRSCAN_U64: o->u64 = neg ? (uint64_t)-(int64_t)x : x; return fmt; default: plainnumber: /* Fast path for plain numbers < 2^63. */ if ((int64_t)x < 0) break; n = (double)(int64_t)x; if (neg) n = -n; o->n = n; return fmt; } } } /* Slow non-integer path. */ if (fmt == STRSCAN_INT) { if ((opt & STRSCAN_OPT_C)) return STRSCAN_ERROR; fmt = STRSCAN_NUM; } else if (fmt > STRSCAN_INT) { return STRSCAN_ERROR; } { uint32_t hi = 0, lo = (uint32_t)(xip-xi); int32_t ex2 = 0, idig = (int32_t)lo + (ex10 >> 1); lua_assert(lo > 0 && (ex10 & 1) == 0); /* Handle simple overflow/underflow. */ if (idig > 310/2) { if (neg) setminfV(o); else setpinfV(o); return fmt; } else if (idig < -326/2) { o->n = neg ? -0.0 : 0.0; return fmt; } /* Scale up until we have at least 17 or 18 integer part digits. */ while (idig < 9 && idig < DLEN(lo, hi)) { uint32_t i, cy = 0; ex2 -= 6; for (i = DPREV(lo); ; i = DPREV(i)) { uint32_t d = (xi[i] << 6) + cy; cy = (((d >> 2) * 5243) >> 17); d = d - cy * 100; /* Div/mod 100. */ xi[i] = (uint8_t)d; if (i == hi) break; if (d == 0 && i == DPREV(lo)) lo = i; } if (cy) { hi = DPREV(hi); if (xi[DPREV(lo)] == 0) lo = DPREV(lo); else if (hi == lo) { lo = DPREV(lo); xi[DPREV(lo)] |= xi[lo]; } xi[hi] = (uint8_t)cy; idig++; } } /* Scale down until no more than 17 or 18 integer part digits remain. */ while (idig > 9) { uint32_t i = hi, cy = 0; ex2 += 6; do { cy += xi[i]; xi[i] = (cy >> 6); cy = 100 * (cy & 0x3f); if (xi[i] == 0 && i == hi) hi = DNEXT(hi), idig--; i = DNEXT(i); } while (i != lo); while (cy) { if (hi == lo) { xi[DPREV(lo)] |= 1; break; } xi[lo] = (cy >> 6); lo = DNEXT(lo); cy = 100 * (cy & 0x3f); } } /* Collect integer part digits and convert to rescaled double. */ { uint64_t x = xi[hi]; uint32_t i; for (i = DNEXT(hi); --idig > 0 && i != lo; i = DNEXT(i)) x = x * 100 + xi[i]; if (i == lo) { while (--idig >= 0) x = x * 100; } else { /* Gather round bit from remaining digits. */ x <<= 1; ex2--; do { if (xi[i]) { x |= 1; break; } i = DNEXT(i); } while (i != lo); } strscan_double(x, o, ex2, neg); } } return fmt; } /* Scan string containing a number. Returns format. Returns value in o. */ StrScanFmt lj_strscan_scan(const uint8_t *p, TValue *o, uint32_t opt) { int32_t neg = 0; /* Remove leading space, parse sign and non-numbers. */ if (LJ_UNLIKELY(!lj_char_isdigit(*p))) { while (lj_char_isspace(*p)) p++; if (*p == '+' || *p == '-') neg = (*p++ == '-'); if (LJ_UNLIKELY(*p >= 'A')) { /* Parse "inf", "infinity" or "nan". */ TValue tmp; setnanV(&tmp); if (casecmp(p[0],'i') && casecmp(p[1],'n') && casecmp(p[2],'f')) { if (neg) setminfV(&tmp); else setpinfV(&tmp); p += 3; if (casecmp(p[0],'i') && casecmp(p[1],'n') && casecmp(p[2],'i') && casecmp(p[3],'t') && casecmp(p[4],'y')) p += 5; } else if (casecmp(p[0],'n') && casecmp(p[1],'a') && casecmp(p[2],'n')) { p += 3; } while (lj_char_isspace(*p)) p++; if (*p) return STRSCAN_ERROR; o->u64 = tmp.u64; return STRSCAN_NUM; } } /* Parse regular number. */ { StrScanFmt fmt = STRSCAN_INT; int cmask = LJ_CHAR_DIGIT; int base = (opt & STRSCAN_OPT_C) && *p == '0' ? 0 : 10; const uint8_t *sp, *dp = NULL; uint32_t dig = 0, hasdig = 0, x = 0; int32_t ex = 0; /* Determine base and skip leading zeros. */ if (LJ_UNLIKELY(*p <= '0')) { if (*p == '0' && casecmp(p[1], 'x')) base = 16, cmask = LJ_CHAR_XDIGIT, p += 2; for ( ; ; p++) { if (*p == '0') { hasdig = 1; } else if (*p == '.') { if (dp) return STRSCAN_ERROR; dp = p; } else { break; } } } /* Preliminary digit and decimal point scan. */ for (sp = p; ; p++) { if (LJ_LIKELY(lj_char_isa(*p, cmask))) { x = x * 10 + (*p & 15); /* For fast path below. */ dig++; } else if (*p == '.') { if (dp) return STRSCAN_ERROR; dp = p; } else { break; } } if (!(hasdig | dig)) return STRSCAN_ERROR; /* Handle decimal point. */ if (dp) { fmt = STRSCAN_NUM; if (dig) { ex = (int32_t)(dp-(p-1)); dp = p-1; while (ex < 0 && *dp-- == '0') ex++, dig--; /* Skip trailing zeros. */ if (base == 16) ex *= 4; } } /* Parse exponent. */ if (casecmp(*p, (uint32_t)(base == 16 ? 'p' : 'e'))) { uint32_t xx; int negx = 0; fmt = STRSCAN_NUM; p++; if (*p == '+' || *p == '-') negx = (*p++ == '-'); if (!lj_char_isdigit(*p)) return STRSCAN_ERROR; xx = (*p++ & 15); while (lj_char_isdigit(*p)) { if (xx < 65536) xx = xx * 10 + (*p & 15); p++; } ex += negx ? -(int32_t)xx : (int32_t)xx; } /* Parse suffix. */ if (*p) { /* I (IMAG), U (U32), LL (I64), ULL/LLU (U64), L (long), UL/LU (ulong). */ /* NYI: f (float). Not needed until cp_number() handles non-integers. */ if (casecmp(*p, 'i')) { if (!(opt & STRSCAN_OPT_IMAG)) return STRSCAN_ERROR; p++; fmt = STRSCAN_IMAG; } else if (fmt == STRSCAN_INT) { if (casecmp(*p, 'u')) p++, fmt = STRSCAN_U32; if (casecmp(*p, 'l')) { p++; if (casecmp(*p, 'l')) p++, fmt += STRSCAN_I64 - STRSCAN_INT; else if (!(opt & STRSCAN_OPT_C)) return STRSCAN_ERROR; else if (sizeof(long) == 8) fmt += STRSCAN_I64 - STRSCAN_INT; } if (casecmp(*p, 'u') && (fmt == STRSCAN_INT || fmt == STRSCAN_I64)) p++, fmt += STRSCAN_U32 - STRSCAN_INT; if ((fmt == STRSCAN_U32 && !(opt & STRSCAN_OPT_C)) || (fmt >= STRSCAN_I64 && !(opt & STRSCAN_OPT_LL))) return STRSCAN_ERROR; } while (lj_char_isspace(*p)) p++; if (*p) return STRSCAN_ERROR; } /* Fast path for decimal 32 bit integers. */ if (fmt == STRSCAN_INT && base == 10 && (dig < 10 || (dig == 10 && *sp <= '2' && x < 0x80000000u+neg))) { int32_t y = neg ? -(int32_t)x : (int32_t)x; if ((opt & STRSCAN_OPT_TONUM)) { o->n = (double)y; return STRSCAN_NUM; } else { o->i = y; return STRSCAN_INT; } } /* Dispatch to base-specific parser. */ if (base == 0 && !(fmt == STRSCAN_NUM || fmt == STRSCAN_IMAG)) return strscan_oct(sp, o, fmt, neg, dig); if (base == 16) fmt = strscan_hex(sp, o, fmt, opt, ex, neg, dig); else fmt = strscan_dec(sp, o, fmt, opt, ex, neg, dig); /* Try to convert number to integer, if requested. */ if (fmt == STRSCAN_NUM && (opt & STRSCAN_OPT_TOINT)) { double n = o->n; int32_t i = lj_num2int(n); if (n == (lua_Number)i) { o->i = i; return STRSCAN_INT; } } return fmt; } } int LJ_FASTCALL lj_strscan_num(GCstr *str, TValue *o) { StrScanFmt fmt = lj_strscan_scan((const uint8_t *)strdata(str), o, STRSCAN_OPT_TONUM); lua_assert(fmt == STRSCAN_ERROR || fmt == STRSCAN_NUM); return (fmt != STRSCAN_ERROR); } #if LJ_DUALNUM int LJ_FASTCALL lj_strscan_number(GCstr *str, TValue *o) { StrScanFmt fmt = lj_strscan_scan((const uint8_t *)strdata(str), o, STRSCAN_OPT_TOINT); lua_assert(fmt == STRSCAN_ERROR || fmt == STRSCAN_NUM || fmt == STRSCAN_INT); if (fmt == STRSCAN_INT) setitype(o, LJ_TISNUM); return (fmt != STRSCAN_ERROR); } #endif #undef DNEXT #undef DPREV #undef DLEN wcc-0.0.2/src/wsh/luajit-2.0/src/vm_arm.dasc0000644000175000017500000036005313122010155017015 0ustar philphil|// Low-level VM code for ARM CPUs. |// Bytecode interpreter, fast functions and helper functions. |// Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h | |.arch arm |.section code_op, code_sub | |.actionlist build_actionlist |.globals GLOB_ |.globalnames globnames |.externnames extnames | |// Note: The ragged indentation of the instructions is intentional. |// The starting columns indicate data dependencies. | |//----------------------------------------------------------------------- | |// Fixed register assignments for the interpreter. | |// The following must be C callee-save. |.define MASKR8, r4 // 255*8 constant for fast bytecode decoding. |.define KBASE, r5 // Constants of current Lua function. |.define PC, r6 // Next PC. |.define DISPATCH, r7 // Opcode dispatch table. |.define LREG, r8 // Register holding lua_State (also in SAVE_L). | |// C callee-save in EABI, but often refetched. Temporary in iOS 3.0+. |.define BASE, r9 // Base of current Lua stack frame. | |// The following temporaries are not saved across C calls, except for RA/RC. |.define RA, r10 // Callee-save. |.define RC, r11 // Callee-save. |.define RB, r12 |.define OP, r12 // Overlaps RB, must not be lr. |.define INS, lr | |// Calling conventions. Also used as temporaries. |.define CARG1, r0 |.define CARG2, r1 |.define CARG3, r2 |.define CARG4, r3 |.define CARG12, r0 // For 1st soft-fp double. |.define CARG34, r2 // For 2nd soft-fp double. | |.define CRET1, r0 |.define CRET2, r1 | |// Stack layout while in interpreter. Must match with lj_frame.h. |.define SAVE_R4, [sp, #28] |.define CFRAME_SPACE, #28 |.define SAVE_ERRF, [sp, #24] |.define SAVE_NRES, [sp, #20] |.define SAVE_CFRAME, [sp, #16] |.define SAVE_L, [sp, #12] |.define SAVE_PC, [sp, #8] |.define SAVE_MULTRES, [sp, #4] |.define ARG5, [sp] | |.define TMPDhi, [sp, #4] |.define TMPDlo, [sp] |.define TMPD, [sp] |.define TMPDp, sp | |.if FPU |.macro saveregs | push {r5, r6, r7, r8, r9, r10, r11, lr} | vpush {d8-d15} | sub sp, sp, CFRAME_SPACE+4 | str r4, SAVE_R4 |.endmacro |.macro restoreregs_ret | ldr r4, SAVE_R4 | add sp, sp, CFRAME_SPACE+4 | vpop {d8-d15} | pop {r5, r6, r7, r8, r9, r10, r11, pc} |.endmacro |.else |.macro saveregs | push {r4, r5, r6, r7, r8, r9, r10, r11, lr} | sub sp, sp, CFRAME_SPACE |.endmacro |.macro restoreregs_ret | add sp, sp, CFRAME_SPACE | pop {r4, r5, r6, r7, r8, r9, r10, r11, pc} |.endmacro |.endif | |// Type definitions. Some of these are only used for documentation. |.type L, lua_State, LREG |.type GL, global_State |.type TVALUE, TValue |.type GCOBJ, GCobj |.type STR, GCstr |.type TAB, GCtab |.type LFUNC, GCfuncL |.type CFUNC, GCfuncC |.type PROTO, GCproto |.type UPVAL, GCupval |.type NODE, Node |.type NARGS8, int |.type TRACE, GCtrace | |//----------------------------------------------------------------------- | |// Trap for not-yet-implemented parts. |.macro NYI; ud; .endmacro | |//----------------------------------------------------------------------- | |// Access to frame relative to BASE. |.define FRAME_FUNC, #-8 |.define FRAME_PC, #-4 | |.macro decode_RA8, dst, ins; and dst, MASKR8, ins, lsr #5; .endmacro |.macro decode_RB8, dst, ins; and dst, MASKR8, ins, lsr #21; .endmacro |.macro decode_RC8, dst, ins; and dst, MASKR8, ins, lsr #13; .endmacro |.macro decode_RD, dst, ins; lsr dst, ins, #16; .endmacro |.macro decode_OP, dst, ins; and dst, ins, #255; .endmacro | |// Instruction fetch. |.macro ins_NEXT1 | ldrb OP, [PC] |.endmacro |.macro ins_NEXT2 | ldr INS, [PC], #4 |.endmacro |// Instruction decode+dispatch. |.macro ins_NEXT3 | ldr OP, [DISPATCH, OP, lsl #2] | decode_RA8 RA, INS | decode_RD RC, INS | bx OP |.endmacro |.macro ins_NEXT | ins_NEXT1 | ins_NEXT2 | ins_NEXT3 |.endmacro | |// Instruction footer. |.if 1 | // Replicated dispatch. Less unpredictable branches, but higher I-Cache use. | .define ins_next, ins_NEXT | .define ins_next_, ins_NEXT | .define ins_next1, ins_NEXT1 | .define ins_next2, ins_NEXT2 | .define ins_next3, ins_NEXT3 |.else | // Common dispatch. Lower I-Cache use, only one (very) unpredictable branch. | // Affects only certain kinds of benchmarks (and only with -j off). | .macro ins_next | b ->ins_next | .endmacro | .macro ins_next1 | .endmacro | .macro ins_next2 | .endmacro | .macro ins_next3 | b ->ins_next | .endmacro | .macro ins_next_ | ->ins_next: | ins_NEXT | .endmacro |.endif | |// Avoid register name substitution for field name. #define field_pc pc | |// Call decode and dispatch. |.macro ins_callt | // BASE = new base, CARG3 = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | ldr PC, LFUNC:CARG3->field_pc | ldrb OP, [PC] // STALL: load PC. early PC. | ldr INS, [PC], #4 | ldr OP, [DISPATCH, OP, lsl #2] // STALL: load OP. early OP. | decode_RA8 RA, INS | add RA, RA, BASE | bx OP |.endmacro | |.macro ins_call | // BASE = new base, CARG3 = LFUNC/CFUNC, RC = nargs*8, PC = caller PC | str PC, [BASE, FRAME_PC] | ins_callt // STALL: locked PC. |.endmacro | |//----------------------------------------------------------------------- | |// Macros to test operand types. |.macro checktp, reg, tp; cmn reg, #-tp; .endmacro |.macro checktpeq, reg, tp; cmneq reg, #-tp; .endmacro |.macro checktpne, reg, tp; cmnne reg, #-tp; .endmacro |.macro checkstr, reg, target; checktp reg, LJ_TSTR; bne target; .endmacro |.macro checktab, reg, target; checktp reg, LJ_TTAB; bne target; .endmacro |.macro checkfunc, reg, target; checktp reg, LJ_TFUNC; bne target; .endmacro | |// Assumes DISPATCH is relative to GL. #define DISPATCH_GL(field) (GG_DISP2G + (int)offsetof(global_State, field)) #define DISPATCH_J(field) (GG_DISP2J + (int)offsetof(jit_State, field)) | #define PC2PROTO(field) ((int)offsetof(GCproto, field)-(int)sizeof(GCproto)) | |.macro hotcheck, delta | lsr CARG1, PC, #1 | and CARG1, CARG1, #126 | sub CARG1, CARG1, #-GG_DISP2HOT | ldrh CARG2, [DISPATCH, CARG1] | subs CARG2, CARG2, #delta | strh CARG2, [DISPATCH, CARG1] |.endmacro | |.macro hotloop | hotcheck HOTCOUNT_LOOP | blo ->vm_hotloop |.endmacro | |.macro hotcall | hotcheck HOTCOUNT_CALL | blo ->vm_hotcall |.endmacro | |// Set current VM state. |.macro mv_vmstate, reg, st; mvn reg, #LJ_VMST_..st; .endmacro |.macro st_vmstate, reg; str reg, [DISPATCH, #DISPATCH_GL(vmstate)]; .endmacro | |// Move table write barrier back. Overwrites mark and tmp. |.macro barrierback, tab, mark, tmp | ldr tmp, [DISPATCH, #DISPATCH_GL(gc.grayagain)] | bic mark, mark, #LJ_GC_BLACK // black2gray(tab) | str tab, [DISPATCH, #DISPATCH_GL(gc.grayagain)] | strb mark, tab->marked | str tmp, tab->gclist |.endmacro | |.macro .IOS, a, b |.if IOS | a, b |.endif |.endmacro | |//----------------------------------------------------------------------- #if !LJ_DUALNUM #error "Only dual-number mode supported for ARM target" #endif /* Generate subroutines used by opcodes and other parts of the VM. */ /* The .code_sub section should be last to help static branch prediction. */ static void build_subroutines(BuildCtx *ctx) { |.code_sub | |//----------------------------------------------------------------------- |//-- Return handling ---------------------------------------------------- |//----------------------------------------------------------------------- | |->vm_returnp: | // See vm_return. Also: RB = previous base. | tst PC, #FRAME_P | beq ->cont_dispatch | | // Return from pcall or xpcall fast func. | ldr PC, [RB, FRAME_PC] // Fetch PC of previous frame. | mvn CARG2, #~LJ_TTRUE | mov BASE, RB | // Prepending may overwrite the pcall frame, so do it at the end. | str CARG2, [RA, FRAME_PC] // Prepend true to results. | sub RA, RA, #8 | |->vm_returnc: | adds RC, RC, #8 // RC = (nresults+1)*8. | mov CRET1, #LUA_YIELD | beq ->vm_unwind_c_eh | str RC, SAVE_MULTRES | ands CARG1, PC, #FRAME_TYPE | beq ->BC_RET_Z // Handle regular return to Lua. | |->vm_return: | // BASE = base, RA = resultptr, RC/MULTRES = (nresults+1)*8, PC = return | // CARG1 = PC & FRAME_TYPE | bic RB, PC, #FRAME_TYPEP | cmp CARG1, #FRAME_C | sub RB, BASE, RB // RB = previous base. | bne ->vm_returnp | | str RB, L->base | ldr KBASE, SAVE_NRES | mv_vmstate CARG4, C | sub BASE, BASE, #8 | subs CARG3, RC, #8 | lsl KBASE, KBASE, #3 // KBASE = (nresults_wanted+1)*8 | st_vmstate CARG4 | beq >2 |1: | subs CARG3, CARG3, #8 | ldrd CARG12, [RA], #8 | strd CARG12, [BASE], #8 | bne <1 |2: | cmp KBASE, RC // More/less results wanted? | bne >6 |3: | str BASE, L->top // Store new top. | |->vm_leave_cp: | ldr RC, SAVE_CFRAME // Restore previous C frame. | mov CRET1, #0 // Ok return status for vm_pcall. | str RC, L->cframe | |->vm_leave_unw: | restoreregs_ret | |6: | blt >7 // Less results wanted? | // More results wanted. Check stack size and fill up results with nil. | ldr CARG3, L->maxstack | mvn CARG2, #~LJ_TNIL | cmp BASE, CARG3 | bhs >8 | str CARG2, [BASE, #4] | add RC, RC, #8 | add BASE, BASE, #8 | b <2 | |7: // Less results wanted. | sub CARG1, RC, KBASE | cmp KBASE, #0 // LUA_MULTRET+1 case? | subne BASE, BASE, CARG1 // Either keep top or shrink it. | b <3 | |8: // Corner case: need to grow stack for filling up results. | // This can happen if: | // - A C function grows the stack (a lot). | // - The GC shrinks the stack in between. | // - A return back from a lua_call() with (high) nresults adjustment. | str BASE, L->top // Save current top held in BASE (yes). | lsr CARG2, KBASE, #3 | mov CARG1, L | bl extern lj_state_growstack // (lua_State *L, int n) | ldr BASE, L->top // Need the (realloced) L->top in BASE. | b <2 | |->vm_unwind_c: // Unwind C stack, return from vm_pcall. | // (void *cframe, int errcode) | mov sp, CARG1 | mov CRET1, CARG2 |->vm_unwind_c_eh: // Landing pad for external unwinder. | ldr L, SAVE_L | mv_vmstate CARG4, C | ldr GL:CARG3, L->glref | str CARG4, GL:CARG3->vmstate | b ->vm_leave_unw | |->vm_unwind_ff: // Unwind C stack, return from ff pcall. | // (void *cframe) | bic CARG1, CARG1, #~CFRAME_RAWMASK // Use two steps: bic sp is deprecated. | mov sp, CARG1 |->vm_unwind_ff_eh: // Landing pad for external unwinder. | ldr L, SAVE_L | mov MASKR8, #255 | mov RC, #16 // 2 results: false + error message. | lsl MASKR8, MASKR8, #3 // MASKR8 = 255*8. | ldr BASE, L->base | ldr DISPATCH, L->glref // Setup pointer to dispatch table. | mvn CARG1, #~LJ_TFALSE | sub RA, BASE, #8 // Results start at BASE-8. | ldr PC, [BASE, FRAME_PC] // Fetch PC of previous frame. | add DISPATCH, DISPATCH, #GG_G2DISP | mv_vmstate CARG2, INTERP | str CARG1, [BASE, #-4] // Prepend false to error message. | st_vmstate CARG2 | b ->vm_returnc | |//----------------------------------------------------------------------- |//-- Grow stack for calls ----------------------------------------------- |//----------------------------------------------------------------------- | |->vm_growstack_c: // Grow stack for C function. | // CARG1 = L | mov CARG2, #LUA_MINSTACK | b >2 | |->vm_growstack_l: // Grow stack for Lua function. | // BASE = new base, RA = BASE+framesize*8, RC = nargs*8, PC = first PC | add RC, BASE, RC | sub RA, RA, BASE | mov CARG1, L | str BASE, L->base | add PC, PC, #4 // Must point after first instruction. | str RC, L->top | lsr CARG2, RA, #3 |2: | // L->base = new base, L->top = top | str PC, SAVE_PC | bl extern lj_state_growstack // (lua_State *L, int n) | ldr BASE, L->base | ldr RC, L->top | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] | sub NARGS8:RC, RC, BASE | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | ins_callt // Just retry the call. | |//----------------------------------------------------------------------- |//-- Entry points into the assembler VM --------------------------------- |//----------------------------------------------------------------------- | |->vm_resume: // Setup C frame and resume thread. | // (lua_State *L, TValue *base, int nres1 = 0, ptrdiff_t ef = 0) | saveregs | mov L, CARG1 | ldr DISPATCH, L:CARG1->glref // Setup pointer to dispatch table. | mov BASE, CARG2 | add DISPATCH, DISPATCH, #GG_G2DISP | str L, SAVE_L | mov PC, #FRAME_CP | str CARG3, SAVE_NRES | add CARG2, sp, #CFRAME_RESUME | ldrb CARG1, L->status | str CARG3, SAVE_ERRF | str CARG2, L->cframe | str CARG3, SAVE_CFRAME | cmp CARG1, #0 | str L, SAVE_PC // Any value outside of bytecode is ok. | beq >3 | | // Resume after yield (like a return). | mov RA, BASE | ldr BASE, L->base | ldr CARG1, L->top | mov MASKR8, #255 | strb CARG3, L->status | sub RC, CARG1, BASE | ldr PC, [BASE, FRAME_PC] | lsl MASKR8, MASKR8, #3 // MASKR8 = 255*8. | mv_vmstate CARG2, INTERP | add RC, RC, #8 | ands CARG1, PC, #FRAME_TYPE | st_vmstate CARG2 | str RC, SAVE_MULTRES | beq ->BC_RET_Z | b ->vm_return | |->vm_pcall: // Setup protected C frame and enter VM. | // (lua_State *L, TValue *base, int nres1, ptrdiff_t ef) | saveregs | mov PC, #FRAME_CP | str CARG4, SAVE_ERRF | b >1 | |->vm_call: // Setup C frame and enter VM. | // (lua_State *L, TValue *base, int nres1) | saveregs | mov PC, #FRAME_C | |1: // Entry point for vm_pcall above (PC = ftype). | ldr RC, L:CARG1->cframe | str CARG3, SAVE_NRES | mov L, CARG1 | str CARG1, SAVE_L | mov BASE, CARG2 | str sp, L->cframe // Add our C frame to cframe chain. | ldr DISPATCH, L->glref // Setup pointer to dispatch table. | str CARG1, SAVE_PC // Any value outside of bytecode is ok. | str RC, SAVE_CFRAME | add DISPATCH, DISPATCH, #GG_G2DISP | |3: // Entry point for vm_cpcall/vm_resume (BASE = base, PC = ftype). | ldr RB, L->base // RB = old base (for vmeta_call). | ldr CARG1, L->top | mov MASKR8, #255 | add PC, PC, BASE | lsl MASKR8, MASKR8, #3 // MASKR8 = 255*8. | sub PC, PC, RB // PC = frame delta + frame type | mv_vmstate CARG2, INTERP | sub NARGS8:RC, CARG1, BASE | st_vmstate CARG2 | |->vm_call_dispatch: | // RB = old base, BASE = new base, RC = nargs*8, PC = caller PC | ldrd CARG34, [BASE, FRAME_FUNC] | checkfunc CARG4, ->vmeta_call | |->vm_call_dispatch_f: | ins_call | // BASE = new base, CARG3 = func, RC = nargs*8, PC = caller PC | |->vm_cpcall: // Setup protected C frame, call C. | // (lua_State *L, lua_CFunction func, void *ud, lua_CPFunction cp) | saveregs | mov L, CARG1 | ldr RA, L:CARG1->stack | str CARG1, SAVE_L | ldr RB, L->top | str CARG1, SAVE_PC // Any value outside of bytecode is ok. | ldr RC, L->cframe | sub RA, RA, RB // Compute -savestack(L, L->top). | str sp, L->cframe // Add our C frame to cframe chain. | mov RB, #0 | str RA, SAVE_NRES // Neg. delta means cframe w/o frame. | str RB, SAVE_ERRF // No error function. | str RC, SAVE_CFRAME | blx CARG4 // (lua_State *L, lua_CFunction func, void *ud) | ldr DISPATCH, L->glref // Setup pointer to dispatch table. | movs BASE, CRET1 | mov PC, #FRAME_CP | add DISPATCH, DISPATCH, #GG_G2DISP | bne <3 // Else continue with the call. | b ->vm_leave_cp // No base? Just remove C frame. | |//----------------------------------------------------------------------- |//-- Metamethod handling ------------------------------------------------ |//----------------------------------------------------------------------- | |//-- Continuation dispatch ---------------------------------------------- | |->cont_dispatch: | // BASE = meta base, RA = resultptr, RC = (nresults+1)*8 | ldr LFUNC:CARG3, [RB, FRAME_FUNC] | ldr CARG1, [BASE, #-16] // Get continuation. | mov CARG4, BASE | mov BASE, RB // Restore caller BASE. |.if FFI | cmp CARG1, #1 |.endif | ldr PC, [CARG4, #-12] // Restore PC from [cont|PC]. | ldr CARG3, LFUNC:CARG3->field_pc | mvn INS, #~LJ_TNIL | add CARG2, RA, RC | str INS, [CARG2, #-4] // Ensure one valid arg. |.if FFI | bls >1 |.endif | ldr KBASE, [CARG3, #PC2PROTO(k)] | // BASE = base, RA = resultptr, CARG4 = meta base | bx CARG1 | |.if FFI |1: | beq ->cont_ffi_callback // cont = 1: return from FFI callback. | // cont = 0: tailcall from C function. | sub CARG4, CARG4, #16 | sub RC, CARG4, BASE | b ->vm_call_tail |.endif | |->cont_cat: // RA = resultptr, CARG4 = meta base | ldr INS, [PC, #-4] | sub CARG2, CARG4, #16 | ldrd CARG34, [RA] | str BASE, L->base | decode_RB8 RC, INS | decode_RA8 RA, INS | add CARG1, BASE, RC | subs CARG1, CARG2, CARG1 | strdne CARG34, [CARG2] | movne CARG3, CARG1 | bne ->BC_CAT_Z | strd CARG34, [BASE, RA] | b ->cont_nop | |//-- Table indexing metamethods ----------------------------------------- | |->vmeta_tgets1: | add CARG2, BASE, RB | b >2 | |->vmeta_tgets: | sub CARG2, DISPATCH, #-DISPATCH_GL(tmptv) | mvn CARG4, #~LJ_TTAB | str TAB:RB, [CARG2] | str CARG4, [CARG2, #4] |2: | mvn CARG4, #~LJ_TSTR | str STR:RC, TMPDlo | str CARG4, TMPDhi | mov CARG3, TMPDp | b >1 | |->vmeta_tgetb: // RC = index | decode_RB8 RB, INS | str RC, TMPDlo | mvn CARG4, #~LJ_TISNUM | add CARG2, BASE, RB | str CARG4, TMPDhi | mov CARG3, TMPDp | b >1 | |->vmeta_tgetv: | add CARG2, BASE, RB | add CARG3, BASE, RC |1: | str BASE, L->base | mov CARG1, L | str PC, SAVE_PC | bl extern lj_meta_tget // (lua_State *L, TValue *o, TValue *k) | // Returns TValue * (finished) or NULL (metamethod). | .IOS ldr BASE, L->base | cmp CRET1, #0 | beq >3 | ldrd CARG34, [CRET1] | ins_next1 | ins_next2 | strd CARG34, [BASE, RA] | ins_next3 | |3: // Call __index metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k | rsb CARG1, BASE, #FRAME_CONT | ldr BASE, L->top | mov NARGS8:RC, #16 // 2 args for func(t, k). | str PC, [BASE, #-12] // [cont|PC] | add PC, CARG1, BASE | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] // Guaranteed to be a function here. | b ->vm_call_dispatch_f | |//----------------------------------------------------------------------- | |->vmeta_tsets1: | add CARG2, BASE, RB | b >2 | |->vmeta_tsets: | sub CARG2, DISPATCH, #-DISPATCH_GL(tmptv) | mvn CARG4, #~LJ_TTAB | str TAB:RB, [CARG2] | str CARG4, [CARG2, #4] |2: | mvn CARG4, #~LJ_TSTR | str STR:RC, TMPDlo | str CARG4, TMPDhi | mov CARG3, TMPDp | b >1 | |->vmeta_tsetb: // RC = index | decode_RB8 RB, INS | str RC, TMPDlo | mvn CARG4, #~LJ_TISNUM | add CARG2, BASE, RB | str CARG4, TMPDhi | mov CARG3, TMPDp | b >1 | |->vmeta_tsetv: | add CARG2, BASE, RB | add CARG3, BASE, RC |1: | str BASE, L->base | mov CARG1, L | str PC, SAVE_PC | bl extern lj_meta_tset // (lua_State *L, TValue *o, TValue *k) | // Returns TValue * (finished) or NULL (metamethod). | .IOS ldr BASE, L->base | cmp CRET1, #0 | ldrd CARG34, [BASE, RA] | beq >3 | ins_next1 | // NOBARRIER: lj_meta_tset ensures the table is not black. | strd CARG34, [CRET1] | ins_next2 | ins_next3 | |3: // Call __newindex metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k/(v) | rsb CARG1, BASE, #FRAME_CONT | ldr BASE, L->top | mov NARGS8:RC, #24 // 3 args for func(t, k, v). | strd CARG34, [BASE, #16] // Copy value to third argument. | str PC, [BASE, #-12] // [cont|PC] | add PC, CARG1, BASE | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] // Guaranteed to be a function here. | b ->vm_call_dispatch_f | |//-- Comparison metamethods --------------------------------------------- | |->vmeta_comp: | mov CARG1, L | sub PC, PC, #4 | mov CARG2, RA | str BASE, L->base | mov CARG3, RC | str PC, SAVE_PC | decode_OP CARG4, INS | bl extern lj_meta_comp // (lua_State *L, TValue *o1, *o2, int op) | // Returns 0/1 or TValue * (metamethod). |3: | .IOS ldr BASE, L->base | cmp CRET1, #1 | bhi ->vmeta_binop |4: | ldrh RB, [PC, #2] | add PC, PC, #4 | add RB, PC, RB, lsl #2 | subhs PC, RB, #0x20000 |->cont_nop: | ins_next | |->cont_ra: // RA = resultptr | ldr INS, [PC, #-4] | ldrd CARG12, [RA] | decode_RA8 CARG3, INS | strd CARG12, [BASE, CARG3] | b ->cont_nop | |->cont_condt: // RA = resultptr | ldr CARG2, [RA, #4] | mvn CARG1, #~LJ_TTRUE | cmp CARG1, CARG2 // Branch if result is true. | b <4 | |->cont_condf: // RA = resultptr | ldr CARG2, [RA, #4] | checktp CARG2, LJ_TFALSE // Branch if result is false. | b <4 | |->vmeta_equal: | // CARG2, CARG3, CARG4 are already set by BC_ISEQV/BC_ISNEV. | sub PC, PC, #4 | str BASE, L->base | mov CARG1, L | str PC, SAVE_PC | bl extern lj_meta_equal // (lua_State *L, GCobj *o1, *o2, int ne) | // Returns 0/1 or TValue * (metamethod). | b <3 | |->vmeta_equal_cd: |.if FFI | sub PC, PC, #4 | str BASE, L->base | mov CARG1, L | mov CARG2, INS | str PC, SAVE_PC | bl extern lj_meta_equal_cd // (lua_State *L, BCIns op) | // Returns 0/1 or TValue * (metamethod). | b <3 |.endif | |//-- Arithmetic metamethods --------------------------------------------- | |->vmeta_arith_vn: | decode_RB8 RB, INS | decode_RC8 RC, INS | add CARG3, BASE, RB | add CARG4, KBASE, RC | b >1 | |->vmeta_arith_nv: | decode_RB8 RB, INS | decode_RC8 RC, INS | add CARG4, BASE, RB | add CARG3, KBASE, RC | b >1 | |->vmeta_unm: | ldr INS, [PC, #-8] | sub PC, PC, #4 | add CARG3, BASE, RC | add CARG4, BASE, RC | b >1 | |->vmeta_arith_vv: | decode_RB8 RB, INS | decode_RC8 RC, INS | add CARG3, BASE, RB | add CARG4, BASE, RC |1: | decode_OP OP, INS | add CARG2, BASE, RA | str BASE, L->base | mov CARG1, L | str PC, SAVE_PC | str OP, ARG5 | bl extern lj_meta_arith // (lua_State *L, TValue *ra,*rb,*rc, BCReg op) | // Returns NULL (finished) or TValue * (metamethod). | .IOS ldr BASE, L->base | cmp CRET1, #0 | beq ->cont_nop | | // Call metamethod for binary op. |->vmeta_binop: | // BASE = old base, CRET1 = new base, stack = cont/func/o1/o2 | sub CARG2, CRET1, BASE | str PC, [CRET1, #-12] // [cont|PC] | add PC, CARG2, #FRAME_CONT | mov BASE, CRET1 | mov NARGS8:RC, #16 // 2 args for func(o1, o2). | b ->vm_call_dispatch | |->vmeta_len: | add CARG2, BASE, RC | str BASE, L->base | mov CARG1, L | str PC, SAVE_PC | bl extern lj_meta_len // (lua_State *L, TValue *o) | // Returns NULL (retry) or TValue * (metamethod base). | .IOS ldr BASE, L->base #if LJ_52 | cmp CRET1, #0 | bne ->vmeta_binop // Binop call for compatibility. | ldr TAB:CARG1, [BASE, RC] | b ->BC_LEN_Z #else | b ->vmeta_binop // Binop call for compatibility. #endif | |//-- Call metamethod ---------------------------------------------------- | |->vmeta_call: // Resolve and call __call metamethod. | // RB = old base, BASE = new base, RC = nargs*8 | mov CARG1, L | str RB, L->base // This is the callers base! | sub CARG2, BASE, #8 | str PC, SAVE_PC | add CARG3, BASE, NARGS8:RC | .IOS mov RA, BASE | bl extern lj_meta_call // (lua_State *L, TValue *func, TValue *top) | .IOS mov BASE, RA | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] // Guaranteed to be a function here. | add NARGS8:RC, NARGS8:RC, #8 // Got one more argument now. | ins_call | |->vmeta_callt: // Resolve __call for BC_CALLT. | // BASE = old base, RA = new base, RC = nargs*8 | mov CARG1, L | str BASE, L->base | sub CARG2, RA, #8 | str PC, SAVE_PC | add CARG3, RA, NARGS8:RC | bl extern lj_meta_call // (lua_State *L, TValue *func, TValue *top) | .IOS ldr BASE, L->base | ldr LFUNC:CARG3, [RA, FRAME_FUNC] // Guaranteed to be a function here. | ldr PC, [BASE, FRAME_PC] | add NARGS8:RC, NARGS8:RC, #8 // Got one more argument now. | b ->BC_CALLT2_Z | |//-- Argument coercion for 'for' statement ------------------------------ | |->vmeta_for: | mov CARG1, L | str BASE, L->base | mov CARG2, RA | str PC, SAVE_PC | bl extern lj_meta_for // (lua_State *L, TValue *base) | .IOS ldr BASE, L->base |.if JIT | ldrb OP, [PC, #-4] |.endif | ldr INS, [PC, #-4] |.if JIT | cmp OP, #BC_JFORI |.endif | decode_RA8 RA, INS | decode_RD RC, INS |.if JIT | beq =>BC_JFORI |.endif | b =>BC_FORI | |//----------------------------------------------------------------------- |//-- Fast functions ----------------------------------------------------- |//----------------------------------------------------------------------- | |.macro .ffunc, name |->ff_ .. name: |.endmacro | |.macro .ffunc_1, name |->ff_ .. name: | ldrd CARG12, [BASE] | cmp NARGS8:RC, #8 | blo ->fff_fallback |.endmacro | |.macro .ffunc_2, name |->ff_ .. name: | ldrd CARG12, [BASE] | ldrd CARG34, [BASE, #8] | cmp NARGS8:RC, #16 | blo ->fff_fallback |.endmacro | |.macro .ffunc_n, name | .ffunc_1 name | checktp CARG2, LJ_TISNUM | bhs ->fff_fallback |.endmacro | |.macro .ffunc_nn, name | .ffunc_2 name | checktp CARG2, LJ_TISNUM | cmnlo CARG4, #-LJ_TISNUM | bhs ->fff_fallback |.endmacro | |.macro .ffunc_d, name | .ffunc name | ldr CARG2, [BASE, #4] | cmp NARGS8:RC, #8 | vldr d0, [BASE] | blo ->fff_fallback | checktp CARG2, LJ_TISNUM | bhs ->fff_fallback |.endmacro | |.macro .ffunc_dd, name | .ffunc name | ldr CARG2, [BASE, #4] | ldr CARG4, [BASE, #12] | cmp NARGS8:RC, #16 | vldr d0, [BASE] | vldr d1, [BASE, #8] | blo ->fff_fallback | checktp CARG2, LJ_TISNUM | cmnlo CARG4, #-LJ_TISNUM | bhs ->fff_fallback |.endmacro | |// Inlined GC threshold check. Caveat: uses CARG1 and CARG2. |.macro ffgccheck | ldr CARG1, [DISPATCH, #DISPATCH_GL(gc.total)] | ldr CARG2, [DISPATCH, #DISPATCH_GL(gc.threshold)] | cmp CARG1, CARG2 | blge ->fff_gcstep |.endmacro | |//-- Base library: checks ----------------------------------------------- | |.ffunc_1 assert | checktp CARG2, LJ_TTRUE | bhi ->fff_fallback | ldr PC, [BASE, FRAME_PC] | strd CARG12, [BASE, #-8] | mov RB, BASE | subs RA, NARGS8:RC, #8 | add RC, NARGS8:RC, #8 // Compute (nresults+1)*8. | beq ->fff_res // Done if exactly 1 argument. |1: | ldrd CARG12, [RB, #8] | subs RA, RA, #8 | strd CARG12, [RB], #8 | bne <1 | b ->fff_res | |.ffunc type | ldr CARG2, [BASE, #4] | cmp NARGS8:RC, #8 | blo ->fff_fallback | checktp CARG2, LJ_TISNUM | mvnlo CARG2, #~LJ_TISNUM | rsb CARG4, CARG2, #(int)(offsetof(GCfuncC, upvalue)>>3)-1 | lsl CARG4, CARG4, #3 | ldrd CARG12, [CFUNC:CARG3, CARG4] | b ->fff_restv | |//-- Base library: getters and setters --------------------------------- | |.ffunc_1 getmetatable | checktp CARG2, LJ_TTAB | cmnne CARG2, #-LJ_TUDATA | bne >6 |1: // Field metatable must be at same offset for GCtab and GCudata! | ldr TAB:RB, TAB:CARG1->metatable |2: | mvn CARG2, #~LJ_TNIL | ldr STR:RC, [DISPATCH, #DISPATCH_GL(gcroot[GCROOT_MMNAME+MM_metatable])] | cmp TAB:RB, #0 | beq ->fff_restv | ldr CARG3, TAB:RB->hmask | ldr CARG4, STR:RC->hash | ldr NODE:INS, TAB:RB->node | and CARG3, CARG3, CARG4 // idx = str->hash & tab->hmask | add CARG3, CARG3, CARG3, lsl #1 | add NODE:INS, NODE:INS, CARG3, lsl #3 // node = tab->node + idx*3*8 |3: // Rearranged logic, because we expect _not_ to find the key. | ldrd CARG34, NODE:INS->key // STALL: early NODE:INS. | ldrd CARG12, NODE:INS->val | ldr NODE:INS, NODE:INS->next | checktp CARG4, LJ_TSTR | cmpeq CARG3, STR:RC | beq >5 | cmp NODE:INS, #0 | bne <3 |4: | mov CARG1, RB // Use metatable as default result. | mvn CARG2, #~LJ_TTAB | b ->fff_restv |5: | checktp CARG2, LJ_TNIL | bne ->fff_restv | b <4 | |6: | checktp CARG2, LJ_TISNUM | mvnhs CARG2, CARG2 | movlo CARG2, #~LJ_TISNUM | add CARG4, DISPATCH, CARG2, lsl #2 | ldr TAB:RB, [CARG4, #DISPATCH_GL(gcroot[GCROOT_BASEMT])] | b <2 | |.ffunc_2 setmetatable | // Fast path: no mt for table yet and not clearing the mt. | checktp CARG2, LJ_TTAB | ldreq TAB:RB, TAB:CARG1->metatable | checktpeq CARG4, LJ_TTAB | ldrbeq CARG4, TAB:CARG1->marked | cmpeq TAB:RB, #0 | bne ->fff_fallback | tst CARG4, #LJ_GC_BLACK // isblack(table) | str TAB:CARG3, TAB:CARG1->metatable | beq ->fff_restv | barrierback TAB:CARG1, CARG4, CARG3 | b ->fff_restv | |.ffunc rawget | ldrd CARG34, [BASE] | cmp NARGS8:RC, #16 | blo ->fff_fallback | mov CARG2, CARG3 | checktab CARG4, ->fff_fallback | mov CARG1, L | add CARG3, BASE, #8 | .IOS mov RA, BASE | bl extern lj_tab_get // (lua_State *L, GCtab *t, cTValue *key) | // Returns cTValue *. | .IOS mov BASE, RA | ldrd CARG12, [CRET1] | b ->fff_restv | |//-- Base library: conversions ------------------------------------------ | |.ffunc tonumber | // Only handles the number case inline (without a base argument). | ldrd CARG12, [BASE] | cmp NARGS8:RC, #8 | bne ->fff_fallback | checktp CARG2, LJ_TISNUM | bls ->fff_restv | b ->fff_fallback | |.ffunc_1 tostring | // Only handles the string or number case inline. | checktp CARG2, LJ_TSTR | // A __tostring method in the string base metatable is ignored. | beq ->fff_restv | // Handle numbers inline, unless a number base metatable is present. | ldr CARG4, [DISPATCH, #DISPATCH_GL(gcroot[GCROOT_BASEMT_NUM])] | str BASE, L->base | checktp CARG2, LJ_TISNUM | cmpls CARG4, #0 | str PC, SAVE_PC // Redundant (but a defined value). | bhi ->fff_fallback | ffgccheck | mov CARG1, L | mov CARG2, BASE | bl extern lj_str_fromnumber // (lua_State *L, cTValue *o) | // Returns GCstr *. | ldr BASE, L->base | mvn CARG2, #~LJ_TSTR | b ->fff_restv | |//-- Base library: iterators ------------------------------------------- | |.ffunc_1 next | mvn CARG4, #~LJ_TNIL | checktab CARG2, ->fff_fallback | strd CARG34, [BASE, NARGS8:RC] // Set missing 2nd arg to nil. | ldr PC, [BASE, FRAME_PC] | mov CARG2, CARG1 | str BASE, L->base // Add frame since C call can throw. | mov CARG1, L | str BASE, L->top // Dummy frame length is ok. | add CARG3, BASE, #8 | str PC, SAVE_PC | bl extern lj_tab_next // (lua_State *L, GCtab *t, TValue *key) | // Returns 0 at end of traversal. | .IOS ldr BASE, L->base | cmp CRET1, #0 | mvneq CRET2, #~LJ_TNIL | beq ->fff_restv // End of traversal: return nil. | ldrd CARG12, [BASE, #8] // Copy key and value to results. | ldrd CARG34, [BASE, #16] | mov RC, #(2+1)*8 | strd CARG12, [BASE, #-8] | strd CARG34, [BASE] | b ->fff_res | |.ffunc_1 pairs | checktab CARG2, ->fff_fallback #if LJ_52 | ldr TAB:RB, TAB:CARG1->metatable #endif | ldrd CFUNC:CARG34, CFUNC:CARG3->upvalue[0] | ldr PC, [BASE, FRAME_PC] #if LJ_52 | cmp TAB:RB, #0 | bne ->fff_fallback #endif | mvn CARG2, #~LJ_TNIL | mov RC, #(3+1)*8 | strd CFUNC:CARG34, [BASE, #-8] | str CARG2, [BASE, #12] | b ->fff_res | |.ffunc_2 ipairs_aux | checktp CARG2, LJ_TTAB | checktpeq CARG4, LJ_TISNUM | bne ->fff_fallback | ldr RB, TAB:CARG1->asize | ldr RC, TAB:CARG1->array | add CARG3, CARG3, #1 | ldr PC, [BASE, FRAME_PC] | cmp CARG3, RB | add RC, RC, CARG3, lsl #3 | strd CARG34, [BASE, #-8] | ldrdlo CARG12, [RC] | mov RC, #(0+1)*8 | bhs >2 // Not in array part? |1: | checktp CARG2, LJ_TNIL | movne RC, #(2+1)*8 | strdne CARG12, [BASE] | b ->fff_res |2: // Check for empty hash part first. Otherwise call C function. | ldr RB, TAB:CARG1->hmask | mov CARG2, CARG3 | cmp RB, #0 | beq ->fff_res | .IOS mov RA, BASE | bl extern lj_tab_getinth // (GCtab *t, int32_t key) | // Returns cTValue * or NULL. | .IOS mov BASE, RA | cmp CRET1, #0 | beq ->fff_res | ldrd CARG12, [CRET1] | b <1 | |.ffunc_1 ipairs | checktab CARG2, ->fff_fallback #if LJ_52 | ldr TAB:RB, TAB:CARG1->metatable #endif | ldrd CFUNC:CARG34, CFUNC:CARG3->upvalue[0] | ldr PC, [BASE, FRAME_PC] #if LJ_52 | cmp TAB:RB, #0 | bne ->fff_fallback #endif | mov CARG1, #0 | mvn CARG2, #~LJ_TISNUM | mov RC, #(3+1)*8 | strd CFUNC:CARG34, [BASE, #-8] | strd CARG12, [BASE, #8] | b ->fff_res | |//-- Base library: catch errors ---------------------------------------- | |.ffunc pcall | ldrb RA, [DISPATCH, #DISPATCH_GL(hookmask)] | cmp NARGS8:RC, #8 | blo ->fff_fallback | tst RA, #HOOK_ACTIVE // Remember active hook before pcall. | mov RB, BASE | add BASE, BASE, #8 | moveq PC, #8+FRAME_PCALL | movne PC, #8+FRAME_PCALLH | sub NARGS8:RC, NARGS8:RC, #8 | b ->vm_call_dispatch | |.ffunc_2 xpcall | ldrb RA, [DISPATCH, #DISPATCH_GL(hookmask)] | checkfunc CARG4, ->fff_fallback // Traceback must be a function. | mov RB, BASE | strd CARG12, [BASE, #8] // Swap function and traceback. | strd CARG34, [BASE] | tst RA, #HOOK_ACTIVE // Remember active hook before pcall. | add BASE, BASE, #16 | moveq PC, #16+FRAME_PCALL | movne PC, #16+FRAME_PCALLH | sub NARGS8:RC, NARGS8:RC, #16 | b ->vm_call_dispatch | |//-- Coroutine library -------------------------------------------------- | |.macro coroutine_resume_wrap, resume |.if resume |.ffunc_1 coroutine_resume | checktp CARG2, LJ_TTHREAD | bne ->fff_fallback |.else |.ffunc coroutine_wrap_aux | ldr L:CARG1, CFUNC:CARG3->upvalue[0].gcr |.endif | ldr PC, [BASE, FRAME_PC] | str BASE, L->base | ldr CARG2, L:CARG1->top | ldrb RA, L:CARG1->status | ldr RB, L:CARG1->base | add CARG3, CARG2, NARGS8:RC | add CARG4, CARG2, RA | str PC, SAVE_PC | cmp CARG4, RB | beq ->fff_fallback | ldr CARG4, L:CARG1->maxstack | ldr RB, L:CARG1->cframe | cmp RA, #LUA_YIELD | cmpls CARG3, CARG4 | cmpls RB, #0 | bhi ->fff_fallback |1: |.if resume | sub CARG3, CARG3, #8 // Keep resumed thread in stack for GC. | add BASE, BASE, #8 | sub NARGS8:RC, NARGS8:RC, #8 |.endif | str CARG3, L:CARG1->top | str BASE, L->top |2: // Move args to coroutine. | ldrd CARG34, [BASE, RB] | cmp RB, NARGS8:RC | strdne CARG34, [CARG2, RB] | add RB, RB, #8 | bne <2 | | mov CARG3, #0 | mov L:RA, L:CARG1 | mov CARG4, #0 | bl ->vm_resume // (lua_State *L, TValue *base, 0, 0) | // Returns thread status. |4: | ldr CARG3, L:RA->base | mv_vmstate CARG2, INTERP | ldr CARG4, L:RA->top | st_vmstate CARG2 | cmp CRET1, #LUA_YIELD | ldr BASE, L->base | bhi >8 | subs RC, CARG4, CARG3 | ldr CARG1, L->maxstack | add CARG2, BASE, RC | beq >6 // No results? | cmp CARG2, CARG1 | mov RB, #0 | bhi >9 // Need to grow stack? | | sub CARG4, RC, #8 | str CARG3, L:RA->top // Clear coroutine stack. |5: // Move results from coroutine. | ldrd CARG12, [CARG3, RB] | cmp RB, CARG4 | strd CARG12, [BASE, RB] | add RB, RB, #8 | bne <5 |6: |.if resume | mvn CARG3, #~LJ_TTRUE | add RC, RC, #16 |7: | str CARG3, [BASE, #-4] // Prepend true/false to results. | sub RA, BASE, #8 |.else | mov RA, BASE | add RC, RC, #8 |.endif | ands CARG1, PC, #FRAME_TYPE | str PC, SAVE_PC | str RC, SAVE_MULTRES | beq ->BC_RET_Z | b ->vm_return | |8: // Coroutine returned with error (at co->top-1). |.if resume | ldrd CARG12, [CARG4, #-8]! | mvn CARG3, #~LJ_TFALSE | mov RC, #(2+1)*8 | str CARG4, L:RA->top // Remove error from coroutine stack. | strd CARG12, [BASE] // Copy error message. | b <7 |.else | mov CARG1, L | mov CARG2, L:RA | bl extern lj_ffh_coroutine_wrap_err // (lua_State *L, lua_State *co) | // Never returns. |.endif | |9: // Handle stack expansion on return from yield. | mov CARG1, L | lsr CARG2, RC, #3 | bl extern lj_state_growstack // (lua_State *L, int n) | mov CRET1, #0 | b <4 |.endmacro | | coroutine_resume_wrap 1 // coroutine.resume | coroutine_resume_wrap 0 // coroutine.wrap | |.ffunc coroutine_yield | ldr CARG1, L->cframe | add CARG2, BASE, NARGS8:RC | str BASE, L->base | tst CARG1, #CFRAME_RESUME | str CARG2, L->top | mov CRET1, #LUA_YIELD | mov CARG3, #0 | beq ->fff_fallback | str CARG3, L->cframe | strb CRET1, L->status | b ->vm_leave_unw | |//-- Math library ------------------------------------------------------- | |.macro math_round, func | .ffunc_1 math_ .. func | checktp CARG2, LJ_TISNUM | beq ->fff_restv | bhi ->fff_fallback | // Round FP value and normalize result. | lsl CARG3, CARG2, #1 | adds RB, CARG3, #0x00200000 | bpl >2 // |x| < 1? | mvn CARG4, #0x3e0 | subs RB, CARG4, RB, asr #21 | lsl CARG4, CARG2, #11 | lsl CARG3, CARG1, #11 | orr CARG4, CARG4, #0x80000000 | rsb INS, RB, #32 | orr CARG4, CARG4, CARG1, lsr #21 | bls >3 // |x| >= 2^31? | orr CARG3, CARG3, CARG4, lsl INS | lsr CARG1, CARG4, RB |.if "func" == "floor" | tst CARG3, CARG2, asr #31 | addne CARG1, CARG1, #1 |.else | bics CARG3, CARG3, CARG2, asr #31 | addsne CARG1, CARG1, #1 | ldrdvs CARG12, >9 | bvs ->fff_restv |.endif | cmp CARG2, #0 | rsblt CARG1, CARG1, #0 |1: | mvn CARG2, #~LJ_TISNUM | b ->fff_restv | |2: // |x| < 1 | bcs ->fff_restv // |x| is not finite. | orr CARG3, CARG3, CARG1 // ztest = abs(hi) | lo |.if "func" == "floor" | tst CARG3, CARG2, asr #31 // return (ztest & sign) == 0 ? 0 : -1 | moveq CARG1, #0 | mvnne CARG1, #0 |.else | bics CARG3, CARG3, CARG2, asr #31 // return (ztest & ~sign) == 0 ? 0 : 1 | moveq CARG1, #0 | movne CARG1, #1 |.endif | mvn CARG2, #~LJ_TISNUM | b ->fff_restv | |3: // |x| >= 2^31. Check for x == -(2^31). | cmpeq CARG4, #0x80000000 |.if "func" == "floor" | cmpeq CARG3, #0 |.endif | bne >4 | cmp CARG2, #0 | movmi CARG1, #0x80000000 | bmi <1 |4: | bl ->vm_..func.._sf | b ->fff_restv |.endmacro | | math_round floor | math_round ceil | |.align 8 |9: | .long 0x00000000, 0x41e00000 // 2^31. | |.ffunc_1 math_abs | checktp CARG2, LJ_TISNUM | bhi ->fff_fallback | bicne CARG2, CARG2, #0x80000000 | bne ->fff_restv | cmp CARG1, #0 | rsbslt CARG1, CARG1, #0 | ldrdvs CARG12, <9 | // Fallthrough. | |->fff_restv: | // CARG12 = TValue result. | ldr PC, [BASE, FRAME_PC] | strd CARG12, [BASE, #-8] |->fff_res1: | // PC = return. | mov RC, #(1+1)*8 |->fff_res: | // RC = (nresults+1)*8, PC = return. | ands CARG1, PC, #FRAME_TYPE | ldreq INS, [PC, #-4] | str RC, SAVE_MULTRES | sub RA, BASE, #8 | bne ->vm_return | decode_RB8 RB, INS |5: | cmp RB, RC // More results expected? | bhi >6 | decode_RA8 CARG1, INS | ins_next1 | ins_next2 | // Adjust BASE. KBASE is assumed to be set for the calling frame. | sub BASE, RA, CARG1 | ins_next3 | |6: // Fill up results with nil. | add CARG2, RA, RC | mvn CARG1, #~LJ_TNIL | add RC, RC, #8 | str CARG1, [CARG2, #-4] | b <5 | |.macro math_extern, func |.if HFABI | .ffunc_d math_ .. func |.else | .ffunc_n math_ .. func |.endif | .IOS mov RA, BASE | bl extern func | .IOS mov BASE, RA |.if HFABI | b ->fff_resd |.else | b ->fff_restv |.endif |.endmacro | |.macro math_extern2, func |.if HFABI | .ffunc_dd math_ .. func |.else | .ffunc_nn math_ .. func |.endif | .IOS mov RA, BASE | bl extern func | .IOS mov BASE, RA |.if HFABI | b ->fff_resd |.else | b ->fff_restv |.endif |.endmacro | |.if FPU | .ffunc_d math_sqrt | vsqrt.f64 d0, d0 |->fff_resd: | ldr PC, [BASE, FRAME_PC] | vstr d0, [BASE, #-8] | b ->fff_res1 |.else | math_extern sqrt |.endif | |.ffunc math_log |.if HFABI | ldr CARG2, [BASE, #4] | cmp NARGS8:RC, #8 // Need exactly 1 argument. | vldr d0, [BASE] | bne ->fff_fallback |.else | ldrd CARG12, [BASE] | cmp NARGS8:RC, #8 // Need exactly 1 argument. | bne ->fff_fallback |.endif | checktp CARG2, LJ_TISNUM | bhs ->fff_fallback | .IOS mov RA, BASE | bl extern log | .IOS mov BASE, RA |.if HFABI | b ->fff_resd |.else | b ->fff_restv |.endif | | math_extern log10 | math_extern exp | math_extern sin | math_extern cos | math_extern tan | math_extern asin | math_extern acos | math_extern atan | math_extern sinh | math_extern cosh | math_extern tanh | math_extern2 pow | math_extern2 atan2 | math_extern2 fmod | |->ff_math_deg: |.if FPU | .ffunc_d math_rad | vldr d1, CFUNC:CARG3->upvalue[0] | vmul.f64 d0, d0, d1 | b ->fff_resd |.else | .ffunc_n math_rad | ldrd CARG34, CFUNC:CARG3->upvalue[0] | bl extern __aeabi_dmul | b ->fff_restv |.endif | |.if HFABI | .ffunc math_ldexp | ldr CARG4, [BASE, #4] | ldrd CARG12, [BASE, #8] | cmp NARGS8:RC, #16 | blo ->fff_fallback | vldr d0, [BASE] | checktp CARG4, LJ_TISNUM | bhs ->fff_fallback | checktp CARG2, LJ_TISNUM | bne ->fff_fallback | .IOS mov RA, BASE | bl extern ldexp // (double x, int exp) | .IOS mov BASE, RA | b ->fff_resd |.else |.ffunc_2 math_ldexp | checktp CARG2, LJ_TISNUM | bhs ->fff_fallback | checktp CARG4, LJ_TISNUM | bne ->fff_fallback | .IOS mov RA, BASE | bl extern ldexp // (double x, int exp) | .IOS mov BASE, RA | b ->fff_restv |.endif | |.if HFABI |.ffunc_d math_frexp | mov CARG1, sp | .IOS mov RA, BASE | bl extern frexp | .IOS mov BASE, RA | ldr CARG3, [sp] | mvn CARG4, #~LJ_TISNUM | ldr PC, [BASE, FRAME_PC] | vstr d0, [BASE, #-8] | mov RC, #(2+1)*8 | strd CARG34, [BASE] | b ->fff_res |.else |.ffunc_n math_frexp | mov CARG3, sp | .IOS mov RA, BASE | bl extern frexp | .IOS mov BASE, RA | ldr CARG3, [sp] | mvn CARG4, #~LJ_TISNUM | ldr PC, [BASE, FRAME_PC] | strd CARG12, [BASE, #-8] | mov RC, #(2+1)*8 | strd CARG34, [BASE] | b ->fff_res |.endif | |.if HFABI |.ffunc_d math_modf | sub CARG1, BASE, #8 | ldr PC, [BASE, FRAME_PC] | .IOS mov RA, BASE | bl extern modf | .IOS mov BASE, RA | mov RC, #(2+1)*8 | vstr d0, [BASE] | b ->fff_res |.else |.ffunc_n math_modf | sub CARG3, BASE, #8 | ldr PC, [BASE, FRAME_PC] | .IOS mov RA, BASE | bl extern modf | .IOS mov BASE, RA | mov RC, #(2+1)*8 | strd CARG12, [BASE] | b ->fff_res |.endif | |.macro math_minmax, name, cond, fcond |.if FPU | .ffunc_1 name | add RB, BASE, RC | checktp CARG2, LJ_TISNUM | add RA, BASE, #8 | bne >4 |1: // Handle integers. | ldrd CARG34, [RA] | cmp RA, RB | bhs ->fff_restv | checktp CARG4, LJ_TISNUM | bne >3 | cmp CARG1, CARG3 | add RA, RA, #8 | mov..cond CARG1, CARG3 | b <1 |3: // Convert intermediate result to number and continue below. | vmov s4, CARG1 | bhi ->fff_fallback | vldr d1, [RA] | vcvt.f64.s32 d0, s4 | b >6 | |4: | vldr d0, [BASE] | bhi ->fff_fallback |5: // Handle numbers. | ldrd CARG34, [RA] | vldr d1, [RA] | cmp RA, RB | bhs ->fff_resd | checktp CARG4, LJ_TISNUM | bhs >7 |6: | vcmp.f64 d0, d1 | vmrs | add RA, RA, #8 | vmov..fcond.f64 d0, d1 | b <5 |7: // Convert integer to number and continue above. | vmov s4, CARG3 | bhi ->fff_fallback | vcvt.f64.s32 d1, s4 | b <6 | |.else | | .ffunc_1 name | checktp CARG2, LJ_TISNUM | mov RA, #8 | bne >4 |1: // Handle integers. | ldrd CARG34, [BASE, RA] | cmp RA, RC | bhs ->fff_restv | checktp CARG4, LJ_TISNUM | bne >3 | cmp CARG1, CARG3 | add RA, RA, #8 | mov..cond CARG1, CARG3 | b <1 |3: // Convert intermediate result to number and continue below. | bhi ->fff_fallback | bl extern __aeabi_i2d | ldrd CARG34, [BASE, RA] | b >6 | |4: | bhi ->fff_fallback |5: // Handle numbers. | ldrd CARG34, [BASE, RA] | cmp RA, RC | bhs ->fff_restv | checktp CARG4, LJ_TISNUM | bhs >7 |6: | bl extern __aeabi_cdcmple | add RA, RA, #8 | mov..fcond CARG1, CARG3 | mov..fcond CARG2, CARG4 | b <5 |7: // Convert integer to number and continue above. | bhi ->fff_fallback | strd CARG12, TMPD | mov CARG1, CARG3 | bl extern __aeabi_i2d | ldrd CARG34, TMPD | b <6 |.endif |.endmacro | | math_minmax math_min, gt, hi | math_minmax math_max, lt, lo | |//-- String library ----------------------------------------------------- | |.ffunc_1 string_len | checkstr CARG2, ->fff_fallback | ldr CARG1, STR:CARG1->len | mvn CARG2, #~LJ_TISNUM | b ->fff_restv | |.ffunc string_byte // Only handle the 1-arg case here. | ldrd CARG12, [BASE] | ldr PC, [BASE, FRAME_PC] | cmp NARGS8:RC, #8 | checktpeq CARG2, LJ_TSTR // Need exactly 1 argument. | bne ->fff_fallback | ldr CARG3, STR:CARG1->len | ldrb CARG1, STR:CARG1[1] // Access is always ok (NUL at end). | mvn CARG2, #~LJ_TISNUM | cmp CARG3, #0 | moveq RC, #(0+1)*8 | movne RC, #(1+1)*8 | strd CARG12, [BASE, #-8] | b ->fff_res | |.ffunc string_char // Only handle the 1-arg case here. | ffgccheck | ldrd CARG12, [BASE] | ldr PC, [BASE, FRAME_PC] | cmp NARGS8:RC, #8 // Need exactly 1 argument. | checktpeq CARG2, LJ_TISNUM | bicseq CARG4, CARG1, #255 | mov CARG3, #1 | bne ->fff_fallback | str CARG1, TMPD | mov CARG2, TMPDp // Points to stack. Little-endian. |->fff_newstr: | // CARG2 = str, CARG3 = len. | str BASE, L->base | mov CARG1, L | str PC, SAVE_PC | bl extern lj_str_new // (lua_State *L, char *str, size_t l) | // Returns GCstr *. | ldr BASE, L->base | mvn CARG2, #~LJ_TSTR | b ->fff_restv | |.ffunc string_sub | ffgccheck | ldrd CARG12, [BASE] | ldrd CARG34, [BASE, #16] | cmp NARGS8:RC, #16 | mvn RB, #0 | beq >1 | blo ->fff_fallback | checktp CARG4, LJ_TISNUM | mov RB, CARG3 | bne ->fff_fallback |1: | ldrd CARG34, [BASE, #8] | checktp CARG2, LJ_TSTR | ldreq CARG2, STR:CARG1->len | checktpeq CARG4, LJ_TISNUM | bne ->fff_fallback | // CARG1 = str, CARG2 = str->len, CARG3 = start, RB = end | add CARG4, CARG2, #1 | cmp CARG3, #0 // if (start < 0) start += len+1 | addlt CARG3, CARG3, CARG4 | cmp CARG3, #1 // if (start < 1) start = 1 | movlt CARG3, #1 | cmp RB, #0 // if (end < 0) end += len+1 | addlt RB, RB, CARG4 | bic RB, RB, RB, asr #31 // if (end < 0) end = 0 | cmp RB, CARG2 // if (end > len) end = len | add CARG1, STR:CARG1, #sizeof(GCstr)-1 | movgt RB, CARG2 | add CARG2, CARG1, CARG3 | subs CARG3, RB, CARG3 // len = end - start | add CARG3, CARG3, #1 // len += 1 | bge ->fff_newstr |->fff_emptystr: | sub STR:CARG1, DISPATCH, #-DISPATCH_GL(strempty) | mvn CARG2, #~LJ_TSTR | b ->fff_restv | |.ffunc string_rep // Only handle the 1-char case inline. | ffgccheck | ldrd CARG12, [BASE] | ldrd CARG34, [BASE, #8] | cmp NARGS8:RC, #16 | bne ->fff_fallback // Exactly 2 arguments | checktp CARG2, LJ_TSTR | checktpeq CARG4, LJ_TISNUM | bne ->fff_fallback | subs CARG4, CARG3, #1 | ldr CARG2, STR:CARG1->len | blt ->fff_emptystr // Count <= 0? | cmp CARG2, #1 | blo ->fff_emptystr // Zero-length string? | bne ->fff_fallback // Fallback for > 1-char strings. | ldr RB, [DISPATCH, #DISPATCH_GL(tmpbuf.sz)] | ldr CARG2, [DISPATCH, #DISPATCH_GL(tmpbuf.buf)] | ldr CARG1, STR:CARG1[1] | cmp RB, CARG3 | blo ->fff_fallback |1: // Fill buffer with char. | strb CARG1, [CARG2, CARG4] | subs CARG4, CARG4, #1 | bge <1 | b ->fff_newstr | |.ffunc string_reverse | ffgccheck | ldrd CARG12, [BASE] | cmp NARGS8:RC, #8 | blo ->fff_fallback | checkstr CARG2, ->fff_fallback | ldr CARG3, STR:CARG1->len | ldr RB, [DISPATCH, #DISPATCH_GL(tmpbuf.sz)] | ldr CARG2, [DISPATCH, #DISPATCH_GL(tmpbuf.buf)] | mov CARG4, CARG3 | add CARG1, STR:CARG1, #sizeof(GCstr) | cmp RB, CARG3 | blo ->fff_fallback |1: // Reverse string copy. | ldrb RB, [CARG1], #1 | subs CARG4, CARG4, #1 | blt ->fff_newstr | strb RB, [CARG2, CARG4] | b <1 | |.macro ffstring_case, name, lo | .ffunc name | ffgccheck | ldrd CARG12, [BASE] | cmp NARGS8:RC, #8 | blo ->fff_fallback | checkstr CARG2, ->fff_fallback | ldr CARG3, STR:CARG1->len | ldr RB, [DISPATCH, #DISPATCH_GL(tmpbuf.sz)] | ldr CARG2, [DISPATCH, #DISPATCH_GL(tmpbuf.buf)] | mov CARG4, #0 | add CARG1, STR:CARG1, #sizeof(GCstr) | cmp RB, CARG3 | blo ->fff_fallback |1: // ASCII case conversion. | ldrb RB, [CARG1, CARG4] | cmp CARG4, CARG3 | bhs ->fff_newstr | sub RC, RB, #lo | cmp RC, #26 | eorlo RB, RB, #0x20 | strb RB, [CARG2, CARG4] | add CARG4, CARG4, #1 | b <1 |.endmacro | |ffstring_case string_lower, 65 |ffstring_case string_upper, 97 | |//-- Table library ------------------------------------------------------ | |.ffunc_1 table_getn | checktab CARG2, ->fff_fallback | .IOS mov RA, BASE | bl extern lj_tab_len // (GCtab *t) | // Returns uint32_t (but less than 2^31). | .IOS mov BASE, RA | mvn CARG2, #~LJ_TISNUM | b ->fff_restv | |//-- Bit library -------------------------------------------------------- | |// FP number to bit conversion for soft-float. Clobbers r0-r3. |->vm_tobit_fb: | bhi ->fff_fallback |->vm_tobit: | lsl RB, CARG2, #1 | adds RB, RB, #0x00200000 | movpl CARG1, #0 // |x| < 1? | bxpl lr | mvn CARG4, #0x3e0 | subs RB, CARG4, RB, asr #21 | bmi >1 // |x| >= 2^32? | lsl CARG4, CARG2, #11 | orr CARG4, CARG4, #0x80000000 | orr CARG4, CARG4, CARG1, lsr #21 | cmp CARG2, #0 | lsr CARG1, CARG4, RB | rsblt CARG1, CARG1, #0 | bx lr |1: | add RB, RB, #21 | lsr CARG4, CARG1, RB | rsb RB, RB, #20 | lsl CARG1, CARG2, #12 | cmp CARG2, #0 | orr CARG1, CARG4, CARG1, lsl RB | rsblt CARG1, CARG1, #0 | bx lr | |.macro .ffunc_bit, name | .ffunc_1 bit_..name | checktp CARG2, LJ_TISNUM | blne ->vm_tobit_fb |.endmacro | |.ffunc_bit tobit | mvn CARG2, #~LJ_TISNUM | b ->fff_restv | |.macro .ffunc_bit_op, name, ins | .ffunc_bit name | mov CARG3, CARG1 | mov RA, #8 |1: | ldrd CARG12, [BASE, RA] | cmp RA, NARGS8:RC | add RA, RA, #8 | bge >2 | checktp CARG2, LJ_TISNUM | blne ->vm_tobit_fb | ins CARG3, CARG3, CARG1 | b <1 |.endmacro | |.ffunc_bit_op band, and |.ffunc_bit_op bor, orr |.ffunc_bit_op bxor, eor | |2: | mvn CARG4, #~LJ_TISNUM | ldr PC, [BASE, FRAME_PC] | strd CARG34, [BASE, #-8] | b ->fff_res1 | |.ffunc_bit bswap | eor CARG3, CARG1, CARG1, ror #16 | bic CARG3, CARG3, #0x00ff0000 | ror CARG1, CARG1, #8 | mvn CARG2, #~LJ_TISNUM | eor CARG1, CARG1, CARG3, lsr #8 | b ->fff_restv | |.ffunc_bit bnot | mvn CARG1, CARG1 | mvn CARG2, #~LJ_TISNUM | b ->fff_restv | |.macro .ffunc_bit_sh, name, ins, shmod | .ffunc bit_..name | ldrd CARG12, [BASE, #8] | cmp NARGS8:RC, #16 | blo ->fff_fallback | checktp CARG2, LJ_TISNUM | blne ->vm_tobit_fb |.if shmod == 0 | and RA, CARG1, #31 |.else | rsb RA, CARG1, #0 |.endif | ldrd CARG12, [BASE] | checktp CARG2, LJ_TISNUM | blne ->vm_tobit_fb | ins CARG1, CARG1, RA | mvn CARG2, #~LJ_TISNUM | b ->fff_restv |.endmacro | |.ffunc_bit_sh lshift, lsl, 0 |.ffunc_bit_sh rshift, lsr, 0 |.ffunc_bit_sh arshift, asr, 0 |.ffunc_bit_sh rol, ror, 1 |.ffunc_bit_sh ror, ror, 0 | |//----------------------------------------------------------------------- | |->fff_fallback: // Call fast function fallback handler. | // BASE = new base, RC = nargs*8 | ldr CARG3, [BASE, FRAME_FUNC] | ldr CARG2, L->maxstack | add CARG1, BASE, NARGS8:RC | ldr PC, [BASE, FRAME_PC] // Fallback may overwrite PC. | str CARG1, L->top | ldr CARG3, CFUNC:CARG3->f | str BASE, L->base | add CARG1, CARG1, #8*LUA_MINSTACK | str PC, SAVE_PC // Redundant (but a defined value). | cmp CARG1, CARG2 | mov CARG1, L | bhi >5 // Need to grow stack. | blx CARG3 // (lua_State *L) | // Either throws an error, or recovers and returns -1, 0 or nresults+1. | ldr BASE, L->base | cmp CRET1, #0 | lsl RC, CRET1, #3 | sub RA, BASE, #8 | bgt ->fff_res // Returned nresults+1? |1: // Returned 0 or -1: retry fast path. | ldr CARG1, L->top | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] | sub NARGS8:RC, CARG1, BASE | bne ->vm_call_tail // Returned -1? | ins_callt // Returned 0: retry fast path. | |// Reconstruct previous base for vmeta_call during tailcall. |->vm_call_tail: | ands CARG1, PC, #FRAME_TYPE | bic CARG2, PC, #FRAME_TYPEP | ldreq INS, [PC, #-4] | andeq CARG2, MASKR8, INS, lsr #5 // Conditional decode_RA8. | addeq CARG2, CARG2, #8 | sub RB, BASE, CARG2 | b ->vm_call_dispatch // Resolve again for tailcall. | |5: // Grow stack for fallback handler. | mov CARG2, #LUA_MINSTACK | bl extern lj_state_growstack // (lua_State *L, int n) | ldr BASE, L->base | cmp CARG1, CARG1 // Set zero-flag to force retry. | b <1 | |->fff_gcstep: // Call GC step function. | // BASE = new base, RC = nargs*8 | mov RA, lr | str BASE, L->base | add CARG2, BASE, NARGS8:RC | str PC, SAVE_PC // Redundant (but a defined value). | str CARG2, L->top | mov CARG1, L | bl extern lj_gc_step // (lua_State *L) | ldr BASE, L->base | mov lr, RA // Help return address predictor. | ldr CFUNC:CARG3, [BASE, FRAME_FUNC] | bx lr | |//----------------------------------------------------------------------- |//-- Special dispatch targets ------------------------------------------- |//----------------------------------------------------------------------- | |->vm_record: // Dispatch target for recording phase. |.if JIT | ldrb CARG1, [DISPATCH, #DISPATCH_GL(hookmask)] | tst CARG1, #HOOK_VMEVENT // No recording while in vmevent. | bne >5 | // Decrement the hookcount for consistency, but always do the call. | ldr CARG2, [DISPATCH, #DISPATCH_GL(hookcount)] | tst CARG1, #HOOK_ACTIVE | bne >1 | sub CARG2, CARG2, #1 | tst CARG1, #LUA_MASKLINE|LUA_MASKCOUNT | strne CARG2, [DISPATCH, #DISPATCH_GL(hookcount)] | b >1 |.endif | |->vm_rethook: // Dispatch target for return hooks. | ldrb CARG1, [DISPATCH, #DISPATCH_GL(hookmask)] | tst CARG1, #HOOK_ACTIVE // Hook already active? | beq >1 |5: // Re-dispatch to static ins. | decode_OP OP, INS | add OP, DISPATCH, OP, lsl #2 | ldr pc, [OP, #GG_DISP2STATIC] | |->vm_inshook: // Dispatch target for instr/line hooks. | ldrb CARG1, [DISPATCH, #DISPATCH_GL(hookmask)] | ldr CARG2, [DISPATCH, #DISPATCH_GL(hookcount)] | tst CARG1, #HOOK_ACTIVE // Hook already active? | bne <5 | tst CARG1, #LUA_MASKLINE|LUA_MASKCOUNT | beq <5 | subs CARG2, CARG2, #1 | str CARG2, [DISPATCH, #DISPATCH_GL(hookcount)] | beq >1 | tst CARG1, #LUA_MASKLINE | beq <5 |1: | mov CARG1, L | str BASE, L->base | mov CARG2, PC | // SAVE_PC must hold the _previous_ PC. The callee updates it with PC. | bl extern lj_dispatch_ins // (lua_State *L, const BCIns *pc) |3: | ldr BASE, L->base |4: // Re-dispatch to static ins. | ldrb OP, [PC, #-4] | ldr INS, [PC, #-4] | add OP, DISPATCH, OP, lsl #2 | ldr OP, [OP, #GG_DISP2STATIC] | decode_RA8 RA, INS | decode_RD RC, INS | bx OP | |->cont_hook: // Continue from hook yield. | ldr CARG1, [CARG4, #-24] | add PC, PC, #4 | str CARG1, SAVE_MULTRES // Restore MULTRES for *M ins. | b <4 | |->vm_hotloop: // Hot loop counter underflow. |.if JIT | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] // Same as curr_topL(L). | sub CARG1, DISPATCH, #-GG_DISP2J | str PC, SAVE_PC | ldr CARG3, LFUNC:CARG3->field_pc | mov CARG2, PC | str L, [DISPATCH, #DISPATCH_J(L)] | ldrb CARG3, [CARG3, #PC2PROTO(framesize)] | str BASE, L->base | add CARG3, BASE, CARG3, lsl #3 | str CARG3, L->top | bl extern lj_trace_hot // (jit_State *J, const BCIns *pc) | b <3 |.endif | |->vm_callhook: // Dispatch target for call hooks. | mov CARG2, PC |.if JIT | b >1 |.endif | |->vm_hotcall: // Hot call counter underflow. |.if JIT | orr CARG2, PC, #1 |1: |.endif | add CARG4, BASE, RC | str PC, SAVE_PC | mov CARG1, L | str BASE, L->base | sub RA, RA, BASE | str CARG4, L->top | bl extern lj_dispatch_call // (lua_State *L, const BCIns *pc) | // Returns ASMFunction. | ldr BASE, L->base | ldr CARG4, L->top | mov CARG2, #0 | add RA, BASE, RA | sub NARGS8:RC, CARG4, BASE | str CARG2, SAVE_PC // Invalidate for subsequent line hook. | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] | ldr INS, [PC, #-4] | bx CRET1 | |//----------------------------------------------------------------------- |//-- Trace exit handler ------------------------------------------------- |//----------------------------------------------------------------------- | |->vm_exit_handler: |.if JIT | sub sp, sp, #12 | push {r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12} | ldr CARG1, [sp, #64] // Load original value of lr. | ldr DISPATCH, [lr] // Load DISPATCH. | add CARG3, sp, #64 // Recompute original value of sp. | mv_vmstate CARG4, EXIT | str CARG3, [sp, #52] // Store sp in RID_SP | st_vmstate CARG4 | ldr CARG2, [CARG1, #-4]! // Get exit instruction. | str CARG1, [sp, #56] // Store exit pc in RID_LR and RID_PC. | str CARG1, [sp, #60] |.if FPU | vpush {d0-d15} |.endif | lsl CARG2, CARG2, #8 | add CARG1, CARG1, CARG2, asr #6 | ldr CARG2, [lr, #4] // Load exit stub group offset. | sub CARG1, CARG1, lr | ldr L, [DISPATCH, #DISPATCH_GL(jit_L)] | add CARG1, CARG2, CARG1, lsr #2 // Compute exit number. | ldr BASE, [DISPATCH, #DISPATCH_GL(jit_base)] | str CARG1, [DISPATCH, #DISPATCH_J(exitno)] | mov CARG4, #0 | str L, [DISPATCH, #DISPATCH_J(L)] | str BASE, L->base | str CARG4, [DISPATCH, #DISPATCH_GL(jit_L)] | sub CARG1, DISPATCH, #-GG_DISP2J | mov CARG2, sp | bl extern lj_trace_exit // (jit_State *J, ExitState *ex) | // Returns MULTRES (unscaled) or negated error code. | ldr CARG2, L->cframe | ldr BASE, L->base | bic CARG2, CARG2, #~CFRAME_RAWMASK // Use two steps: bic sp is deprecated. | mov sp, CARG2 | ldr PC, SAVE_PC // Get SAVE_PC. | str L, SAVE_L // Set SAVE_L (on-trace resume/yield). | b >1 |.endif |->vm_exit_interp: | // CARG1 = MULTRES or negated error code, BASE, PC and DISPATCH set. |.if JIT | ldr L, SAVE_L |1: | cmp CARG1, #0 | blt >3 // Check for error from exit. | lsl RC, CARG1, #3 | ldr LFUNC:CARG2, [BASE, FRAME_FUNC] | str RC, SAVE_MULTRES | mov CARG3, #0 | ldr CARG2, LFUNC:CARG2->field_pc | str CARG3, [DISPATCH, #DISPATCH_GL(jit_L)] | mv_vmstate CARG4, INTERP | ldr KBASE, [CARG2, #PC2PROTO(k)] | // Modified copy of ins_next which handles function header dispatch, too. | ldrb OP, [PC] | mov MASKR8, #255 | ldr INS, [PC], #4 | lsl MASKR8, MASKR8, #3 // MASKR8 = 255*8. | st_vmstate CARG4 | cmp OP, #BC_FUNCF // Function header? | ldr OP, [DISPATCH, OP, lsl #2] | decode_RA8 RA, INS | lsrlo RC, INS, #16 // No: Decode operands A*8 and D. | subhs RC, RC, #8 | addhs RA, RA, BASE // Yes: RA = BASE+framesize*8, RC = nargs*8 | bx OP | |3: // Rethrow error from the right C frame. | rsb CARG2, CARG1, #0 | mov CARG1, L | bl extern lj_err_throw // (lua_State *L, int errcode) |.endif | |//----------------------------------------------------------------------- |//-- Math helper functions ---------------------------------------------- |//----------------------------------------------------------------------- | |// FP value rounding. Called from JIT code. |// |// double lj_vm_floor/ceil/trunc(double x); |.macro vm_round, func, hf |.if hf == 1 | vmov CARG1, CARG2, d0 |.endif | lsl CARG3, CARG2, #1 | adds RB, CARG3, #0x00200000 | bpl >2 // |x| < 1? | mvn CARG4, #0x3cc | subs RB, CARG4, RB, asr #21 // 2^0: RB = 51, 2^51: RB = 0. | bxlo lr // |x| >= 2^52: done. | mvn CARG4, #1 | bic CARG3, CARG1, CARG4, lsl RB // ztest = lo & ~lomask | and CARG1, CARG1, CARG4, lsl RB // lo &= lomask | subs RB, RB, #32 | bicpl CARG4, CARG2, CARG4, lsl RB // |x| <= 2^20: ztest |= hi & ~himask | orrpl CARG3, CARG3, CARG4 | mvnpl CARG4, #1 | andpl CARG2, CARG2, CARG4, lsl RB // |x| <= 2^20: hi &= himask |.if "func" == "floor" | tst CARG3, CARG2, asr #31 // iszero = ((ztest & signmask) == 0) |.else | bics CARG3, CARG3, CARG2, asr #31 // iszero = ((ztest & ~signmask) == 0) |.endif |.if hf == 1 | vmoveq d0, CARG1, CARG2 |.endif | bxeq lr // iszero: done. | mvn CARG4, #1 | cmp RB, #0 | lslpl CARG3, CARG4, RB | mvnmi CARG3, #0 | add RB, RB, #32 | subs CARG1, CARG1, CARG4, lsl RB // lo = lo-lomask | sbc CARG2, CARG2, CARG3 // hi = hi-himask+carry |.if hf == 1 | vmov d0, CARG1, CARG2 |.endif | bx lr | |2: // |x| < 1: | bxcs lr // |x| is not finite. | orr CARG3, CARG3, CARG1 // ztest = (2*hi) | lo |.if "func" == "floor" | tst CARG3, CARG2, asr #31 // iszero = ((ztest & signmask) == 0) |.else | bics CARG3, CARG3, CARG2, asr #31 // iszero = ((ztest & ~signmask) == 0) |.endif | mov CARG1, #0 // lo = 0 | and CARG2, CARG2, #0x80000000 | ldrne CARG4, <9 // hi = sign(x) | (iszero ? 0.0 : 1.0) | orrne CARG2, CARG2, CARG4 |.if hf == 1 | vmov d0, CARG1, CARG2 |.endif | bx lr |.endmacro | |9: | .long 0x3ff00000 // hiword(+1.0) | |->vm_floor: |.if HFABI | vm_round floor, 1 |.endif |->vm_floor_sf: | vm_round floor, 0 | |->vm_ceil: |.if HFABI | vm_round ceil, 1 |.endif |->vm_ceil_sf: | vm_round ceil, 0 | |.macro vm_trunc, hf |.if JIT |.if hf == 1 | vmov CARG1, CARG2, d0 |.endif | lsl CARG3, CARG2, #1 | adds RB, CARG3, #0x00200000 | andpl CARG2, CARG2, #0x80000000 // |x| < 1? hi = sign(x), lo = 0. | movpl CARG1, #0 |.if hf == 1 | vmovpl d0, CARG1, CARG2 |.endif | bxpl lr | mvn CARG4, #0x3cc | subs RB, CARG4, RB, asr #21 // 2^0: RB = 51, 2^51: RB = 0. | bxlo lr // |x| >= 2^52: already done. | mvn CARG4, #1 | and CARG1, CARG1, CARG4, lsl RB // lo &= lomask | subs RB, RB, #32 | andpl CARG2, CARG2, CARG4, lsl RB // |x| <= 2^20: hi &= himask |.if hf == 1 | vmov d0, CARG1, CARG2 |.endif | bx lr |.endif |.endmacro | |->vm_trunc: |.if HFABI | vm_trunc 1 |.endif |->vm_trunc_sf: | vm_trunc 0 | | // double lj_vm_mod(double dividend, double divisor); |->vm_mod: |.if FPU | // Special calling convention. Also, RC (r11) is not preserved. | vdiv.f64 d0, d6, d7 | mov RC, lr | vmov CARG1, CARG2, d0 | bl ->vm_floor_sf | vmov d0, CARG1, CARG2 | vmul.f64 d0, d0, d7 | mov lr, RC | vsub.f64 d6, d6, d0 | bx lr |.else | push {r0, r1, r2, r3, r4, lr} | bl extern __aeabi_ddiv | bl ->vm_floor_sf | ldrd CARG34, [sp, #8] | bl extern __aeabi_dmul | ldrd CARG34, [sp] | eor CARG2, CARG2, #0x80000000 | bl extern __aeabi_dadd | add sp, sp, #20 | pop {pc} |.endif | | // int lj_vm_modi(int dividend, int divisor); |->vm_modi: | ands RB, CARG1, #0x80000000 | rsbmi CARG1, CARG1, #0 // a = |dividend| | eor RB, RB, CARG2, asr #1 // Keep signdiff and sign(divisor). | cmp CARG2, #0 | rsbmi CARG2, CARG2, #0 // b = |divisor| | subs CARG4, CARG2, #1 | cmpne CARG1, CARG2 | moveq CARG1, #0 // if (b == 1 || a == b) a = 0 | tsthi CARG2, CARG4 | andeq CARG1, CARG1, CARG4 // else if ((b & (b-1)) == 0) a &= b-1 | bls >1 | // Use repeated subtraction to get the remainder. | clz CARG3, CARG1 | clz CARG4, CARG2 | sub CARG4, CARG4, CARG3 | rsbs CARG3, CARG4, #31 // entry = (31-(clz(b)-clz(a)))*8 | addne pc, pc, CARG3, lsl #3 // Duff's device. | nop { int i; for (i = 31; i >= 0; i--) { | cmp CARG1, CARG2, lsl #i | subhs CARG1, CARG1, CARG2, lsl #i } } |1: | cmp CARG1, #0 | cmpne RB, #0 | submi CARG1, CARG1, CARG2 // if (y != 0 && signdiff) y = y - b | eors CARG2, CARG1, RB, lsl #1 | rsbmi CARG1, CARG1, #0 // if (sign(divisor) != sign(y)) y = -y | bx lr | |//----------------------------------------------------------------------- |//-- Miscellaneous functions -------------------------------------------- |//----------------------------------------------------------------------- | |//----------------------------------------------------------------------- |//-- FFI helper functions ----------------------------------------------- |//----------------------------------------------------------------------- | |// Handler for callback functions. |// Saveregs already performed. Callback slot number in [sp], g in r12. |->vm_ffi_callback: |.if FFI |.type CTSTATE, CTState, PC | ldr CTSTATE, GL:r12->ctype_state | add DISPATCH, r12, #GG_G2DISP |.if FPU | str r4, SAVE_R4 | add r4, sp, CFRAME_SPACE+4+8*8 | vstmdb r4!, {d8-d15} |.endif |.if HFABI | add r12, CTSTATE, #offsetof(CTState, cb.fpr[8]) |.endif | strd CARG34, CTSTATE->cb.gpr[2] | strd CARG12, CTSTATE->cb.gpr[0] |.if HFABI | vstmdb r12!, {d0-d7} |.endif | ldr CARG4, [sp] | add CARG3, sp, #CFRAME_SIZE | mov CARG1, CTSTATE | lsr CARG4, CARG4, #3 | str CARG3, CTSTATE->cb.stack | mov CARG2, sp | str CARG4, CTSTATE->cb.slot | str CTSTATE, SAVE_PC // Any value outside of bytecode is ok. | bl extern lj_ccallback_enter // (CTState *cts, void *cf) | // Returns lua_State *. | ldr BASE, L:CRET1->base | mv_vmstate CARG2, INTERP | ldr RC, L:CRET1->top | mov MASKR8, #255 | ldr LFUNC:CARG3, [BASE, FRAME_FUNC] | mov L, CRET1 | sub RC, RC, BASE | lsl MASKR8, MASKR8, #3 // MASKR8 = 255*8. | st_vmstate CARG2 | ins_callt |.endif | |->cont_ffi_callback: // Return from FFI callback. |.if FFI | ldr CTSTATE, [DISPATCH, #DISPATCH_GL(ctype_state)] | str BASE, L->base | str CARG4, L->top | str L, CTSTATE->L | mov CARG1, CTSTATE | mov CARG2, RA | bl extern lj_ccallback_leave // (CTState *cts, TValue *o) | ldrd CARG12, CTSTATE->cb.gpr[0] |.if HFABI | vldr d0, CTSTATE->cb.fpr[0] |.endif | b ->vm_leave_unw |.endif | |->vm_ffi_call: // Call C function via FFI. | // Caveat: needs special frame unwinding, see below. |.if FFI | .type CCSTATE, CCallState, r4 | push {CCSTATE, r5, r11, lr} | mov CCSTATE, CARG1 | ldr CARG1, CCSTATE:CARG1->spadj | ldrb CARG2, CCSTATE->nsp | add CARG3, CCSTATE, #offsetof(CCallState, stack) |.if HFABI | add RB, CCSTATE, #offsetof(CCallState, fpr[0]) |.endif | mov r11, sp | sub sp, sp, CARG1 // Readjust stack. | subs CARG2, CARG2, #1 |.if HFABI | vldm RB, {d0-d7} |.endif | ldr RB, CCSTATE->func | bmi >2 |1: // Copy stack slots. | ldr CARG4, [CARG3, CARG2, lsl #2] | str CARG4, [sp, CARG2, lsl #2] | subs CARG2, CARG2, #1 | bpl <1 |2: | ldrd CARG12, CCSTATE->gpr[0] | ldrd CARG34, CCSTATE->gpr[2] | blx RB | mov sp, r11 |.if HFABI | add r12, CCSTATE, #offsetof(CCallState, fpr[4]) |.endif | strd CRET1, CCSTATE->gpr[0] |.if HFABI | vstmdb r12!, {d0-d3} |.endif | pop {CCSTATE, r5, r11, pc} |.endif |// Note: vm_ffi_call must be the last function in this object file! | |//----------------------------------------------------------------------- } /* Generate the code for a single instruction. */ static void build_ins(BuildCtx *ctx, BCOp op, int defop) { int vk = 0; |=>defop: switch (op) { /* -- Comparison ops ---------------------------------------------------- */ /* Remember: all ops branch for a true comparison, fall through otherwise. */ case BC_ISLT: case BC_ISGE: case BC_ISLE: case BC_ISGT: | // RA = src1*8, RC = src2, JMP with RC = target | lsl RC, RC, #3 | ldrd CARG12, [RA, BASE]! | ldrh RB, [PC, #2] | ldrd CARG34, [RC, BASE]! | add PC, PC, #4 | add RB, PC, RB, lsl #2 | checktp CARG2, LJ_TISNUM | bne >3 | checktp CARG4, LJ_TISNUM | bne >4 | cmp CARG1, CARG3 if (op == BC_ISLT) { | sublt PC, RB, #0x20000 } else if (op == BC_ISGE) { | subge PC, RB, #0x20000 } else if (op == BC_ISLE) { | suble PC, RB, #0x20000 } else { | subgt PC, RB, #0x20000 } |1: | ins_next | |3: // CARG12 is not an integer. |.if FPU | vldr d0, [RA] | bhi ->vmeta_comp | // d0 is a number. | checktp CARG4, LJ_TISNUM | vldr d1, [RC] | blo >5 | bhi ->vmeta_comp | // d0 is a number, CARG3 is an integer. | vmov s4, CARG3 | vcvt.f64.s32 d1, s4 | b >5 |4: // CARG1 is an integer, CARG34 is not an integer. | vldr d1, [RC] | bhi ->vmeta_comp | // CARG1 is an integer, d1 is a number. | vmov s4, CARG1 | vcvt.f64.s32 d0, s4 |5: // d0 and d1 are numbers. | vcmp.f64 d0, d1 | vmrs | // To preserve NaN semantics GE/GT branch on unordered, but LT/LE don't. if (op == BC_ISLT) { | sublo PC, RB, #0x20000 } else if (op == BC_ISGE) { | subhs PC, RB, #0x20000 } else if (op == BC_ISLE) { | subls PC, RB, #0x20000 } else { | subhi PC, RB, #0x20000 } | b <1 |.else | bhi ->vmeta_comp | // CARG12 is a number. | checktp CARG4, LJ_TISNUM | movlo RA, RB // Save RB. | blo >5 | bhi ->vmeta_comp | // CARG12 is a number, CARG3 is an integer. | mov CARG1, CARG3 | mov RC, RA | mov RA, RB // Save RB. | bl extern __aeabi_i2d | mov CARG3, CARG1 | mov CARG4, CARG2 | ldrd CARG12, [RC] // Restore first operand. | b >5 |4: // CARG1 is an integer, CARG34 is not an integer. | bhi ->vmeta_comp | // CARG1 is an integer, CARG34 is a number. | mov RA, RB // Save RB. | bl extern __aeabi_i2d | ldrd CARG34, [RC] // Restore second operand. |5: // CARG12 and CARG34 are numbers. | bl extern __aeabi_cdcmple | // To preserve NaN semantics GE/GT branch on unordered, but LT/LE don't. if (op == BC_ISLT) { | sublo PC, RA, #0x20000 } else if (op == BC_ISGE) { | subhs PC, RA, #0x20000 } else if (op == BC_ISLE) { | subls PC, RA, #0x20000 } else { | subhi PC, RA, #0x20000 } | b <1 |.endif break; case BC_ISEQV: case BC_ISNEV: vk = op == BC_ISEQV; | // RA = src1*8, RC = src2, JMP with RC = target | lsl RC, RC, #3 | ldrd CARG12, [RA, BASE]! | ldrh RB, [PC, #2] | ldrd CARG34, [RC, BASE]! | add PC, PC, #4 | add RB, PC, RB, lsl #2 | checktp CARG2, LJ_TISNUM | cmnls CARG4, #-LJ_TISNUM if (vk) { | bls ->BC_ISEQN_Z } else { | bls ->BC_ISNEN_Z } | // Either or both types are not numbers. |.if FFI | checktp CARG2, LJ_TCDATA | checktpne CARG4, LJ_TCDATA | beq ->vmeta_equal_cd |.endif | cmp CARG2, CARG4 // Compare types. | bne >2 // Not the same type? | checktp CARG2, LJ_TISPRI | bhs >1 // Same type and primitive type? | | // Same types and not a primitive type. Compare GCobj or pvalue. | cmp CARG1, CARG3 if (vk) { | bne >3 // Different GCobjs or pvalues? |1: // Branch if same. | sub PC, RB, #0x20000 |2: // Different. | ins_next |3: | checktp CARG2, LJ_TISTABUD | bhi <2 // Different objects and not table/ud? } else { | beq >1 // Same GCobjs or pvalues? | checktp CARG2, LJ_TISTABUD | bhi >2 // Different objects and not table/ud? } | // Different tables or userdatas. Need to check __eq metamethod. | // Field metatable must be at same offset for GCtab and GCudata! | ldr TAB:RA, TAB:CARG1->metatable | cmp TAB:RA, #0 if (vk) { | beq <2 // No metatable? } else { | beq >2 // No metatable? } | ldrb RA, TAB:RA->nomm | mov CARG4, #1-vk // ne = 0 or 1. | mov CARG2, CARG1 | tst RA, #1<vmeta_equal // 'no __eq' flag not set? if (vk) { | b <2 } else { |2: // Branch if different. | sub PC, RB, #0x20000 |1: // Same. | ins_next } break; case BC_ISEQS: case BC_ISNES: vk = op == BC_ISEQS; | // RA = src*8, RC = str_const (~), JMP with RC = target | mvn RC, RC | ldrd CARG12, [BASE, RA] | ldrh RB, [PC, #2] | ldr STR:CARG3, [KBASE, RC, lsl #2] | add PC, PC, #4 | add RB, PC, RB, lsl #2 | checktp CARG2, LJ_TSTR |.if FFI | bne >7 | cmp CARG1, CARG3 |.else | cmpeq CARG1, CARG3 |.endif if (vk) { | subeq PC, RB, #0x20000 |1: } else { |1: | subne PC, RB, #0x20000 } | ins_next | |.if FFI |7: | checktp CARG2, LJ_TCDATA | bne <1 | b ->vmeta_equal_cd |.endif break; case BC_ISEQN: case BC_ISNEN: vk = op == BC_ISEQN; | // RA = src*8, RC = num_const (~), JMP with RC = target | lsl RC, RC, #3 | ldrd CARG12, [RA, BASE]! | ldrh RB, [PC, #2] | ldrd CARG34, [RC, KBASE]! | add PC, PC, #4 | add RB, PC, RB, lsl #2 if (vk) { |->BC_ISEQN_Z: } else { |->BC_ISNEN_Z: } | checktp CARG2, LJ_TISNUM | bne >3 | checktp CARG4, LJ_TISNUM | bne >4 | cmp CARG1, CARG3 if (vk) { | subeq PC, RB, #0x20000 |1: } else { |1: | subne PC, RB, #0x20000 } |2: | ins_next | |3: // CARG12 is not an integer. |.if FFI | bhi >7 |.else if (!vk) { | subhi PC, RB, #0x20000 } | bhi <2 |.endif |.if FPU | checktp CARG4, LJ_TISNUM | vmov s4, CARG3 | vldr d0, [RA] | vldrlo d1, [RC] | vcvths.f64.s32 d1, s4 | b >5 |4: // CARG1 is an integer, d1 is a number. | vmov s4, CARG1 | vldr d1, [RC] | vcvt.f64.s32 d0, s4 |5: // d0 and d1 are numbers. | vcmp.f64 d0, d1 | vmrs if (vk) { | subeq PC, RB, #0x20000 } else { | subne PC, RB, #0x20000 } | b <2 |.else | // CARG12 is a number. | checktp CARG4, LJ_TISNUM | movlo RA, RB // Save RB. | blo >5 | // CARG12 is a number, CARG3 is an integer. | mov CARG1, CARG3 | mov RC, RA |4: // CARG1 is an integer, CARG34 is a number. | mov RA, RB // Save RB. | bl extern __aeabi_i2d | ldrd CARG34, [RC] // Restore other operand. |5: // CARG12 and CARG34 are numbers. | bl extern __aeabi_cdcmpeq if (vk) { | subeq PC, RA, #0x20000 } else { | subne PC, RA, #0x20000 } | b <2 |.endif | |.if FFI |7: | checktp CARG2, LJ_TCDATA | bne <1 | b ->vmeta_equal_cd |.endif break; case BC_ISEQP: case BC_ISNEP: vk = op == BC_ISEQP; | // RA = src*8, RC = primitive_type (~), JMP with RC = target | ldrd CARG12, [BASE, RA] | ldrh RB, [PC, #2] | add PC, PC, #4 | mvn RC, RC | add RB, PC, RB, lsl #2 |.if FFI | checktp CARG2, LJ_TCDATA | beq ->vmeta_equal_cd |.endif | cmp CARG2, RC if (vk) { | subeq PC, RB, #0x20000 } else { | subne PC, RB, #0x20000 } | ins_next break; /* -- Unary test and copy ops ------------------------------------------- */ case BC_ISTC: case BC_ISFC: case BC_IST: case BC_ISF: | // RA = dst*8 or unused, RC = src, JMP with RC = target | add RC, BASE, RC, lsl #3 | ldrh RB, [PC, #2] | ldrd CARG12, [RC] | add PC, PC, #4 | add RB, PC, RB, lsl #2 | checktp CARG2, LJ_TTRUE if (op == BC_ISTC || op == BC_IST) { | subls PC, RB, #0x20000 if (op == BC_ISTC) { | strdls CARG12, [BASE, RA] } } else { | subhi PC, RB, #0x20000 if (op == BC_ISFC) { | strdhi CARG12, [BASE, RA] } } | ins_next break; /* -- Unary ops --------------------------------------------------------- */ case BC_MOV: | // RA = dst*8, RC = src | lsl RC, RC, #3 | ins_next1 | ldrd CARG12, [BASE, RC] | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 break; case BC_NOT: | // RA = dst*8, RC = src | add RC, BASE, RC, lsl #3 | ins_next1 | ldr CARG1, [RC, #4] | add RA, BASE, RA | ins_next2 | checktp CARG1, LJ_TTRUE | mvnls CARG2, #~LJ_TFALSE | mvnhi CARG2, #~LJ_TTRUE | str CARG2, [RA, #4] | ins_next3 break; case BC_UNM: | // RA = dst*8, RC = src | lsl RC, RC, #3 | ldrd CARG12, [BASE, RC] | ins_next1 | ins_next2 | checktp CARG2, LJ_TISNUM | bhi ->vmeta_unm | eorne CARG2, CARG2, #0x80000000 | bne >5 | rsbseq CARG1, CARG1, #0 | ldrdvs CARG12, >9 |5: | strd CARG12, [BASE, RA] | ins_next3 | |.align 8 |9: | .long 0x00000000, 0x41e00000 // 2^31. break; case BC_LEN: | // RA = dst*8, RC = src | lsl RC, RC, #3 | ldrd CARG12, [BASE, RC] | checkstr CARG2, >2 | ldr CARG1, STR:CARG1->len |1: | mvn CARG2, #~LJ_TISNUM | ins_next1 | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 |2: | checktab CARG2, ->vmeta_len #if LJ_52 | ldr TAB:CARG3, TAB:CARG1->metatable | cmp TAB:CARG3, #0 | bne >9 |3: #endif |->BC_LEN_Z: | .IOS mov RC, BASE | bl extern lj_tab_len // (GCtab *t) | // Returns uint32_t (but less than 2^31). | .IOS mov BASE, RC | b <1 #if LJ_52 |9: | ldrb CARG4, TAB:CARG3->nomm | tst CARG4, #1<vmeta_len #endif break; /* -- Binary ops -------------------------------------------------------- */ |.macro ins_arithcheck, cond, ncond, target ||if (vk == 1) { | cmn CARG4, #-LJ_TISNUM | cmn..cond CARG2, #-LJ_TISNUM ||} else { | cmn CARG2, #-LJ_TISNUM | cmn..cond CARG4, #-LJ_TISNUM ||} | b..ncond target |.endmacro |.macro ins_arithcheck_int, target | ins_arithcheck eq, ne, target |.endmacro |.macro ins_arithcheck_num, target | ins_arithcheck lo, hs, target |.endmacro | |.macro ins_arithpre | decode_RB8 RB, INS | decode_RC8 RC, INS | // RA = dst*8, RB = src1*8, RC = src2*8 | num_const*8 ||vk = ((int)op - BC_ADDVN) / (BC_ADDNV-BC_ADDVN); ||switch (vk) { ||case 0: | .if FPU | ldrd CARG12, [RB, BASE]! | ldrd CARG34, [RC, KBASE]! | .else | ldrd CARG12, [BASE, RB] | ldrd CARG34, [KBASE, RC] | .endif || break; ||case 1: | .if FPU | ldrd CARG34, [RB, BASE]! | ldrd CARG12, [RC, KBASE]! | .else | ldrd CARG34, [BASE, RB] | ldrd CARG12, [KBASE, RC] | .endif || break; ||default: | .if FPU | ldrd CARG12, [RB, BASE]! | ldrd CARG34, [RC, BASE]! | .else | ldrd CARG12, [BASE, RB] | ldrd CARG34, [BASE, RC] | .endif || break; ||} |.endmacro | |.macro ins_arithpre_fpu, reg1, reg2 |.if FPU ||if (vk == 1) { | vldr reg2, [RB] | vldr reg1, [RC] ||} else { | vldr reg1, [RB] | vldr reg2, [RC] ||} |.endif |.endmacro | |.macro ins_arithpost_fpu, reg | ins_next1 | add RA, BASE, RA | ins_next2 | vstr reg, [RA] | ins_next3 |.endmacro | |.macro ins_arithfallback, ins ||switch (vk) { ||case 0: | ins ->vmeta_arith_vn || break; ||case 1: | ins ->vmeta_arith_nv || break; ||default: | ins ->vmeta_arith_vv || break; ||} |.endmacro | |.macro ins_arithdn, intins, fpins, fpcall | ins_arithpre |.if "intins" ~= "vm_modi" and not FPU | ins_next1 |.endif | ins_arithcheck_int >5 |.if "intins" == "smull" | smull CARG1, RC, CARG3, CARG1 | cmp RC, CARG1, asr #31 | ins_arithfallback bne |.elif "intins" == "vm_modi" | movs CARG2, CARG3 | ins_arithfallback beq | bl ->vm_modi | mvn CARG2, #~LJ_TISNUM |.else | intins CARG1, CARG1, CARG3 | ins_arithfallback bvs |.endif |4: |.if "intins" == "vm_modi" or FPU | ins_next1 |.endif | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 |5: // FP variant. | ins_arithpre_fpu d6, d7 | ins_arithfallback ins_arithcheck_num |.if FPU |.if "intins" == "vm_modi" | bl fpcall |.else | fpins d6, d6, d7 |.endif | ins_arithpost_fpu d6 |.else | bl fpcall |.if "intins" ~= "vm_modi" | ins_next1 |.endif | b <4 |.endif |.endmacro | |.macro ins_arithfp, fpins, fpcall | ins_arithpre |.if "fpins" ~= "extern" or HFABI | ins_arithpre_fpu d0, d1 |.endif | ins_arithfallback ins_arithcheck_num |.if "fpins" == "extern" | .IOS mov RC, BASE | bl fpcall | .IOS mov BASE, RC |.elif FPU | fpins d0, d0, d1 |.else | bl fpcall |.endif |.if ("fpins" ~= "extern" or HFABI) and FPU | ins_arithpost_fpu d0 |.else | ins_next1 | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 |.endif |.endmacro case BC_ADDVN: case BC_ADDNV: case BC_ADDVV: | ins_arithdn adds, vadd.f64, extern __aeabi_dadd break; case BC_SUBVN: case BC_SUBNV: case BC_SUBVV: | ins_arithdn subs, vsub.f64, extern __aeabi_dsub break; case BC_MULVN: case BC_MULNV: case BC_MULVV: | ins_arithdn smull, vmul.f64, extern __aeabi_dmul break; case BC_DIVVN: case BC_DIVNV: case BC_DIVVV: | ins_arithfp vdiv.f64, extern __aeabi_ddiv break; case BC_MODVN: case BC_MODNV: case BC_MODVV: | ins_arithdn vm_modi, vm_mod, ->vm_mod break; case BC_POW: | // NYI: (partial) integer arithmetic. | ins_arithfp extern, extern pow break; case BC_CAT: | decode_RB8 RC, INS | decode_RC8 RB, INS | // RA = dst*8, RC = src_start*8, RB = src_end*8 (note: RB/RC swapped!) | sub CARG3, RB, RC | str BASE, L->base | add CARG2, BASE, RB |->BC_CAT_Z: | // RA = dst*8, RC = src_start*8, CARG2 = top-1 | mov CARG1, L | str PC, SAVE_PC | lsr CARG3, CARG3, #3 | bl extern lj_meta_cat // (lua_State *L, TValue *top, int left) | // Returns NULL (finished) or TValue * (metamethod). | ldr BASE, L->base | cmp CRET1, #0 | bne ->vmeta_binop | ldrd CARG34, [BASE, RC] | ins_next1 | ins_next2 | strd CARG34, [BASE, RA] // Copy result to RA. | ins_next3 break; /* -- Constant ops ------------------------------------------------------ */ case BC_KSTR: | // RA = dst*8, RC = str_const (~) | mvn RC, RC | ins_next1 | ldr CARG1, [KBASE, RC, lsl #2] | mvn CARG2, #~LJ_TSTR | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 break; case BC_KCDATA: |.if FFI | // RA = dst*8, RC = cdata_const (~) | mvn RC, RC | ins_next1 | ldr CARG1, [KBASE, RC, lsl #2] | mvn CARG2, #~LJ_TCDATA | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 |.endif break; case BC_KSHORT: | // RA = dst*8, (RC = int16_literal) | mov CARG1, INS, asr #16 // Refetch sign-extended reg. | mvn CARG2, #~LJ_TISNUM | ins_next1 | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 break; case BC_KNUM: | // RA = dst*8, RC = num_const | lsl RC, RC, #3 | ins_next1 | ldrd CARG12, [KBASE, RC] | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 break; case BC_KPRI: | // RA = dst*8, RC = primitive_type (~) | add RA, BASE, RA | mvn RC, RC | ins_next1 | ins_next2 | str RC, [RA, #4] | ins_next3 break; case BC_KNIL: | // RA = base*8, RC = end | add RA, BASE, RA | add RC, BASE, RC, lsl #3 | mvn CARG1, #~LJ_TNIL | str CARG1, [RA, #4] | add RA, RA, #8 |1: | str CARG1, [RA, #4] | cmp RA, RC | add RA, RA, #8 | blt <1 | ins_next_ break; /* -- Upvalue and function ops ------------------------------------------ */ case BC_UGET: | // RA = dst*8, RC = uvnum | ldr LFUNC:CARG2, [BASE, FRAME_FUNC] | lsl RC, RC, #2 | add RC, RC, #offsetof(GCfuncL, uvptr) | ldr UPVAL:CARG2, [LFUNC:CARG2, RC] | ldr CARG2, UPVAL:CARG2->v | ldrd CARG34, [CARG2] | ins_next1 | ins_next2 | strd CARG34, [BASE, RA] | ins_next3 break; case BC_USETV: | // RA = uvnum*8, RC = src | ldr LFUNC:CARG2, [BASE, FRAME_FUNC] | lsr RA, RA, #1 | add RA, RA, #offsetof(GCfuncL, uvptr) | lsl RC, RC, #3 | ldr UPVAL:CARG2, [LFUNC:CARG2, RA] | ldrd CARG34, [BASE, RC] | ldrb RB, UPVAL:CARG2->marked | ldrb RC, UPVAL:CARG2->closed | ldr CARG2, UPVAL:CARG2->v | tst RB, #LJ_GC_BLACK // isblack(uv) | add RB, CARG4, #-LJ_TISGCV | cmpne RC, #0 | strd CARG34, [CARG2] | bne >2 // Upvalue is closed and black? |1: | ins_next | |2: // Check if new value is collectable. | cmn RB, #-(LJ_TNUMX - LJ_TISGCV) | ldrbhi RC, GCOBJ:CARG3->gch.marked | bls <1 // tvisgcv(v) | sub CARG1, DISPATCH, #-GG_DISP2G | tst RC, #LJ_GC_WHITES | // Crossed a write barrier. Move the barrier forward. |.if IOS | beq <1 | mov RC, BASE | bl extern lj_gc_barrieruv // (global_State *g, TValue *tv) | mov BASE, RC |.else | blne extern lj_gc_barrieruv // (global_State *g, TValue *tv) |.endif | b <1 break; case BC_USETS: | // RA = uvnum*8, RC = str_const (~) | ldr LFUNC:CARG2, [BASE, FRAME_FUNC] | lsr RA, RA, #1 | add RA, RA, #offsetof(GCfuncL, uvptr) | mvn RC, RC | ldr UPVAL:CARG2, [LFUNC:CARG2, RA] | ldr STR:CARG3, [KBASE, RC, lsl #2] | ldrb RB, UPVAL:CARG2->marked | ldrb RC, UPVAL:CARG2->closed | ldr CARG2, UPVAL:CARG2->v | mvn CARG4, #~LJ_TSTR | tst RB, #LJ_GC_BLACK // isblack(uv) | ldrb RB, STR:CARG3->marked | strd CARG34, [CARG2] | bne >2 |1: | ins_next | |2: // Check if string is white and ensure upvalue is closed. | tst RB, #LJ_GC_WHITES // iswhite(str) | cmpne RC, #0 | sub CARG1, DISPATCH, #-GG_DISP2G | // Crossed a write barrier. Move the barrier forward. |.if IOS | beq <1 | mov RC, BASE | bl extern lj_gc_barrieruv // (global_State *g, TValue *tv) | mov BASE, RC |.else | blne extern lj_gc_barrieruv // (global_State *g, TValue *tv) |.endif | b <1 break; case BC_USETN: | // RA = uvnum*8, RC = num_const | ldr LFUNC:CARG2, [BASE, FRAME_FUNC] | lsr RA, RA, #1 | add RA, RA, #offsetof(GCfuncL, uvptr) | lsl RC, RC, #3 | ldr UPVAL:CARG2, [LFUNC:CARG2, RA] | ldrd CARG34, [KBASE, RC] | ldr CARG2, UPVAL:CARG2->v | ins_next1 | ins_next2 | strd CARG34, [CARG2] | ins_next3 break; case BC_USETP: | // RA = uvnum*8, RC = primitive_type (~) | ldr LFUNC:CARG2, [BASE, FRAME_FUNC] | lsr RA, RA, #1 | add RA, RA, #offsetof(GCfuncL, uvptr) | ldr UPVAL:CARG2, [LFUNC:CARG2, RA] | mvn RC, RC | ldr CARG2, UPVAL:CARG2->v | ins_next1 | ins_next2 | str RC, [CARG2, #4] | ins_next3 break; case BC_UCLO: | // RA = level*8, RC = target | ldr CARG3, L->openupval | add RC, PC, RC, lsl #2 | str BASE, L->base | cmp CARG3, #0 | sub PC, RC, #0x20000 | beq >1 | mov CARG1, L | add CARG2, BASE, RA | bl extern lj_func_closeuv // (lua_State *L, TValue *level) | ldr BASE, L->base |1: | ins_next break; case BC_FNEW: | // RA = dst*8, RC = proto_const (~) (holding function prototype) | mvn RC, RC | str BASE, L->base | ldr CARG2, [KBASE, RC, lsl #2] | str PC, SAVE_PC | ldr CARG3, [BASE, FRAME_FUNC] | mov CARG1, L | // (lua_State *L, GCproto *pt, GCfuncL *parent) | bl extern lj_func_newL_gc | // Returns GCfuncL *. | ldr BASE, L->base | mvn CARG2, #~LJ_TFUNC | ins_next1 | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 break; /* -- Table ops --------------------------------------------------------- */ case BC_TNEW: case BC_TDUP: | // RA = dst*8, RC = (hbits|asize) | tab_const (~) if (op == BC_TDUP) { | mvn RC, RC } | ldr CARG3, [DISPATCH, #DISPATCH_GL(gc.total)] | ldr CARG4, [DISPATCH, #DISPATCH_GL(gc.threshold)] | str BASE, L->base | str PC, SAVE_PC | cmp CARG3, CARG4 | mov CARG1, L | bhs >5 |1: if (op == BC_TNEW) { | lsl CARG2, RC, #21 | lsr CARG3, RC, #11 | asr RC, CARG2, #21 | lsr CARG2, CARG2, #21 | cmn RC, #1 | addeq CARG2, CARG2, #2 | bl extern lj_tab_new // (lua_State *L, int32_t asize, uint32_t hbits) | // Returns GCtab *. } else { | ldr CARG2, [KBASE, RC, lsl #2] | bl extern lj_tab_dup // (lua_State *L, Table *kt) | // Returns GCtab *. } | ldr BASE, L->base | mvn CARG2, #~LJ_TTAB | ins_next1 | ins_next2 | strd CARG12, [BASE, RA] | ins_next3 |5: | bl extern lj_gc_step_fixtop // (lua_State *L) | mov CARG1, L | b <1 break; case BC_GGET: | // RA = dst*8, RC = str_const (~) case BC_GSET: | // RA = dst*8, RC = str_const (~) | ldr LFUNC:CARG2, [BASE, FRAME_FUNC] | mvn RC, RC | ldr TAB:CARG1, LFUNC:CARG2->env | ldr STR:RC, [KBASE, RC, lsl #2] if (op == BC_GGET) { | b ->BC_TGETS_Z } else { | b ->BC_TSETS_Z } break; case BC_TGETV: | decode_RB8 RB, INS | decode_RC8 RC, INS | // RA = dst*8, RB = table*8, RC = key*8 | ldrd TAB:CARG12, [BASE, RB] | ldrd CARG34, [BASE, RC] | checktab CARG2, ->vmeta_tgetv // STALL: load CARG12. | checktp CARG4, LJ_TISNUM // Integer key? | ldreq CARG4, TAB:CARG1->array | ldreq CARG2, TAB:CARG1->asize | bne >9 | | add CARG4, CARG4, CARG3, lsl #3 | cmp CARG3, CARG2 // In array part? | ldrdlo CARG34, [CARG4] | bhs ->vmeta_tgetv | ins_next1 // Overwrites RB! | checktp CARG4, LJ_TNIL | beq >5 |1: | ins_next2 | strd CARG34, [BASE, RA] | ins_next3 | |5: // Check for __index if table value is nil. | ldr TAB:CARG2, TAB:CARG1->metatable | cmp TAB:CARG2, #0 | beq <1 // No metatable: done. | ldrb CARG2, TAB:CARG2->nomm | tst CARG2, #1<vmeta_tgetv | |9: | checktp CARG4, LJ_TSTR // String key? | moveq STR:RC, CARG3 | beq ->BC_TGETS_Z | b ->vmeta_tgetv break; case BC_TGETS: | decode_RB8 RB, INS | and RC, RC, #255 | // RA = dst*8, RB = table*8, RC = str_const (~) | ldrd CARG12, [BASE, RB] | mvn RC, RC | ldr STR:RC, [KBASE, RC, lsl #2] // STALL: early RC. | checktab CARG2, ->vmeta_tgets1 |->BC_TGETS_Z: | // (TAB:RB =) TAB:CARG1 = GCtab *, STR:RC = GCstr *, RA = dst*8 | ldr CARG3, TAB:CARG1->hmask | ldr CARG4, STR:RC->hash | ldr NODE:INS, TAB:CARG1->node | mov TAB:RB, TAB:CARG1 | and CARG3, CARG3, CARG4 // idx = str->hash & tab->hmask | add CARG3, CARG3, CARG3, lsl #1 | add NODE:INS, NODE:INS, CARG3, lsl #3 // node = tab->node + idx*3*8 |1: | ldrd CARG12, NODE:INS->key // STALL: early NODE:INS. | ldrd CARG34, NODE:INS->val | ldr NODE:INS, NODE:INS->next | checktp CARG2, LJ_TSTR | cmpeq CARG1, STR:RC | bne >4 | checktp CARG4, LJ_TNIL | beq >5 |3: | ins_next1 | ins_next2 | strd CARG34, [BASE, RA] | ins_next3 | |4: // Follow hash chain. | cmp NODE:INS, #0 | bne <1 | // End of hash chain: key not found, nil result. | |5: // Check for __index if table value is nil. | ldr TAB:CARG1, TAB:RB->metatable | mov CARG3, #0 // Optional clear of undef. value (during load stall). | mvn CARG4, #~LJ_TNIL | cmp TAB:CARG1, #0 | beq <3 // No metatable: done. | ldrb CARG2, TAB:CARG1->nomm | tst CARG2, #1<vmeta_tgets break; case BC_TGETB: | decode_RB8 RB, INS | and RC, RC, #255 | // RA = dst*8, RB = table*8, RC = index | ldrd CARG12, [BASE, RB] | checktab CARG2, ->vmeta_tgetb // STALL: load CARG12. | ldr CARG3, TAB:CARG1->asize | ldr CARG4, TAB:CARG1->array | lsl CARG2, RC, #3 | cmp RC, CARG3 | ldrdlo CARG34, [CARG4, CARG2] | bhs ->vmeta_tgetb | ins_next1 // Overwrites RB! | checktp CARG4, LJ_TNIL | beq >5 |1: | ins_next2 | strd CARG34, [BASE, RA] | ins_next3 | |5: // Check for __index if table value is nil. | ldr TAB:CARG2, TAB:CARG1->metatable | cmp TAB:CARG2, #0 | beq <1 // No metatable: done. | ldrb CARG2, TAB:CARG2->nomm | tst CARG2, #1<vmeta_tgetb break; case BC_TSETV: | decode_RB8 RB, INS | decode_RC8 RC, INS | // RA = src*8, RB = table*8, RC = key*8 | ldrd TAB:CARG12, [BASE, RB] | ldrd CARG34, [BASE, RC] | checktab CARG2, ->vmeta_tsetv // STALL: load CARG12. | checktp CARG4, LJ_TISNUM // Integer key? | ldreq CARG2, TAB:CARG1->array | ldreq CARG4, TAB:CARG1->asize | bne >9 | | add CARG2, CARG2, CARG3, lsl #3 | cmp CARG3, CARG4 // In array part? | ldrlo INS, [CARG2, #4] | bhs ->vmeta_tsetv | ins_next1 // Overwrites RB! | checktp INS, LJ_TNIL | ldrb INS, TAB:CARG1->marked | ldrd CARG34, [BASE, RA] | beq >5 |1: | tst INS, #LJ_GC_BLACK // isblack(table) | strd CARG34, [CARG2] | bne >7 |2: | ins_next2 | ins_next3 | |5: // Check for __newindex if previous value is nil. | ldr TAB:RA, TAB:CARG1->metatable | cmp TAB:RA, #0 | beq <1 // No metatable: done. | ldrb RA, TAB:RA->nomm | tst RA, #1<vmeta_tsetv | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:CARG1, INS, CARG3 | b <2 | |9: | checktp CARG4, LJ_TSTR // String key? | moveq STR:RC, CARG3 | beq ->BC_TSETS_Z | b ->vmeta_tsetv break; case BC_TSETS: | decode_RB8 RB, INS | and RC, RC, #255 | // RA = src*8, RB = table*8, RC = str_const (~) | ldrd CARG12, [BASE, RB] | mvn RC, RC | ldr STR:RC, [KBASE, RC, lsl #2] // STALL: early RC. | checktab CARG2, ->vmeta_tsets1 |->BC_TSETS_Z: | // (TAB:RB =) TAB:CARG1 = GCtab *, STR:RC = GCstr *, RA = dst*8 | ldr CARG3, TAB:CARG1->hmask | ldr CARG4, STR:RC->hash | ldr NODE:INS, TAB:CARG1->node | mov TAB:RB, TAB:CARG1 | and CARG3, CARG3, CARG4 // idx = str->hash & tab->hmask | add CARG3, CARG3, CARG3, lsl #1 | mov CARG4, #0 | add NODE:INS, NODE:INS, CARG3, lsl #3 // node = tab->node + idx*3*8 | strb CARG4, TAB:RB->nomm // Clear metamethod cache. |1: | ldrd CARG12, NODE:INS->key | ldr CARG4, NODE:INS->val.it | ldr NODE:CARG3, NODE:INS->next | checktp CARG2, LJ_TSTR | cmpeq CARG1, STR:RC | bne >5 | ldrb CARG2, TAB:RB->marked | checktp CARG4, LJ_TNIL // Key found, but nil value? | ldrd CARG34, [BASE, RA] | beq >4 |2: | tst CARG2, #LJ_GC_BLACK // isblack(table) | strd CARG34, NODE:INS->val | bne >7 |3: | ins_next | |4: // Check for __newindex if previous value is nil. | ldr TAB:CARG1, TAB:RB->metatable | cmp TAB:CARG1, #0 | beq <2 // No metatable: done. | ldrb CARG1, TAB:CARG1->nomm | tst CARG1, #1<vmeta_tsets | |5: // Follow hash chain. | movs NODE:INS, NODE:CARG3 | bne <1 | // End of hash chain: key not found, add a new one. | | // But check for __newindex first. | ldr TAB:CARG1, TAB:RB->metatable | mov CARG3, TMPDp | str PC, SAVE_PC | cmp TAB:CARG1, #0 // No metatable: continue. | str BASE, L->base | ldrbne CARG2, TAB:CARG1->nomm | mov CARG1, L | beq >6 | tst CARG2, #1<vmeta_tsets // 'no __newindex' flag NOT set: check. |6: | mvn CARG4, #~LJ_TSTR | str STR:RC, TMPDlo | mov CARG2, TAB:RB | str CARG4, TMPDhi | bl extern lj_tab_newkey // (lua_State *L, GCtab *t, TValue *k) | // Returns TValue *. | ldr BASE, L->base | ldrd CARG34, [BASE, RA] | strd CARG34, [CRET1] | b <3 // No 2nd write barrier needed. | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, CARG2, CARG3 | b <3 break; case BC_TSETB: | decode_RB8 RB, INS | and RC, RC, #255 | // RA = src*8, RB = table*8, RC = index | ldrd CARG12, [BASE, RB] | checktab CARG2, ->vmeta_tsetb // STALL: load CARG12. | ldr CARG3, TAB:CARG1->asize | ldr RB, TAB:CARG1->array | lsl CARG2, RC, #3 | cmp RC, CARG3 | ldrdlo CARG34, [CARG2, RB]! | bhs ->vmeta_tsetb | ins_next1 // Overwrites RB! | checktp CARG4, LJ_TNIL | ldrb INS, TAB:CARG1->marked | ldrd CARG34, [BASE, RA] | beq >5 |1: | tst INS, #LJ_GC_BLACK // isblack(table) | strd CARG34, [CARG2] | bne >7 |2: | ins_next2 | ins_next3 | |5: // Check for __newindex if previous value is nil. | ldr TAB:RA, TAB:CARG1->metatable | cmp TAB:RA, #0 | beq <1 // No metatable: done. | ldrb RA, TAB:RA->nomm | tst RA, #1<vmeta_tsetb | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:CARG1, INS, CARG3 | b <2 break; case BC_TSETM: | // RA = base*8 (table at base-1), RC = num_const (start index) | add RA, BASE, RA |1: | ldr RB, SAVE_MULTRES | ldr TAB:CARG2, [RA, #-8] // Guaranteed to be a table. | ldr CARG1, [KBASE, RC, lsl #3] // Integer constant is in lo-word. | subs RB, RB, #8 | ldr CARG4, TAB:CARG2->asize | beq >4 // Nothing to copy? | add CARG3, CARG1, RB, lsr #3 | cmp CARG3, CARG4 | ldr CARG4, TAB:CARG2->array | add RB, RA, RB | bhi >5 | add INS, CARG4, CARG1, lsl #3 | ldrb CARG1, TAB:CARG2->marked |3: // Copy result slots to table. | ldrd CARG34, [RA], #8 | strd CARG34, [INS], #8 | cmp RA, RB | blo <3 | tst CARG1, #LJ_GC_BLACK // isblack(table) | bne >7 |4: | ins_next | |5: // Need to resize array part. | str BASE, L->base | mov CARG1, L | str PC, SAVE_PC | bl extern lj_tab_reasize // (lua_State *L, GCtab *t, int nasize) | // Must not reallocate the stack. | .IOS ldr BASE, L->base | b <1 | |7: // Possible table write barrier for any value. Skip valiswhite check. | barrierback TAB:CARG2, CARG1, CARG3 | b <4 break; /* -- Calls and vararg handling ----------------------------------------- */ case BC_CALLM: | // RA = base*8, (RB = nresults+1,) RC = extra_nargs | ldr CARG1, SAVE_MULTRES | decode_RC8 NARGS8:RC, INS | add NARGS8:RC, NARGS8:RC, CARG1 | b ->BC_CALL_Z break; case BC_CALL: | decode_RC8 NARGS8:RC, INS | // RA = base*8, (RB = nresults+1,) RC = (nargs+1)*8 |->BC_CALL_Z: | mov RB, BASE // Save old BASE for vmeta_call. | ldrd CARG34, [BASE, RA]! | sub NARGS8:RC, NARGS8:RC, #8 | add BASE, BASE, #8 | checkfunc CARG4, ->vmeta_call | ins_call break; case BC_CALLMT: | // RA = base*8, (RB = 0,) RC = extra_nargs | ldr CARG1, SAVE_MULTRES | add NARGS8:RC, CARG1, RC, lsl #3 | b ->BC_CALLT1_Z break; case BC_CALLT: | lsl NARGS8:RC, RC, #3 | // RA = base*8, (RB = 0,) RC = (nargs+1)*8 |->BC_CALLT1_Z: | ldrd LFUNC:CARG34, [RA, BASE]! | sub NARGS8:RC, NARGS8:RC, #8 | add RA, RA, #8 | checkfunc CARG4, ->vmeta_callt | ldr PC, [BASE, FRAME_PC] |->BC_CALLT2_Z: | mov RB, #0 | ldrb CARG4, LFUNC:CARG3->ffid | tst PC, #FRAME_TYPE | bne >7 |1: | str LFUNC:CARG3, [BASE, FRAME_FUNC] // Copy function down, but keep PC. | cmp NARGS8:RC, #0 | beq >3 |2: | ldrd CARG12, [RA, RB] | add INS, RB, #8 | cmp INS, NARGS8:RC | strd CARG12, [BASE, RB] | mov RB, INS | bne <2 |3: | cmp CARG4, #1 // (> FF_C) Calling a fast function? | bhi >5 |4: | ins_callt | |5: // Tailcall to a fast function with a Lua frame below. | ldr INS, [PC, #-4] | decode_RA8 RA, INS | sub CARG1, BASE, RA | ldr LFUNC:CARG1, [CARG1, #-16] | ldr CARG1, LFUNC:CARG1->field_pc | ldr KBASE, [CARG1, #PC2PROTO(k)] | b <4 | |7: // Tailcall from a vararg function. | eor PC, PC, #FRAME_VARG | tst PC, #FRAME_TYPEP // Vararg frame below? | movne CARG4, #0 // Clear ffid if no Lua function below. | bne <1 | sub BASE, BASE, PC | ldr PC, [BASE, FRAME_PC] | tst PC, #FRAME_TYPE | movne CARG4, #0 // Clear ffid if no Lua function below. | b <1 break; case BC_ITERC: | // RA = base*8, (RB = nresults+1, RC = nargs+1 (2+1)) | add RA, BASE, RA | mov RB, BASE // Save old BASE for vmeta_call. | ldrd CARG34, [RA, #-16] | ldrd CARG12, [RA, #-8] | add BASE, RA, #8 | strd CARG34, [RA, #8] // Copy state. | strd CARG12, [RA, #16] // Copy control var. | // STALL: locked CARG34. | ldrd LFUNC:CARG34, [RA, #-24] | mov NARGS8:RC, #16 // Iterators get 2 arguments. | // STALL: load CARG34. | strd LFUNC:CARG34, [RA] // Copy callable. | checkfunc CARG4, ->vmeta_call | ins_call break; case BC_ITERN: | // RA = base*8, (RB = nresults+1, RC = nargs+1 (2+1)) |.if JIT | // NYI: add hotloop, record BC_ITERN. |.endif | add RA, BASE, RA | ldr TAB:RB, [RA, #-16] | ldr CARG1, [RA, #-8] // Get index from control var. | ldr INS, TAB:RB->asize | ldr CARG2, TAB:RB->array | add PC, PC, #4 |1: // Traverse array part. | subs RC, CARG1, INS | add CARG3, CARG2, CARG1, lsl #3 | bhs >5 // Index points after array part? | ldrd CARG34, [CARG3] | checktp CARG4, LJ_TNIL | addeq CARG1, CARG1, #1 // Skip holes in array part. | beq <1 | ldrh RC, [PC, #-2] | mvn CARG2, #~LJ_TISNUM | strd CARG34, [RA, #8] | add RC, PC, RC, lsl #2 | add RB, CARG1, #1 | strd CARG12, [RA] | sub PC, RC, #0x20000 | str RB, [RA, #-8] // Update control var. |3: | ins_next | |5: // Traverse hash part. | ldr CARG4, TAB:RB->hmask | ldr NODE:RB, TAB:RB->node |6: | add CARG1, RC, RC, lsl #1 | cmp RC, CARG4 // End of iteration? Branch to ITERL+1. | add NODE:CARG3, NODE:RB, CARG1, lsl #3 // node = tab->node + idx*3*8 | bhi <3 | ldrd CARG12, NODE:CARG3->val | checktp CARG2, LJ_TNIL | add RC, RC, #1 | beq <6 // Skip holes in hash part. | ldrh RB, [PC, #-2] | add RC, RC, INS | ldrd CARG34, NODE:CARG3->key | str RC, [RA, #-8] // Update control var. | strd CARG12, [RA, #8] | add RC, PC, RB, lsl #2 | sub PC, RC, #0x20000 | strd CARG34, [RA] | b <3 break; case BC_ISNEXT: | // RA = base*8, RC = target (points to ITERN) | add RA, BASE, RA | add RC, PC, RC, lsl #2 | ldrd CFUNC:CARG12, [RA, #-24] | ldr CARG3, [RA, #-12] | ldr CARG4, [RA, #-4] | checktp CARG2, LJ_TFUNC | ldrbeq CARG1, CFUNC:CARG1->ffid | checktpeq CARG3, LJ_TTAB | checktpeq CARG4, LJ_TNIL | cmpeq CARG1, #FF_next_N | subeq PC, RC, #0x20000 | bne >5 | ins_next1 | ins_next2 | mov CARG1, #0 | mvn CARG2, #0x00018000 | strd CARG1, [RA, #-8] // Initialize control var. |1: | ins_next3 |5: // Despecialize bytecode if any of the checks fail. | mov CARG1, #BC_JMP | mov OP, #BC_ITERC | strb CARG1, [PC, #-4] | sub PC, RC, #0x20000 | strb OP, [PC] // Subsumes ins_next1. | ins_next2 | b <1 break; case BC_VARG: | decode_RB8 RB, INS | decode_RC8 RC, INS | // RA = base*8, RB = (nresults+1)*8, RC = numparams*8 | ldr CARG1, [BASE, FRAME_PC] | add RC, BASE, RC | add RA, BASE, RA | add RC, RC, #FRAME_VARG | add CARG4, RA, RB | sub CARG3, BASE, #8 // CARG3 = vtop | sub RC, RC, CARG1 // RC = vbase | // Note: RC may now be even _above_ BASE if nargs was < numparams. | cmp RB, #0 | sub CARG1, CARG3, RC | beq >5 // Copy all varargs? | sub CARG4, CARG4, #16 |1: // Copy vararg slots to destination slots. | cmp RC, CARG3 | ldrdlo CARG12, [RC], #8 | mvnhs CARG2, #~LJ_TNIL | cmp RA, CARG4 | strd CARG12, [RA], #8 | blo <1 |2: | ins_next | |5: // Copy all varargs. | ldr CARG4, L->maxstack | cmp CARG1, #0 | movle RB, #8 // MULTRES = (0+1)*8 | addgt RB, CARG1, #8 | add CARG2, RA, CARG1 | str RB, SAVE_MULTRES | ble <2 | cmp CARG2, CARG4 | bhi >7 |6: | ldrd CARG12, [RC], #8 | strd CARG12, [RA], #8 | cmp RC, CARG3 | blo <6 | b <2 | |7: // Grow stack for varargs. | lsr CARG2, CARG1, #3 | str RA, L->top | mov CARG1, L | str BASE, L->base | sub RC, RC, BASE // Need delta, because BASE may change. | str PC, SAVE_PC | sub RA, RA, BASE | bl extern lj_state_growstack // (lua_State *L, int n) | ldr BASE, L->base | add RA, BASE, RA | add RC, BASE, RC | sub CARG3, BASE, #8 | b <6 break; /* -- Returns ----------------------------------------------------------- */ case BC_RETM: | // RA = results*8, RC = extra results | ldr CARG1, SAVE_MULTRES | ldr PC, [BASE, FRAME_PC] | add RA, BASE, RA | add RC, CARG1, RC, lsl #3 | b ->BC_RETM_Z break; case BC_RET: | // RA = results*8, RC = nresults+1 | ldr PC, [BASE, FRAME_PC] | lsl RC, RC, #3 | add RA, BASE, RA |->BC_RETM_Z: | str RC, SAVE_MULTRES |1: | ands CARG1, PC, #FRAME_TYPE | eor CARG2, PC, #FRAME_VARG | bne ->BC_RETV2_Z | |->BC_RET_Z: | // BASE = base, RA = resultptr, RC = (nresults+1)*8, PC = return | ldr INS, [PC, #-4] | subs CARG4, RC, #8 | sub CARG3, BASE, #8 | beq >3 |2: | ldrd CARG12, [RA], #8 | add BASE, BASE, #8 | subs CARG4, CARG4, #8 | strd CARG12, [BASE, #-16] | bne <2 |3: | decode_RA8 RA, INS | sub CARG4, CARG3, RA | decode_RB8 RB, INS | ldr LFUNC:CARG1, [CARG4, FRAME_FUNC] |5: | cmp RB, RC // More results expected? | bhi >6 | mov BASE, CARG4 | ldr CARG2, LFUNC:CARG1->field_pc | ins_next1 | ins_next2 | ldr KBASE, [CARG2, #PC2PROTO(k)] | ins_next3 | |6: // Fill up results with nil. | mvn CARG2, #~LJ_TNIL | add BASE, BASE, #8 | add RC, RC, #8 | str CARG2, [BASE, #-12] | b <5 | |->BC_RETV1_Z: // Non-standard return case. | add RA, BASE, RA |->BC_RETV2_Z: | tst CARG2, #FRAME_TYPEP | bne ->vm_return | // Return from vararg function: relocate BASE down. | sub BASE, BASE, CARG2 | ldr PC, [BASE, FRAME_PC] | b <1 break; case BC_RET0: case BC_RET1: | // RA = results*8, RC = nresults+1 | ldr PC, [BASE, FRAME_PC] | lsl RC, RC, #3 | str RC, SAVE_MULTRES | ands CARG1, PC, #FRAME_TYPE | eor CARG2, PC, #FRAME_VARG | ldreq INS, [PC, #-4] | bne ->BC_RETV1_Z if (op == BC_RET1) { | ldrd CARG12, [BASE, RA] } | sub CARG4, BASE, #8 | decode_RA8 RA, INS if (op == BC_RET1) { | strd CARG12, [CARG4] } | sub BASE, CARG4, RA | decode_RB8 RB, INS | ldr LFUNC:CARG1, [BASE, FRAME_FUNC] |5: | cmp RB, RC | bhi >6 | ldr CARG2, LFUNC:CARG1->field_pc | ins_next1 | ins_next2 | ldr KBASE, [CARG2, #PC2PROTO(k)] | ins_next3 | |6: // Fill up results with nil. | sub CARG2, CARG4, #4 | mvn CARG3, #~LJ_TNIL | str CARG3, [CARG2, RC] | add RC, RC, #8 | b <5 break; /* -- Loops and branches ------------------------------------------------ */ |.define FOR_IDX, [RA]; .define FOR_TIDX, [RA, #4] |.define FOR_STOP, [RA, #8]; .define FOR_TSTOP, [RA, #12] |.define FOR_STEP, [RA, #16]; .define FOR_TSTEP, [RA, #20] |.define FOR_EXT, [RA, #24]; .define FOR_TEXT, [RA, #28] case BC_FORL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IFORL follows. break; case BC_JFORI: case BC_JFORL: #if !LJ_HASJIT break; #endif case BC_FORI: case BC_IFORL: | // RA = base*8, RC = target (after end of loop or start of loop) vk = (op == BC_IFORL || op == BC_JFORL); | ldrd CARG12, [RA, BASE]! if (op != BC_JFORL) { | add RC, PC, RC, lsl #2 } if (!vk) { | ldrd CARG34, FOR_STOP | checktp CARG2, LJ_TISNUM | ldr RB, FOR_TSTEP | bne >5 | checktp CARG4, LJ_TISNUM | ldr CARG4, FOR_STEP | checktpeq RB, LJ_TISNUM | bne ->vmeta_for | cmp CARG4, #0 | blt >4 | cmp CARG1, CARG3 } else { | ldrd CARG34, FOR_STEP | checktp CARG2, LJ_TISNUM | bne >5 | adds CARG1, CARG1, CARG3 | ldr CARG4, FOR_STOP if (op == BC_IFORL) { | addvs RC, PC, #0x20000 // Overflow: prevent branch. } else { | bvs >2 // Overflow: do not enter mcode. } | cmp CARG3, #0 | blt >4 | cmp CARG1, CARG4 } |1: if (op == BC_FORI) { | subgt PC, RC, #0x20000 } else if (op == BC_JFORI) { | sub PC, RC, #0x20000 | ldrhle RC, [PC, #-2] } else if (op == BC_IFORL) { | suble PC, RC, #0x20000 } if (vk) { | strd CARG12, FOR_IDX } |2: | ins_next1 | ins_next2 | strd CARG12, FOR_EXT if (op == BC_JFORI || op == BC_JFORL) { | ble =>BC_JLOOP } |3: | ins_next3 | |4: // Invert check for negative step. if (!vk) { | cmp CARG3, CARG1 } else { | cmp CARG4, CARG1 } | b <1 | |5: // FP loop. if (!vk) { | cmnlo CARG4, #-LJ_TISNUM | cmnlo RB, #-LJ_TISNUM | bhs ->vmeta_for |.if FPU | vldr d0, FOR_IDX | vldr d1, FOR_STOP | cmp RB, #0 | vstr d0, FOR_EXT |.else | cmp RB, #0 | strd CARG12, FOR_EXT | blt >8 |.endif } else { |.if FPU | vldr d0, FOR_IDX | vldr d2, FOR_STEP | vldr d1, FOR_STOP | cmp CARG4, #0 | vadd.f64 d0, d0, d2 |.else | cmp CARG4, #0 | blt >8 | bl extern __aeabi_dadd | strd CARG12, FOR_IDX | ldrd CARG34, FOR_STOP | strd CARG12, FOR_EXT |.endif } |6: |.if FPU | vcmpge.f64 d0, d1 | vcmplt.f64 d1, d0 | vmrs |.else | bl extern __aeabi_cdcmple |.endif if (vk) { |.if FPU | vstr d0, FOR_IDX | vstr d0, FOR_EXT |.endif } if (op == BC_FORI) { | subhi PC, RC, #0x20000 } else if (op == BC_JFORI) { | sub PC, RC, #0x20000 | ldrhls RC, [PC, #-2] | bls =>BC_JLOOP } else if (op == BC_IFORL) { | subls PC, RC, #0x20000 } else { | bls =>BC_JLOOP } | ins_next1 | ins_next2 | b <3 | |.if not FPU |8: // Invert check for negative step. if (vk) { | bl extern __aeabi_dadd | strd CARG12, FOR_IDX | strd CARG12, FOR_EXT } | mov CARG3, CARG1 | mov CARG4, CARG2 | ldrd CARG12, FOR_STOP | b <6 |.endif break; case BC_ITERL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IITERL follows. break; case BC_JITERL: #if !LJ_HASJIT break; #endif case BC_IITERL: | // RA = base*8, RC = target | ldrd CARG12, [RA, BASE]! if (op == BC_JITERL) { | cmn CARG2, #-LJ_TNIL // Stop if iterator returned nil. | strdne CARG12, [RA, #-8] | bne =>BC_JLOOP } else { | add RC, PC, RC, lsl #2 | // STALL: load CARG12. | cmn CARG2, #-LJ_TNIL // Stop if iterator returned nil. | subne PC, RC, #0x20000 // Otherwise save control var + branch. | strdne CARG12, [RA, #-8] } | ins_next break; case BC_LOOP: | // RA = base*8, RC = target (loop extent) | // Note: RA/RC is only used by trace recorder to determine scope/extent | // This opcode does NOT jump, it's only purpose is to detect a hot loop. |.if JIT | hotloop |.endif | // Fall through. Assumes BC_ILOOP follows. break; case BC_ILOOP: | // RA = base*8, RC = target (loop extent) | ins_next break; case BC_JLOOP: |.if JIT | // RA = base (ignored), RC = traceno | ldr CARG1, [DISPATCH, #DISPATCH_J(trace)] | mov CARG2, #0 // Traces on ARM don't store the trace number, so use 0. | ldr TRACE:RC, [CARG1, RC, lsl #2] | st_vmstate CARG2 | ldr RA, TRACE:RC->mcode | str BASE, [DISPATCH, #DISPATCH_GL(jit_base)] | str L, [DISPATCH, #DISPATCH_GL(jit_L)] | bx RA |.endif break; case BC_JMP: | // RA = base*8 (only used by trace recorder), RC = target | add RC, PC, RC, lsl #2 | sub PC, RC, #0x20000 | ins_next break; /* -- Function headers -------------------------------------------------- */ case BC_FUNCF: |.if JIT | hotcall |.endif case BC_FUNCV: /* NYI: compiled vararg functions. */ | // Fall through. Assumes BC_IFUNCF/BC_IFUNCV follow. break; case BC_JFUNCF: #if !LJ_HASJIT break; #endif case BC_IFUNCF: | // BASE = new base, RA = BASE+framesize*8, CARG3 = LFUNC, RC = nargs*8 | ldr CARG1, L->maxstack | ldrb CARG2, [PC, #-4+PC2PROTO(numparams)] | ldr KBASE, [PC, #-4+PC2PROTO(k)] | cmp RA, CARG1 | bhi ->vm_growstack_l if (op != BC_JFUNCF) { | ins_next1 | ins_next2 } |2: | cmp NARGS8:RC, CARG2, lsl #3 // Check for missing parameters. | mvn CARG4, #~LJ_TNIL | blo >3 if (op == BC_JFUNCF) { | decode_RD RC, INS | b =>BC_JLOOP } else { | ins_next3 } | |3: // Clear missing parameters. | strd CARG34, [BASE, NARGS8:RC] | add NARGS8:RC, NARGS8:RC, #8 | b <2 break; case BC_JFUNCV: #if !LJ_HASJIT break; #endif | NYI // NYI: compiled vararg functions break; /* NYI: compiled vararg functions. */ case BC_IFUNCV: | // BASE = new base, RA = BASE+framesize*8, CARG3 = LFUNC, RC = nargs*8 | ldr CARG1, L->maxstack | add CARG4, BASE, RC | add RA, RA, RC | str LFUNC:CARG3, [CARG4] // Store copy of LFUNC. | add CARG2, RC, #8+FRAME_VARG | ldr KBASE, [PC, #-4+PC2PROTO(k)] | cmp RA, CARG1 | str CARG2, [CARG4, #4] // Store delta + FRAME_VARG. | bhs ->vm_growstack_l | ldrb RB, [PC, #-4+PC2PROTO(numparams)] | mov RA, BASE | mov RC, CARG4 | cmp RB, #0 | add BASE, CARG4, #8 | beq >3 | mvn CARG3, #~LJ_TNIL |1: | cmp RA, RC // Less args than parameters? | ldrdlo CARG12, [RA], #8 | movhs CARG2, CARG3 | strlo CARG3, [RA, #-4] // Clear old fixarg slot (help the GC). |2: | subs RB, RB, #1 | strd CARG12, [CARG4, #8]! | bne <1 |3: | ins_next break; case BC_FUNCC: case BC_FUNCCW: | // BASE = new base, RA = BASE+framesize*8, CARG3 = CFUNC, RC = nargs*8 if (op == BC_FUNCC) { | ldr CARG4, CFUNC:CARG3->f } else { | ldr CARG4, [DISPATCH, #DISPATCH_GL(wrapf)] } | add CARG2, RA, NARGS8:RC | ldr CARG1, L->maxstack | add RC, BASE, NARGS8:RC | str BASE, L->base | cmp CARG2, CARG1 | str RC, L->top if (op == BC_FUNCCW) { | ldr CARG2, CFUNC:CARG3->f } | mv_vmstate CARG3, C | mov CARG1, L | bhi ->vm_growstack_c // Need to grow stack. | st_vmstate CARG3 | blx CARG4 // (lua_State *L [, lua_CFunction f]) | // Returns nresults. | ldr BASE, L->base | mv_vmstate CARG3, INTERP | ldr CRET2, L->top | lsl RC, CRET1, #3 | st_vmstate CARG3 | ldr PC, [BASE, FRAME_PC] | sub RA, CRET2, RC // RA = L->top - nresults*8 | b ->vm_returnc break; /* ---------------------------------------------------------------------- */ default: fprintf(stderr, "Error: undefined opcode BC_%s\n", bc_names[op]); exit(2); break; } } static int build_backend(BuildCtx *ctx) { int op; dasm_growpc(Dst, BC__MAX); build_subroutines(ctx); |.code_op for (op = 0; op < BC__MAX; op++) build_ins(ctx, (BCOp)op, op); return BC__MAX; } /* Emit pseudo frame-info for all assembler functions. */ static void emit_asm_debug(BuildCtx *ctx) { int fcofs = (int)((uint8_t *)ctx->glob[GLOB_vm_ffi_call] - ctx->code); int i; switch (ctx->mode) { case BUILD_elfasm: fprintf(ctx->fp, "\t.section .debug_frame,\"\",%%progbits\n"); fprintf(ctx->fp, ".Lframe0:\n" "\t.long .LECIE0-.LSCIE0\n" ".LSCIE0:\n" "\t.long 0xffffffff\n" "\t.byte 0x1\n" "\t.string \"\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 0xe\n" /* Return address is in lr. */ "\t.byte 0xc\n\t.uleb128 0xd\n\t.uleb128 0\n" /* def_cfa sp */ "\t.align 2\n" ".LECIE0:\n\n"); fprintf(ctx->fp, ".LSFDE0:\n" "\t.long .LEFDE0-.LASFDE0\n" ".LASFDE0:\n" "\t.long .Lframe0\n" "\t.long .Lbegin\n" "\t.long %d\n" "\t.byte 0xe\n\t.uleb128 %d\n" /* def_cfa_offset */ "\t.byte 0x8e\n\t.uleb128 1\n", /* offset lr */ fcofs, CFRAME_SIZE); for (i = 11; i >= (LJ_ARCH_HASFPU ? 5 : 4); i--) /* offset r4-r11 */ fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n", 0x80+i, 2+(11-i)); #if LJ_ARCH_HASFPU for (i = 15; i >= 8; i--) /* offset d8-d15 */ fprintf(ctx->fp, "\t.byte 5\n\t.uleb128 %d, %d\n", 64+2*i, 10+2*(15-i)); fprintf(ctx->fp, "\t.byte 0x84\n\t.uleb128 %d\n", 25); /* offset r4 */ #endif fprintf(ctx->fp, "\t.align 2\n" ".LEFDE0:\n\n"); #if LJ_HASFFI fprintf(ctx->fp, ".LSFDE1:\n" "\t.long .LEFDE1-.LASFDE1\n" ".LASFDE1:\n" "\t.long .Lframe0\n" "\t.long lj_vm_ffi_call\n" "\t.long %d\n" "\t.byte 0xe\n\t.uleb128 16\n" /* def_cfa_offset */ "\t.byte 0x8e\n\t.uleb128 1\n" /* offset lr */ "\t.byte 0x8b\n\t.uleb128 2\n" /* offset r11 */ "\t.byte 0x85\n\t.uleb128 3\n" /* offset r5 */ "\t.byte 0x84\n\t.uleb128 4\n" /* offset r4 */ "\t.byte 0xd\n\t.uleb128 0xb\n" /* def_cfa_register r11 */ "\t.align 2\n" ".LEFDE1:\n\n", (int)ctx->codesz - fcofs); #endif break; default: break; } } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_bc.c0000644000175000017500000000040513122010155016105 0ustar philphil/* ** Bytecode instruction modes. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_bc_c #define LUA_CORE #include "lj_obj.h" #include "lj_bc.h" /* Bytecode offsets and bytecode instruction modes. */ #include "lj_bcdef.h" wcc-0.0.2/src/wsh/luajit-2.0/src/lj_lib.h0000644000175000017500000000703513122010155016302 0ustar philphil/* ** Library function support. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_LIB_H #define _LJ_LIB_H #include "lj_obj.h" /* ** A fallback handler is called by the assembler VM if the fast path fails: ** ** - too few arguments: unrecoverable. ** - wrong argument type: recoverable, if coercion succeeds. ** - bad argument value: unrecoverable. ** - stack overflow: recoverable, if stack reallocation succeeds. ** - extra handling: recoverable. ** ** The unrecoverable cases throw an error with lj_err_arg(), lj_err_argtype(), ** lj_err_caller() or lj_err_callermsg(). ** The recoverable cases return 0 or the number of results + 1. ** The assembler VM retries the fast path only if 0 is returned. ** This time the fallback must not be called again or it gets stuck in a loop. */ /* Return values from fallback handler. */ #define FFH_RETRY 0 #define FFH_UNREACHABLE FFH_RETRY #define FFH_RES(n) ((n)+1) #define FFH_TAILCALL (-1) LJ_FUNC TValue *lj_lib_checkany(lua_State *L, int narg); LJ_FUNC GCstr *lj_lib_checkstr(lua_State *L, int narg); LJ_FUNC GCstr *lj_lib_optstr(lua_State *L, int narg); #if LJ_DUALNUM LJ_FUNC void lj_lib_checknumber(lua_State *L, int narg); #else #define lj_lib_checknumber(L, narg) lj_lib_checknum((L), (narg)) #endif LJ_FUNC lua_Number lj_lib_checknum(lua_State *L, int narg); LJ_FUNC int32_t lj_lib_checkint(lua_State *L, int narg); LJ_FUNC int32_t lj_lib_optint(lua_State *L, int narg, int32_t def); LJ_FUNC int32_t lj_lib_checkbit(lua_State *L, int narg); LJ_FUNC GCfunc *lj_lib_checkfunc(lua_State *L, int narg); LJ_FUNC GCtab *lj_lib_checktab(lua_State *L, int narg); LJ_FUNC GCtab *lj_lib_checktabornil(lua_State *L, int narg); LJ_FUNC int lj_lib_checkopt(lua_State *L, int narg, int def, const char *lst); /* Avoid including lj_frame.h. */ #define lj_lib_upvalue(L, n) \ (&gcref((L->base-1)->fr.func)->fn.c.upvalue[(n)-1]) #if LJ_TARGET_WINDOWS #define lj_lib_checkfpu(L) \ do { setnumV(L->top++, (lua_Number)1437217655); \ if (lua_tointeger(L, -1) != 1437217655) lj_err_caller(L, LJ_ERR_BADFPU); \ L->top--; } while (0) #else #define lj_lib_checkfpu(L) UNUSED(L) #endif /* Push internal function on the stack. */ static LJ_AINLINE void lj_lib_pushcc(lua_State *L, lua_CFunction f, int id, int n) { GCfunc *fn; lua_pushcclosure(L, f, n); fn = funcV(L->top-1); fn->c.ffid = (uint8_t)id; setmref(fn->c.pc, &G(L)->bc_cfunc_int); } #define lj_lib_pushcf(L, fn, id) (lj_lib_pushcc(L, (fn), (id), 0)) /* Library function declarations. Scanned by buildvm. */ #define LJLIB_CF(name) static int lj_cf_##name(lua_State *L) #define LJLIB_ASM(name) static int lj_ffh_##name(lua_State *L) #define LJLIB_ASM_(name) #define LJLIB_SET(name) #define LJLIB_PUSH(arg) #define LJLIB_REC(handler) #define LJLIB_NOREGUV #define LJLIB_NOREG #define LJ_LIB_REG(L, regname, name) \ lj_lib_register(L, regname, lj_lib_init_##name, lj_lib_cf_##name) LJ_FUNC void lj_lib_register(lua_State *L, const char *libname, const uint8_t *init, const lua_CFunction *cf); /* Library init data tags. */ #define LIBINIT_LENMASK 0x3f #define LIBINIT_TAGMASK 0xc0 #define LIBINIT_CF 0x00 #define LIBINIT_ASM 0x40 #define LIBINIT_ASM_ 0x80 #define LIBINIT_STRING 0xc0 #define LIBINIT_MAXSTR 0x39 #define LIBINIT_SET 0xfa #define LIBINIT_NUMBER 0xfb #define LIBINIT_COPY 0xfc #define LIBINIT_LASTCL 0xfd #define LIBINIT_FFID 0xfe #define LIBINIT_END 0xff /* Exported library functions. */ typedef struct RandomState RandomState; LJ_FUNC uint64_t LJ_FASTCALL lj_math_random_step(RandomState *rs); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/vm_ppc.dasc0000644000175000017500000041671113122010155017023 0ustar philphil|// Low-level VM code for PowerPC CPUs. |// Bytecode interpreter, fast functions and helper functions. |// Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h | |.arch ppc |.section code_op, code_sub | |.actionlist build_actionlist |.globals GLOB_ |.globalnames globnames |.externnames extnames | |// Note: The ragged indentation of the instructions is intentional. |// The starting columns indicate data dependencies. | |//----------------------------------------------------------------------- | |// DynASM defines used by the PPC port: |// |// P64 64 bit pointers (only for GPR64 testing). |// Note: a full PPC64 _LP64 port is not planned. |// GPR64 64 bit registers (but possibly 32 bit pointers, e.g. PS3). |// Affects reg saves, stack layout, carry/overflow/dot flags etc. |// FRAME32 Use 32 bit frame layout, even with GPR64 (Xbox 360). |// TOC Need table of contents (64 bit or 32 bit variant, e.g. PS3). |// Function pointers are really a struct: code, TOC, env (optional). |// TOCENV Function pointers have an environment pointer, too (not on PS3). |// PPE Power Processor Element of Cell (PS3) or Xenon (Xbox 360). |// Must avoid (slow) micro-coded instructions. | |.if P64 |.define TOC, 1 |.define TOCENV, 1 |.macro lpx, a, b, c; ldx a, b, c; .endmacro |.macro lp, a, b; ld a, b; .endmacro |.macro stp, a, b; std a, b; .endmacro |.define decode_OPP, decode_OP8 |.if FFI |// Missing: Calling conventions, 64 bit regs, TOC. |.error lib_ffi not yet implemented for PPC64 |.endif |.else |.macro lpx, a, b, c; lwzx a, b, c; .endmacro |.macro lp, a, b; lwz a, b; .endmacro |.macro stp, a, b; stw a, b; .endmacro |.define decode_OPP, decode_OP4 |.endif | |// Convenience macros for TOC handling. |.if TOC |// Linker needs a TOC patch area for every external call relocation. |.macro blex, target; bl extern target@plt; nop; .endmacro |.macro .toc, a, b; a, b; .endmacro |.if P64 |.define TOC_OFS, 8 |.define ENV_OFS, 16 |.else |.define TOC_OFS, 4 |.define ENV_OFS, 8 |.endif |.else // No TOC. |.macro blex, target; bl extern target@plt; .endmacro |.macro .toc, a, b; .endmacro |.endif |.macro .tocenv, a, b; .if TOCENV; a, b; .endif; .endmacro | |.macro .gpr64, a, b; .if GPR64; a, b; .endif; .endmacro | |.macro andix., y, a, i |.if PPE | rlwinm y, a, 0, 31-lj_fls(i), 31-lj_ffs(i) | cmpwi y, 0 |.else | andi. y, a, i |.endif |.endmacro | |.macro clrso, reg |.if PPE | li reg, 0 | mtxer reg |.else | mcrxr cr0 |.endif |.endmacro | |.macro checkov, reg, noov |.if PPE | mfxer reg | add reg, reg, reg | cmpwi reg, 0 | li reg, 0 | mtxer reg | bgey noov |.else | mcrxr cr0 | bley noov |.endif |.endmacro | |//----------------------------------------------------------------------- | |// Fixed register assignments for the interpreter. |// Don't use: r1 = sp, r2 and r13 = reserved (TOC, TLS or SDATA) | |// The following must be C callee-save (but BASE is often refetched). |.define BASE, r14 // Base of current Lua stack frame. |.define KBASE, r15 // Constants of current Lua function. |.define PC, r16 // Next PC. |.define DISPATCH, r17 // Opcode dispatch table. |.define LREG, r18 // Register holding lua_State (also in SAVE_L). |.define MULTRES, r19 // Size of multi-result: (nresults+1)*8. |.define JGL, r31 // On-trace: global_State + 32768. | |// Constants for type-comparisons, stores and conversions. C callee-save. |.define TISNUM, r22 |.define TISNIL, r23 |.define ZERO, r24 |.define TOBIT, f30 // 2^52 + 2^51. |.define TONUM, f31 // 2^52 + 2^51 + 2^31. | |// The following temporaries are not saved across C calls, except for RA. |.define RA, r20 // Callee-save. |.define RB, r10 |.define RC, r11 |.define RD, r12 |.define INS, r7 // Overlaps CARG5. | |.define TMP0, r0 |.define TMP1, r8 |.define TMP2, r9 |.define TMP3, r6 // Overlaps CARG4. | |// Saved temporaries. |.define SAVE0, r21 | |// Calling conventions. |.define CARG1, r3 |.define CARG2, r4 |.define CARG3, r5 |.define CARG4, r6 // Overlaps TMP3. |.define CARG5, r7 // Overlaps INS. | |.define FARG1, f1 |.define FARG2, f2 | |.define CRET1, r3 |.define CRET2, r4 | |.define TOCREG, r2 // TOC register (only used by C code). |.define ENVREG, r11 // Environment pointer (nested C functions). | |// Stack layout while in interpreter. Must match with lj_frame.h. |.if GPR64 |.if FRAME32 | |// 456(sp) // \ 32/64 bit C frame info |.define TONUM_LO, 452(sp) // | |.define TONUM_HI, 448(sp) // | |.define TMPD_LO, 444(sp) // | |.define TMPD_HI, 440(sp) // | |.define SAVE_CR, 432(sp) // | 64 bit CR save. |.define SAVE_ERRF, 424(sp) // > Parameter save area. |.define SAVE_NRES, 420(sp) // | |.define SAVE_L, 416(sp) // | |.define SAVE_PC, 412(sp) // | |.define SAVE_MULTRES, 408(sp) // | |.define SAVE_CFRAME, 400(sp) // / 64 bit C frame chain. |// 392(sp) // Reserved. |.define CFRAME_SPACE, 384 // Delta for sp. |// Back chain for sp: 384(sp) <-- sp entering interpreter |.define SAVE_LR, 376(sp) // 32 bit LR stored in hi-part. |.define SAVE_GPR_, 232 // .. 232+18*8: 64 bit GPR saves. |.define SAVE_FPR_, 88 // .. 88+18*8: 64 bit FPR saves. |// 80(sp) // Needed for 16 byte stack frame alignment. |// 16(sp) // Callee parameter save area (ABI mandated). |// 8(sp) // Reserved |// Back chain for sp: 0(sp) <-- sp while in interpreter |// 32 bit sp stored in hi-part of 0(sp). | |.define TMPD_BLO, 447(sp) |.define TMPD, TMPD_HI |.define TONUM_D, TONUM_HI | |.else | |// 508(sp) // \ 32 bit C frame info. |.define SAVE_ERRF, 472(sp) // | |.define SAVE_NRES, 468(sp) // | |.define SAVE_L, 464(sp) // > Parameter save area. |.define SAVE_PC, 460(sp) // | |.define SAVE_MULTRES, 456(sp) // | |.define SAVE_CFRAME, 448(sp) // / 64 bit C frame chain. |.define SAVE_LR, 416(sp) |.define CFRAME_SPACE, 400 // Delta for sp. |// Back chain for sp: 400(sp) <-- sp entering interpreter |.define SAVE_FPR_, 256 // .. 256+18*8: 64 bit FPR saves. |.define SAVE_GPR_, 112 // .. 112+18*8: 64 bit GPR saves. |// 48(sp) // Callee parameter save area (ABI mandated). |.define SAVE_TOC, 40(sp) // TOC save area. |.define TMPD_LO, 36(sp) // \ Link editor temp (ABI mandated). |.define TMPD_HI, 32(sp) // / |.define TONUM_LO, 28(sp) // \ Compiler temp (ABI mandated). |.define TONUM_HI, 24(sp) // / |// Next frame lr: 16(sp) |.define SAVE_CR, 8(sp) // 64 bit CR save. |// Back chain for sp: 0(sp) <-- sp while in interpreter | |.define TMPD_BLO, 39(sp) |.define TMPD, TMPD_HI |.define TONUM_D, TONUM_HI | |.endif |.else | |.define SAVE_LR, 276(sp) |.define CFRAME_SPACE, 272 // Delta for sp. |// Back chain for sp: 272(sp) <-- sp entering interpreter |.define SAVE_FPR_, 128 // .. 128+18*8: 64 bit FPR saves. |.define SAVE_GPR_, 56 // .. 56+18*4: 32 bit GPR saves. |.define SAVE_CR, 52(sp) // 32 bit CR save. |.define SAVE_ERRF, 48(sp) // 32 bit C frame info. |.define SAVE_NRES, 44(sp) |.define SAVE_CFRAME, 40(sp) |.define SAVE_L, 36(sp) |.define SAVE_PC, 32(sp) |.define SAVE_MULTRES, 28(sp) |.define UNUSED1, 24(sp) |.define TMPD_LO, 20(sp) |.define TMPD_HI, 16(sp) |.define TONUM_LO, 12(sp) |.define TONUM_HI, 8(sp) |// Next frame lr: 4(sp) |// Back chain for sp: 0(sp) <-- sp while in interpreter | |.define TMPD_BLO, 23(sp) |.define TMPD, TMPD_HI |.define TONUM_D, TONUM_HI | |.endif | |.macro save_, reg |.if GPR64 | std r..reg, SAVE_GPR_+(reg-14)*8(sp) |.else | stw r..reg, SAVE_GPR_+(reg-14)*4(sp) |.endif | stfd f..reg, SAVE_FPR_+(reg-14)*8(sp) |.endmacro |.macro rest_, reg |.if GPR64 | ld r..reg, SAVE_GPR_+(reg-14)*8(sp) |.else | lwz r..reg, SAVE_GPR_+(reg-14)*4(sp) |.endif | lfd f..reg, SAVE_FPR_+(reg-14)*8(sp) |.endmacro | |.macro saveregs |.if GPR64 and not FRAME32 | stdu sp, -CFRAME_SPACE(sp) |.else | stwu sp, -CFRAME_SPACE(sp) |.endif | save_ 14; save_ 15; save_ 16 | mflr r0 | save_ 17; save_ 18; save_ 19; save_ 20; save_ 21; save_ 22 |.if GPR64 and not FRAME32 | std r0, SAVE_LR |.else | stw r0, SAVE_LR |.endif | save_ 23; save_ 24; save_ 25 | mfcr r0 | save_ 26; save_ 27; save_ 28; save_ 29; save_ 30; save_ 31 |.if GPR64 | std r0, SAVE_CR |.else | stw r0, SAVE_CR |.endif | .toc std TOCREG, SAVE_TOC |.endmacro | |.macro restoreregs |.if GPR64 and not FRAME32 | ld r0, SAVE_LR |.else | lwz r0, SAVE_LR |.endif |.if GPR64 | ld r12, SAVE_CR |.else | lwz r12, SAVE_CR |.endif | rest_ 14; rest_ 15; rest_ 16; rest_ 17; rest_ 18; rest_ 19 | mtlr r0; |.if PPE; mtocrf 0x20, r12; .else; mtcrf 0x38, r12; .endif | rest_ 20; rest_ 21; rest_ 22; rest_ 23; rest_ 24; rest_ 25 |.if PPE; mtocrf 0x10, r12; .endif | rest_ 26; rest_ 27; rest_ 28; rest_ 29; rest_ 30; rest_ 31 |.if PPE; mtocrf 0x08, r12; .endif | addi sp, sp, CFRAME_SPACE |.endmacro | |// Type definitions. Some of these are only used for documentation. |.type L, lua_State, LREG |.type GL, global_State |.type TVALUE, TValue |.type GCOBJ, GCobj |.type STR, GCstr |.type TAB, GCtab |.type LFUNC, GCfuncL |.type CFUNC, GCfuncC |.type PROTO, GCproto |.type UPVAL, GCupval |.type NODE, Node |.type NARGS8, int |.type TRACE, GCtrace | |//----------------------------------------------------------------------- | |// These basic macros should really be part of DynASM. |.macro srwi, rx, ry, n; rlwinm rx, ry, 32-n, n, 31; .endmacro |.macro slwi, rx, ry, n; rlwinm rx, ry, n, 0, 31-n; .endmacro |.macro rotlwi, rx, ry, n; rlwinm rx, ry, n, 0, 31; .endmacro |.macro rotlw, rx, ry, rn; rlwnm rx, ry, rn, 0, 31; .endmacro |.macro subi, rx, ry, i; addi rx, ry, -i; .endmacro | |// Trap for not-yet-implemented parts. |.macro NYI; tw 4, sp, sp; .endmacro | |// int/FP conversions. |.macro tonum_i, freg, reg | xoris reg, reg, 0x8000 | stw reg, TONUM_LO | lfd freg, TONUM_D | fsub freg, freg, TONUM |.endmacro | |.macro tonum_u, freg, reg | stw reg, TONUM_LO | lfd freg, TONUM_D | fsub freg, freg, TOBIT |.endmacro | |.macro toint, reg, freg, tmpfreg | fctiwz tmpfreg, freg | stfd tmpfreg, TMPD | lwz reg, TMPD_LO |.endmacro | |.macro toint, reg, freg | toint reg, freg, freg |.endmacro | |//----------------------------------------------------------------------- | |// Access to frame relative to BASE. |.define FRAME_PC, -8 |.define FRAME_FUNC, -4 | |// Instruction decode. |.macro decode_OP4, dst, ins; rlwinm dst, ins, 2, 22, 29; .endmacro |.macro decode_OP8, dst, ins; rlwinm dst, ins, 3, 21, 28; .endmacro |.macro decode_RA8, dst, ins; rlwinm dst, ins, 27, 21, 28; .endmacro |.macro decode_RB8, dst, ins; rlwinm dst, ins, 11, 21, 28; .endmacro |.macro decode_RC8, dst, ins; rlwinm dst, ins, 19, 21, 28; .endmacro |.macro decode_RD8, dst, ins; rlwinm dst, ins, 19, 13, 28; .endmacro | |.macro decode_OP1, dst, ins; rlwinm dst, ins, 0, 24, 31; .endmacro |.macro decode_RD4, dst, ins; rlwinm dst, ins, 18, 14, 29; .endmacro | |// Instruction fetch. |.macro ins_NEXT1 | lwz INS, 0(PC) | addi PC, PC, 4 |.endmacro |// Instruction decode+dispatch. Note: optimized for e300! |.macro ins_NEXT2 | decode_OPP TMP1, INS | lpx TMP0, DISPATCH, TMP1 | mtctr TMP0 | decode_RB8 RB, INS | decode_RD8 RD, INS | decode_RA8 RA, INS | decode_RC8 RC, INS | bctr |.endmacro |.macro ins_NEXT | ins_NEXT1 | ins_NEXT2 |.endmacro | |// Instruction footer. |.if 1 | // Replicated dispatch. Less unpredictable branches, but higher I-Cache use. | .define ins_next, ins_NEXT | .define ins_next_, ins_NEXT | .define ins_next1, ins_NEXT1 | .define ins_next2, ins_NEXT2 |.else | // Common dispatch. Lower I-Cache use, only one (very) unpredictable branch. | // Affects only certain kinds of benchmarks (and only with -j off). | .macro ins_next | b ->ins_next | .endmacro | .macro ins_next1 | .endmacro | .macro ins_next2 | b ->ins_next | .endmacro | .macro ins_next_ | ->ins_next: | ins_NEXT | .endmacro |.endif | |// Call decode and dispatch. |.macro ins_callt | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | lwz PC, LFUNC:RB->pc | lwz INS, 0(PC) | addi PC, PC, 4 | decode_OPP TMP1, INS | decode_RA8 RA, INS | lpx TMP0, DISPATCH, TMP1 | add RA, RA, BASE | mtctr TMP0 | bctr |.endmacro | |.macro ins_call | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, PC = caller PC | stw PC, FRAME_PC(BASE) | ins_callt |.endmacro | |//----------------------------------------------------------------------- | |// Macros to test operand types. |.macro checknum, reg; cmplw reg, TISNUM; .endmacro |.macro checknum, cr, reg; cmplw cr, reg, TISNUM; .endmacro |.macro checkstr, reg; cmpwi reg, LJ_TSTR; .endmacro |.macro checktab, reg; cmpwi reg, LJ_TTAB; .endmacro |.macro checkfunc, reg; cmpwi reg, LJ_TFUNC; .endmacro |.macro checknil, reg; cmpwi reg, LJ_TNIL; .endmacro | |.macro branch_RD | srwi TMP0, RD, 1 | addis PC, PC, -(BCBIAS_J*4 >> 16) | add PC, PC, TMP0 |.endmacro | |// Assumes DISPATCH is relative to GL. #define DISPATCH_GL(field) (GG_DISP2G + (int)offsetof(global_State, field)) #define DISPATCH_J(field) (GG_DISP2J + (int)offsetof(jit_State, field)) | #define PC2PROTO(field) ((int)offsetof(GCproto, field)-(int)sizeof(GCproto)) | |.macro hotcheck, delta, target | rlwinm TMP1, PC, 31, 25, 30 | addi TMP1, TMP1, GG_DISP2HOT | lhzx TMP2, DISPATCH, TMP1 | addic. TMP2, TMP2, -delta | sthx TMP2, DISPATCH, TMP1 | blt target |.endmacro | |.macro hotloop | hotcheck HOTCOUNT_LOOP, ->vm_hotloop |.endmacro | |.macro hotcall | hotcheck HOTCOUNT_CALL, ->vm_hotcall |.endmacro | |// Set current VM state. Uses TMP0. |.macro li_vmstate, st; li TMP0, ~LJ_VMST_..st; .endmacro |.macro st_vmstate; stw TMP0, DISPATCH_GL(vmstate)(DISPATCH); .endmacro | |// Move table write barrier back. Overwrites mark and tmp. |.macro barrierback, tab, mark, tmp | lwz tmp, DISPATCH_GL(gc.grayagain)(DISPATCH) | // Assumes LJ_GC_BLACK is 0x04. | rlwinm mark, mark, 0, 30, 28 // black2gray(tab) | stw tab, DISPATCH_GL(gc.grayagain)(DISPATCH) | stb mark, tab->marked | stw tmp, tab->gclist |.endmacro | |//----------------------------------------------------------------------- /* Generate subroutines used by opcodes and other parts of the VM. */ /* The .code_sub section should be last to help static branch prediction. */ static void build_subroutines(BuildCtx *ctx) { |.code_sub | |//----------------------------------------------------------------------- |//-- Return handling ---------------------------------------------------- |//----------------------------------------------------------------------- | |->vm_returnp: | // See vm_return. Also: TMP2 = previous base. | andix. TMP0, PC, FRAME_P | li TMP1, LJ_TTRUE | beq ->cont_dispatch | | // Return from pcall or xpcall fast func. | lwz PC, FRAME_PC(TMP2) // Fetch PC of previous frame. | mr BASE, TMP2 // Restore caller base. | // Prepending may overwrite the pcall frame, so do it at the end. | stwu TMP1, FRAME_PC(RA) // Prepend true to results. | |->vm_returnc: | addi RD, RD, 8 // RD = (nresults+1)*8. | andix. TMP0, PC, FRAME_TYPE | cmpwi cr1, RD, 0 | li CRET1, LUA_YIELD | beq cr1, ->vm_unwind_c_eh | mr MULTRES, RD | beq ->BC_RET_Z // Handle regular return to Lua. | |->vm_return: | // BASE = base, RA = resultptr, RD/MULTRES = (nresults+1)*8, PC = return | // TMP0 = PC & FRAME_TYPE | cmpwi TMP0, FRAME_C | rlwinm TMP2, PC, 0, 0, 28 | li_vmstate C | sub TMP2, BASE, TMP2 // TMP2 = previous base. | bney ->vm_returnp | | addic. TMP1, RD, -8 | stp TMP2, L->base | lwz TMP2, SAVE_NRES | subi BASE, BASE, 8 | st_vmstate | slwi TMP2, TMP2, 3 | beq >2 |1: | addic. TMP1, TMP1, -8 | lfd f0, 0(RA) | addi RA, RA, 8 | stfd f0, 0(BASE) | addi BASE, BASE, 8 | bney <1 | |2: | cmpw TMP2, RD // More/less results wanted? | bne >6 |3: | stp BASE, L->top // Store new top. | |->vm_leave_cp: | lp TMP0, SAVE_CFRAME // Restore previous C frame. | li CRET1, 0 // Ok return status for vm_pcall. | stp TMP0, L->cframe | |->vm_leave_unw: | restoreregs | blr | |6: | ble >7 // Less results wanted? | // More results wanted. Check stack size and fill up results with nil. | lwz TMP1, L->maxstack | cmplw BASE, TMP1 | bge >8 | stw TISNIL, 0(BASE) | addi RD, RD, 8 | addi BASE, BASE, 8 | b <2 | |7: // Less results wanted. | subfic TMP3, TMP2, 0 // LUA_MULTRET+1 case? | sub TMP0, RD, TMP2 | subfe TMP1, TMP1, TMP1 // TMP1 = TMP2 == 0 ? 0 : -1 | and TMP0, TMP0, TMP1 | sub BASE, BASE, TMP0 // Either keep top or shrink it. | b <3 | |8: // Corner case: need to grow stack for filling up results. | // This can happen if: | // - A C function grows the stack (a lot). | // - The GC shrinks the stack in between. | // - A return back from a lua_call() with (high) nresults adjustment. | stp BASE, L->top // Save current top held in BASE (yes). | mr SAVE0, RD | srwi CARG2, TMP2, 3 | mr CARG1, L | bl extern lj_state_growstack // (lua_State *L, int n) | lwz TMP2, SAVE_NRES | mr RD, SAVE0 | slwi TMP2, TMP2, 3 | lp BASE, L->top // Need the (realloced) L->top in BASE. | b <2 | |->vm_unwind_c: // Unwind C stack, return from vm_pcall. | // (void *cframe, int errcode) | mr sp, CARG1 | mr CRET1, CARG2 |->vm_unwind_c_eh: // Landing pad for external unwinder. | lwz L, SAVE_L | .toc ld TOCREG, SAVE_TOC | li TMP0, ~LJ_VMST_C | lwz GL:TMP1, L->glref | stw TMP0, GL:TMP1->vmstate | b ->vm_leave_unw | |->vm_unwind_ff: // Unwind C stack, return from ff pcall. | // (void *cframe) |.if GPR64 | rldicr sp, CARG1, 0, 61 |.else | rlwinm sp, CARG1, 0, 0, 29 |.endif |->vm_unwind_ff_eh: // Landing pad for external unwinder. | lwz L, SAVE_L | .toc ld TOCREG, SAVE_TOC | li TISNUM, LJ_TISNUM // Setup type comparison constants. | lp BASE, L->base | lus TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | li ZERO, 0 | stw TMP3, TMPD | li TMP1, LJ_TFALSE | ori TMP3, TMP3, 0x0004 // TONUM = 2^52 + 2^51 + 2^31 (float). | li TISNIL, LJ_TNIL | li_vmstate INTERP | lfs TOBIT, TMPD | lwz PC, FRAME_PC(BASE) // Fetch PC of previous frame. | la RA, -8(BASE) // Results start at BASE-8. | stw TMP3, TMPD | addi DISPATCH, DISPATCH, GG_G2DISP | stw TMP1, 0(RA) // Prepend false to error message. | li RD, 16 // 2 results: false + error message. | st_vmstate | lfs TONUM, TMPD | b ->vm_returnc | |//----------------------------------------------------------------------- |//-- Grow stack for calls ----------------------------------------------- |//----------------------------------------------------------------------- | |->vm_growstack_c: // Grow stack for C function. | li CARG2, LUA_MINSTACK | b >2 | |->vm_growstack_l: // Grow stack for Lua function. | // BASE = new base, RA = BASE+framesize*8, RC = nargs*8, PC = first PC | add RC, BASE, RC | sub RA, RA, BASE | stp BASE, L->base | addi PC, PC, 4 // Must point after first instruction. | stp RC, L->top | srwi CARG2, RA, 3 |2: | // L->base = new base, L->top = top | stw PC, SAVE_PC | mr CARG1, L | bl extern lj_state_growstack // (lua_State *L, int n) | lp BASE, L->base | lp RC, L->top | lwz LFUNC:RB, FRAME_FUNC(BASE) | sub RC, RC, BASE | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | ins_callt // Just retry the call. | |//----------------------------------------------------------------------- |//-- Entry points into the assembler VM --------------------------------- |//----------------------------------------------------------------------- | |->vm_resume: // Setup C frame and resume thread. | // (lua_State *L, TValue *base, int nres1 = 0, ptrdiff_t ef = 0) | saveregs | mr L, CARG1 | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | mr BASE, CARG2 | lbz TMP1, L->status | stw L, SAVE_L | li PC, FRAME_CP | addi TMP0, sp, CFRAME_RESUME | addi DISPATCH, DISPATCH, GG_G2DISP | stw CARG3, SAVE_NRES | cmplwi TMP1, 0 | stw CARG3, SAVE_ERRF | stp TMP0, L->cframe | stp CARG3, SAVE_CFRAME | stw CARG1, SAVE_PC // Any value outside of bytecode is ok. | beq >3 | | // Resume after yield (like a return). | mr RA, BASE | lp BASE, L->base | li TISNUM, LJ_TISNUM // Setup type comparison constants. | lp TMP1, L->top | lwz PC, FRAME_PC(BASE) | lus TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | stb CARG3, L->status | stw TMP3, TMPD | ori TMP3, TMP3, 0x0004 // TONUM = 2^52 + 2^51 + 2^31 (float). | lfs TOBIT, TMPD | sub RD, TMP1, BASE | stw TMP3, TMPD | lus TMP0, 0x4338 // Hiword of 2^52 + 2^51 (double) | addi RD, RD, 8 | stw TMP0, TONUM_HI | li_vmstate INTERP | li ZERO, 0 | st_vmstate | andix. TMP0, PC, FRAME_TYPE | mr MULTRES, RD | lfs TONUM, TMPD | li TISNIL, LJ_TNIL | beq ->BC_RET_Z | b ->vm_return | |->vm_pcall: // Setup protected C frame and enter VM. | // (lua_State *L, TValue *base, int nres1, ptrdiff_t ef) | saveregs | li PC, FRAME_CP | stw CARG4, SAVE_ERRF | b >1 | |->vm_call: // Setup C frame and enter VM. | // (lua_State *L, TValue *base, int nres1) | saveregs | li PC, FRAME_C | |1: // Entry point for vm_pcall above (PC = ftype). | lp TMP1, L:CARG1->cframe | stw CARG3, SAVE_NRES | mr L, CARG1 | stw CARG1, SAVE_L | mr BASE, CARG2 | stp sp, L->cframe // Add our C frame to cframe chain. | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | stw CARG1, SAVE_PC // Any value outside of bytecode is ok. | stp TMP1, SAVE_CFRAME | addi DISPATCH, DISPATCH, GG_G2DISP | |3: // Entry point for vm_cpcall/vm_resume (BASE = base, PC = ftype). | lp TMP2, L->base // TMP2 = old base (used in vmeta_call). | li TISNUM, LJ_TISNUM // Setup type comparison constants. | lp TMP1, L->top | lus TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | add PC, PC, BASE | stw TMP3, TMPD | li ZERO, 0 | ori TMP3, TMP3, 0x0004 // TONUM = 2^52 + 2^51 + 2^31 (float). | lfs TOBIT, TMPD | sub PC, PC, TMP2 // PC = frame delta + frame type | stw TMP3, TMPD | lus TMP0, 0x4338 // Hiword of 2^52 + 2^51 (double) | sub NARGS8:RC, TMP1, BASE | stw TMP0, TONUM_HI | li_vmstate INTERP | lfs TONUM, TMPD | li TISNIL, LJ_TNIL | st_vmstate | |->vm_call_dispatch: | // TMP2 = old base, BASE = new base, RC = nargs*8, PC = caller PC | lwz TMP0, FRAME_PC(BASE) | lwz LFUNC:RB, FRAME_FUNC(BASE) | checkfunc TMP0; bne ->vmeta_call | |->vm_call_dispatch_f: | ins_call | // BASE = new base, RB = func, RC = nargs*8, PC = caller PC | |->vm_cpcall: // Setup protected C frame, call C. | // (lua_State *L, lua_CFunction func, void *ud, lua_CPFunction cp) | saveregs | mr L, CARG1 | lwz TMP0, L:CARG1->stack | stw CARG1, SAVE_L | lp TMP1, L->top | stw CARG1, SAVE_PC // Any value outside of bytecode is ok. | sub TMP0, TMP0, TMP1 // Compute -savestack(L, L->top). | lp TMP1, L->cframe | stp sp, L->cframe // Add our C frame to cframe chain. | .toc lp CARG4, 0(CARG4) | li TMP2, 0 | stw TMP0, SAVE_NRES // Neg. delta means cframe w/o frame. | stw TMP2, SAVE_ERRF // No error function. | stp TMP1, SAVE_CFRAME | mtctr CARG4 | bctrl // (lua_State *L, lua_CFunction func, void *ud) |.if PPE | mr BASE, CRET1 | cmpwi CRET1, 0 |.else | mr. BASE, CRET1 |.endif | lwz DISPATCH, L->glref // Setup pointer to dispatch table. | li PC, FRAME_CP | addi DISPATCH, DISPATCH, GG_G2DISP | bne <3 // Else continue with the call. | b ->vm_leave_cp // No base? Just remove C frame. | |//----------------------------------------------------------------------- |//-- Metamethod handling ------------------------------------------------ |//----------------------------------------------------------------------- | |// The lj_meta_* functions (except for lj_meta_cat) don't reallocate the |// stack, so BASE doesn't need to be reloaded across these calls. | |//-- Continuation dispatch ---------------------------------------------- | |->cont_dispatch: | // BASE = meta base, RA = resultptr, RD = (nresults+1)*8 | lwz TMP0, -12(BASE) // Continuation. | mr RB, BASE | mr BASE, TMP2 // Restore caller BASE. | lwz LFUNC:TMP1, FRAME_FUNC(TMP2) |.if FFI | cmplwi TMP0, 1 |.endif | lwz PC, -16(RB) // Restore PC from [cont|PC]. | subi TMP2, RD, 8 | lwz TMP1, LFUNC:TMP1->pc | stwx TISNIL, RA, TMP2 // Ensure one valid arg. |.if FFI | ble >1 |.endif | lwz KBASE, PC2PROTO(k)(TMP1) | // BASE = base, RA = resultptr, RB = meta base | mtctr TMP0 | bctr // Jump to continuation. | |.if FFI |1: | beq ->cont_ffi_callback // cont = 1: return from FFI callback. | // cont = 0: tailcall from C function. | subi TMP1, RB, 16 | sub RC, TMP1, BASE | b ->vm_call_tail |.endif | |->cont_cat: // RA = resultptr, RB = meta base | lwz INS, -4(PC) | subi CARG2, RB, 16 | decode_RB8 SAVE0, INS | lfd f0, 0(RA) | add TMP1, BASE, SAVE0 | stp BASE, L->base | cmplw TMP1, CARG2 | sub CARG3, CARG2, TMP1 | decode_RA8 RA, INS | stfd f0, 0(CARG2) | bney ->BC_CAT_Z | stfdx f0, BASE, RA | b ->cont_nop | |//-- Table indexing metamethods ----------------------------------------- | |->vmeta_tgets1: | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | li TMP0, LJ_TSTR | decode_RB8 RB, INS | stw STR:RC, 4(CARG3) | add CARG2, BASE, RB | stw TMP0, 0(CARG3) | b >1 | |->vmeta_tgets: | la CARG2, DISPATCH_GL(tmptv)(DISPATCH) | li TMP0, LJ_TTAB | stw TAB:RB, 4(CARG2) | la CARG3, DISPATCH_GL(tmptv2)(DISPATCH) | stw TMP0, 0(CARG2) | li TMP1, LJ_TSTR | stw STR:RC, 4(CARG3) | stw TMP1, 0(CARG3) | b >1 | |->vmeta_tgetb: // TMP0 = index |.if not DUALNUM | tonum_u f0, TMP0 |.endif | decode_RB8 RB, INS | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | add CARG2, BASE, RB |.if DUALNUM | stw TISNUM, 0(CARG3) | stw TMP0, 4(CARG3) |.else | stfd f0, 0(CARG3) |.endif | b >1 | |->vmeta_tgetv: | decode_RB8 RB, INS | decode_RC8 RC, INS | add CARG2, BASE, RB | add CARG3, BASE, RC |1: | stp BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_tget // (lua_State *L, TValue *o, TValue *k) | // Returns TValue * (finished) or NULL (metamethod). | cmplwi CRET1, 0 | beq >3 | lfd f0, 0(CRET1) | ins_next1 | stfdx f0, BASE, RA | ins_next2 | |3: // Call __index metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k | subfic TMP1, BASE, FRAME_CONT | lp BASE, L->top | stw PC, -16(BASE) // [cont|PC] | add PC, TMP1, BASE | lwz LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | li NARGS8:RC, 16 // 2 args for func(t, k). | b ->vm_call_dispatch_f | |//----------------------------------------------------------------------- | |->vmeta_tsets1: | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | li TMP0, LJ_TSTR | decode_RB8 RB, INS | stw STR:RC, 4(CARG3) | add CARG2, BASE, RB | stw TMP0, 0(CARG3) | b >1 | |->vmeta_tsets: | la CARG2, DISPATCH_GL(tmptv)(DISPATCH) | li TMP0, LJ_TTAB | stw TAB:RB, 4(CARG2) | la CARG3, DISPATCH_GL(tmptv2)(DISPATCH) | stw TMP0, 0(CARG2) | li TMP1, LJ_TSTR | stw STR:RC, 4(CARG3) | stw TMP1, 0(CARG3) | b >1 | |->vmeta_tsetb: // TMP0 = index |.if not DUALNUM | tonum_u f0, TMP0 |.endif | decode_RB8 RB, INS | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | add CARG2, BASE, RB |.if DUALNUM | stw TISNUM, 0(CARG3) | stw TMP0, 4(CARG3) |.else | stfd f0, 0(CARG3) |.endif | b >1 | |->vmeta_tsetv: | decode_RB8 RB, INS | decode_RC8 RC, INS | add CARG2, BASE, RB | add CARG3, BASE, RC |1: | stp BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_tset // (lua_State *L, TValue *o, TValue *k) | // Returns TValue * (finished) or NULL (metamethod). | cmplwi CRET1, 0 | lfdx f0, BASE, RA | beq >3 | // NOBARRIER: lj_meta_tset ensures the table is not black. | ins_next1 | stfd f0, 0(CRET1) | ins_next2 | |3: // Call __newindex metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k/(v) | subfic TMP1, BASE, FRAME_CONT | lp BASE, L->top | stw PC, -16(BASE) // [cont|PC] | add PC, TMP1, BASE | lwz LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | li NARGS8:RC, 24 // 3 args for func(t, k, v) | stfd f0, 16(BASE) // Copy value to third argument. | b ->vm_call_dispatch_f | |//-- Comparison metamethods --------------------------------------------- | |->vmeta_comp: | mr CARG1, L | subi PC, PC, 4 |.if DUALNUM | mr CARG2, RA |.else | add CARG2, BASE, RA |.endif | stw PC, SAVE_PC |.if DUALNUM | mr CARG3, RD |.else | add CARG3, BASE, RD |.endif | stp BASE, L->base | decode_OP1 CARG4, INS | bl extern lj_meta_comp // (lua_State *L, TValue *o1, *o2, int op) | // Returns 0/1 or TValue * (metamethod). |3: | cmplwi CRET1, 1 | bgt ->vmeta_binop | subfic CRET1, CRET1, 0 |4: | lwz INS, 0(PC) | addi PC, PC, 4 | decode_RD4 TMP2, INS | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) | and TMP2, TMP2, CRET1 | add PC, PC, TMP2 |->cont_nop: | ins_next | |->cont_ra: // RA = resultptr | lwz INS, -4(PC) | lfd f0, 0(RA) | decode_RA8 TMP1, INS | stfdx f0, BASE, TMP1 | b ->cont_nop | |->cont_condt: // RA = resultptr | lwz TMP0, 0(RA) | .gpr64 extsw TMP0, TMP0 | subfic TMP0, TMP0, LJ_TTRUE // Branch if result is true. | subfe CRET1, CRET1, CRET1 | not CRET1, CRET1 | b <4 | |->cont_condf: // RA = resultptr | lwz TMP0, 0(RA) | .gpr64 extsw TMP0, TMP0 | subfic TMP0, TMP0, LJ_TTRUE // Branch if result is false. | subfe CRET1, CRET1, CRET1 | b <4 | |->vmeta_equal: | // CARG2, CARG3, CARG4 are already set by BC_ISEQV/BC_ISNEV. | subi PC, PC, 4 | stp BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_equal // (lua_State *L, GCobj *o1, *o2, int ne) | // Returns 0/1 or TValue * (metamethod). | b <3 | |->vmeta_equal_cd: |.if FFI | mr CARG2, INS | subi PC, PC, 4 | stp BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_equal_cd // (lua_State *L, BCIns op) | // Returns 0/1 or TValue * (metamethod). | b <3 |.endif | |//-- Arithmetic metamethods --------------------------------------------- | |->vmeta_arith_nv: | add CARG3, KBASE, RC | add CARG4, BASE, RB | b >1 |->vmeta_arith_nv2: |.if DUALNUM | mr CARG3, RC | mr CARG4, RB | b >1 |.endif | |->vmeta_unm: | mr CARG3, RD | mr CARG4, RD | b >1 | |->vmeta_arith_vn: | add CARG3, BASE, RB | add CARG4, KBASE, RC | b >1 | |->vmeta_arith_vv: | add CARG3, BASE, RB | add CARG4, BASE, RC |.if DUALNUM | b >1 |.endif |->vmeta_arith_vn2: |->vmeta_arith_vv2: |.if DUALNUM | mr CARG3, RB | mr CARG4, RC |.endif |1: | add CARG2, BASE, RA | stp BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | decode_OP1 CARG5, INS // Caveat: CARG5 overlaps INS. | bl extern lj_meta_arith // (lua_State *L, TValue *ra,*rb,*rc, BCReg op) | // Returns NULL (finished) or TValue * (metamethod). | cmplwi CRET1, 0 | beq ->cont_nop | | // Call metamethod for binary op. |->vmeta_binop: | // BASE = old base, CRET1 = new base, stack = cont/func/o1/o2 | sub TMP1, CRET1, BASE | stw PC, -16(CRET1) // [cont|PC] | mr TMP2, BASE | addi PC, TMP1, FRAME_CONT | mr BASE, CRET1 | li NARGS8:RC, 16 // 2 args for func(o1, o2). | b ->vm_call_dispatch | |->vmeta_len: #if LJ_52 | mr SAVE0, CARG1 #endif | mr CARG2, RD | stp BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | bl extern lj_meta_len // (lua_State *L, TValue *o) | // Returns NULL (retry) or TValue * (metamethod base). #if LJ_52 | cmplwi CRET1, 0 | bne ->vmeta_binop // Binop call for compatibility. | mr CARG1, SAVE0 | b ->BC_LEN_Z #else | b ->vmeta_binop // Binop call for compatibility. #endif | |//-- Call metamethod ---------------------------------------------------- | |->vmeta_call: // Resolve and call __call metamethod. | // TMP2 = old base, BASE = new base, RC = nargs*8 | mr CARG1, L | stp TMP2, L->base // This is the callers base! | subi CARG2, BASE, 8 | stw PC, SAVE_PC | add CARG3, BASE, RC | mr SAVE0, NARGS8:RC | bl extern lj_meta_call // (lua_State *L, TValue *func, TValue *top) | lwz LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | addi NARGS8:RC, SAVE0, 8 // Got one more argument now. | ins_call | |->vmeta_callt: // Resolve __call for BC_CALLT. | // BASE = old base, RA = new base, RC = nargs*8 | mr CARG1, L | stp BASE, L->base | subi CARG2, RA, 8 | stw PC, SAVE_PC | add CARG3, RA, RC | mr SAVE0, NARGS8:RC | bl extern lj_meta_call // (lua_State *L, TValue *func, TValue *top) | lwz TMP1, FRAME_PC(BASE) | addi NARGS8:RC, SAVE0, 8 // Got one more argument now. | lwz LFUNC:RB, FRAME_FUNC(RA) // Guaranteed to be a function here. | b ->BC_CALLT_Z | |//-- Argument coercion for 'for' statement ------------------------------ | |->vmeta_for: | mr CARG1, L | stp BASE, L->base | mr CARG2, RA | stw PC, SAVE_PC | mr SAVE0, INS | bl extern lj_meta_for // (lua_State *L, TValue *base) |.if JIT | decode_OP1 TMP0, SAVE0 |.endif | decode_RA8 RA, SAVE0 |.if JIT | cmpwi TMP0, BC_JFORI |.endif | decode_RD8 RD, SAVE0 |.if JIT | beqy =>BC_JFORI |.endif | b =>BC_FORI | |//----------------------------------------------------------------------- |//-- Fast functions ----------------------------------------------------- |//----------------------------------------------------------------------- | |.macro .ffunc, name |->ff_ .. name: |.endmacro | |.macro .ffunc_1, name |->ff_ .. name: | cmplwi NARGS8:RC, 8 | lwz CARG3, 0(BASE) | lwz CARG1, 4(BASE) | blt ->fff_fallback |.endmacro | |.macro .ffunc_2, name |->ff_ .. name: | cmplwi NARGS8:RC, 16 | lwz CARG3, 0(BASE) | lwz CARG4, 8(BASE) | lwz CARG1, 4(BASE) | lwz CARG2, 12(BASE) | blt ->fff_fallback |.endmacro | |.macro .ffunc_n, name |->ff_ .. name: | cmplwi NARGS8:RC, 8 | lwz CARG3, 0(BASE) | lfd FARG1, 0(BASE) | blt ->fff_fallback | checknum CARG3; bge ->fff_fallback |.endmacro | |.macro .ffunc_nn, name |->ff_ .. name: | cmplwi NARGS8:RC, 16 | lwz CARG3, 0(BASE) | lfd FARG1, 0(BASE) | lwz CARG4, 8(BASE) | lfd FARG2, 8(BASE) | blt ->fff_fallback | checknum CARG3; bge ->fff_fallback | checknum CARG4; bge ->fff_fallback |.endmacro | |// Inlined GC threshold check. Caveat: uses TMP0 and TMP1. |.macro ffgccheck | lwz TMP0, DISPATCH_GL(gc.total)(DISPATCH) | lwz TMP1, DISPATCH_GL(gc.threshold)(DISPATCH) | cmplw TMP0, TMP1 | bgel ->fff_gcstep |.endmacro | |//-- Base library: checks ----------------------------------------------- | |.ffunc_1 assert | li TMP1, LJ_TFALSE | la RA, -8(BASE) | cmplw cr1, CARG3, TMP1 | lwz PC, FRAME_PC(BASE) | bge cr1, ->fff_fallback | stw CARG3, 0(RA) | addi RD, NARGS8:RC, 8 // Compute (nresults+1)*8. | stw CARG1, 4(RA) | beq ->fff_res // Done if exactly 1 argument. | li TMP1, 8 | subi RC, RC, 8 |1: | cmplw TMP1, RC | lfdx f0, BASE, TMP1 | stfdx f0, RA, TMP1 | addi TMP1, TMP1, 8 | bney <1 | b ->fff_res | |.ffunc type | cmplwi NARGS8:RC, 8 | lwz CARG1, 0(BASE) | blt ->fff_fallback | .gpr64 extsw CARG1, CARG1 | subfc TMP0, TISNUM, CARG1 | subfe TMP2, CARG1, CARG1 | orc TMP1, TMP2, TMP0 | addi TMP1, TMP1, ~LJ_TISNUM+1 | slwi TMP1, TMP1, 3 | la TMP2, CFUNC:RB->upvalue | lfdx FARG1, TMP2, TMP1 | b ->fff_resn | |//-- Base library: getters and setters --------------------------------- | |.ffunc_1 getmetatable | checktab CARG3; bne >6 |1: // Field metatable must be at same offset for GCtab and GCudata! | lwz TAB:CARG1, TAB:CARG1->metatable |2: | li CARG3, LJ_TNIL | cmplwi TAB:CARG1, 0 | lwz STR:RC, DISPATCH_GL(gcroot[GCROOT_MMNAME+MM_metatable])(DISPATCH) | beq ->fff_restv | lwz TMP0, TAB:CARG1->hmask | li CARG3, LJ_TTAB // Use metatable as default result. | lwz TMP1, STR:RC->hash | lwz NODE:TMP2, TAB:CARG1->node | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | slwi TMP0, TMP1, 5 | slwi TMP1, TMP1, 3 | sub TMP1, TMP0, TMP1 | add NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) |3: // Rearranged logic, because we expect _not_ to find the key. | lwz CARG4, NODE:TMP2->key | lwz TMP0, 4+offsetof(Node, key)(NODE:TMP2) | lwz CARG2, NODE:TMP2->val | lwz TMP1, 4+offsetof(Node, val)(NODE:TMP2) | checkstr CARG4; bne >4 | cmpw TMP0, STR:RC; beq >5 |4: | lwz NODE:TMP2, NODE:TMP2->next | cmplwi NODE:TMP2, 0 | beq ->fff_restv // Not found, keep default result. | b <3 |5: | checknil CARG2 | beq ->fff_restv // Ditto for nil value. | mr CARG3, CARG2 // Return value of mt.__metatable. | mr CARG1, TMP1 | b ->fff_restv | |6: | cmpwi CARG3, LJ_TUDATA; beq <1 | .gpr64 extsw CARG3, CARG3 | subfc TMP0, TISNUM, CARG3 | subfe TMP2, CARG3, CARG3 | orc TMP1, TMP2, TMP0 | addi TMP1, TMP1, ~LJ_TISNUM+1 | slwi TMP1, TMP1, 2 | la TMP2, DISPATCH_GL(gcroot[GCROOT_BASEMT])(DISPATCH) | lwzx TAB:CARG1, TMP2, TMP1 | b <2 | |.ffunc_2 setmetatable | // Fast path: no mt for table yet and not clearing the mt. | checktab CARG3; bne ->fff_fallback | lwz TAB:TMP1, TAB:CARG1->metatable | checktab CARG4; bne ->fff_fallback | cmplwi TAB:TMP1, 0 | lbz TMP3, TAB:CARG1->marked | bne ->fff_fallback | andix. TMP0, TMP3, LJ_GC_BLACK // isblack(table) | stw TAB:CARG2, TAB:CARG1->metatable | beq ->fff_restv | barrierback TAB:CARG1, TMP3, TMP0 | b ->fff_restv | |.ffunc rawget | cmplwi NARGS8:RC, 16 | lwz CARG4, 0(BASE) | lwz TAB:CARG2, 4(BASE) | blt ->fff_fallback | checktab CARG4; bne ->fff_fallback | la CARG3, 8(BASE) | mr CARG1, L | bl extern lj_tab_get // (lua_State *L, GCtab *t, cTValue *key) | // Returns cTValue *. | lfd FARG1, 0(CRET1) | b ->fff_resn | |//-- Base library: conversions ------------------------------------------ | |.ffunc tonumber | // Only handles the number case inline (without a base argument). | cmplwi NARGS8:RC, 8 | lwz CARG1, 0(BASE) | lfd FARG1, 0(BASE) | bne ->fff_fallback // Exactly one argument. | checknum CARG1; bgt ->fff_fallback | b ->fff_resn | |.ffunc_1 tostring | // Only handles the string or number case inline. | checkstr CARG3 | // A __tostring method in the string base metatable is ignored. | beq ->fff_restv // String key? | // Handle numbers inline, unless a number base metatable is present. | lwz TMP0, DISPATCH_GL(gcroot[GCROOT_BASEMT_NUM])(DISPATCH) | checknum CARG3 | cmplwi cr1, TMP0, 0 | stp BASE, L->base // Add frame since C call can throw. | crorc 4*cr0+eq, 4*cr0+gt, 4*cr1+eq | stw PC, SAVE_PC // Redundant (but a defined value). | beq ->fff_fallback | ffgccheck | mr CARG1, L | mr CARG2, BASE |.if DUALNUM | bl extern lj_str_fromnumber // (lua_State *L, cTValue *o) |.else | bl extern lj_str_fromnum // (lua_State *L, lua_Number *np) |.endif | // Returns GCstr *. | li CARG3, LJ_TSTR | b ->fff_restv | |//-- Base library: iterators ------------------------------------------- | |.ffunc next | cmplwi NARGS8:RC, 8 | lwz CARG1, 0(BASE) | lwz TAB:CARG2, 4(BASE) | blt ->fff_fallback | stwx TISNIL, BASE, NARGS8:RC // Set missing 2nd arg to nil. | checktab CARG1 | lwz PC, FRAME_PC(BASE) | bne ->fff_fallback | stp BASE, L->base // Add frame since C call can throw. | mr CARG1, L | stp BASE, L->top // Dummy frame length is ok. | la CARG3, 8(BASE) | stw PC, SAVE_PC | bl extern lj_tab_next // (lua_State *L, GCtab *t, TValue *key) | // Returns 0 at end of traversal. | cmplwi CRET1, 0 | li CARG3, LJ_TNIL | beq ->fff_restv // End of traversal: return nil. | lfd f0, 8(BASE) // Copy key and value to results. | la RA, -8(BASE) | lfd f1, 16(BASE) | stfd f0, 0(RA) | li RD, (2+1)*8 | stfd f1, 8(RA) | b ->fff_res | |.ffunc_1 pairs | checktab CARG3 | lwz PC, FRAME_PC(BASE) | bne ->fff_fallback #if LJ_52 | lwz TAB:TMP2, TAB:CARG1->metatable | lfd f0, CFUNC:RB->upvalue[0] | cmplwi TAB:TMP2, 0 | la RA, -8(BASE) | bne ->fff_fallback #else | lfd f0, CFUNC:RB->upvalue[0] | la RA, -8(BASE) #endif | stw TISNIL, 8(BASE) | li RD, (3+1)*8 | stfd f0, 0(RA) | b ->fff_res | |.ffunc ipairs_aux | cmplwi NARGS8:RC, 16 | lwz CARG3, 0(BASE) | lwz TAB:CARG1, 4(BASE) | lwz CARG4, 8(BASE) |.if DUALNUM | lwz TMP2, 12(BASE) |.else | lfd FARG2, 8(BASE) |.endif | blt ->fff_fallback | checktab CARG3 | checknum cr1, CARG4 | lwz PC, FRAME_PC(BASE) |.if DUALNUM | bne ->fff_fallback | bne cr1, ->fff_fallback |.else | lus TMP0, 0x3ff0 | stw ZERO, TMPD_LO | bne ->fff_fallback | stw TMP0, TMPD_HI | bge cr1, ->fff_fallback | lfd FARG1, TMPD | toint TMP2, FARG2, f0 |.endif | lwz TMP0, TAB:CARG1->asize | lwz TMP1, TAB:CARG1->array |.if not DUALNUM | fadd FARG2, FARG2, FARG1 |.endif | addi TMP2, TMP2, 1 | la RA, -8(BASE) | cmplw TMP0, TMP2 |.if DUALNUM | stw TISNUM, 0(RA) | slwi TMP3, TMP2, 3 | stw TMP2, 4(RA) |.else | slwi TMP3, TMP2, 3 | stfd FARG2, 0(RA) |.endif | ble >2 // Not in array part? | lwzx TMP2, TMP1, TMP3 | lfdx f0, TMP1, TMP3 |1: | checknil TMP2 | li RD, (0+1)*8 | beq ->fff_res // End of iteration, return 0 results. | li RD, (2+1)*8 | stfd f0, 8(RA) | b ->fff_res |2: // Check for empty hash part first. Otherwise call C function. | lwz TMP0, TAB:CARG1->hmask | cmplwi TMP0, 0 | li RD, (0+1)*8 | beq ->fff_res | mr CARG2, TMP2 | bl extern lj_tab_getinth // (GCtab *t, int32_t key) | // Returns cTValue * or NULL. | cmplwi CRET1, 0 | li RD, (0+1)*8 | beq ->fff_res | lwz TMP2, 0(CRET1) | lfd f0, 0(CRET1) | b <1 | |.ffunc_1 ipairs | checktab CARG3 | lwz PC, FRAME_PC(BASE) | bne ->fff_fallback #if LJ_52 | lwz TAB:TMP2, TAB:CARG1->metatable | lfd f0, CFUNC:RB->upvalue[0] | cmplwi TAB:TMP2, 0 | la RA, -8(BASE) | bne ->fff_fallback #else | lfd f0, CFUNC:RB->upvalue[0] | la RA, -8(BASE) #endif |.if DUALNUM | stw TISNUM, 8(BASE) |.else | stw ZERO, 8(BASE) |.endif | stw ZERO, 12(BASE) | li RD, (3+1)*8 | stfd f0, 0(RA) | b ->fff_res | |//-- Base library: catch errors ---------------------------------------- | |.ffunc pcall | cmplwi NARGS8:RC, 8 | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | blt ->fff_fallback | mr TMP2, BASE | la BASE, 8(BASE) | // Remember active hook before pcall. | rlwinm TMP3, TMP3, 32-HOOK_ACTIVE_SHIFT, 31, 31 | subi NARGS8:RC, NARGS8:RC, 8 | addi PC, TMP3, 8+FRAME_PCALL | b ->vm_call_dispatch | |.ffunc xpcall | cmplwi NARGS8:RC, 16 | lwz CARG4, 8(BASE) | lfd FARG2, 8(BASE) | lfd FARG1, 0(BASE) | blt ->fff_fallback | lbz TMP1, DISPATCH_GL(hookmask)(DISPATCH) | mr TMP2, BASE | checkfunc CARG4; bne ->fff_fallback // Traceback must be a function. | la BASE, 16(BASE) | // Remember active hook before pcall. | rlwinm TMP1, TMP1, 32-HOOK_ACTIVE_SHIFT, 31, 31 | stfd FARG2, 0(TMP2) // Swap function and traceback. | subi NARGS8:RC, NARGS8:RC, 16 | stfd FARG1, 8(TMP2) | addi PC, TMP1, 16+FRAME_PCALL | b ->vm_call_dispatch | |//-- Coroutine library -------------------------------------------------- | |.macro coroutine_resume_wrap, resume |.if resume |.ffunc_1 coroutine_resume | cmpwi CARG3, LJ_TTHREAD; bne ->fff_fallback |.else |.ffunc coroutine_wrap_aux | lwz L:CARG1, CFUNC:RB->upvalue[0].gcr |.endif | lbz TMP0, L:CARG1->status | lp TMP1, L:CARG1->cframe | lp CARG2, L:CARG1->top | cmplwi cr0, TMP0, LUA_YIELD | lp TMP2, L:CARG1->base | cmplwi cr1, TMP1, 0 | lwz TMP0, L:CARG1->maxstack | cmplw cr7, CARG2, TMP2 | lwz PC, FRAME_PC(BASE) | crorc 4*cr6+lt, 4*cr0+gt, 4*cr1+eq // st>LUA_YIELD || cframe!=0 | add TMP2, CARG2, NARGS8:RC | crandc 4*cr6+gt, 4*cr7+eq, 4*cr0+eq // base==top && st!=LUA_YIELD | cmplw cr1, TMP2, TMP0 | cror 4*cr6+lt, 4*cr6+lt, 4*cr6+gt | stw PC, SAVE_PC | cror 4*cr6+lt, 4*cr6+lt, 4*cr1+gt // cond1 || cond2 || stackov | stp BASE, L->base | blt cr6, ->fff_fallback |1: |.if resume | addi BASE, BASE, 8 // Keep resumed thread in stack for GC. | subi NARGS8:RC, NARGS8:RC, 8 | subi TMP2, TMP2, 8 |.endif | stp TMP2, L:CARG1->top | li TMP1, 0 | stp BASE, L->top |2: // Move args to coroutine. | cmpw TMP1, NARGS8:RC | lfdx f0, BASE, TMP1 | beq >3 | stfdx f0, CARG2, TMP1 | addi TMP1, TMP1, 8 | b <2 |3: | li CARG3, 0 | mr L:SAVE0, L:CARG1 | li CARG4, 0 | bl ->vm_resume // (lua_State *L, TValue *base, 0, 0) | // Returns thread status. |4: | lp TMP2, L:SAVE0->base | cmplwi CRET1, LUA_YIELD | lp TMP3, L:SAVE0->top | li_vmstate INTERP | lp BASE, L->base | st_vmstate | bgt >8 | sub RD, TMP3, TMP2 | lwz TMP0, L->maxstack | cmplwi RD, 0 | add TMP1, BASE, RD | beq >6 // No results? | cmplw TMP1, TMP0 | li TMP1, 0 | bgt >9 // Need to grow stack? | | subi TMP3, RD, 8 | stp TMP2, L:SAVE0->top // Clear coroutine stack. |5: // Move results from coroutine. | cmplw TMP1, TMP3 | lfdx f0, TMP2, TMP1 | stfdx f0, BASE, TMP1 | addi TMP1, TMP1, 8 | bne <5 |6: | andix. TMP0, PC, FRAME_TYPE |.if resume | li TMP1, LJ_TTRUE | la RA, -8(BASE) | stw TMP1, -8(BASE) // Prepend true to results. | addi RD, RD, 16 |.else | mr RA, BASE | addi RD, RD, 8 |.endif |7: | stw PC, SAVE_PC | mr MULTRES, RD | beq ->BC_RET_Z | b ->vm_return | |8: // Coroutine returned with error (at co->top-1). |.if resume | andix. TMP0, PC, FRAME_TYPE | la TMP3, -8(TMP3) | li TMP1, LJ_TFALSE | lfd f0, 0(TMP3) | stp TMP3, L:SAVE0->top // Remove error from coroutine stack. | li RD, (2+1)*8 | stw TMP1, -8(BASE) // Prepend false to results. | la RA, -8(BASE) | stfd f0, 0(BASE) // Copy error message. | b <7 |.else | mr CARG1, L | mr CARG2, L:SAVE0 | bl extern lj_ffh_coroutine_wrap_err // (lua_State *L, lua_State *co) |.endif | |9: // Handle stack expansion on return from yield. | mr CARG1, L | srwi CARG2, RD, 3 | bl extern lj_state_growstack // (lua_State *L, int n) | li CRET1, 0 | b <4 |.endmacro | | coroutine_resume_wrap 1 // coroutine.resume | coroutine_resume_wrap 0 // coroutine.wrap | |.ffunc coroutine_yield | lp TMP0, L->cframe | add TMP1, BASE, NARGS8:RC | stp BASE, L->base | andix. TMP0, TMP0, CFRAME_RESUME | stp TMP1, L->top | li CRET1, LUA_YIELD | beq ->fff_fallback | stp ZERO, L->cframe | stb CRET1, L->status | b ->vm_leave_unw | |//-- Math library ------------------------------------------------------- | |.ffunc_1 math_abs | checknum CARG3 |.if DUALNUM | bne >2 | srawi TMP1, CARG1, 31 | xor TMP2, TMP1, CARG1 |.if GPR64 | lus TMP0, 0x8000 | sub CARG1, TMP2, TMP1 | cmplw CARG1, TMP0 | beq >1 |.else | sub. CARG1, TMP2, TMP1 | blt >1 |.endif |->fff_resi: | lwz PC, FRAME_PC(BASE) | la RA, -8(BASE) | stw TISNUM, -8(BASE) | stw CRET1, -4(BASE) | b ->fff_res1 |1: | lus CARG3, 0x41e0 // 2^31. | li CARG1, 0 | b ->fff_restv |2: |.endif | bge ->fff_fallback | rlwinm CARG3, CARG3, 0, 1, 31 | // Fallthrough. | |->fff_restv: | // CARG3/CARG1 = TValue result. | lwz PC, FRAME_PC(BASE) | stw CARG3, -8(BASE) | la RA, -8(BASE) | stw CARG1, -4(BASE) |->fff_res1: | // RA = results, PC = return. | li RD, (1+1)*8 |->fff_res: | // RA = results, RD = (nresults+1)*8, PC = return. | andix. TMP0, PC, FRAME_TYPE | mr MULTRES, RD | bney ->vm_return | lwz INS, -4(PC) | decode_RB8 RB, INS |5: | cmplw RB, RD // More results expected? | decode_RA8 TMP0, INS | bgt >6 | ins_next1 | // Adjust BASE. KBASE is assumed to be set for the calling frame. | sub BASE, RA, TMP0 | ins_next2 | |6: // Fill up results with nil. | subi TMP1, RD, 8 | addi RD, RD, 8 | stwx TISNIL, RA, TMP1 | b <5 | |.macro math_extern, func | .ffunc_n math_ .. func | blex func | b ->fff_resn |.endmacro | |.macro math_extern2, func | .ffunc_nn math_ .. func | blex func | b ->fff_resn |.endmacro | |.macro math_round, func | .ffunc_1 math_ .. func | checknum CARG3; beqy ->fff_restv | rlwinm TMP2, CARG3, 12, 21, 31 | bge ->fff_fallback | addic. TMP2, TMP2, -1023 // exp = exponent(x) - 1023 | cmplwi cr1, TMP2, 31 // 0 <= exp < 31? | subfic TMP0, TMP2, 31 | blt >3 | slwi TMP1, CARG3, 11 | srwi TMP3, CARG1, 21 | oris TMP1, TMP1, 0x8000 | addi TMP2, TMP2, 1 | or TMP1, TMP1, TMP3 | slwi CARG2, CARG1, 11 | bge cr1, >4 | slw TMP3, TMP1, TMP2 | srw RD, TMP1, TMP0 | or TMP3, TMP3, CARG2 | srawi TMP2, CARG3, 31 |.if "func" == "floor" | and TMP1, TMP3, TMP2 | addic TMP0, TMP1, -1 | subfe TMP1, TMP0, TMP1 | add CARG1, RD, TMP1 | xor CARG1, CARG1, TMP2 | sub CARG1, CARG1, TMP2 | b ->fff_resi |.else | andc TMP1, TMP3, TMP2 | addic TMP0, TMP1, -1 | subfe TMP1, TMP0, TMP1 | add CARG1, RD, TMP1 | cmpw CARG1, RD | xor CARG1, CARG1, TMP2 | sub CARG1, CARG1, TMP2 | bge ->fff_resi | // Overflow to 2^31. | lus CARG3, 0x41e0 // 2^31. | li CARG1, 0 | b ->fff_restv |.endif |3: // |x| < 1 | slwi TMP2, CARG3, 1 | srawi TMP1, CARG3, 31 | or TMP2, CARG1, TMP2 // ztest = (hi+hi) | lo |.if "func" == "floor" | and TMP1, TMP2, TMP1 // (ztest & sign) == 0 ? 0 : -1 | subfic TMP2, TMP1, 0 | subfe CARG1, CARG1, CARG1 |.else | andc TMP1, TMP2, TMP1 // (ztest & ~sign) == 0 ? 0 : 1 | addic TMP2, TMP1, -1 | subfe CARG1, TMP2, TMP1 |.endif | b ->fff_resi |4: // exp >= 31. Check for -(2^31). | xoris TMP1, TMP1, 0x8000 | srawi TMP2, CARG3, 31 |.if "func" == "floor" | or TMP1, TMP1, CARG2 |.endif |.if PPE | orc TMP1, TMP1, TMP2 | cmpwi TMP1, 0 |.else | orc. TMP1, TMP1, TMP2 |.endif | crand 4*cr0+eq, 4*cr0+eq, 4*cr1+eq | lus CARG1, 0x8000 // -(2^31). | beqy ->fff_resi |5: | lfd FARG1, 0(BASE) | blex func | b ->fff_resn |.endmacro | |.if DUALNUM | math_round floor | math_round ceil |.else | // NYI: use internal implementation. | math_extern floor | math_extern ceil |.endif | |.if SQRT |.ffunc_n math_sqrt | fsqrt FARG1, FARG1 | b ->fff_resn |.else | math_extern sqrt |.endif | |.ffunc math_log | cmplwi NARGS8:RC, 8 | lwz CARG3, 0(BASE) | lfd FARG1, 0(BASE) | bne ->fff_fallback // Need exactly 1 argument. | checknum CARG3; bge ->fff_fallback | blex log | b ->fff_resn | | math_extern log10 | math_extern exp | math_extern sin | math_extern cos | math_extern tan | math_extern asin | math_extern acos | math_extern atan | math_extern sinh | math_extern cosh | math_extern tanh | math_extern2 pow | math_extern2 atan2 | math_extern2 fmod | |->ff_math_deg: |.ffunc_n math_rad | lfd FARG2, CFUNC:RB->upvalue[0] | fmul FARG1, FARG1, FARG2 | b ->fff_resn | |.if DUALNUM |.ffunc math_ldexp | cmplwi NARGS8:RC, 16 | lwz CARG3, 0(BASE) | lfd FARG1, 0(BASE) | lwz CARG4, 8(BASE) |.if GPR64 | lwz CARG2, 12(BASE) |.else | lwz CARG1, 12(BASE) |.endif | blt ->fff_fallback | checknum CARG3; bge ->fff_fallback | checknum CARG4; bne ->fff_fallback |.else |.ffunc_nn math_ldexp |.if GPR64 | toint CARG2, FARG2 |.else | toint CARG1, FARG2 |.endif |.endif | blex ldexp | b ->fff_resn | |.ffunc_n math_frexp |.if GPR64 | la CARG2, DISPATCH_GL(tmptv)(DISPATCH) |.else | la CARG1, DISPATCH_GL(tmptv)(DISPATCH) |.endif | lwz PC, FRAME_PC(BASE) | blex frexp | lwz TMP1, DISPATCH_GL(tmptv)(DISPATCH) | la RA, -8(BASE) |.if not DUALNUM | tonum_i FARG2, TMP1 |.endif | stfd FARG1, 0(RA) | li RD, (2+1)*8 |.if DUALNUM | stw TISNUM, 8(RA) | stw TMP1, 12(RA) |.else | stfd FARG2, 8(RA) |.endif | b ->fff_res | |.ffunc_n math_modf |.if GPR64 | la CARG2, -8(BASE) |.else | la CARG1, -8(BASE) |.endif | lwz PC, FRAME_PC(BASE) | blex modf | la RA, -8(BASE) | stfd FARG1, 0(BASE) | li RD, (2+1)*8 | b ->fff_res | |.macro math_minmax, name, ismax |.if DUALNUM | .ffunc_1 name | checknum CARG3 | addi TMP1, BASE, 8 | add TMP2, BASE, NARGS8:RC | bne >4 |1: // Handle integers. | lwz CARG4, 0(TMP1) | cmplw cr1, TMP1, TMP2 | lwz CARG2, 4(TMP1) | bge cr1, ->fff_resi | checknum CARG4 | xoris TMP0, CARG1, 0x8000 | xoris TMP3, CARG2, 0x8000 | bne >3 | subfc TMP3, TMP3, TMP0 | subfe TMP0, TMP0, TMP0 |.if ismax | andc TMP3, TMP3, TMP0 |.else | and TMP3, TMP3, TMP0 |.endif | add CARG1, TMP3, CARG2 |.if GPR64 | rldicl CARG1, CARG1, 0, 32 |.endif | addi TMP1, TMP1, 8 | b <1 |3: | bge ->fff_fallback | // Convert intermediate result to number and continue below. | tonum_i FARG1, CARG1 | lfd FARG2, 0(TMP1) | b >6 |4: | lfd FARG1, 0(BASE) | bge ->fff_fallback |5: // Handle numbers. | lwz CARG4, 0(TMP1) | cmplw cr1, TMP1, TMP2 | lfd FARG2, 0(TMP1) | bge cr1, ->fff_resn | checknum CARG4; bge >7 |6: | fsub f0, FARG1, FARG2 | addi TMP1, TMP1, 8 |.if ismax | fsel FARG1, f0, FARG1, FARG2 |.else | fsel FARG1, f0, FARG2, FARG1 |.endif | b <5 |7: // Convert integer to number and continue above. | lwz CARG2, 4(TMP1) | bne ->fff_fallback | tonum_i FARG2, CARG2 | b <6 |.else | .ffunc_n name | li TMP1, 8 |1: | lwzx CARG2, BASE, TMP1 | lfdx FARG2, BASE, TMP1 | cmplw cr1, TMP1, NARGS8:RC | checknum CARG2 | bge cr1, ->fff_resn | bge ->fff_fallback | fsub f0, FARG1, FARG2 | addi TMP1, TMP1, 8 |.if ismax | fsel FARG1, f0, FARG1, FARG2 |.else | fsel FARG1, f0, FARG2, FARG1 |.endif | b <1 |.endif |.endmacro | | math_minmax math_min, 0 | math_minmax math_max, 1 | |//-- String library ----------------------------------------------------- | |.ffunc_1 string_len | checkstr CARG3; bne ->fff_fallback | lwz CRET1, STR:CARG1->len | b ->fff_resi | |.ffunc string_byte // Only handle the 1-arg case here. | cmplwi NARGS8:RC, 8 | lwz CARG3, 0(BASE) | lwz STR:CARG1, 4(BASE) | bne ->fff_fallback // Need exactly 1 argument. | checkstr CARG3 | bne ->fff_fallback | lwz TMP0, STR:CARG1->len |.if DUALNUM | lbz CARG1, STR:CARG1[1] // Access is always ok (NUL at end). | li RD, (0+1)*8 | lwz PC, FRAME_PC(BASE) | cmplwi TMP0, 0 | la RA, -8(BASE) | beqy ->fff_res | b ->fff_resi |.else | lbz TMP1, STR:CARG1[1] // Access is always ok (NUL at end). | addic TMP3, TMP0, -1 // RD = ((str->len != 0)+1)*8 | subfe RD, TMP3, TMP0 | stw TMP1, TONUM_LO // Inlined tonum_u f0, TMP1. | addi RD, RD, 1 | lfd f0, TONUM_D | la RA, -8(BASE) | lwz PC, FRAME_PC(BASE) | fsub f0, f0, TOBIT | slwi RD, RD, 3 | stfd f0, 0(RA) | b ->fff_res |.endif | |.ffunc string_char // Only handle the 1-arg case here. | ffgccheck | cmplwi NARGS8:RC, 8 | lwz CARG3, 0(BASE) |.if DUALNUM | lwz TMP0, 4(BASE) | bne ->fff_fallback // Exactly 1 argument. | checknum CARG3; bne ->fff_fallback | la CARG2, 7(BASE) |.else | lfd FARG1, 0(BASE) | bne ->fff_fallback // Exactly 1 argument. | checknum CARG3; bge ->fff_fallback | toint TMP0, FARG1 | la CARG2, TMPD_BLO |.endif | li CARG3, 1 | cmplwi TMP0, 255; bgt ->fff_fallback |->fff_newstr: | mr CARG1, L | stp BASE, L->base | stw PC, SAVE_PC | bl extern lj_str_new // (lua_State *L, char *str, size_t l) | // Returns GCstr *. | lp BASE, L->base | li CARG3, LJ_TSTR | b ->fff_restv | |.ffunc string_sub | ffgccheck | cmplwi NARGS8:RC, 16 | lwz CARG3, 16(BASE) |.if not DUALNUM | lfd f0, 16(BASE) |.endif | lwz TMP0, 0(BASE) | lwz STR:CARG1, 4(BASE) | blt ->fff_fallback | lwz CARG2, 8(BASE) |.if DUALNUM | lwz TMP1, 12(BASE) |.else | lfd f1, 8(BASE) |.endif | li TMP2, -1 | beq >1 |.if DUALNUM | checknum CARG3 | lwz TMP2, 20(BASE) | bne ->fff_fallback |1: | checknum CARG2; bne ->fff_fallback |.else | checknum CARG3; bge ->fff_fallback | toint TMP2, f0 |1: | checknum CARG2; bge ->fff_fallback |.endif | checkstr TMP0; bne ->fff_fallback |.if not DUALNUM | toint TMP1, f1 |.endif | lwz TMP0, STR:CARG1->len | cmplw TMP0, TMP2 // len < end? (unsigned compare) | addi TMP3, TMP2, 1 | blt >5 |2: | cmpwi TMP1, 0 // start <= 0? | add TMP3, TMP1, TMP0 | ble >7 |3: | sub CARG3, TMP2, TMP1 | addi CARG2, STR:CARG1, #STR-1 | srawi TMP0, CARG3, 31 | addi CARG3, CARG3, 1 | add CARG2, CARG2, TMP1 | andc CARG3, CARG3, TMP0 |.if GPR64 | rldicl CARG2, CARG2, 0, 32 | rldicl CARG3, CARG3, 0, 32 |.endif | b ->fff_newstr | |5: // Negative end or overflow. | cmpw TMP0, TMP2 // len >= end? (signed compare) | add TMP2, TMP0, TMP3 // Negative end: end = end+len+1. | bge <2 | mr TMP2, TMP0 // Overflow: end = len. | b <2 | |7: // Negative start or underflow. | .gpr64 extsw TMP1, TMP1 | addic CARG3, TMP1, -1 | subfe CARG3, CARG3, CARG3 | srawi CARG2, TMP3, 31 // Note: modifies carry. | andc TMP3, TMP3, CARG3 | andc TMP1, TMP3, CARG2 | addi TMP1, TMP1, 1 // start = 1 + (start ? start+len : 0) | b <3 | |.ffunc string_rep // Only handle the 1-char case inline. | ffgccheck | cmplwi NARGS8:RC, 16 | lwz TMP0, 0(BASE) | lwz STR:CARG1, 4(BASE) | lwz CARG4, 8(BASE) |.if DUALNUM | lwz CARG3, 12(BASE) |.else | lfd FARG2, 8(BASE) |.endif | bne ->fff_fallback // Exactly 2 arguments. | checkstr TMP0; bne ->fff_fallback |.if DUALNUM | checknum CARG4; bne ->fff_fallback |.else | checknum CARG4; bge ->fff_fallback | toint CARG3, FARG2 |.endif | lwz TMP0, STR:CARG1->len | cmpwi CARG3, 0 | lwz TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | ble >2 // Count <= 0? (or non-int) | cmplwi TMP0, 1 | subi TMP2, CARG3, 1 | blt >2 // Zero length string? | cmplw cr1, TMP1, CARG3 | bne ->fff_fallback // Fallback for > 1-char strings. | lbz TMP0, STR:CARG1[1] | lp CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | blt cr1, ->fff_fallback |1: // Fill buffer with char. Yes, this is suboptimal code (do you care?). | cmplwi TMP2, 0 | stbx TMP0, CARG2, TMP2 | subi TMP2, TMP2, 1 | bne <1 | b ->fff_newstr |2: // Return empty string. | la STR:CARG1, DISPATCH_GL(strempty)(DISPATCH) | li CARG3, LJ_TSTR | b ->fff_restv | |.ffunc string_reverse | ffgccheck | cmplwi NARGS8:RC, 8 | lwz CARG3, 0(BASE) | lwz STR:CARG1, 4(BASE) | blt ->fff_fallback | checkstr CARG3 | lwz TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | bne ->fff_fallback | lwz CARG3, STR:CARG1->len | la CARG1, #STR(STR:CARG1) | lp CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | li TMP2, 0 | cmplw TMP1, CARG3 | subi TMP3, CARG3, 1 | blt ->fff_fallback |1: // Reverse string copy. | cmpwi TMP3, 0 | lbzx TMP1, CARG1, TMP2 | blty ->fff_newstr | stbx TMP1, CARG2, TMP3 | subi TMP3, TMP3, 1 | addi TMP2, TMP2, 1 | b <1 | |.macro ffstring_case, name, lo | .ffunc name | ffgccheck | cmplwi NARGS8:RC, 8 | lwz CARG3, 0(BASE) | lwz STR:CARG1, 4(BASE) | blt ->fff_fallback | checkstr CARG3 | lwz TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | bne ->fff_fallback | lwz CARG3, STR:CARG1->len | la CARG1, #STR(STR:CARG1) | lp CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | cmplw TMP1, CARG3 | li TMP2, 0 | blt ->fff_fallback |1: // ASCII case conversion. | cmplw TMP2, CARG3 | lbzx TMP1, CARG1, TMP2 | bgey ->fff_newstr | subi TMP0, TMP1, lo | xori TMP3, TMP1, 0x20 | addic TMP0, TMP0, -26 | subfe TMP3, TMP3, TMP3 | rlwinm TMP3, TMP3, 0, 26, 26 // x &= 0x20. | xor TMP1, TMP1, TMP3 | stbx TMP1, CARG2, TMP2 | addi TMP2, TMP2, 1 | b <1 |.endmacro | |ffstring_case string_lower, 65 |ffstring_case string_upper, 97 | |//-- Table library ------------------------------------------------------ | |.ffunc_1 table_getn | checktab CARG3; bne ->fff_fallback | bl extern lj_tab_len // (GCtab *t) | // Returns uint32_t (but less than 2^31). | b ->fff_resi | |//-- Bit library -------------------------------------------------------- | |.macro .ffunc_bit, name |.if DUALNUM | .ffunc_1 bit_..name | checknum CARG3; bnel ->fff_tobit_fb |.else | .ffunc_n bit_..name | fadd FARG1, FARG1, TOBIT | stfd FARG1, TMPD | lwz CARG1, TMPD_LO |.endif |.endmacro | |.macro .ffunc_bit_op, name, ins | .ffunc_bit name | addi TMP1, BASE, 8 | add TMP2, BASE, NARGS8:RC |1: | lwz CARG4, 0(TMP1) | cmplw cr1, TMP1, TMP2 |.if DUALNUM | lwz CARG2, 4(TMP1) |.else | lfd FARG1, 0(TMP1) |.endif | bgey cr1, ->fff_resi | checknum CARG4 |.if DUALNUM | bnel ->fff_bitop_fb |.else | fadd FARG1, FARG1, TOBIT | bge ->fff_fallback | stfd FARG1, TMPD | lwz CARG2, TMPD_LO |.endif | ins CARG1, CARG1, CARG2 | addi TMP1, TMP1, 8 | b <1 |.endmacro | |.ffunc_bit_op band, and |.ffunc_bit_op bor, or |.ffunc_bit_op bxor, xor | |.ffunc_bit bswap | rotlwi TMP0, CARG1, 8 | rlwimi TMP0, CARG1, 24, 0, 7 | rlwimi TMP0, CARG1, 24, 16, 23 | mr CRET1, TMP0 | b ->fff_resi | |.ffunc_bit bnot | not CRET1, CARG1 | b ->fff_resi | |.macro .ffunc_bit_sh, name, ins, shmod |.if DUALNUM | .ffunc_2 bit_..name | checknum CARG3; bnel ->fff_tobit_fb | // Note: no inline conversion from number for 2nd argument! | checknum CARG4; bne ->fff_fallback |.else | .ffunc_nn bit_..name | fadd FARG1, FARG1, TOBIT | fadd FARG2, FARG2, TOBIT | stfd FARG1, TMPD | lwz CARG1, TMPD_LO | stfd FARG2, TMPD | lwz CARG2, TMPD_LO |.endif |.if shmod == 1 | rlwinm CARG2, CARG2, 0, 27, 31 |.elif shmod == 2 | neg CARG2, CARG2 |.endif | ins CRET1, CARG1, CARG2 | b ->fff_resi |.endmacro | |.ffunc_bit_sh lshift, slw, 1 |.ffunc_bit_sh rshift, srw, 1 |.ffunc_bit_sh arshift, sraw, 1 |.ffunc_bit_sh rol, rotlw, 0 |.ffunc_bit_sh ror, rotlw, 2 | |.ffunc_bit tobit |.if DUALNUM | b ->fff_resi |.else |->fff_resi: | tonum_i FARG1, CRET1 |.endif |->fff_resn: | lwz PC, FRAME_PC(BASE) | la RA, -8(BASE) | stfd FARG1, -8(BASE) | b ->fff_res1 | |// Fallback FP number to bit conversion. |->fff_tobit_fb: |.if DUALNUM | lfd FARG1, 0(BASE) | bgt ->fff_fallback | fadd FARG1, FARG1, TOBIT | stfd FARG1, TMPD | lwz CARG1, TMPD_LO | blr |.endif |->fff_bitop_fb: |.if DUALNUM | lfd FARG1, 0(TMP1) | bgt ->fff_fallback | fadd FARG1, FARG1, TOBIT | stfd FARG1, TMPD | lwz CARG2, TMPD_LO | blr |.endif | |//----------------------------------------------------------------------- | |->fff_fallback: // Call fast function fallback handler. | // BASE = new base, RB = CFUNC, RC = nargs*8 | lp TMP3, CFUNC:RB->f | add TMP1, BASE, NARGS8:RC | lwz PC, FRAME_PC(BASE) // Fallback may overwrite PC. | addi TMP0, TMP1, 8*LUA_MINSTACK | lwz TMP2, L->maxstack | stw PC, SAVE_PC // Redundant (but a defined value). | .toc lp TMP3, 0(TMP3) | cmplw TMP0, TMP2 | stp BASE, L->base | stp TMP1, L->top | mr CARG1, L | bgt >5 // Need to grow stack. | mtctr TMP3 | bctrl // (lua_State *L) | // Either throws an error, or recovers and returns -1, 0 or nresults+1. | lp BASE, L->base | cmpwi CRET1, 0 | slwi RD, CRET1, 3 | la RA, -8(BASE) | bgt ->fff_res // Returned nresults+1? |1: // Returned 0 or -1: retry fast path. | lp TMP0, L->top | lwz LFUNC:RB, FRAME_FUNC(BASE) | sub NARGS8:RC, TMP0, BASE | bne ->vm_call_tail // Returned -1? | ins_callt // Returned 0: retry fast path. | |// Reconstruct previous base for vmeta_call during tailcall. |->vm_call_tail: | andix. TMP0, PC, FRAME_TYPE | rlwinm TMP1, PC, 0, 0, 28 | bne >3 | lwz INS, -4(PC) | decode_RA8 TMP1, INS | addi TMP1, TMP1, 8 |3: | sub TMP2, BASE, TMP1 | b ->vm_call_dispatch // Resolve again for tailcall. | |5: // Grow stack for fallback handler. | li CARG2, LUA_MINSTACK | bl extern lj_state_growstack // (lua_State *L, int n) | lp BASE, L->base | cmpw TMP0, TMP0 // Set 4*cr0+eq to force retry. | b <1 | |->fff_gcstep: // Call GC step function. | // BASE = new base, RC = nargs*8 | mflr SAVE0 | stp BASE, L->base | add TMP0, BASE, NARGS8:RC | stw PC, SAVE_PC // Redundant (but a defined value). | stp TMP0, L->top | mr CARG1, L | bl extern lj_gc_step // (lua_State *L) | lp BASE, L->base | mtlr SAVE0 | lp TMP0, L->top | sub NARGS8:RC, TMP0, BASE | lwz CFUNC:RB, FRAME_FUNC(BASE) | blr | |//----------------------------------------------------------------------- |//-- Special dispatch targets ------------------------------------------- |//----------------------------------------------------------------------- | |->vm_record: // Dispatch target for recording phase. |.if JIT | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | andix. TMP0, TMP3, HOOK_VMEVENT // No recording while in vmevent. | bne >5 | // Decrement the hookcount for consistency, but always do the call. | lwz TMP2, DISPATCH_GL(hookcount)(DISPATCH) | andix. TMP0, TMP3, HOOK_ACTIVE | bne >1 | subi TMP2, TMP2, 1 | andi. TMP0, TMP3, LUA_MASKLINE|LUA_MASKCOUNT | beqy >1 | stw TMP2, DISPATCH_GL(hookcount)(DISPATCH) | b >1 |.endif | |->vm_rethook: // Dispatch target for return hooks. | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | andix. TMP0, TMP3, HOOK_ACTIVE // Hook already active? | beq >1 |5: // Re-dispatch to static ins. | addi TMP1, TMP1, GG_DISP2STATIC // Assumes decode_OPP TMP1, INS. | lpx TMP0, DISPATCH, TMP1 | mtctr TMP0 | bctr | |->vm_inshook: // Dispatch target for instr/line hooks. | lbz TMP3, DISPATCH_GL(hookmask)(DISPATCH) | lwz TMP2, DISPATCH_GL(hookcount)(DISPATCH) | andix. TMP0, TMP3, HOOK_ACTIVE // Hook already active? | rlwinm TMP0, TMP3, 31-LUA_HOOKLINE, 31, 0 | bne <5 | | cmpwi cr1, TMP0, 0 | addic. TMP2, TMP2, -1 | beq cr1, <5 | stw TMP2, DISPATCH_GL(hookcount)(DISPATCH) | beq >1 | bge cr1, <5 |1: | mr CARG1, L | stw MULTRES, SAVE_MULTRES | mr CARG2, PC | stp BASE, L->base | // SAVE_PC must hold the _previous_ PC. The callee updates it with PC. | bl extern lj_dispatch_ins // (lua_State *L, const BCIns *pc) |3: | lp BASE, L->base |4: // Re-dispatch to static ins. | lwz INS, -4(PC) | decode_OPP TMP1, INS | decode_RB8 RB, INS | addi TMP1, TMP1, GG_DISP2STATIC | decode_RD8 RD, INS | lpx TMP0, DISPATCH, TMP1 | decode_RA8 RA, INS | decode_RC8 RC, INS | mtctr TMP0 | bctr | |->cont_hook: // Continue from hook yield. | addi PC, PC, 4 | lwz MULTRES, -20(RB) // Restore MULTRES for *M ins. | b <4 | |->vm_hotloop: // Hot loop counter underflow. |.if JIT | lwz LFUNC:TMP1, FRAME_FUNC(BASE) | addi CARG1, DISPATCH, GG_DISP2J | stw PC, SAVE_PC | lwz TMP1, LFUNC:TMP1->pc | mr CARG2, PC | stw L, DISPATCH_J(L)(DISPATCH) | lbz TMP1, PC2PROTO(framesize)(TMP1) | stp BASE, L->base | slwi TMP1, TMP1, 3 | add TMP1, BASE, TMP1 | stp TMP1, L->top | bl extern lj_trace_hot // (jit_State *J, const BCIns *pc) | b <3 |.endif | |->vm_callhook: // Dispatch target for call hooks. | mr CARG2, PC |.if JIT | b >1 |.endif | |->vm_hotcall: // Hot call counter underflow. |.if JIT | ori CARG2, PC, 1 |1: |.endif | add TMP0, BASE, RC | stw PC, SAVE_PC | mr CARG1, L | stp BASE, L->base | sub RA, RA, BASE | stp TMP0, L->top | bl extern lj_dispatch_call // (lua_State *L, const BCIns *pc) | // Returns ASMFunction. | lp BASE, L->base | lp TMP0, L->top | stw ZERO, SAVE_PC // Invalidate for subsequent line hook. | sub NARGS8:RC, TMP0, BASE | add RA, BASE, RA | lwz LFUNC:RB, FRAME_FUNC(BASE) | lwz INS, -4(PC) | mtctr CRET1 | bctr | |//----------------------------------------------------------------------- |//-- Trace exit handler ------------------------------------------------- |//----------------------------------------------------------------------- | |.macro savex_, a, b, c, d | stfd f..a, 16+a*8(sp) | stfd f..b, 16+b*8(sp) | stfd f..c, 16+c*8(sp) | stfd f..d, 16+d*8(sp) |.endmacro | |->vm_exit_handler: |.if JIT | addi sp, sp, -(16+32*8+32*4) | stmw r2, 16+32*8+2*4(sp) | addi DISPATCH, JGL, -GG_DISP2G-32768 | li CARG2, ~LJ_VMST_EXIT | lwz CARG1, 16+32*8+32*4(sp) // Get stack chain. | stw CARG2, DISPATCH_GL(vmstate)(DISPATCH) | savex_ 0,1,2,3 | stw CARG1, 0(sp) // Store extended stack chain. | clrso TMP1 | savex_ 4,5,6,7 | addi CARG2, sp, 16+32*8+32*4 // Recompute original value of sp. | savex_ 8,9,10,11 | stw CARG2, 16+32*8+1*4(sp) // Store sp in RID_SP. | savex_ 12,13,14,15 | mflr CARG3 | li TMP1, 0 | savex_ 16,17,18,19 | stw TMP1, 16+32*8+0*4(sp) // Clear RID_TMP. | savex_ 20,21,22,23 | lhz CARG4, 2(CARG3) // Load trace number. | savex_ 24,25,26,27 | lwz L, DISPATCH_GL(jit_L)(DISPATCH) | savex_ 28,29,30,31 | sub CARG3, TMP0, CARG3 // Compute exit number. | lp BASE, DISPATCH_GL(jit_base)(DISPATCH) | srwi CARG3, CARG3, 2 | stw L, DISPATCH_J(L)(DISPATCH) | subi CARG3, CARG3, 2 | stw TMP1, DISPATCH_GL(jit_L)(DISPATCH) | stw CARG4, DISPATCH_J(parent)(DISPATCH) | stp BASE, L->base | addi CARG1, DISPATCH, GG_DISP2J | stw CARG3, DISPATCH_J(exitno)(DISPATCH) | addi CARG2, sp, 16 | bl extern lj_trace_exit // (jit_State *J, ExitState *ex) | // Returns MULTRES (unscaled) or negated error code. | lp TMP1, L->cframe | lwz TMP2, 0(sp) | lp BASE, L->base |.if GPR64 | rldicr sp, TMP1, 0, 61 |.else | rlwinm sp, TMP1, 0, 0, 29 |.endif | lwz PC, SAVE_PC // Get SAVE_PC. | stw TMP2, 0(sp) | stw L, SAVE_L // Set SAVE_L (on-trace resume/yield). | b >1 |.endif |->vm_exit_interp: |.if JIT | // CARG1 = MULTRES or negated error code, BASE, PC and JGL set. | lwz L, SAVE_L | addi DISPATCH, JGL, -GG_DISP2G-32768 |1: | cmpwi CARG1, 0 | blt >3 // Check for error from exit. | lwz LFUNC:TMP1, FRAME_FUNC(BASE) | slwi MULTRES, CARG1, 3 | li TMP2, 0 | stw MULTRES, SAVE_MULTRES | lwz TMP1, LFUNC:TMP1->pc | stw TMP2, DISPATCH_GL(jit_L)(DISPATCH) | lwz KBASE, PC2PROTO(k)(TMP1) | // Setup type comparison constants. | li TISNUM, LJ_TISNUM | lus TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | stw TMP3, TMPD | li ZERO, 0 | ori TMP3, TMP3, 0x0004 // TONUM = 2^52 + 2^51 + 2^31 (float). | lfs TOBIT, TMPD | stw TMP3, TMPD | lus TMP0, 0x4338 // Hiword of 2^52 + 2^51 (double) | li TISNIL, LJ_TNIL | stw TMP0, TONUM_HI | lfs TONUM, TMPD | // Modified copy of ins_next which handles function header dispatch, too. | lwz INS, 0(PC) | addi PC, PC, 4 | // Assumes TISNIL == ~LJ_VMST_INTERP == -1. | stw TISNIL, DISPATCH_GL(vmstate)(DISPATCH) | decode_OPP TMP1, INS | decode_RA8 RA, INS | lpx TMP0, DISPATCH, TMP1 | mtctr TMP0 | cmplwi TMP1, BC_FUNCF*4 // Function header? | bge >2 | decode_RB8 RB, INS | decode_RD8 RD, INS | decode_RC8 RC, INS | bctr |2: | subi RC, MULTRES, 8 | add RA, RA, BASE | bctr | |3: // Rethrow error from the right C frame. | neg CARG2, CARG1 | mr CARG1, L | bl extern lj_err_throw // (lua_State *L, int errcode) |.endif | |//----------------------------------------------------------------------- |//-- Math helper functions ---------------------------------------------- |//----------------------------------------------------------------------- | |// NYI: Use internal implementations of floor, ceil, trunc. | |->vm_modi: | divwo. TMP0, CARG1, CARG2 | bso >1 |.if GPR64 | xor CARG3, CARG1, CARG2 | cmpwi CARG3, 0 |.else | xor. CARG3, CARG1, CARG2 |.endif | mullw TMP0, TMP0, CARG2 | sub CARG1, CARG1, TMP0 | bgelr | cmpwi CARG1, 0; beqlr | add CARG1, CARG1, CARG2 | blr |1: | cmpwi CARG2, 0 | li CARG1, 0 | beqlr | clrso TMP0 // Clear SO for -2147483648 % -1 and return 0. | blr | |//----------------------------------------------------------------------- |//-- Miscellaneous functions -------------------------------------------- |//----------------------------------------------------------------------- | |// void lj_vm_cachesync(void *start, void *end) |// Flush D-Cache and invalidate I-Cache. Assumes 32 byte cache line size. |// This is a good lower bound, except for very ancient PPC models. |->vm_cachesync: |.if JIT or FFI | // Compute start of first cache line and number of cache lines. | rlwinm CARG1, CARG1, 0, 0, 26 | sub CARG2, CARG2, CARG1 | addi CARG2, CARG2, 31 | rlwinm. CARG2, CARG2, 27, 5, 31 | beqlr | mtctr CARG2 | mr CARG3, CARG1 |1: // Flush D-Cache. | dcbst r0, CARG1 | addi CARG1, CARG1, 32 | bdnz <1 | sync | mtctr CARG2 |1: // Invalidate I-Cache. | icbi r0, CARG3 | addi CARG3, CARG3, 32 | bdnz <1 | isync | blr |.endif | |//----------------------------------------------------------------------- |//-- FFI helper functions ----------------------------------------------- |//----------------------------------------------------------------------- | |// Handler for callback functions. Callback slot number in r11, g in r12. |->vm_ffi_callback: |.if FFI |.type CTSTATE, CTState, PC | saveregs | lwz CTSTATE, GL:r12->ctype_state | addi DISPATCH, r12, GG_G2DISP | stw r11, CTSTATE->cb.slot | stw r3, CTSTATE->cb.gpr[0] | stfd f1, CTSTATE->cb.fpr[0] | stw r4, CTSTATE->cb.gpr[1] | stfd f2, CTSTATE->cb.fpr[1] | stw r5, CTSTATE->cb.gpr[2] | stfd f3, CTSTATE->cb.fpr[2] | stw r6, CTSTATE->cb.gpr[3] | stfd f4, CTSTATE->cb.fpr[3] | stw r7, CTSTATE->cb.gpr[4] | stfd f5, CTSTATE->cb.fpr[4] | stw r8, CTSTATE->cb.gpr[5] | stfd f6, CTSTATE->cb.fpr[5] | stw r9, CTSTATE->cb.gpr[6] | stfd f7, CTSTATE->cb.fpr[6] | stw r10, CTSTATE->cb.gpr[7] | stfd f8, CTSTATE->cb.fpr[7] | addi TMP0, sp, CFRAME_SPACE+8 | stw TMP0, CTSTATE->cb.stack | mr CARG1, CTSTATE | stw CTSTATE, SAVE_PC // Any value outside of bytecode is ok. | mr CARG2, sp | bl extern lj_ccallback_enter // (CTState *cts, void *cf) | // Returns lua_State *. | lp BASE, L:CRET1->base | li TISNUM, LJ_TISNUM // Setup type comparison constants. | lp RC, L:CRET1->top | lus TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | li ZERO, 0 | mr L, CRET1 | stw TMP3, TMPD | lus TMP0, 0x4338 // Hiword of 2^52 + 2^51 (double) | lwz LFUNC:RB, FRAME_FUNC(BASE) | ori TMP3, TMP3, 0x0004 // TONUM = 2^52 + 2^51 + 2^31 (float). | stw TMP0, TONUM_HI | li TISNIL, LJ_TNIL | li_vmstate INTERP | lfs TOBIT, TMPD | stw TMP3, TMPD | sub RC, RC, BASE | st_vmstate | lfs TONUM, TMPD | ins_callt |.endif | |->cont_ffi_callback: // Return from FFI callback. |.if FFI | lwz CTSTATE, DISPATCH_GL(ctype_state)(DISPATCH) | stp BASE, L->base | stp RB, L->top | stp L, CTSTATE->L | mr CARG1, CTSTATE | mr CARG2, RA | bl extern lj_ccallback_leave // (CTState *cts, TValue *o) | lwz CRET1, CTSTATE->cb.gpr[0] | lfd FARG1, CTSTATE->cb.fpr[0] | lwz CRET2, CTSTATE->cb.gpr[1] | b ->vm_leave_unw |.endif | |->vm_ffi_call: // Call C function via FFI. | // Caveat: needs special frame unwinding, see below. |.if FFI | .type CCSTATE, CCallState, CARG1 | lwz TMP1, CCSTATE->spadj | mflr TMP0 | lbz CARG2, CCSTATE->nsp | lbz CARG3, CCSTATE->nfpr | neg TMP1, TMP1 | stw TMP0, 4(sp) | cmpwi cr1, CARG3, 0 | mr TMP2, sp | addic. CARG2, CARG2, -1 | stwux sp, sp, TMP1 | crnot 4*cr1+eq, 4*cr1+eq // For vararg calls. | stw r14, -4(TMP2) | stw CCSTATE, -8(TMP2) | mr r14, TMP2 | la TMP1, CCSTATE->stack | slwi CARG2, CARG2, 2 | blty >2 | la TMP2, 8(sp) |1: | lwzx TMP0, TMP1, CARG2 | stwx TMP0, TMP2, CARG2 | addic. CARG2, CARG2, -4 | bge <1 |2: | bney cr1, >3 | lfd f1, CCSTATE->fpr[0] | lfd f2, CCSTATE->fpr[1] | lfd f3, CCSTATE->fpr[2] | lfd f4, CCSTATE->fpr[3] | lfd f5, CCSTATE->fpr[4] | lfd f6, CCSTATE->fpr[5] | lfd f7, CCSTATE->fpr[6] | lfd f8, CCSTATE->fpr[7] |3: | lp TMP0, CCSTATE->func | lwz CARG2, CCSTATE->gpr[1] | lwz CARG3, CCSTATE->gpr[2] | lwz CARG4, CCSTATE->gpr[3] | lwz CARG5, CCSTATE->gpr[4] | mtctr TMP0 | lwz r8, CCSTATE->gpr[5] | lwz r9, CCSTATE->gpr[6] | lwz r10, CCSTATE->gpr[7] | lwz CARG1, CCSTATE->gpr[0] // Do this last, since CCSTATE is CARG1. | bctrl | lwz CCSTATE:TMP1, -8(r14) | lwz TMP2, -4(r14) | lwz TMP0, 4(r14) | stw CARG1, CCSTATE:TMP1->gpr[0] | stfd FARG1, CCSTATE:TMP1->fpr[0] | stw CARG2, CCSTATE:TMP1->gpr[1] | mtlr TMP0 | stw CARG3, CCSTATE:TMP1->gpr[2] | mr sp, r14 | stw CARG4, CCSTATE:TMP1->gpr[3] | mr r14, TMP2 | blr |.endif |// Note: vm_ffi_call must be the last function in this object file! | |//----------------------------------------------------------------------- } /* Generate the code for a single instruction. */ static void build_ins(BuildCtx *ctx, BCOp op, int defop) { int vk = 0; |=>defop: switch (op) { /* -- Comparison ops ---------------------------------------------------- */ /* Remember: all ops branch for a true comparison, fall through otherwise. */ case BC_ISLT: case BC_ISGE: case BC_ISLE: case BC_ISGT: | // RA = src1*8, RD = src2*8, JMP with RD = target |.if DUALNUM | lwzux TMP0, RA, BASE | addi PC, PC, 4 | lwz CARG2, 4(RA) | lwzux TMP1, RD, BASE | lwz TMP2, -4(PC) | checknum cr0, TMP0 | lwz CARG3, 4(RD) | decode_RD4 TMP2, TMP2 | checknum cr1, TMP1 | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) | bne cr0, >7 | bne cr1, >8 | cmpw CARG2, CARG3 if (op == BC_ISLT) { | bge >2 } else if (op == BC_ISGE) { | blt >2 } else if (op == BC_ISLE) { | bgt >2 } else { | ble >2 } |1: | add PC, PC, TMP2 |2: | ins_next | |7: // RA is not an integer. | bgt cr0, ->vmeta_comp | // RA is a number. | lfd f0, 0(RA) | bgt cr1, ->vmeta_comp | blt cr1, >4 | // RA is a number, RD is an integer. | tonum_i f1, CARG3 | b >5 | |8: // RA is an integer, RD is not an integer. | bgt cr1, ->vmeta_comp | // RA is an integer, RD is a number. | tonum_i f0, CARG2 |4: | lfd f1, 0(RD) |5: | fcmpu cr0, f0, f1 if (op == BC_ISLT) { | bge <2 } else if (op == BC_ISGE) { | blt <2 } else if (op == BC_ISLE) { | cror 4*cr0+lt, 4*cr0+lt, 4*cr0+eq | bge <2 } else { | cror 4*cr0+lt, 4*cr0+lt, 4*cr0+eq | blt <2 } | b <1 |.else | lwzx TMP0, BASE, RA | addi PC, PC, 4 | lfdx f0, BASE, RA | lwzx TMP1, BASE, RD | checknum cr0, TMP0 | lwz TMP2, -4(PC) | lfdx f1, BASE, RD | checknum cr1, TMP1 | decode_RD4 TMP2, TMP2 | bge cr0, ->vmeta_comp | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) | bge cr1, ->vmeta_comp | fcmpu cr0, f0, f1 if (op == BC_ISLT) { | bge >1 } else if (op == BC_ISGE) { | blt >1 } else if (op == BC_ISLE) { | cror 4*cr0+lt, 4*cr0+lt, 4*cr0+eq | bge >1 } else { | cror 4*cr0+lt, 4*cr0+lt, 4*cr0+eq | blt >1 } | add PC, PC, TMP2 |1: | ins_next |.endif break; case BC_ISEQV: case BC_ISNEV: vk = op == BC_ISEQV; | // RA = src1*8, RD = src2*8, JMP with RD = target |.if DUALNUM | lwzux TMP0, RA, BASE | addi PC, PC, 4 | lwz CARG2, 4(RA) | lwzux TMP1, RD, BASE | checknum cr0, TMP0 | lwz TMP2, -4(PC) | checknum cr1, TMP1 | decode_RD4 TMP2, TMP2 | lwz CARG3, 4(RD) | cror 4*cr7+gt, 4*cr0+gt, 4*cr1+gt | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) if (vk) { | ble cr7, ->BC_ISEQN_Z } else { | ble cr7, ->BC_ISNEN_Z } |.else | lwzux TMP0, RA, BASE | lwz TMP2, 0(PC) | lfd f0, 0(RA) | addi PC, PC, 4 | lwzux TMP1, RD, BASE | checknum cr0, TMP0 | decode_RD4 TMP2, TMP2 | lfd f1, 0(RD) | checknum cr1, TMP1 | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) | bge cr0, >5 | bge cr1, >5 | fcmpu cr0, f0, f1 if (vk) { | bne >1 | add PC, PC, TMP2 } else { | beq >1 | add PC, PC, TMP2 } |1: | ins_next |.endif |5: // Either or both types are not numbers. |.if not DUALNUM | lwz CARG2, 4(RA) | lwz CARG3, 4(RD) |.endif |.if FFI | cmpwi cr7, TMP0, LJ_TCDATA | cmpwi cr5, TMP1, LJ_TCDATA |.endif | not TMP3, TMP0 | cmplw TMP0, TMP1 | cmplwi cr1, TMP3, ~LJ_TISPRI // Primitive? |.if FFI | cror 4*cr7+eq, 4*cr7+eq, 4*cr5+eq |.endif | cmplwi cr6, TMP3, ~LJ_TISTABUD // Table or userdata? |.if FFI | beq cr7, ->vmeta_equal_cd |.endif | cmplw cr5, CARG2, CARG3 | crandc 4*cr0+gt, 4*cr0+eq, 4*cr1+gt // 2: Same type and primitive. | crorc 4*cr0+lt, 4*cr5+eq, 4*cr0+eq // 1: Same tv or different type. | crand 4*cr0+eq, 4*cr0+eq, 4*cr5+eq // 0: Same type and same tv. | mr SAVE0, PC | cror 4*cr0+eq, 4*cr0+eq, 4*cr0+gt // 0 or 2. | cror 4*cr0+lt, 4*cr0+lt, 4*cr0+gt // 1 or 2. if (vk) { | bne cr0, >6 | add PC, PC, TMP2 |6: } else { | beq cr0, >6 | add PC, PC, TMP2 |6: } |.if DUALNUM | bge cr0, >2 // Done if 1 or 2. |1: | ins_next |2: |.else | blt cr0, <1 // Done if 1 or 2. |.endif | blt cr6, <1 // Done if not tab/ud. | | // Different tables or userdatas. Need to check __eq metamethod. | // Field metatable must be at same offset for GCtab and GCudata! | lwz TAB:TMP2, TAB:CARG2->metatable | li CARG4, 1-vk // ne = 0 or 1. | cmplwi TAB:TMP2, 0 | beq <1 // No metatable? | lbz TMP2, TAB:TMP2->nomm | andix. TMP2, TMP2, 1<vmeta_equal // Handle __eq metamethod. break; case BC_ISEQS: case BC_ISNES: vk = op == BC_ISEQS; | // RA = src*8, RD = str_const*8 (~), JMP with RD = target | lwzux TMP0, RA, BASE | srwi RD, RD, 1 | lwz STR:TMP3, 4(RA) | lwz TMP2, 0(PC) | subfic RD, RD, -4 | addi PC, PC, 4 |.if FFI | cmpwi TMP0, LJ_TCDATA |.endif | lwzx STR:TMP1, KBASE, RD // KBASE-4-str_const*4 | .gpr64 extsw TMP0, TMP0 | subfic TMP0, TMP0, LJ_TSTR |.if FFI | beq ->vmeta_equal_cd |.endif | sub TMP1, STR:TMP1, STR:TMP3 | or TMP0, TMP0, TMP1 | decode_RD4 TMP2, TMP2 | subfic TMP0, TMP0, 0 | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) | subfe TMP1, TMP1, TMP1 if (vk) { | andc TMP2, TMP2, TMP1 } else { | and TMP2, TMP2, TMP1 } | add PC, PC, TMP2 | ins_next break; case BC_ISEQN: case BC_ISNEN: vk = op == BC_ISEQN; | // RA = src*8, RD = num_const*8, JMP with RD = target |.if DUALNUM | lwzux TMP0, RA, BASE | addi PC, PC, 4 | lwz CARG2, 4(RA) | lwzux TMP1, RD, KBASE | checknum cr0, TMP0 | lwz TMP2, -4(PC) | checknum cr1, TMP1 | decode_RD4 TMP2, TMP2 | lwz CARG3, 4(RD) | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) if (vk) { |->BC_ISEQN_Z: } else { |->BC_ISNEN_Z: } | bne cr0, >7 | bne cr1, >8 | cmpw CARG2, CARG3 |4: |.else if (vk) { |->BC_ISEQN_Z: // Dummy label. } else { |->BC_ISNEN_Z: // Dummy label. } | lwzx TMP0, BASE, RA | addi PC, PC, 4 | lfdx f0, BASE, RA | lwz TMP2, -4(PC) | lfdx f1, KBASE, RD | decode_RD4 TMP2, TMP2 | checknum TMP0 | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) | bge >3 | fcmpu cr0, f0, f1 |.endif if (vk) { | bne >1 | add PC, PC, TMP2 |1: |.if not FFI |3: |.endif } else { | beq >2 |1: |.if not FFI |3: |.endif | add PC, PC, TMP2 |2: } | ins_next |.if FFI |3: | cmpwi TMP0, LJ_TCDATA | beq ->vmeta_equal_cd | b <1 |.endif |.if DUALNUM |7: // RA is not an integer. | bge cr0, <3 | // RA is a number. | lfd f0, 0(RA) | blt cr1, >1 | // RA is a number, RD is an integer. | tonum_i f1, CARG3 | b >2 | |8: // RA is an integer, RD is a number. | tonum_i f0, CARG2 |1: | lfd f1, 0(RD) |2: | fcmpu cr0, f0, f1 | b <4 |.endif break; case BC_ISEQP: case BC_ISNEP: vk = op == BC_ISEQP; | // RA = src*8, RD = primitive_type*8 (~), JMP with RD = target | lwzx TMP0, BASE, RA | srwi TMP1, RD, 3 | lwz TMP2, 0(PC) | not TMP1, TMP1 | addi PC, PC, 4 |.if FFI | cmpwi TMP0, LJ_TCDATA |.endif | sub TMP0, TMP0, TMP1 |.if FFI | beq ->vmeta_equal_cd |.endif | decode_RD4 TMP2, TMP2 | .gpr64 extsw TMP0, TMP0 | addic TMP0, TMP0, -1 | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) | subfe TMP1, TMP1, TMP1 if (vk) { | and TMP2, TMP2, TMP1 } else { | andc TMP2, TMP2, TMP1 } | add PC, PC, TMP2 | ins_next break; /* -- Unary test and copy ops ------------------------------------------- */ case BC_ISTC: case BC_ISFC: case BC_IST: case BC_ISF: | // RA = dst*8 or unused, RD = src*8, JMP with RD = target | lwzx TMP0, BASE, RD | lwz INS, 0(PC) | addi PC, PC, 4 if (op == BC_IST || op == BC_ISF) { | .gpr64 extsw TMP0, TMP0 | subfic TMP0, TMP0, LJ_TTRUE | decode_RD4 TMP2, INS | subfe TMP1, TMP1, TMP1 | addis TMP2, TMP2, -(BCBIAS_J*4 >> 16) if (op == BC_IST) { | andc TMP2, TMP2, TMP1 } else { | and TMP2, TMP2, TMP1 } | add PC, PC, TMP2 } else { | li TMP1, LJ_TFALSE | lfdx f0, BASE, RD | cmplw TMP0, TMP1 if (op == BC_ISTC) { | bge >1 } else { | blt >1 } | addis PC, PC, -(BCBIAS_J*4 >> 16) | decode_RD4 TMP2, INS | stfdx f0, BASE, RA | add PC, PC, TMP2 |1: } | ins_next break; /* -- Unary ops --------------------------------------------------------- */ case BC_MOV: | // RA = dst*8, RD = src*8 | ins_next1 | lfdx f0, BASE, RD | stfdx f0, BASE, RA | ins_next2 break; case BC_NOT: | // RA = dst*8, RD = src*8 | ins_next1 | lwzx TMP0, BASE, RD | .gpr64 extsw TMP0, TMP0 | subfic TMP1, TMP0, LJ_TTRUE | adde TMP0, TMP0, TMP1 | stwx TMP0, BASE, RA | ins_next2 break; case BC_UNM: | // RA = dst*8, RD = src*8 | lwzux TMP1, RD, BASE | lwz TMP0, 4(RD) | checknum TMP1 |.if DUALNUM | bne >5 |.if GPR64 | lus TMP2, 0x8000 | neg TMP0, TMP0 | cmplw TMP0, TMP2 | beq >4 |.else | nego. TMP0, TMP0 | bso >4 |1: |.endif | ins_next1 | stwux TISNUM, RA, BASE | stw TMP0, 4(RA) |3: | ins_next2 |4: |.if not GPR64 | // Potential overflow. | checkov TMP1, <1 // Ignore unrelated overflow. |.endif | lus TMP1, 0x41e0 // 2^31. | li TMP0, 0 | b >7 |.endif |5: | bge ->vmeta_unm | xoris TMP1, TMP1, 0x8000 |7: | ins_next1 | stwux TMP1, RA, BASE | stw TMP0, 4(RA) |.if DUALNUM | b <3 |.else | ins_next2 |.endif break; case BC_LEN: | // RA = dst*8, RD = src*8 | lwzux TMP0, RD, BASE | lwz CARG1, 4(RD) | checkstr TMP0; bne >2 | lwz CRET1, STR:CARG1->len |1: |.if DUALNUM | ins_next1 | stwux TISNUM, RA, BASE | stw CRET1, 4(RA) |.else | tonum_u f0, CRET1 // Result is a non-negative integer. | ins_next1 | stfdx f0, BASE, RA |.endif | ins_next2 |2: | checktab TMP0; bne ->vmeta_len #if LJ_52 | lwz TAB:TMP2, TAB:CARG1->metatable | cmplwi TAB:TMP2, 0 | bne >9 |3: #endif |->BC_LEN_Z: | bl extern lj_tab_len // (GCtab *t) | // Returns uint32_t (but less than 2^31). | b <1 #if LJ_52 |9: | lbz TMP0, TAB:TMP2->nomm | andix. TMP0, TMP0, 1<vmeta_len #endif break; /* -- Binary ops -------------------------------------------------------- */ |.macro ins_arithpre | // RA = dst*8, RB = src1*8, RC = src2*8 | num_const*8 ||vk = ((int)op - BC_ADDVN) / (BC_ADDNV-BC_ADDVN); ||switch (vk) { ||case 0: | lwzx TMP1, BASE, RB | .if DUALNUM | lwzx TMP2, KBASE, RC | .endif | lfdx f14, BASE, RB | lfdx f15, KBASE, RC | .if DUALNUM | checknum cr0, TMP1 | checknum cr1, TMP2 | crand 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | bge ->vmeta_arith_vn | .else | checknum TMP1; bge ->vmeta_arith_vn | .endif || break; ||case 1: | lwzx TMP1, BASE, RB | .if DUALNUM | lwzx TMP2, KBASE, RC | .endif | lfdx f15, BASE, RB | lfdx f14, KBASE, RC | .if DUALNUM | checknum cr0, TMP1 | checknum cr1, TMP2 | crand 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | bge ->vmeta_arith_nv | .else | checknum TMP1; bge ->vmeta_arith_nv | .endif || break; ||default: | lwzx TMP1, BASE, RB | lwzx TMP2, BASE, RC | lfdx f14, BASE, RB | lfdx f15, BASE, RC | checknum cr0, TMP1 | checknum cr1, TMP2 | crand 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | bge ->vmeta_arith_vv || break; ||} |.endmacro | |.macro ins_arithfallback, ins ||switch (vk) { ||case 0: | ins ->vmeta_arith_vn2 || break; ||case 1: | ins ->vmeta_arith_nv2 || break; ||default: | ins ->vmeta_arith_vv2 || break; ||} |.endmacro | |.macro intmod, a, b, c | bl ->vm_modi |.endmacro | |.macro fpmod, a, b, c |->BC_MODVN_Z: | fdiv FARG1, b, c | // NYI: Use internal implementation of floor. | blex floor // floor(b/c) | fmul a, FARG1, c | fsub a, b, a // b - floor(b/c)*c |.endmacro | |.macro ins_arithfp, fpins | ins_arithpre |.if "fpins" == "fpmod_" | b ->BC_MODVN_Z // Avoid 3 copies. It's slow anyway. |.else | fpins f0, f14, f15 | ins_next1 | stfdx f0, BASE, RA | ins_next2 |.endif |.endmacro | |.macro ins_arithdn, intins, fpins | // RA = dst*8, RB = src1*8, RC = src2*8 | num_const*8 ||vk = ((int)op - BC_ADDVN) / (BC_ADDNV-BC_ADDVN); ||switch (vk) { ||case 0: | lwzux TMP1, RB, BASE | lwzux TMP2, RC, KBASE | lwz CARG1, 4(RB) | checknum cr0, TMP1 | lwz CARG2, 4(RC) || break; ||case 1: | lwzux TMP1, RB, BASE | lwzux TMP2, RC, KBASE | lwz CARG2, 4(RB) | checknum cr0, TMP1 | lwz CARG1, 4(RC) || break; ||default: | lwzux TMP1, RB, BASE | lwzux TMP2, RC, BASE | lwz CARG1, 4(RB) | checknum cr0, TMP1 | lwz CARG2, 4(RC) || break; ||} | checknum cr1, TMP2 | bne >5 | bne cr1, >5 | intins CARG1, CARG1, CARG2 | bso >4 |1: | ins_next1 | stwux TISNUM, RA, BASE | stw CARG1, 4(RA) |2: | ins_next2 |4: // Overflow. | checkov TMP0, <1 // Ignore unrelated overflow. | ins_arithfallback b |5: // FP variant. ||if (vk == 1) { | lfd f15, 0(RB) | crand 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | lfd f14, 0(RC) ||} else { | lfd f14, 0(RB) | crand 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | lfd f15, 0(RC) ||} | ins_arithfallback bge |.if "fpins" == "fpmod_" | b ->BC_MODVN_Z // Avoid 3 copies. It's slow anyway. |.else | fpins f0, f14, f15 | ins_next1 | stfdx f0, BASE, RA | b <2 |.endif |.endmacro | |.macro ins_arith, intins, fpins |.if DUALNUM | ins_arithdn intins, fpins |.else | ins_arithfp fpins |.endif |.endmacro case BC_ADDVN: case BC_ADDNV: case BC_ADDVV: |.if GPR64 |.macro addo32., y, a, b | // Need to check overflow for (a<<32) + (b<<32). | rldicr TMP0, a, 32, 31 | rldicr TMP3, b, 32, 31 | addo. TMP0, TMP0, TMP3 | add y, a, b |.endmacro | ins_arith addo32., fadd |.else | ins_arith addo., fadd |.endif break; case BC_SUBVN: case BC_SUBNV: case BC_SUBVV: |.if GPR64 |.macro subo32., y, a, b | // Need to check overflow for (a<<32) - (b<<32). | rldicr TMP0, a, 32, 31 | rldicr TMP3, b, 32, 31 | subo. TMP0, TMP0, TMP3 | sub y, a, b |.endmacro | ins_arith subo32., fsub |.else | ins_arith subo., fsub |.endif break; case BC_MULVN: case BC_MULNV: case BC_MULVV: | ins_arith mullwo., fmul break; case BC_DIVVN: case BC_DIVNV: case BC_DIVVV: | ins_arithfp fdiv break; case BC_MODVN: | ins_arith intmod, fpmod break; case BC_MODNV: case BC_MODVV: | ins_arith intmod, fpmod_ break; case BC_POW: | // NYI: (partial) integer arithmetic. | lwzx TMP1, BASE, RB | lfdx FARG1, BASE, RB | lwzx TMP2, BASE, RC | lfdx FARG2, BASE, RC | checknum cr0, TMP1 | checknum cr1, TMP2 | crand 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | bge ->vmeta_arith_vv | blex pow | ins_next1 | stfdx FARG1, BASE, RA | ins_next2 break; case BC_CAT: | // RA = dst*8, RB = src_start*8, RC = src_end*8 | sub CARG3, RC, RB | stp BASE, L->base | add CARG2, BASE, RC | mr SAVE0, RB |->BC_CAT_Z: | stw PC, SAVE_PC | mr CARG1, L | srwi CARG3, CARG3, 3 | bl extern lj_meta_cat // (lua_State *L, TValue *top, int left) | // Returns NULL (finished) or TValue * (metamethod). | cmplwi CRET1, 0 | lp BASE, L->base | bne ->vmeta_binop | ins_next1 | lfdx f0, BASE, SAVE0 // Copy result from RB to RA. | stfdx f0, BASE, RA | ins_next2 break; /* -- Constant ops ------------------------------------------------------ */ case BC_KSTR: | // RA = dst*8, RD = str_const*8 (~) | srwi TMP1, RD, 1 | subfic TMP1, TMP1, -4 | ins_next1 | lwzx TMP0, KBASE, TMP1 // KBASE-4-str_const*4 | li TMP2, LJ_TSTR | stwux TMP2, RA, BASE | stw TMP0, 4(RA) | ins_next2 break; case BC_KCDATA: |.if FFI | // RA = dst*8, RD = cdata_const*8 (~) | srwi TMP1, RD, 1 | subfic TMP1, TMP1, -4 | ins_next1 | lwzx TMP0, KBASE, TMP1 // KBASE-4-cdata_const*4 | li TMP2, LJ_TCDATA | stwux TMP2, RA, BASE | stw TMP0, 4(RA) | ins_next2 |.endif break; case BC_KSHORT: | // RA = dst*8, RD = int16_literal*8 |.if DUALNUM | slwi RD, RD, 13 | srawi RD, RD, 16 | ins_next1 | stwux TISNUM, RA, BASE | stw RD, 4(RA) | ins_next2 |.else | // The soft-float approach is faster. | slwi RD, RD, 13 | srawi TMP1, RD, 31 | xor TMP2, TMP1, RD | sub TMP2, TMP2, TMP1 // TMP2 = abs(x) | cntlzw TMP3, TMP2 | subfic TMP1, TMP3, 0x40d // TMP1 = exponent-1 | slw TMP2, TMP2, TMP3 // TMP2 = left aligned mantissa | subfic TMP3, RD, 0 | slwi TMP1, TMP1, 20 | rlwimi RD, TMP2, 21, 1, 31 // hi = sign(x) | (mantissa>>11) | subfe TMP0, TMP0, TMP0 | add RD, RD, TMP1 // hi = hi + exponent-1 | and RD, RD, TMP0 // hi = x == 0 ? 0 : hi | ins_next1 | stwux RD, RA, BASE | stw ZERO, 4(RA) | ins_next2 |.endif break; case BC_KNUM: | // RA = dst*8, RD = num_const*8 | ins_next1 | lfdx f0, KBASE, RD | stfdx f0, BASE, RA | ins_next2 break; case BC_KPRI: | // RA = dst*8, RD = primitive_type*8 (~) | srwi TMP1, RD, 3 | not TMP0, TMP1 | ins_next1 | stwx TMP0, BASE, RA | ins_next2 break; case BC_KNIL: | // RA = base*8, RD = end*8 | stwx TISNIL, BASE, RA | addi RA, RA, 8 |1: | stwx TISNIL, BASE, RA | cmpw RA, RD | addi RA, RA, 8 | blt <1 | ins_next_ break; /* -- Upvalue and function ops ------------------------------------------ */ case BC_UGET: | // RA = dst*8, RD = uvnum*8 | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RD, RD, 1 | addi RD, RD, offsetof(GCfuncL, uvptr) | lwzx UPVAL:RB, LFUNC:RB, RD | ins_next1 | lwz TMP1, UPVAL:RB->v | lfd f0, 0(TMP1) | stfdx f0, BASE, RA | ins_next2 break; case BC_USETV: | // RA = uvnum*8, RD = src*8 | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RA, RA, 1 | addi RA, RA, offsetof(GCfuncL, uvptr) | lfdux f0, RD, BASE | lwzx UPVAL:RB, LFUNC:RB, RA | lbz TMP3, UPVAL:RB->marked | lwz CARG2, UPVAL:RB->v | andix. TMP3, TMP3, LJ_GC_BLACK // isblack(uv) | lbz TMP0, UPVAL:RB->closed | lwz TMP2, 0(RD) | stfd f0, 0(CARG2) | cmplwi cr1, TMP0, 0 | lwz TMP1, 4(RD) | cror 4*cr0+eq, 4*cr0+eq, 4*cr1+eq | subi TMP2, TMP2, (LJ_TNUMX+1) | bne >2 // Upvalue is closed and black? |1: | ins_next | |2: // Check if new value is collectable. | cmplwi TMP2, LJ_TISGCV - (LJ_TNUMX+1) | bge <1 // tvisgcv(v) | lbz TMP3, GCOBJ:TMP1->gch.marked | andix. TMP3, TMP3, LJ_GC_WHITES // iswhite(v) | la CARG1, GG_DISP2G(DISPATCH) | // Crossed a write barrier. Move the barrier forward. | beq <1 | bl extern lj_gc_barrieruv // (global_State *g, TValue *tv) | b <1 break; case BC_USETS: | // RA = uvnum*8, RD = str_const*8 (~) | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi TMP1, RD, 1 | srwi RA, RA, 1 | subfic TMP1, TMP1, -4 | addi RA, RA, offsetof(GCfuncL, uvptr) | lwzx STR:TMP1, KBASE, TMP1 // KBASE-4-str_const*4 | lwzx UPVAL:RB, LFUNC:RB, RA | lbz TMP3, UPVAL:RB->marked | lwz CARG2, UPVAL:RB->v | andix. TMP3, TMP3, LJ_GC_BLACK // isblack(uv) | lbz TMP3, STR:TMP1->marked | lbz TMP2, UPVAL:RB->closed | li TMP0, LJ_TSTR | stw STR:TMP1, 4(CARG2) | stw TMP0, 0(CARG2) | bne >2 |1: | ins_next | |2: // Check if string is white and ensure upvalue is closed. | andix. TMP3, TMP3, LJ_GC_WHITES // iswhite(str) | cmplwi cr1, TMP2, 0 | cror 4*cr0+eq, 4*cr0+eq, 4*cr1+eq | la CARG1, GG_DISP2G(DISPATCH) | // Crossed a write barrier. Move the barrier forward. | beq <1 | bl extern lj_gc_barrieruv // (global_State *g, TValue *tv) | b <1 break; case BC_USETN: | // RA = uvnum*8, RD = num_const*8 | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RA, RA, 1 | addi RA, RA, offsetof(GCfuncL, uvptr) | lfdx f0, KBASE, RD | lwzx UPVAL:RB, LFUNC:RB, RA | ins_next1 | lwz TMP1, UPVAL:RB->v | stfd f0, 0(TMP1) | ins_next2 break; case BC_USETP: | // RA = uvnum*8, RD = primitive_type*8 (~) | lwz LFUNC:RB, FRAME_FUNC(BASE) | srwi RA, RA, 1 | srwi TMP0, RD, 3 | addi RA, RA, offsetof(GCfuncL, uvptr) | not TMP0, TMP0 | lwzx UPVAL:RB, LFUNC:RB, RA | ins_next1 | lwz TMP1, UPVAL:RB->v | stw TMP0, 0(TMP1) | ins_next2 break; case BC_UCLO: | // RA = level*8, RD = target | lwz TMP1, L->openupval | branch_RD // Do this first since RD is not saved. | stp BASE, L->base | cmplwi TMP1, 0 | mr CARG1, L | beq >1 | add CARG2, BASE, RA | bl extern lj_func_closeuv // (lua_State *L, TValue *level) | lp BASE, L->base |1: | ins_next break; case BC_FNEW: | // RA = dst*8, RD = proto_const*8 (~) (holding function prototype) | srwi TMP1, RD, 1 | stp BASE, L->base | subfic TMP1, TMP1, -4 | stw PC, SAVE_PC | lwzx CARG2, KBASE, TMP1 // KBASE-4-tab_const*4 | mr CARG1, L | lwz CARG3, FRAME_FUNC(BASE) | // (lua_State *L, GCproto *pt, GCfuncL *parent) | bl extern lj_func_newL_gc | // Returns GCfuncL *. | lp BASE, L->base | li TMP0, LJ_TFUNC | stwux TMP0, RA, BASE | stw LFUNC:CRET1, 4(RA) | ins_next break; /* -- Table ops --------------------------------------------------------- */ case BC_TNEW: case BC_TDUP: | // RA = dst*8, RD = (hbits|asize)*8 | tab_const*8 (~) | lwz TMP0, DISPATCH_GL(gc.total)(DISPATCH) | mr CARG1, L | lwz TMP1, DISPATCH_GL(gc.threshold)(DISPATCH) | stp BASE, L->base | cmplw TMP0, TMP1 | stw PC, SAVE_PC | bge >5 |1: if (op == BC_TNEW) { | rlwinm CARG2, RD, 29, 21, 31 | rlwinm CARG3, RD, 18, 27, 31 | cmpwi CARG2, 0x7ff; beq >3 |2: | bl extern lj_tab_new // (lua_State *L, int32_t asize, uint32_t hbits) | // Returns Table *. } else { | srwi TMP1, RD, 1 | subfic TMP1, TMP1, -4 | lwzx CARG2, KBASE, TMP1 // KBASE-4-tab_const*4 | bl extern lj_tab_dup // (lua_State *L, Table *kt) | // Returns Table *. } | lp BASE, L->base | li TMP0, LJ_TTAB | stwux TMP0, RA, BASE | stw TAB:CRET1, 4(RA) | ins_next if (op == BC_TNEW) { |3: | li CARG2, 0x801 | b <2 } |5: | mr SAVE0, RD | bl extern lj_gc_step_fixtop // (lua_State *L) | mr RD, SAVE0 | mr CARG1, L | b <1 break; case BC_GGET: | // RA = dst*8, RD = str_const*8 (~) case BC_GSET: | // RA = src*8, RD = str_const*8 (~) | lwz LFUNC:TMP2, FRAME_FUNC(BASE) | srwi TMP1, RD, 1 | lwz TAB:RB, LFUNC:TMP2->env | subfic TMP1, TMP1, -4 | lwzx STR:RC, KBASE, TMP1 // KBASE-4-str_const*4 if (op == BC_GGET) { | b ->BC_TGETS_Z } else { | b ->BC_TSETS_Z } break; case BC_TGETV: | // RA = dst*8, RB = table*8, RC = key*8 | lwzux CARG1, RB, BASE | lwzux CARG2, RC, BASE | lwz TAB:RB, 4(RB) |.if DUALNUM | lwz RC, 4(RC) |.else | lfd f0, 0(RC) |.endif | checktab CARG1 | checknum cr1, CARG2 | bne ->vmeta_tgetv |.if DUALNUM | lwz TMP0, TAB:RB->asize | bne cr1, >5 | lwz TMP1, TAB:RB->array | cmplw TMP0, RC | slwi TMP2, RC, 3 |.else | bge cr1, >5 | // Convert number key to integer, check for integerness and range. | fctiwz f1, f0 | fadd f2, f0, TOBIT | stfd f1, TMPD | lwz TMP0, TAB:RB->asize | fsub f2, f2, TOBIT | lwz TMP2, TMPD_LO | lwz TMP1, TAB:RB->array | fcmpu cr1, f0, f2 | cmplw cr0, TMP0, TMP2 | crand 4*cr0+gt, 4*cr0+gt, 4*cr1+eq | slwi TMP2, TMP2, 3 |.endif | ble ->vmeta_tgetv // Integer key and in array part? | lwzx TMP0, TMP1, TMP2 | lfdx f14, TMP1, TMP2 | checknil TMP0; beq >2 |1: | ins_next1 | stfdx f14, BASE, RA | ins_next2 | |2: // Check for __index if table value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <1 // No metatable: done. | lbz TMP0, TAB:TMP2->nomm | andix. TMP0, TMP0, 1<vmeta_tgetv | |5: | checkstr CARG2; bne ->vmeta_tgetv |.if not DUALNUM | lwz STR:RC, 4(RC) |.endif | b ->BC_TGETS_Z // String key? break; case BC_TGETS: | // RA = dst*8, RB = table*8, RC = str_const*8 (~) | lwzux CARG1, RB, BASE | srwi TMP1, RC, 1 | lwz TAB:RB, 4(RB) | subfic TMP1, TMP1, -4 | checktab CARG1 | lwzx STR:RC, KBASE, TMP1 // KBASE-4-str_const*4 | bne ->vmeta_tgets1 |->BC_TGETS_Z: | // TAB:RB = GCtab *, STR:RC = GCstr *, RA = dst*8 | lwz TMP0, TAB:RB->hmask | lwz TMP1, STR:RC->hash | lwz NODE:TMP2, TAB:RB->node | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | slwi TMP0, TMP1, 5 | slwi TMP1, TMP1, 3 | sub TMP1, TMP0, TMP1 | add NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) |1: | lwz CARG1, NODE:TMP2->key | lwz TMP0, 4+offsetof(Node, key)(NODE:TMP2) | lwz CARG2, NODE:TMP2->val | lwz TMP1, 4+offsetof(Node, val)(NODE:TMP2) | checkstr CARG1; bne >4 | cmpw TMP0, STR:RC; bne >4 | checknil CARG2; beq >5 // Key found, but nil value? |3: | stwux CARG2, RA, BASE | stw TMP1, 4(RA) | ins_next | |4: // Follow hash chain. | lwz NODE:TMP2, NODE:TMP2->next | cmplwi NODE:TMP2, 0 | bne <1 | // End of hash chain: key not found, nil result. | li CARG2, LJ_TNIL | |5: // Check for __index if table value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <3 // No metatable: done. | lbz TMP0, TAB:TMP2->nomm | andix. TMP0, TMP0, 1<vmeta_tgets break; case BC_TGETB: | // RA = dst*8, RB = table*8, RC = index*8 | lwzux CARG1, RB, BASE | srwi TMP0, RC, 3 | lwz TAB:RB, 4(RB) | checktab CARG1; bne ->vmeta_tgetb | lwz TMP1, TAB:RB->asize | lwz TMP2, TAB:RB->array | cmplw TMP0, TMP1; bge ->vmeta_tgetb | lwzx TMP1, TMP2, RC | lfdx f0, TMP2, RC | checknil TMP1; beq >5 |1: | ins_next1 | stfdx f0, BASE, RA | ins_next2 | |5: // Check for __index if table value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <1 // No metatable: done. | lbz TMP2, TAB:TMP2->nomm | andix. TMP2, TMP2, 1<vmeta_tgetb // Caveat: preserve TMP0! break; case BC_TSETV: | // RA = src*8, RB = table*8, RC = key*8 | lwzux CARG1, RB, BASE | lwzux CARG2, RC, BASE | lwz TAB:RB, 4(RB) |.if DUALNUM | lwz RC, 4(RC) |.else | lfd f0, 0(RC) |.endif | checktab CARG1 | checknum cr1, CARG2 | bne ->vmeta_tsetv |.if DUALNUM | lwz TMP0, TAB:RB->asize | bne cr1, >5 | lwz TMP1, TAB:RB->array | cmplw TMP0, RC | slwi TMP0, RC, 3 |.else | bge cr1, >5 | // Convert number key to integer, check for integerness and range. | fctiwz f1, f0 | fadd f2, f0, TOBIT | stfd f1, TMPD | lwz TMP0, TAB:RB->asize | fsub f2, f2, TOBIT | lwz TMP2, TMPD_LO | lwz TMP1, TAB:RB->array | fcmpu cr1, f0, f2 | cmplw cr0, TMP0, TMP2 | crand 4*cr0+gt, 4*cr0+gt, 4*cr1+eq | slwi TMP0, TMP2, 3 |.endif | ble ->vmeta_tsetv // Integer key and in array part? | lwzx TMP2, TMP1, TMP0 | lbz TMP3, TAB:RB->marked | lfdx f14, BASE, RA | checknil TMP2; beq >3 |1: | andix. TMP2, TMP3, LJ_GC_BLACK // isblack(table) | stfdx f14, TMP1, TMP0 | bne >7 |2: | ins_next | |3: // Check for __newindex if previous value is nil. | lwz TAB:TMP2, TAB:RB->metatable | cmplwi TAB:TMP2, 0 | beq <1 // No metatable: done. | lbz TMP2, TAB:TMP2->nomm | andix. TMP2, TMP2, 1<vmeta_tsetv | |5: | checkstr CARG2; bne ->vmeta_tsetv |.if not DUALNUM | lwz STR:RC, 4(RC) |.endif | b ->BC_TSETS_Z // String key? | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0 | b <2 break; case BC_TSETS: | // RA = src*8, RB = table*8, RC = str_const*8 (~) | lwzux CARG1, RB, BASE | srwi TMP1, RC, 1 | lwz TAB:RB, 4(RB) | subfic TMP1, TMP1, -4 | checktab CARG1 | lwzx STR:RC, KBASE, TMP1 // KBASE-4-str_const*4 | bne ->vmeta_tsets1 |->BC_TSETS_Z: | // TAB:RB = GCtab *, STR:RC = GCstr *, RA = src*8 | lwz TMP0, TAB:RB->hmask | lwz TMP1, STR:RC->hash | lwz NODE:TMP2, TAB:RB->node | stb ZERO, TAB:RB->nomm // Clear metamethod cache. | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | lfdx f14, BASE, RA | slwi TMP0, TMP1, 5 | slwi TMP1, TMP1, 3 | sub TMP1, TMP0, TMP1 | lbz TMP3, TAB:RB->marked | add NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) |1: | lwz CARG1, NODE:TMP2->key | lwz TMP0, 4+offsetof(Node, key)(NODE:TMP2) | lwz CARG2, NODE:TMP2->val | lwz NODE:TMP1, NODE:TMP2->next | checkstr CARG1; bne >5 | cmpw TMP0, STR:RC; bne >5 | checknil CARG2; beq >4 // Key found, but nil value? |2: | andix. TMP0, TMP3, LJ_GC_BLACK // isblack(table) | stfd f14, NODE:TMP2->val | bne >7 |3: | ins_next | |4: // Check for __newindex if previous value is nil. | lwz TAB:TMP1, TAB:RB->metatable | cmplwi TAB:TMP1, 0 | beq <2 // No metatable: done. | lbz TMP0, TAB:TMP1->nomm | andix. TMP0, TMP0, 1<vmeta_tsets | |5: // Follow hash chain. | cmplwi NODE:TMP1, 0 | mr NODE:TMP2, NODE:TMP1 | bne <1 | // End of hash chain: key not found, add a new one. | | // But check for __newindex first. | lwz TAB:TMP1, TAB:RB->metatable | la CARG3, DISPATCH_GL(tmptv)(DISPATCH) | stw PC, SAVE_PC | mr CARG1, L | cmplwi TAB:TMP1, 0 | stp BASE, L->base | beq >6 // No metatable: continue. | lbz TMP0, TAB:TMP1->nomm | andix. TMP0, TMP0, 1<vmeta_tsets // 'no __newindex' flag NOT set: check. |6: | li TMP0, LJ_TSTR | stw STR:RC, 4(CARG3) | mr CARG2, TAB:RB | stw TMP0, 0(CARG3) | bl extern lj_tab_newkey // (lua_State *L, GCtab *t, TValue *k) | // Returns TValue *. | lp BASE, L->base | stfd f14, 0(CRET1) | b <3 // No 2nd write barrier needed. | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0 | b <3 break; case BC_TSETB: | // RA = src*8, RB = table*8, RC = index*8 | lwzux CARG1, RB, BASE | srwi TMP0, RC, 3 | lwz TAB:RB, 4(RB) | checktab CARG1; bne ->vmeta_tsetb | lwz TMP1, TAB:RB->asize | lwz TMP2, TAB:RB->array | lbz TMP3, TAB:RB->marked | cmplw TMP0, TMP1 | lfdx f14, BASE, RA | bge ->vmeta_tsetb | lwzx TMP1, TMP2, RC | checknil TMP1; beq >5 |1: | andix. TMP0, TMP3, LJ_GC_BLACK // isblack(table) | stfdx f14, TMP2, RC | bne >7 |2: | ins_next | |5: // Check for __newindex if previous value is nil. | lwz TAB:TMP1, TAB:RB->metatable | cmplwi TAB:TMP1, 0 | beq <1 // No metatable: done. | lbz TMP1, TAB:TMP1->nomm | andix. TMP1, TMP1, 1<vmeta_tsetb // Caveat: preserve TMP0! | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0 | b <2 break; case BC_TSETM: | // RA = base*8 (table at base-1), RD = num_const*8 (start index) | add RA, BASE, RA |1: | add TMP3, KBASE, RD | lwz TAB:CARG2, -4(RA) // Guaranteed to be a table. | addic. TMP0, MULTRES, -8 | lwz TMP3, 4(TMP3) // Integer constant is in lo-word. | srwi CARG3, TMP0, 3 | beq >4 // Nothing to copy? | add CARG3, CARG3, TMP3 | lwz TMP2, TAB:CARG2->asize | slwi TMP1, TMP3, 3 | lbz TMP3, TAB:CARG2->marked | cmplw CARG3, TMP2 | add TMP2, RA, TMP0 | lwz TMP0, TAB:CARG2->array | bgt >5 | add TMP1, TMP1, TMP0 | andix. TMP0, TMP3, LJ_GC_BLACK // isblack(table) |3: // Copy result slots to table. | lfd f0, 0(RA) | addi RA, RA, 8 | cmpw cr1, RA, TMP2 | stfd f0, 0(TMP1) | addi TMP1, TMP1, 8 | blt cr1, <3 | bne >7 |4: | ins_next | |5: // Need to resize array part. | stp BASE, L->base | mr CARG1, L | stw PC, SAVE_PC | mr SAVE0, RD | bl extern lj_tab_reasize // (lua_State *L, GCtab *t, int nasize) | // Must not reallocate the stack. | mr RD, SAVE0 | b <1 | |7: // Possible table write barrier for any value. Skip valiswhite check. | barrierback TAB:CARG2, TMP3, TMP0 | b <4 break; /* -- Calls and vararg handling ----------------------------------------- */ case BC_CALLM: | // RA = base*8, (RB = (nresults+1)*8,) RC = extra_nargs*8 | add NARGS8:RC, NARGS8:RC, MULTRES | // Fall through. Assumes BC_CALL follows. break; case BC_CALL: | // RA = base*8, (RB = (nresults+1)*8,) RC = (nargs+1)*8 | mr TMP2, BASE | lwzux TMP0, BASE, RA | lwz LFUNC:RB, 4(BASE) | subi NARGS8:RC, NARGS8:RC, 8 | addi BASE, BASE, 8 | checkfunc TMP0; bne ->vmeta_call | ins_call break; case BC_CALLMT: | // RA = base*8, (RB = 0,) RC = extra_nargs*8 | add NARGS8:RC, NARGS8:RC, MULTRES | // Fall through. Assumes BC_CALLT follows. break; case BC_CALLT: | // RA = base*8, (RB = 0,) RC = (nargs+1)*8 | lwzux TMP0, RA, BASE | lwz LFUNC:RB, 4(RA) | subi NARGS8:RC, NARGS8:RC, 8 | lwz TMP1, FRAME_PC(BASE) | checkfunc TMP0 | addi RA, RA, 8 | bne ->vmeta_callt |->BC_CALLT_Z: | andix. TMP0, TMP1, FRAME_TYPE // Caveat: preserve cr0 until the crand. | lbz TMP3, LFUNC:RB->ffid | xori TMP2, TMP1, FRAME_VARG | cmplwi cr1, NARGS8:RC, 0 | bne >7 |1: | stw LFUNC:RB, FRAME_FUNC(BASE) // Copy function down, but keep PC. | li TMP2, 0 | cmplwi cr7, TMP3, 1 // (> FF_C) Calling a fast function? | beq cr1, >3 |2: | addi TMP3, TMP2, 8 | lfdx f0, RA, TMP2 | cmplw cr1, TMP3, NARGS8:RC | stfdx f0, BASE, TMP2 | mr TMP2, TMP3 | bne cr1, <2 |3: | crand 4*cr0+eq, 4*cr0+eq, 4*cr7+gt | beq >5 |4: | ins_callt | |5: // Tailcall to a fast function with a Lua frame below. | lwz INS, -4(TMP1) | decode_RA8 RA, INS | sub TMP1, BASE, RA | lwz LFUNC:TMP1, FRAME_FUNC-8(TMP1) | lwz TMP1, LFUNC:TMP1->pc | lwz KBASE, PC2PROTO(k)(TMP1) // Need to prepare KBASE. | b <4 | |7: // Tailcall from a vararg function. | andix. TMP0, TMP2, FRAME_TYPEP | bne <1 // Vararg frame below? | sub BASE, BASE, TMP2 // Relocate BASE down. | lwz TMP1, FRAME_PC(BASE) | andix. TMP0, TMP1, FRAME_TYPE | b <1 break; case BC_ITERC: | // RA = base*8, (RB = (nresults+1)*8, RC = (nargs+1)*8 ((2+1)*8)) | mr TMP2, BASE | add BASE, BASE, RA | lwz TMP1, -24(BASE) | lwz LFUNC:RB, -20(BASE) | lfd f1, -8(BASE) | lfd f0, -16(BASE) | stw TMP1, 0(BASE) // Copy callable. | stw LFUNC:RB, 4(BASE) | checkfunc TMP1 | stfd f1, 16(BASE) // Copy control var. | li NARGS8:RC, 16 // Iterators get 2 arguments. | stfdu f0, 8(BASE) // Copy state. | bne ->vmeta_call | ins_call break; case BC_ITERN: | // RA = base*8, (RB = (nresults+1)*8, RC = (nargs+1)*8 (2+1)*8) |.if JIT | // NYI: add hotloop, record BC_ITERN. |.endif | add RA, BASE, RA | lwz TAB:RB, -12(RA) | lwz RC, -4(RA) // Get index from control var. | lwz TMP0, TAB:RB->asize | lwz TMP1, TAB:RB->array | addi PC, PC, 4 |1: // Traverse array part. | cmplw RC, TMP0 | slwi TMP3, RC, 3 | bge >5 // Index points after array part? | lwzx TMP2, TMP1, TMP3 | lfdx f0, TMP1, TMP3 | checknil TMP2 | lwz INS, -4(PC) | beq >4 |.if DUALNUM | stw RC, 4(RA) | stw TISNUM, 0(RA) |.else | tonum_u f1, RC |.endif | addi RC, RC, 1 | addis TMP3, PC, -(BCBIAS_J*4 >> 16) | stfd f0, 8(RA) | decode_RD4 TMP1, INS | stw RC, -4(RA) // Update control var. | add PC, TMP1, TMP3 |.if not DUALNUM | stfd f1, 0(RA) |.endif |3: | ins_next | |4: // Skip holes in array part. | addi RC, RC, 1 | b <1 | |5: // Traverse hash part. | lwz TMP1, TAB:RB->hmask | sub RC, RC, TMP0 | lwz TMP2, TAB:RB->node |6: | cmplw RC, TMP1 // End of iteration? Branch to ITERL+1. | slwi TMP3, RC, 5 | bgty <3 | slwi RB, RC, 3 | sub TMP3, TMP3, RB | lwzx RB, TMP2, TMP3 | lfdx f0, TMP2, TMP3 | add NODE:TMP3, TMP2, TMP3 | checknil RB | lwz INS, -4(PC) | beq >7 | lfd f1, NODE:TMP3->key | addis TMP2, PC, -(BCBIAS_J*4 >> 16) | stfd f0, 8(RA) | add RC, RC, TMP0 | decode_RD4 TMP1, INS | stfd f1, 0(RA) | addi RC, RC, 1 | add PC, TMP1, TMP2 | stw RC, -4(RA) // Update control var. | b <3 | |7: // Skip holes in hash part. | addi RC, RC, 1 | b <6 break; case BC_ISNEXT: | // RA = base*8, RD = target (points to ITERN) | add RA, BASE, RA | lwz TMP0, -24(RA) | lwz CFUNC:TMP1, -20(RA) | lwz TMP2, -16(RA) | lwz TMP3, -8(RA) | cmpwi cr0, TMP2, LJ_TTAB | cmpwi cr1, TMP0, LJ_TFUNC | cmpwi cr6, TMP3, LJ_TNIL | bne cr1, >5 | lbz TMP1, CFUNC:TMP1->ffid | crand 4*cr0+eq, 4*cr0+eq, 4*cr6+eq | cmpwi cr7, TMP1, FF_next_N | srwi TMP0, RD, 1 | crand 4*cr0+eq, 4*cr0+eq, 4*cr7+eq | add TMP3, PC, TMP0 | bne cr0, >5 | lus TMP1, 0xfffe | ori TMP1, TMP1, 0x7fff | stw ZERO, -4(RA) // Initialize control var. | stw TMP1, -8(RA) | addis PC, TMP3, -(BCBIAS_J*4 >> 16) |1: | ins_next |5: // Despecialize bytecode if any of the checks fail. | li TMP0, BC_JMP | li TMP1, BC_ITERC | stb TMP0, -1(PC) | addis PC, TMP3, -(BCBIAS_J*4 >> 16) | stb TMP1, 3(PC) | b <1 break; case BC_VARG: | // RA = base*8, RB = (nresults+1)*8, RC = numparams*8 | lwz TMP0, FRAME_PC(BASE) | add RC, BASE, RC | add RA, BASE, RA | addi RC, RC, FRAME_VARG | add TMP2, RA, RB | subi TMP3, BASE, 8 // TMP3 = vtop | sub RC, RC, TMP0 // RC = vbase | // Note: RC may now be even _above_ BASE if nargs was < numparams. | cmplwi cr1, RB, 0 |.if PPE | sub TMP1, TMP3, RC | cmpwi TMP1, 0 |.else | sub. TMP1, TMP3, RC |.endif | beq cr1, >5 // Copy all varargs? | subi TMP2, TMP2, 16 | ble >2 // No vararg slots? |1: // Copy vararg slots to destination slots. | lfd f0, 0(RC) | addi RC, RC, 8 | stfd f0, 0(RA) | cmplw RA, TMP2 | cmplw cr1, RC, TMP3 | bge >3 // All destination slots filled? | addi RA, RA, 8 | blt cr1, <1 // More vararg slots? |2: // Fill up remainder with nil. | stw TISNIL, 0(RA) | cmplw RA, TMP2 | addi RA, RA, 8 | blt <2 |3: | ins_next | |5: // Copy all varargs. | lwz TMP0, L->maxstack | li MULTRES, 8 // MULTRES = (0+1)*8 | bley <3 // No vararg slots? | add TMP2, RA, TMP1 | cmplw TMP2, TMP0 | addi MULTRES, TMP1, 8 | bgt >7 |6: | lfd f0, 0(RC) | addi RC, RC, 8 | stfd f0, 0(RA) | cmplw RC, TMP3 | addi RA, RA, 8 | blt <6 // More vararg slots? | b <3 | |7: // Grow stack for varargs. | mr CARG1, L | stp RA, L->top | sub SAVE0, RC, BASE // Need delta, because BASE may change. | stp BASE, L->base | sub RA, RA, BASE | stw PC, SAVE_PC | srwi CARG2, TMP1, 3 | bl extern lj_state_growstack // (lua_State *L, int n) | lp BASE, L->base | add RA, BASE, RA | add RC, BASE, SAVE0 | subi TMP3, BASE, 8 | b <6 break; /* -- Returns ----------------------------------------------------------- */ case BC_RETM: | // RA = results*8, RD = extra_nresults*8 | add RD, RD, MULTRES // MULTRES >= 8, so RD >= 8. | // Fall through. Assumes BC_RET follows. break; case BC_RET: | // RA = results*8, RD = (nresults+1)*8 | lwz PC, FRAME_PC(BASE) | add RA, BASE, RA | mr MULTRES, RD |1: | andix. TMP0, PC, FRAME_TYPE | xori TMP1, PC, FRAME_VARG | bne ->BC_RETV_Z | |->BC_RET_Z: | // BASE = base, RA = resultptr, RD = (nresults+1)*8, PC = return | lwz INS, -4(PC) | cmpwi RD, 8 | subi TMP2, BASE, 8 | subi RC, RD, 8 | decode_RB8 RB, INS | beq >3 | li TMP1, 0 |2: | addi TMP3, TMP1, 8 | lfdx f0, RA, TMP1 | cmpw TMP3, RC | stfdx f0, TMP2, TMP1 | beq >3 | addi TMP1, TMP3, 8 | lfdx f1, RA, TMP3 | cmpw TMP1, RC | stfdx f1, TMP2, TMP3 | bne <2 |3: |5: | cmplw RB, RD | decode_RA8 RA, INS | bgt >6 | sub BASE, TMP2, RA | lwz LFUNC:TMP1, FRAME_FUNC(BASE) | ins_next1 | lwz TMP1, LFUNC:TMP1->pc | lwz KBASE, PC2PROTO(k)(TMP1) | ins_next2 | |6: // Fill up results with nil. | subi TMP1, RD, 8 | addi RD, RD, 8 | stwx TISNIL, TMP2, TMP1 | b <5 | |->BC_RETV_Z: // Non-standard return case. | andix. TMP2, TMP1, FRAME_TYPEP | bne ->vm_return | // Return from vararg function: relocate BASE down. | sub BASE, BASE, TMP1 | lwz PC, FRAME_PC(BASE) | b <1 break; case BC_RET0: case BC_RET1: | // RA = results*8, RD = (nresults+1)*8 | lwz PC, FRAME_PC(BASE) | add RA, BASE, RA | mr MULTRES, RD | andix. TMP0, PC, FRAME_TYPE | xori TMP1, PC, FRAME_VARG | bney ->BC_RETV_Z | | lwz INS, -4(PC) | subi TMP2, BASE, 8 | decode_RB8 RB, INS if (op == BC_RET1) { | lfd f0, 0(RA) | stfd f0, 0(TMP2) } |5: | cmplw RB, RD | decode_RA8 RA, INS | bgt >6 | sub BASE, TMP2, RA | lwz LFUNC:TMP1, FRAME_FUNC(BASE) | ins_next1 | lwz TMP1, LFUNC:TMP1->pc | lwz KBASE, PC2PROTO(k)(TMP1) | ins_next2 | |6: // Fill up results with nil. | subi TMP1, RD, 8 | addi RD, RD, 8 | stwx TISNIL, TMP2, TMP1 | b <5 break; /* -- Loops and branches ------------------------------------------------ */ case BC_FORL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IFORL follows. break; case BC_JFORI: case BC_JFORL: #if !LJ_HASJIT break; #endif case BC_FORI: case BC_IFORL: | // RA = base*8, RD = target (after end of loop or start of loop) vk = (op == BC_IFORL || op == BC_JFORL); |.if DUALNUM | // Integer loop. | lwzux TMP1, RA, BASE | lwz CARG1, FORL_IDX*8+4(RA) | cmplw cr0, TMP1, TISNUM if (vk) { | lwz CARG3, FORL_STEP*8+4(RA) | bne >9 |.if GPR64 | // Need to check overflow for (a<<32) + (b<<32). | rldicr TMP0, CARG1, 32, 31 | rldicr TMP2, CARG3, 32, 31 | add CARG1, CARG1, CARG3 | addo. TMP0, TMP0, TMP2 |.else | addo. CARG1, CARG1, CARG3 |.endif | cmpwi cr6, CARG3, 0 | lwz CARG2, FORL_STOP*8+4(RA) | bso >6 |4: | stw CARG1, FORL_IDX*8+4(RA) } else { | lwz TMP3, FORL_STEP*8(RA) | lwz CARG3, FORL_STEP*8+4(RA) | lwz TMP2, FORL_STOP*8(RA) | lwz CARG2, FORL_STOP*8+4(RA) | cmplw cr7, TMP3, TISNUM | cmplw cr1, TMP2, TISNUM | crand 4*cr0+eq, 4*cr0+eq, 4*cr7+eq | crand 4*cr0+eq, 4*cr0+eq, 4*cr1+eq | cmpwi cr6, CARG3, 0 | bne >9 } | blt cr6, >5 | cmpw CARG1, CARG2 |1: | stw TISNUM, FORL_EXT*8(RA) if (op != BC_JFORL) { | srwi RD, RD, 1 } | stw CARG1, FORL_EXT*8+4(RA) if (op != BC_JFORL) { | add RD, PC, RD } if (op == BC_FORI) { | bgt >3 // See FP loop below. } else if (op == BC_JFORI) { | addis PC, RD, -(BCBIAS_J*4 >> 16) | bley >7 } else if (op == BC_IFORL) { | bgt >2 | addis PC, RD, -(BCBIAS_J*4 >> 16) } else { | bley =>BC_JLOOP } |2: | ins_next |5: // Invert check for negative step. | cmpw CARG2, CARG1 | b <1 if (vk) { |6: // Potential overflow. | checkov TMP0, <4 // Ignore unrelated overflow. | b <2 } |.endif if (vk) { |.if DUALNUM |9: // FP loop. | lfd f1, FORL_IDX*8(RA) |.else | lfdux f1, RA, BASE |.endif | lfd f3, FORL_STEP*8(RA) | lfd f2, FORL_STOP*8(RA) | lwz TMP3, FORL_STEP*8(RA) | fadd f1, f1, f3 | stfd f1, FORL_IDX*8(RA) } else { |.if DUALNUM |9: // FP loop. |.else | lwzux TMP1, RA, BASE | lwz TMP3, FORL_STEP*8(RA) | lwz TMP2, FORL_STOP*8(RA) | cmplw cr0, TMP1, TISNUM | cmplw cr7, TMP3, TISNUM | cmplw cr1, TMP2, TISNUM |.endif | lfd f1, FORL_IDX*8(RA) | crand 4*cr0+lt, 4*cr0+lt, 4*cr7+lt | crand 4*cr0+lt, 4*cr0+lt, 4*cr1+lt | lfd f2, FORL_STOP*8(RA) | bge ->vmeta_for } | cmpwi cr6, TMP3, 0 if (op != BC_JFORL) { | srwi RD, RD, 1 } | stfd f1, FORL_EXT*8(RA) if (op != BC_JFORL) { | add RD, PC, RD } | fcmpu cr0, f1, f2 if (op == BC_JFORI) { | addis PC, RD, -(BCBIAS_J*4 >> 16) } | blt cr6, >5 if (op == BC_FORI) { | bgt >3 } else if (op == BC_IFORL) { |.if DUALNUM | bgty <2 |.else | bgt >2 |.endif |1: | addis PC, RD, -(BCBIAS_J*4 >> 16) } else if (op == BC_JFORI) { | bley >7 } else { | bley =>BC_JLOOP } |.if DUALNUM | b <2 |.else |2: | ins_next |.endif |5: // Negative step. if (op == BC_FORI) { | bge <2 |3: // Used by integer loop, too. | addis PC, RD, -(BCBIAS_J*4 >> 16) } else if (op == BC_IFORL) { | bgey <1 } else if (op == BC_JFORI) { | bgey >7 } else { | bgey =>BC_JLOOP } | b <2 if (op == BC_JFORI) { |7: | lwz INS, -4(PC) | decode_RD8 RD, INS | b =>BC_JLOOP } break; case BC_ITERL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IITERL follows. break; case BC_JITERL: #if !LJ_HASJIT break; #endif case BC_IITERL: | // RA = base*8, RD = target | lwzux TMP1, RA, BASE | lwz TMP2, 4(RA) | checknil TMP1; beq >1 // Stop if iterator returned nil. if (op == BC_JITERL) { | stw TMP1, -8(RA) | stw TMP2, -4(RA) | b =>BC_JLOOP } else { | branch_RD // Otherwise save control var + branch. | stw TMP1, -8(RA) | stw TMP2, -4(RA) } |1: | ins_next break; case BC_LOOP: | // RA = base*8, RD = target (loop extent) | // Note: RA/RD is only used by trace recorder to determine scope/extent | // This opcode does NOT jump, it's only purpose is to detect a hot loop. |.if JIT | hotloop |.endif | // Fall through. Assumes BC_ILOOP follows. break; case BC_ILOOP: | // RA = base*8, RD = target (loop extent) | ins_next break; case BC_JLOOP: |.if JIT | // RA = base*8 (ignored), RD = traceno*8 | lwz TMP1, DISPATCH_J(trace)(DISPATCH) | srwi RD, RD, 1 | // Traces on PPC don't store the trace number, so use 0. | stw ZERO, DISPATCH_GL(vmstate)(DISPATCH) | lwzx TRACE:TMP2, TMP1, RD | clrso TMP1 | lp TMP2, TRACE:TMP2->mcode | stw BASE, DISPATCH_GL(jit_base)(DISPATCH) | mtctr TMP2 | stw L, DISPATCH_GL(jit_L)(DISPATCH) | addi JGL, DISPATCH, GG_DISP2G+32768 | bctr |.endif break; case BC_JMP: | // RA = base*8 (only used by trace recorder), RD = target | branch_RD | ins_next break; /* -- Function headers -------------------------------------------------- */ case BC_FUNCF: |.if JIT | hotcall |.endif case BC_FUNCV: /* NYI: compiled vararg functions. */ | // Fall through. Assumes BC_IFUNCF/BC_IFUNCV follow. break; case BC_JFUNCF: #if !LJ_HASJIT break; #endif case BC_IFUNCF: | // BASE = new base, RA = BASE+framesize*8, RB = LFUNC, RC = nargs*8 | lwz TMP2, L->maxstack | lbz TMP1, -4+PC2PROTO(numparams)(PC) | lwz KBASE, -4+PC2PROTO(k)(PC) | cmplw RA, TMP2 | slwi TMP1, TMP1, 3 | bgt ->vm_growstack_l if (op != BC_JFUNCF) { | ins_next1 } |2: | cmplw NARGS8:RC, TMP1 // Check for missing parameters. | blt >3 if (op == BC_JFUNCF) { | decode_RD8 RD, INS | b =>BC_JLOOP } else { | ins_next2 } | |3: // Clear missing parameters. | stwx TISNIL, BASE, NARGS8:RC | addi NARGS8:RC, NARGS8:RC, 8 | b <2 break; case BC_JFUNCV: #if !LJ_HASJIT break; #endif | NYI // NYI: compiled vararg functions break; /* NYI: compiled vararg functions. */ case BC_IFUNCV: | // BASE = new base, RA = BASE+framesize*8, RB = LFUNC, RC = nargs*8 | lwz TMP2, L->maxstack | add TMP1, BASE, RC | add TMP0, RA, RC | stw LFUNC:RB, 4(TMP1) // Store copy of LFUNC. | addi TMP3, RC, 8+FRAME_VARG | lwz KBASE, -4+PC2PROTO(k)(PC) | cmplw TMP0, TMP2 | stw TMP3, 0(TMP1) // Store delta + FRAME_VARG. | bge ->vm_growstack_l | lbz TMP2, -4+PC2PROTO(numparams)(PC) | mr RA, BASE | mr RC, TMP1 | ins_next1 | cmpwi TMP2, 0 | addi BASE, TMP1, 8 | beq >3 |1: | cmplw RA, RC // Less args than parameters? | lwz TMP0, 0(RA) | lwz TMP3, 4(RA) | bge >4 | stw TISNIL, 0(RA) // Clear old fixarg slot (help the GC). | addi RA, RA, 8 |2: | addic. TMP2, TMP2, -1 | stw TMP0, 8(TMP1) | stw TMP3, 12(TMP1) | addi TMP1, TMP1, 8 | bne <1 |3: | ins_next2 | |4: // Clear missing parameters. | li TMP0, LJ_TNIL | b <2 break; case BC_FUNCC: case BC_FUNCCW: | // BASE = new base, RA = BASE+framesize*8, RB = CFUNC, RC = nargs*8 if (op == BC_FUNCC) { | lp RD, CFUNC:RB->f } else { | lp RD, DISPATCH_GL(wrapf)(DISPATCH) } | add TMP1, RA, NARGS8:RC | lwz TMP2, L->maxstack | .toc lp TMP3, 0(RD) | add RC, BASE, NARGS8:RC | stp BASE, L->base | cmplw TMP1, TMP2 | stp RC, L->top | li_vmstate C |.if TOC | mtctr TMP3 |.else | mtctr RD |.endif if (op == BC_FUNCCW) { | lp CARG2, CFUNC:RB->f } | mr CARG1, L | bgt ->vm_growstack_c // Need to grow stack. | .toc lp TOCREG, TOC_OFS(RD) | .tocenv lp ENVREG, ENV_OFS(RD) | st_vmstate | bctrl // (lua_State *L [, lua_CFunction f]) | // Returns nresults. | lp BASE, L->base | .toc ld TOCREG, SAVE_TOC | slwi RD, CRET1, 3 | lp TMP1, L->top | li_vmstate INTERP | lwz PC, FRAME_PC(BASE) // Fetch PC of caller. | sub RA, TMP1, RD // RA = L->top - nresults*8 | st_vmstate | b ->vm_returnc break; /* ---------------------------------------------------------------------- */ default: fprintf(stderr, "Error: undefined opcode BC_%s\n", bc_names[op]); exit(2); break; } } static int build_backend(BuildCtx *ctx) { int op; dasm_growpc(Dst, BC__MAX); build_subroutines(ctx); |.code_op for (op = 0; op < BC__MAX; op++) build_ins(ctx, (BCOp)op, op); return BC__MAX; } /* Emit pseudo frame-info for all assembler functions. */ static void emit_asm_debug(BuildCtx *ctx) { int fcofs = (int)((uint8_t *)ctx->glob[GLOB_vm_ffi_call] - ctx->code); int i; switch (ctx->mode) { case BUILD_elfasm: fprintf(ctx->fp, "\t.section .debug_frame,\"\",@progbits\n"); fprintf(ctx->fp, ".Lframe0:\n" "\t.long .LECIE0-.LSCIE0\n" ".LSCIE0:\n" "\t.long 0xffffffff\n" "\t.byte 0x1\n" "\t.string \"\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 65\n" "\t.byte 0xc\n\t.uleb128 1\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE0:\n\n"); fprintf(ctx->fp, ".LSFDE0:\n" "\t.long .LEFDE0-.LASFDE0\n" ".LASFDE0:\n" "\t.long .Lframe0\n" "\t.long .Lbegin\n" "\t.long %d\n" "\t.byte 0xe\n\t.uleb128 %d\n" "\t.byte 0x11\n\t.uleb128 65\n\t.sleb128 -1\n" "\t.byte 0x5\n\t.uleb128 70\n\t.uleb128 55\n", fcofs, CFRAME_SIZE); for (i = 14; i <= 31; i++) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n" "\t.byte %d\n\t.uleb128 %d\n", 0x80+i, 37+(31-i), 0x80+32+i, 2+2*(31-i)); fprintf(ctx->fp, "\t.align 2\n" ".LEFDE0:\n\n"); #if LJ_HASFFI fprintf(ctx->fp, ".LSFDE1:\n" "\t.long .LEFDE1-.LASFDE1\n" ".LASFDE1:\n" "\t.long .Lframe0\n" #if LJ_TARGET_PS3 "\t.long .lj_vm_ffi_call\n" #else "\t.long lj_vm_ffi_call\n" #endif "\t.long %d\n" "\t.byte 0x11\n\t.uleb128 65\n\t.sleb128 -1\n" "\t.byte 0x8e\n\t.uleb128 2\n" "\t.byte 0xd\n\t.uleb128 0xe\n" "\t.align 2\n" ".LEFDE1:\n\n", (int)ctx->codesz - fcofs); #endif #if !LJ_NO_UNWIND fprintf(ctx->fp, "\t.section .eh_frame,\"a\",@progbits\n"); fprintf(ctx->fp, ".Lframe1:\n" "\t.long .LECIE1-.LSCIE1\n" ".LSCIE1:\n" "\t.long 0\n" "\t.byte 0x1\n" "\t.string \"zPR\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 65\n" "\t.uleb128 6\n" /* augmentation length */ "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.long lj_err_unwind_dwarf-.\n" "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.uleb128 1\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE1:\n\n"); fprintf(ctx->fp, ".LSFDE2:\n" "\t.long .LEFDE2-.LASFDE2\n" ".LASFDE2:\n" "\t.long .LASFDE2-.Lframe1\n" "\t.long .Lbegin-.\n" "\t.long %d\n" "\t.uleb128 0\n" /* augmentation length */ "\t.byte 0xe\n\t.uleb128 %d\n" "\t.byte 0x11\n\t.uleb128 65\n\t.sleb128 -1\n" "\t.byte 0x5\n\t.uleb128 70\n\t.uleb128 55\n", fcofs, CFRAME_SIZE); for (i = 14; i <= 31; i++) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n" "\t.byte %d\n\t.uleb128 %d\n", 0x80+i, 37+(31-i), 0x80+32+i, 2+2*(31-i)); fprintf(ctx->fp, "\t.align 2\n" ".LEFDE2:\n\n"); #if LJ_HASFFI fprintf(ctx->fp, ".Lframe2:\n" "\t.long .LECIE2-.LSCIE2\n" ".LSCIE2:\n" "\t.long 0\n" "\t.byte 0x1\n" "\t.string \"zR\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 65\n" "\t.uleb128 1\n" /* augmentation length */ "\t.byte 0x1b\n" /* pcrel|sdata4 */ "\t.byte 0xc\n\t.uleb128 1\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE2:\n\n"); fprintf(ctx->fp, ".LSFDE3:\n" "\t.long .LEFDE3-.LASFDE3\n" ".LASFDE3:\n" "\t.long .LASFDE3-.Lframe2\n" "\t.long lj_vm_ffi_call-.\n" "\t.long %d\n" "\t.uleb128 0\n" /* augmentation length */ "\t.byte 0x11\n\t.uleb128 65\n\t.sleb128 -1\n" "\t.byte 0x8e\n\t.uleb128 2\n" "\t.byte 0xd\n\t.uleb128 0xe\n" "\t.align 2\n" ".LEFDE3:\n\n", (int)ctx->codesz - fcofs); #endif #endif break; default: break; } } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ccall.h0000644000175000017500000001003513122010155016604 0ustar philphil/* ** FFI C call handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CCALL_H #define _LJ_CCALL_H #include "lj_obj.h" #include "lj_ctype.h" #if LJ_HASFFI /* -- C calling conventions ----------------------------------------------- */ #if LJ_TARGET_X86ORX64 #if LJ_TARGET_X86 #define CCALL_NARG_GPR 2 /* For fastcall arguments. */ #define CCALL_NARG_FPR 0 #define CCALL_NRET_GPR 2 #define CCALL_NRET_FPR 1 /* For FP results on x87 stack. */ #define CCALL_ALIGN_STACKARG 0 /* Don't align argument on stack. */ #elif LJ_ABI_WIN #define CCALL_NARG_GPR 4 #define CCALL_NARG_FPR 4 #define CCALL_NRET_GPR 1 #define CCALL_NRET_FPR 1 #define CCALL_SPS_EXTRA 4 #else #define CCALL_NARG_GPR 6 #define CCALL_NARG_FPR 8 #define CCALL_NRET_GPR 2 #define CCALL_NRET_FPR 2 #define CCALL_VECTOR_REG 1 /* Pass vectors in registers. */ #endif #define CCALL_SPS_FREE 1 #define CCALL_ALIGN_CALLSTATE 16 typedef LJ_ALIGN(16) union FPRArg { double d[2]; float f[4]; uint8_t b[16]; uint16_t s[8]; int i[4]; int64_t l[2]; } FPRArg; typedef intptr_t GPRArg; #elif LJ_TARGET_ARM #define CCALL_NARG_GPR 4 #define CCALL_NRET_GPR 2 /* For softfp double. */ #if LJ_ABI_SOFTFP #define CCALL_NARG_FPR 0 #define CCALL_NRET_FPR 0 #else #define CCALL_NARG_FPR 8 #define CCALL_NRET_FPR 4 #endif #define CCALL_SPS_FREE 0 typedef intptr_t GPRArg; typedef union FPRArg { double d; float f[2]; } FPRArg; #elif LJ_TARGET_PPC #define CCALL_NARG_GPR 8 #define CCALL_NARG_FPR 8 #define CCALL_NRET_GPR 4 /* For complex double. */ #define CCALL_NRET_FPR 1 #define CCALL_SPS_EXTRA 4 #define CCALL_SPS_FREE 0 typedef intptr_t GPRArg; typedef double FPRArg; #elif LJ_TARGET_PPCSPE #define CCALL_NARG_GPR 8 #define CCALL_NARG_FPR 0 #define CCALL_NRET_GPR 4 /* For softfp complex double. */ #define CCALL_NRET_FPR 0 #define CCALL_SPS_FREE 0 /* NYI */ typedef intptr_t GPRArg; #elif LJ_TARGET_MIPS #define CCALL_NARG_GPR 4 #define CCALL_NARG_FPR 2 #define CCALL_NRET_GPR 2 #define CCALL_NRET_FPR 2 #define CCALL_SPS_EXTRA 7 #define CCALL_SPS_FREE 1 typedef intptr_t GPRArg; typedef union FPRArg { double d; struct { LJ_ENDIAN_LOHI(float f; , float g;) }; } FPRArg; #else #error "Missing calling convention definitions for this architecture" #endif #ifndef CCALL_SPS_EXTRA #define CCALL_SPS_EXTRA 0 #endif #ifndef CCALL_VECTOR_REG #define CCALL_VECTOR_REG 0 #endif #ifndef CCALL_ALIGN_STACKARG #define CCALL_ALIGN_STACKARG 1 #endif #ifndef CCALL_ALIGN_CALLSTATE #define CCALL_ALIGN_CALLSTATE 8 #endif #define CCALL_NUM_GPR \ (CCALL_NARG_GPR > CCALL_NRET_GPR ? CCALL_NARG_GPR : CCALL_NRET_GPR) #define CCALL_NUM_FPR \ (CCALL_NARG_FPR > CCALL_NRET_FPR ? CCALL_NARG_FPR : CCALL_NRET_FPR) /* Check against constants in lj_ctype.h. */ LJ_STATIC_ASSERT(CCALL_NUM_GPR <= CCALL_MAX_GPR); LJ_STATIC_ASSERT(CCALL_NUM_FPR <= CCALL_MAX_FPR); #define CCALL_MAXSTACK 32 /* -- C call state -------------------------------------------------------- */ typedef LJ_ALIGN(CCALL_ALIGN_CALLSTATE) struct CCallState { void (*func)(void); /* Pointer to called function. */ uint32_t spadj; /* Stack pointer adjustment. */ uint8_t nsp; /* Number of stack slots. */ uint8_t retref; /* Return value by reference. */ #if LJ_TARGET_X64 uint8_t ngpr; /* Number of arguments in GPRs. */ uint8_t nfpr; /* Number of arguments in FPRs. */ #elif LJ_TARGET_X86 uint8_t resx87; /* Result on x87 stack: 1:float, 2:double. */ #elif LJ_TARGET_PPC uint8_t nfpr; /* Number of arguments in FPRs. */ #endif #if LJ_32 int32_t align1; #endif #if CCALL_NUM_FPR FPRArg fpr[CCALL_NUM_FPR]; /* Arguments/results in FPRs. */ #endif GPRArg gpr[CCALL_NUM_GPR]; /* Arguments/results in GPRs. */ GPRArg stack[CCALL_MAXSTACK]; /* Stack slots. */ } CCallState; /* -- C call handling ----------------------------------------------------- */ /* Really belongs to lj_vm.h. */ LJ_ASMF void LJ_FASTCALL lj_vm_ffi_call(CCallState *cc); LJ_FUNC CTypeID lj_ccall_ctid_vararg(CTState *cts, cTValue *o); LJ_FUNC int lj_ccall_func(lua_State *L, GCcdata *cd); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_lex.c0000644000175000017500000003063613122010155016322 0ustar philphil/* ** Lexical analyzer. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_lex_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #if LJ_HASFFI #include "lj_tab.h" #include "lj_ctype.h" #include "lj_cdata.h" #include "lualib.h" #endif #include "lj_state.h" #include "lj_lex.h" #include "lj_parse.h" #include "lj_char.h" #include "lj_strscan.h" /* Lua lexer token names. */ static const char *const tokennames[] = { #define TKSTR1(name) #name, #define TKSTR2(name, sym) #sym, TKDEF(TKSTR1, TKSTR2) #undef TKSTR1 #undef TKSTR2 NULL }; /* -- Buffer handling ----------------------------------------------------- */ #define char2int(c) ((int)(uint8_t)(c)) #define next(ls) \ (ls->current = (ls->n--) > 0 ? char2int(*ls->p++) : fillbuf(ls)) #define save_and_next(ls) (save(ls, ls->current), next(ls)) #define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r') #define END_OF_STREAM (-1) static int fillbuf(LexState *ls) { size_t sz; const char *buf = ls->rfunc(ls->L, ls->rdata, &sz); if (buf == NULL || sz == 0) return END_OF_STREAM; ls->n = (MSize)sz - 1; ls->p = buf; return char2int(*(ls->p++)); } static LJ_NOINLINE void save_grow(LexState *ls, int c) { MSize newsize; if (ls->sb.sz >= LJ_MAX_STR/2) lj_lex_error(ls, 0, LJ_ERR_XELEM); newsize = ls->sb.sz * 2; lj_str_resizebuf(ls->L, &ls->sb, newsize); ls->sb.buf[ls->sb.n++] = (char)c; } static LJ_AINLINE void save(LexState *ls, int c) { if (LJ_UNLIKELY(ls->sb.n + 1 > ls->sb.sz)) save_grow(ls, c); else ls->sb.buf[ls->sb.n++] = (char)c; } static void inclinenumber(LexState *ls) { int old = ls->current; lua_assert(currIsNewline(ls)); next(ls); /* skip `\n' or `\r' */ if (currIsNewline(ls) && ls->current != old) next(ls); /* skip `\n\r' or `\r\n' */ if (++ls->linenumber >= LJ_MAX_LINE) lj_lex_error(ls, ls->token, LJ_ERR_XLINES); } /* -- Scanner for terminals ----------------------------------------------- */ /* Parse a number literal. */ static void lex_number(LexState *ls, TValue *tv) { StrScanFmt fmt; int c, xp = 'e'; lua_assert(lj_char_isdigit(ls->current)); if ((c = ls->current) == '0') { save_and_next(ls); if ((ls->current | 0x20) == 'x') xp = 'p'; } while (lj_char_isident(ls->current) || ls->current == '.' || ((ls->current == '-' || ls->current == '+') && (c | 0x20) == xp)) { c = ls->current; save_and_next(ls); } save(ls, '\0'); fmt = lj_strscan_scan((const uint8_t *)ls->sb.buf, tv, (LJ_DUALNUM ? STRSCAN_OPT_TOINT : STRSCAN_OPT_TONUM) | (LJ_HASFFI ? (STRSCAN_OPT_LL|STRSCAN_OPT_IMAG) : 0)); if (LJ_DUALNUM && fmt == STRSCAN_INT) { setitype(tv, LJ_TISNUM); } else if (fmt == STRSCAN_NUM) { /* Already in correct format. */ #if LJ_HASFFI } else if (fmt != STRSCAN_ERROR) { lua_State *L = ls->L; GCcdata *cd; lua_assert(fmt == STRSCAN_I64 || fmt == STRSCAN_U64 || fmt == STRSCAN_IMAG); if (!ctype_ctsG(G(L))) { ptrdiff_t oldtop = savestack(L, L->top); luaopen_ffi(L); /* Load FFI library on-demand. */ L->top = restorestack(L, oldtop); } if (fmt == STRSCAN_IMAG) { cd = lj_cdata_new_(L, CTID_COMPLEX_DOUBLE, 2*sizeof(double)); ((double *)cdataptr(cd))[0] = 0; ((double *)cdataptr(cd))[1] = numV(tv); } else { cd = lj_cdata_new_(L, fmt==STRSCAN_I64 ? CTID_INT64 : CTID_UINT64, 8); *(uint64_t *)cdataptr(cd) = tv->u64; } lj_parse_keepcdata(ls, tv, cd); #endif } else { lua_assert(fmt == STRSCAN_ERROR); lj_lex_error(ls, TK_number, LJ_ERR_XNUMBER); } } static int skip_sep(LexState *ls) { int count = 0; int s = ls->current; lua_assert(s == '[' || s == ']'); save_and_next(ls); while (ls->current == '=') { save_and_next(ls); count++; } return (ls->current == s) ? count : (-count) - 1; } static void read_long_string(LexState *ls, TValue *tv, int sep) { save_and_next(ls); /* skip 2nd `[' */ if (currIsNewline(ls)) /* string starts with a newline? */ inclinenumber(ls); /* skip it */ for (;;) { switch (ls->current) { case END_OF_STREAM: lj_lex_error(ls, TK_eof, tv ? LJ_ERR_XLSTR : LJ_ERR_XLCOM); break; case ']': if (skip_sep(ls) == sep) { save_and_next(ls); /* skip 2nd `]' */ goto endloop; } break; case '\n': case '\r': save(ls, '\n'); inclinenumber(ls); if (!tv) lj_str_resetbuf(&ls->sb); /* avoid wasting space */ break; default: if (tv) save_and_next(ls); else next(ls); break; } } endloop: if (tv) { GCstr *str = lj_parse_keepstr(ls, ls->sb.buf + (2 + (MSize)sep), ls->sb.n - 2*(2 + (MSize)sep)); setstrV(ls->L, tv, str); } } static void read_string(LexState *ls, int delim, TValue *tv) { save_and_next(ls); while (ls->current != delim) { switch (ls->current) { case END_OF_STREAM: lj_lex_error(ls, TK_eof, LJ_ERR_XSTR); continue; case '\n': case '\r': lj_lex_error(ls, TK_string, LJ_ERR_XSTR); continue; case '\\': { int c = next(ls); /* Skip the '\\'. */ switch (c) { case 'a': c = '\a'; break; case 'b': c = '\b'; break; case 'f': c = '\f'; break; case 'n': c = '\n'; break; case 'r': c = '\r'; break; case 't': c = '\t'; break; case 'v': c = '\v'; break; case 'x': /* Hexadecimal escape '\xXX'. */ c = (next(ls) & 15u) << 4; if (!lj_char_isdigit(ls->current)) { if (!lj_char_isxdigit(ls->current)) goto err_xesc; c += 9 << 4; } c += (next(ls) & 15u); if (!lj_char_isdigit(ls->current)) { if (!lj_char_isxdigit(ls->current)) goto err_xesc; c += 9; } break; case 'z': /* Skip whitespace. */ next(ls); while (lj_char_isspace(ls->current)) if (currIsNewline(ls)) inclinenumber(ls); else next(ls); continue; case '\n': case '\r': save(ls, '\n'); inclinenumber(ls); continue; case '\\': case '\"': case '\'': break; case END_OF_STREAM: continue; default: if (!lj_char_isdigit(c)) goto err_xesc; c -= '0'; /* Decimal escape '\ddd'. */ if (lj_char_isdigit(next(ls))) { c = c*10 + (ls->current - '0'); if (lj_char_isdigit(next(ls))) { c = c*10 + (ls->current - '0'); if (c > 255) { err_xesc: lj_lex_error(ls, TK_string, LJ_ERR_XESC); } next(ls); } } save(ls, c); continue; } save(ls, c); next(ls); continue; } default: save_and_next(ls); break; } } save_and_next(ls); /* skip delimiter */ setstrV(ls->L, tv, lj_parse_keepstr(ls, ls->sb.buf + 1, ls->sb.n - 2)); } /* -- Main lexical scanner ------------------------------------------------ */ static int llex(LexState *ls, TValue *tv) { lj_str_resetbuf(&ls->sb); for (;;) { if (lj_char_isident(ls->current)) { GCstr *s; if (lj_char_isdigit(ls->current)) { /* Numeric literal. */ lex_number(ls, tv); return TK_number; } /* Identifier or reserved word. */ do { save_and_next(ls); } while (lj_char_isident(ls->current)); s = lj_parse_keepstr(ls, ls->sb.buf, ls->sb.n); setstrV(ls->L, tv, s); if (s->reserved > 0) /* Reserved word? */ return TK_OFS + s->reserved; return TK_name; } switch (ls->current) { case '\n': case '\r': inclinenumber(ls); continue; case ' ': case '\t': case '\v': case '\f': next(ls); continue; case '-': next(ls); if (ls->current != '-') return '-'; /* else is a comment */ next(ls); if (ls->current == '[') { int sep = skip_sep(ls); lj_str_resetbuf(&ls->sb); /* `skip_sep' may dirty the buffer */ if (sep >= 0) { read_long_string(ls, NULL, sep); /* long comment */ lj_str_resetbuf(&ls->sb); continue; } } /* else short comment */ while (!currIsNewline(ls) && ls->current != END_OF_STREAM) next(ls); continue; case '[': { int sep = skip_sep(ls); if (sep >= 0) { read_long_string(ls, tv, sep); return TK_string; } else if (sep == -1) { return '['; } else { lj_lex_error(ls, TK_string, LJ_ERR_XLDELIM); continue; } } case '=': next(ls); if (ls->current != '=') return '='; else { next(ls); return TK_eq; } case '<': next(ls); if (ls->current != '=') return '<'; else { next(ls); return TK_le; } case '>': next(ls); if (ls->current != '=') return '>'; else { next(ls); return TK_ge; } case '~': next(ls); if (ls->current != '=') return '~'; else { next(ls); return TK_ne; } case ':': next(ls); if (ls->current != ':') return ':'; else { next(ls); return TK_label; } case '"': case '\'': read_string(ls, ls->current, tv); return TK_string; case '.': save_and_next(ls); if (ls->current == '.') { next(ls); if (ls->current == '.') { next(ls); return TK_dots; /* ... */ } return TK_concat; /* .. */ } else if (!lj_char_isdigit(ls->current)) { return '.'; } else { lex_number(ls, tv); return TK_number; } case END_OF_STREAM: return TK_eof; default: { int c = ls->current; next(ls); return c; /* Single-char tokens (+ - / ...). */ } } } } /* -- Lexer API ----------------------------------------------------------- */ /* Setup lexer state. */ int lj_lex_setup(lua_State *L, LexState *ls) { int header = 0; ls->L = L; ls->fs = NULL; ls->n = 0; ls->p = NULL; ls->vstack = NULL; ls->sizevstack = 0; ls->vtop = 0; ls->bcstack = NULL; ls->sizebcstack = 0; ls->token = 0; ls->lookahead = TK_eof; /* No look-ahead token. */ ls->linenumber = 1; ls->lastline = 1; lj_str_resizebuf(ls->L, &ls->sb, LJ_MIN_SBUF); next(ls); /* Read-ahead first char. */ if (ls->current == 0xef && ls->n >= 2 && char2int(ls->p[0]) == 0xbb && char2int(ls->p[1]) == 0xbf) { /* Skip UTF-8 BOM (if buffered). */ ls->n -= 2; ls->p += 2; next(ls); header = 1; } if (ls->current == '#') { /* Skip POSIX #! header line. */ do { next(ls); if (ls->current == END_OF_STREAM) return 0; } while (!currIsNewline(ls)); inclinenumber(ls); header = 1; } if (ls->current == LUA_SIGNATURE[0]) { /* Bytecode dump. */ if (header) { /* ** Loading bytecode with an extra header is disabled for security ** reasons. This may circumvent the usual check for bytecode vs. ** Lua code by looking at the first char. Since this is a potential ** security violation no attempt is made to echo the chunkname either. */ setstrV(L, L->top++, lj_err_str(L, LJ_ERR_BCBAD)); lj_err_throw(L, LUA_ERRSYNTAX); } return 1; } return 0; } /* Cleanup lexer state. */ void lj_lex_cleanup(lua_State *L, LexState *ls) { global_State *g = G(L); lj_mem_freevec(g, ls->bcstack, ls->sizebcstack, BCInsLine); lj_mem_freevec(g, ls->vstack, ls->sizevstack, VarInfo); lj_str_freebuf(g, &ls->sb); } void lj_lex_next(LexState *ls) { ls->lastline = ls->linenumber; if (LJ_LIKELY(ls->lookahead == TK_eof)) { /* No lookahead token? */ ls->token = llex(ls, &ls->tokenval); /* Get next token. */ } else { /* Otherwise return lookahead token. */ ls->token = ls->lookahead; ls->lookahead = TK_eof; ls->tokenval = ls->lookaheadval; } } LexToken lj_lex_lookahead(LexState *ls) { lua_assert(ls->lookahead == TK_eof); ls->lookahead = llex(ls, &ls->lookaheadval); return ls->lookahead; } const char *lj_lex_token2str(LexState *ls, LexToken token) { if (token > TK_OFS) return tokennames[token-TK_OFS-1]; else if (!lj_char_iscntrl(token)) return lj_str_pushf(ls->L, "%c", token); else return lj_str_pushf(ls->L, "char(%d)", token); } void lj_lex_error(LexState *ls, LexToken token, ErrMsg em, ...) { const char *tok; va_list argp; if (token == 0) { tok = NULL; } else if (token == TK_name || token == TK_string || token == TK_number) { save(ls, '\0'); tok = ls->sb.buf; } else { tok = lj_lex_token2str(ls, token); } va_start(argp, em); lj_err_lex(ls->L, ls->chunkname, tok, ls->linenumber, em, argp); va_end(argp); } void lj_lex_init(lua_State *L) { uint32_t i; for (i = 0; i < TK_RESERVED; i++) { GCstr *s = lj_str_newz(L, tokennames[i]); fixstring(s); /* Reserved words are never collected. */ s->reserved = (uint8_t)(i+1); } } wcc-0.0.2/src/wsh/luajit-2.0/src/lib_os.c0000644000175000017500000001442513122010155016312 0ustar philphil/* ** OS library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #include #include #define lib_os_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_err.h" #include "lj_lib.h" #if LJ_TARGET_POSIX #include #else #include #endif #if !LJ_TARGET_PSVITA #include #endif /* ------------------------------------------------------------------------ */ #define LJLIB_MODULE_os LJLIB_CF(os_execute) { #if LJ_NO_SYSTEM #if LJ_52 errno = ENOSYS; return luaL_fileresult(L, 0, NULL); #else lua_pushinteger(L, -1); return 1; #endif #else const char *cmd = luaL_optstring(L, 1, NULL); int stat = system(cmd); #if LJ_52 if (cmd) return luaL_execresult(L, stat); setboolV(L->top++, 1); #else setintV(L->top++, stat); #endif return 1; #endif } LJLIB_CF(os_remove) { const char *filename = luaL_checkstring(L, 1); return luaL_fileresult(L, remove(filename) == 0, filename); } LJLIB_CF(os_rename) { const char *fromname = luaL_checkstring(L, 1); const char *toname = luaL_checkstring(L, 2); return luaL_fileresult(L, rename(fromname, toname) == 0, fromname); } LJLIB_CF(os_tmpname) { #if LJ_TARGET_PS3 || LJ_TARGET_PS4 || LJ_TARGET_PSVITA lj_err_caller(L, LJ_ERR_OSUNIQF); return 0; #else #if LJ_TARGET_POSIX char buf[15+1]; int fp; strcpy(buf, "/tmp/lua_XXXXXX"); fp = mkstemp(buf); if (fp != -1) close(fp); else lj_err_caller(L, LJ_ERR_OSUNIQF); #else char buf[L_tmpnam]; if (tmpnam(buf) == NULL) lj_err_caller(L, LJ_ERR_OSUNIQF); #endif lua_pushstring(L, buf); return 1; #endif } LJLIB_CF(os_getenv) { #if LJ_TARGET_CONSOLE lua_pushnil(L); #else lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */ #endif return 1; } LJLIB_CF(os_exit) { int status; if (L->base < L->top && tvisbool(L->base)) status = boolV(L->base) ? EXIT_SUCCESS : EXIT_FAILURE; else status = lj_lib_optint(L, 1, EXIT_SUCCESS); if (L->base+1 < L->top && tvistruecond(L->base+1)) lua_close(L); exit(status); return 0; /* Unreachable. */ } LJLIB_CF(os_clock) { setnumV(L->top++, ((lua_Number)clock())*(1.0/(lua_Number)CLOCKS_PER_SEC)); return 1; } /* ------------------------------------------------------------------------ */ static void setfield(lua_State *L, const char *key, int value) { lua_pushinteger(L, value); lua_setfield(L, -2, key); } static void setboolfield(lua_State *L, const char *key, int value) { if (value < 0) /* undefined? */ return; /* does not set field */ lua_pushboolean(L, value); lua_setfield(L, -2, key); } static int getboolfield(lua_State *L, const char *key) { int res; lua_getfield(L, -1, key); res = lua_isnil(L, -1) ? -1 : lua_toboolean(L, -1); lua_pop(L, 1); return res; } static int getfield(lua_State *L, const char *key, int d) { int res; lua_getfield(L, -1, key); if (lua_isnumber(L, -1)) { res = (int)lua_tointeger(L, -1); } else { if (d < 0) lj_err_callerv(L, LJ_ERR_OSDATEF, key); res = d; } lua_pop(L, 1); return res; } LJLIB_CF(os_date) { const char *s = luaL_optstring(L, 1, "%c"); time_t t = luaL_opt(L, (time_t)luaL_checknumber, 2, time(NULL)); struct tm *stm; #if LJ_TARGET_POSIX struct tm rtm; #endif if (*s == '!') { /* UTC? */ s++; /* Skip '!' */ #if LJ_TARGET_POSIX stm = gmtime_r(&t, &rtm); #else stm = gmtime(&t); #endif } else { #if LJ_TARGET_POSIX stm = localtime_r(&t, &rtm); #else stm = localtime(&t); #endif } if (stm == NULL) { /* Invalid date? */ setnilV(L->top-1); } else if (strcmp(s, "*t") == 0) { lua_createtable(L, 0, 9); /* 9 = number of fields */ setfield(L, "sec", stm->tm_sec); setfield(L, "min", stm->tm_min); setfield(L, "hour", stm->tm_hour); setfield(L, "day", stm->tm_mday); setfield(L, "month", stm->tm_mon+1); setfield(L, "year", stm->tm_year+1900); setfield(L, "wday", stm->tm_wday+1); setfield(L, "yday", stm->tm_yday+1); setboolfield(L, "isdst", stm->tm_isdst); } else { char cc[3]; luaL_Buffer b; cc[0] = '%'; cc[2] = '\0'; luaL_buffinit(L, &b); for (; *s; s++) { if (*s != '%' || *(s + 1) == '\0') { /* No conversion specifier? */ luaL_addchar(&b, *s); } else { size_t reslen; char buff[200]; /* Should be big enough for any conversion result. */ cc[1] = *(++s); reslen = strftime(buff, sizeof(buff), cc, stm); luaL_addlstring(&b, buff, reslen); } } luaL_pushresult(&b); } return 1; } LJLIB_CF(os_time) { time_t t; if (lua_isnoneornil(L, 1)) { /* called without args? */ t = time(NULL); /* get current time */ } else { struct tm ts; luaL_checktype(L, 1, LUA_TTABLE); lua_settop(L, 1); /* make sure table is at the top */ ts.tm_sec = getfield(L, "sec", 0); ts.tm_min = getfield(L, "min", 0); ts.tm_hour = getfield(L, "hour", 12); ts.tm_mday = getfield(L, "day", -1); ts.tm_mon = getfield(L, "month", -1) - 1; ts.tm_year = getfield(L, "year", -1) - 1900; ts.tm_isdst = getboolfield(L, "isdst"); t = mktime(&ts); } if (t == (time_t)(-1)) lua_pushnil(L); else lua_pushnumber(L, (lua_Number)t); return 1; } LJLIB_CF(os_difftime) { lua_pushnumber(L, difftime((time_t)(luaL_checknumber(L, 1)), (time_t)(luaL_optnumber(L, 2, (lua_Number)0)))); return 1; } /* ------------------------------------------------------------------------ */ LJLIB_CF(os_setlocale) { #if LJ_TARGET_PSVITA lua_pushliteral(L, "C"); #else GCstr *s = lj_lib_optstr(L, 1); const char *str = s ? strdata(s) : NULL; int opt = lj_lib_checkopt(L, 2, 6, "\5ctype\7numeric\4time\7collate\10monetary\1\377\3all"); if (opt == 0) opt = LC_CTYPE; else if (opt == 1) opt = LC_NUMERIC; else if (opt == 2) opt = LC_TIME; else if (opt == 3) opt = LC_COLLATE; else if (opt == 4) opt = LC_MONETARY; else if (opt == 6) opt = LC_ALL; lua_pushstring(L, setlocale(opt, str)); #endif return 1; } /* ------------------------------------------------------------------------ */ #include "lj_libdef.h" LUALIB_API int luaopen_os(lua_State *L) { LJ_LIB_REG(L, LUA_OSLIBNAME, os); return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_opt_split.c0000644000175000017500000005543613122010155017554 0ustar philphil/* ** SPLIT: Split 64 bit IR instructions into 32 bit IR instructions. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_opt_split_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT && (LJ_SOFTFP || (LJ_32 && LJ_HASFFI)) #include "lj_err.h" #include "lj_str.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_ircall.h" #include "lj_iropt.h" #include "lj_vm.h" /* SPLIT pass: ** ** This pass splits up 64 bit IR instructions into multiple 32 bit IR ** instructions. It's only active for soft-float targets or for 32 bit CPUs ** which lack native 64 bit integer operations (the FFI is currently the ** only emitter for 64 bit integer instructions). ** ** Splitting the IR in a separate pass keeps each 32 bit IR assembler ** backend simple. Only a small amount of extra functionality needs to be ** implemented. This is much easier than adding support for allocating ** register pairs to each backend (believe me, I tried). A few simple, but ** important optimizations can be performed by the SPLIT pass, which would ** be tedious to do in the backend. ** ** The basic idea is to replace each 64 bit IR instruction with its 32 bit ** equivalent plus an extra HIOP instruction. The splitted IR is not passed ** through FOLD or any other optimizations, so each HIOP is guaranteed to ** immediately follow it's counterpart. The actual functionality of HIOP is ** inferred from the previous instruction. ** ** The operands of HIOP hold the hiword input references. The output of HIOP ** is the hiword output reference, which is also used to hold the hiword ** register or spill slot information. The register allocator treats this ** instruction independently of any other instruction, which improves code ** quality compared to using fixed register pairs. ** ** It's easier to split up some instructions into two regular 32 bit ** instructions. E.g. XLOAD is split up into two XLOADs with two different ** addresses. Obviously 64 bit constants need to be split up into two 32 bit ** constants, too. Some hiword instructions can be entirely omitted, e.g. ** when zero-extending a 32 bit value to 64 bits. 64 bit arguments for calls ** are split up into two 32 bit arguments each. ** ** On soft-float targets, floating-point instructions are directly converted ** to soft-float calls by the SPLIT pass (except for comparisons and MIN/MAX). ** HIOP for number results has the type IRT_SOFTFP ("sfp" in -jdump). ** ** Here's the IR and x64 machine code for 'x.b = x.a + 1' for a struct with ** two int64_t fields: ** ** 0100 p32 ADD base +8 ** 0101 i64 XLOAD 0100 ** 0102 i64 ADD 0101 +1 ** 0103 p32 ADD base +16 ** 0104 i64 XSTORE 0103 0102 ** ** mov rax, [esi+0x8] ** add rax, +0x01 ** mov [esi+0x10], rax ** ** Here's the transformed IR and the x86 machine code after the SPLIT pass: ** ** 0100 p32 ADD base +8 ** 0101 int XLOAD 0100 ** 0102 p32 ADD base +12 ** 0103 int XLOAD 0102 ** 0104 int ADD 0101 +1 ** 0105 int HIOP 0103 +0 ** 0106 p32 ADD base +16 ** 0107 int XSTORE 0106 0104 ** 0108 int HIOP 0106 0105 ** ** mov eax, [esi+0x8] ** mov ecx, [esi+0xc] ** add eax, +0x01 ** adc ecx, +0x00 ** mov [esi+0x10], eax ** mov [esi+0x14], ecx ** ** You may notice the reassociated hiword address computation, which is ** later fused into the mov operands by the assembler. */ /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) /* Directly emit the transformed IR without updating chains etc. */ static IRRef split_emit(jit_State *J, uint16_t ot, IRRef1 op1, IRRef1 op2) { IRRef nref = lj_ir_nextins(J); IRIns *ir = IR(nref); ir->ot = ot; ir->op1 = op1; ir->op2 = op2; return nref; } #if LJ_SOFTFP /* Emit a (checked) number to integer conversion. */ static IRRef split_num2int(jit_State *J, IRRef lo, IRRef hi, int check) { IRRef tmp, res; #if LJ_LE tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), lo, hi); #else tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), hi, lo); #endif res = split_emit(J, IRTI(IR_CALLN), tmp, IRCALL_softfp_d2i); if (check) { tmp = split_emit(J, IRTI(IR_CALLN), res, IRCALL_softfp_i2d); split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), tmp, tmp); split_emit(J, IRTGI(IR_EQ), tmp, lo); split_emit(J, IRTG(IR_HIOP, IRT_SOFTFP), tmp+1, hi); } return res; } /* Emit a CALLN with one split 64 bit argument. */ static IRRef split_call_l(jit_State *J, IRRef1 *hisubst, IRIns *oir, IRIns *ir, IRCallID id) { IRRef tmp, op1 = ir->op1; J->cur.nins--; #if LJ_LE tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), oir[op1].prev, hisubst[op1]); #else tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), hisubst[op1], oir[op1].prev); #endif ir->prev = tmp = split_emit(J, IRTI(IR_CALLN), tmp, id); return split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), tmp, tmp); } /* Emit a CALLN with one split 64 bit argument and a 32 bit argument. */ static IRRef split_call_li(jit_State *J, IRRef1 *hisubst, IRIns *oir, IRIns *ir, IRCallID id) { IRRef tmp, op1 = ir->op1, op2 = ir->op2; J->cur.nins--; #if LJ_LE tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), oir[op1].prev, hisubst[op1]); #else tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), hisubst[op1], oir[op1].prev); #endif tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), tmp, oir[op2].prev); ir->prev = tmp = split_emit(J, IRTI(IR_CALLN), tmp, id); return split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), tmp, tmp); } #endif /* Emit a CALLN with two split 64 bit arguments. */ static IRRef split_call_ll(jit_State *J, IRRef1 *hisubst, IRIns *oir, IRIns *ir, IRCallID id) { IRRef tmp, op1 = ir->op1, op2 = ir->op2; J->cur.nins--; #if LJ_LE tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), oir[op1].prev, hisubst[op1]); tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), tmp, oir[op2].prev); tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), tmp, hisubst[op2]); #else tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), hisubst[op1], oir[op1].prev); tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), tmp, hisubst[op2]); tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), tmp, oir[op2].prev); #endif ir->prev = tmp = split_emit(J, IRTI(IR_CALLN), tmp, id); return split_emit(J, IRT(IR_HIOP, (LJ_SOFTFP && irt_isnum(ir->t)) ? IRT_SOFTFP : IRT_INT), tmp, tmp); } /* Get a pointer to the other 32 bit word (LE: hiword, BE: loword). */ static IRRef split_ptr(jit_State *J, IRIns *oir, IRRef ref) { IRRef nref = oir[ref].prev; IRIns *ir = IR(nref); int32_t ofs = 4; if (ir->o == IR_KPTR) return lj_ir_kptr(J, (char *)ir_kptr(ir) + ofs); if (ir->o == IR_ADD && irref_isk(ir->op2) && !irt_isphi(oir[ref].t)) { /* Reassociate address. */ ofs += IR(ir->op2)->i; nref = ir->op1; if (ofs == 0) return nref; } return split_emit(J, IRTI(IR_ADD), nref, lj_ir_kint(J, ofs)); } /* Substitute references of a snapshot. */ static void split_subst_snap(jit_State *J, SnapShot *snap, IRIns *oir) { SnapEntry *map = &J->cur.snapmap[snap->mapofs]; MSize n, nent = snap->nent; for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; IRIns *ir = &oir[snap_ref(sn)]; if (!(LJ_SOFTFP && (sn & SNAP_SOFTFPNUM) && irref_isk(snap_ref(sn)))) map[n] = ((sn & 0xffff0000) | ir->prev); } } /* Transform the old IR to the new IR. */ static void split_ir(jit_State *J) { IRRef nins = J->cur.nins, nk = J->cur.nk; MSize irlen = nins - nk; MSize need = (irlen+1)*(sizeof(IRIns) + sizeof(IRRef1)); IRIns *oir = (IRIns *)lj_str_needbuf(J->L, &G(J->L)->tmpbuf, need); IRRef1 *hisubst; IRRef ref, snref; SnapShot *snap; /* Copy old IR to buffer. */ memcpy(oir, IR(nk), irlen*sizeof(IRIns)); /* Bias hiword substitution table and old IR. Loword kept in field prev. */ hisubst = (IRRef1 *)&oir[irlen] - nk; oir -= nk; /* Remove all IR instructions, but retain IR constants. */ J->cur.nins = REF_FIRST; J->loopref = 0; /* Process constants and fixed references. */ for (ref = nk; ref <= REF_BASE; ref++) { IRIns *ir = &oir[ref]; if ((LJ_SOFTFP && ir->o == IR_KNUM) || ir->o == IR_KINT64) { /* Split up 64 bit constant. */ TValue tv = *ir_k64(ir); ir->prev = lj_ir_kint(J, (int32_t)tv.u32.lo); hisubst[ref] = lj_ir_kint(J, (int32_t)tv.u32.hi); } else { ir->prev = ref; /* Identity substitution for loword. */ hisubst[ref] = 0; } } /* Process old IR instructions. */ snap = J->cur.snap; snref = snap->ref; for (ref = REF_FIRST; ref < nins; ref++) { IRIns *ir = &oir[ref]; IRRef nref = lj_ir_nextins(J); IRIns *nir = IR(nref); IRRef hi = 0; if (ref >= snref) { snap->ref = nref; split_subst_snap(J, snap++, oir); snref = snap < &J->cur.snap[J->cur.nsnap] ? snap->ref : ~(IRRef)0; } /* Copy-substitute old instruction to new instruction. */ nir->op1 = ir->op1 < nk ? ir->op1 : oir[ir->op1].prev; nir->op2 = ir->op2 < nk ? ir->op2 : oir[ir->op2].prev; ir->prev = nref; /* Loword substitution. */ nir->o = ir->o; nir->t.irt = ir->t.irt & ~(IRT_MARK|IRT_ISPHI); hisubst[ref] = 0; /* Split 64 bit instructions. */ #if LJ_SOFTFP if (irt_isnum(ir->t)) { nir->t.irt = IRT_INT | (nir->t.irt & IRT_GUARD); /* Turn into INT op. */ /* Note: hi ref = lo ref + 1! Required for SNAP_SOFTFPNUM logic. */ switch (ir->o) { case IR_ADD: hi = split_call_ll(J, hisubst, oir, ir, IRCALL_softfp_add); break; case IR_SUB: hi = split_call_ll(J, hisubst, oir, ir, IRCALL_softfp_sub); break; case IR_MUL: hi = split_call_ll(J, hisubst, oir, ir, IRCALL_softfp_mul); break; case IR_DIV: hi = split_call_ll(J, hisubst, oir, ir, IRCALL_softfp_div); break; case IR_POW: hi = split_call_li(J, hisubst, oir, ir, IRCALL_lj_vm_powi); break; case IR_FPMATH: /* Try to rejoin pow from EXP2, MUL and LOG2. */ if (nir->op2 == IRFPM_EXP2 && nir->op1 > J->loopref) { IRIns *irp = IR(nir->op1); if (irp->o == IR_CALLN && irp->op2 == IRCALL_softfp_mul) { IRIns *irm4 = IR(irp->op1); IRIns *irm3 = IR(irm4->op1); IRIns *irm12 = IR(irm3->op1); IRIns *irl1 = IR(irm12->op1); if (irm12->op1 > J->loopref && irl1->o == IR_CALLN && irl1->op2 == IRCALL_lj_vm_log2) { IRRef tmp = irl1->op1; /* Recycle first two args from LOG2. */ IRRef arg3 = irm3->op2, arg4 = irm4->op2; J->cur.nins--; tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), tmp, arg3); tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), tmp, arg4); ir->prev = tmp = split_emit(J, IRTI(IR_CALLN), tmp, IRCALL_pow); hi = split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), tmp, tmp); break; } } } hi = split_call_l(J, hisubst, oir, ir, IRCALL_lj_vm_floor + ir->op2); break; case IR_ATAN2: hi = split_call_ll(J, hisubst, oir, ir, IRCALL_atan2); break; case IR_LDEXP: hi = split_call_li(J, hisubst, oir, ir, IRCALL_ldexp); break; case IR_NEG: case IR_ABS: nir->o = IR_CONV; /* Pass through loword. */ nir->op2 = (IRT_INT << 5) | IRT_INT; hi = split_emit(J, IRT(ir->o == IR_NEG ? IR_BXOR : IR_BAND, IRT_SOFTFP), hisubst[ir->op1], hisubst[ir->op2]); break; case IR_SLOAD: if ((nir->op2 & IRSLOAD_CONVERT)) { /* Convert from int to number. */ nir->op2 &= ~IRSLOAD_CONVERT; ir->prev = nref = split_emit(J, IRTI(IR_CALLN), nref, IRCALL_softfp_i2d); hi = split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), nref, nref); break; } /* fallthrough */ case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: case IR_STRTO: hi = split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), nref, nref); break; case IR_XLOAD: { IRIns inslo = *nir; /* Save/undo the emit of the lo XLOAD. */ J->cur.nins--; hi = split_ptr(J, oir, ir->op1); /* Insert the hiref ADD. */ nref = lj_ir_nextins(J); nir = IR(nref); *nir = inslo; /* Re-emit lo XLOAD immediately before hi XLOAD. */ hi = split_emit(J, IRT(IR_XLOAD, IRT_SOFTFP), hi, ir->op2); #if LJ_LE ir->prev = nref; #else ir->prev = hi; hi = nref; #endif break; } case IR_ASTORE: case IR_HSTORE: case IR_USTORE: case IR_XSTORE: split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), nir->op1, hisubst[ir->op2]); break; case IR_CONV: { /* Conversion to number. Others handled below. */ IRType st = (IRType)(ir->op2 & IRCONV_SRCMASK); UNUSED(st); #if LJ_32 && LJ_HASFFI if (st == IRT_I64 || st == IRT_U64) { hi = split_call_l(J, hisubst, oir, ir, st == IRT_I64 ? IRCALL_fp64_l2d : IRCALL_fp64_ul2d); break; } #endif lua_assert(st == IRT_INT || (LJ_32 && LJ_HASFFI && (st == IRT_U32 || st == IRT_FLOAT))); nir->o = IR_CALLN; #if LJ_32 && LJ_HASFFI nir->op2 = st == IRT_INT ? IRCALL_softfp_i2d : st == IRT_FLOAT ? IRCALL_softfp_f2d : IRCALL_softfp_ui2d; #else nir->op2 = IRCALL_softfp_i2d; #endif hi = split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), nref, nref); break; } case IR_CALLN: case IR_CALLL: case IR_CALLS: case IR_CALLXS: goto split_call; case IR_PHI: if (nir->op1 == nir->op2) J->cur.nins--; /* Drop useless PHIs. */ if (hisubst[ir->op1] != hisubst[ir->op2]) split_emit(J, IRT(IR_PHI, IRT_SOFTFP), hisubst[ir->op1], hisubst[ir->op2]); break; case IR_HIOP: J->cur.nins--; /* Drop joining HIOP. */ ir->prev = nir->op1; hi = nir->op2; break; default: lua_assert(ir->o <= IR_NE || ir->o == IR_MIN || ir->o == IR_MAX); hi = split_emit(J, IRTG(IR_HIOP, IRT_SOFTFP), hisubst[ir->op1], hisubst[ir->op2]); break; } } else #endif #if LJ_32 && LJ_HASFFI if (irt_isint64(ir->t)) { IRRef hiref = hisubst[ir->op1]; nir->t.irt = IRT_INT | (nir->t.irt & IRT_GUARD); /* Turn into INT op. */ switch (ir->o) { case IR_ADD: case IR_SUB: /* Use plain op for hiword if loword cannot produce a carry/borrow. */ if (irref_isk(nir->op2) && IR(nir->op2)->i == 0) { ir->prev = nir->op1; /* Pass through loword. */ nir->op1 = hiref; nir->op2 = hisubst[ir->op2]; hi = nref; break; } /* fallthrough */ case IR_NEG: hi = split_emit(J, IRTI(IR_HIOP), hiref, hisubst[ir->op2]); break; case IR_MUL: hi = split_call_ll(J, hisubst, oir, ir, IRCALL_lj_carith_mul64); break; case IR_DIV: hi = split_call_ll(J, hisubst, oir, ir, irt_isi64(ir->t) ? IRCALL_lj_carith_divi64 : IRCALL_lj_carith_divu64); break; case IR_MOD: hi = split_call_ll(J, hisubst, oir, ir, irt_isi64(ir->t) ? IRCALL_lj_carith_modi64 : IRCALL_lj_carith_modu64); break; case IR_POW: hi = split_call_ll(J, hisubst, oir, ir, irt_isi64(ir->t) ? IRCALL_lj_carith_powi64 : IRCALL_lj_carith_powu64); break; case IR_FLOAD: lua_assert(ir->op2 == IRFL_CDATA_INT64); hi = split_emit(J, IRTI(IR_FLOAD), nir->op1, IRFL_CDATA_INT64_4); #if LJ_BE ir->prev = hi; hi = nref; #endif break; case IR_XLOAD: hi = split_emit(J, IRTI(IR_XLOAD), split_ptr(J, oir, ir->op1), ir->op2); #if LJ_BE ir->prev = hi; hi = nref; #endif break; case IR_XSTORE: split_emit(J, IRTI(IR_HIOP), nir->op1, hisubst[ir->op2]); break; case IR_CONV: { /* Conversion to 64 bit integer. Others handled below. */ IRType st = (IRType)(ir->op2 & IRCONV_SRCMASK); #if LJ_SOFTFP if (st == IRT_NUM) { /* NUM to 64 bit int conv. */ hi = split_call_l(J, hisubst, oir, ir, irt_isi64(ir->t) ? IRCALL_fp64_d2l : IRCALL_fp64_d2ul); } else if (st == IRT_FLOAT) { /* FLOAT to 64 bit int conv. */ nir->o = IR_CALLN; nir->op2 = irt_isi64(ir->t) ? IRCALL_fp64_f2l : IRCALL_fp64_f2ul; hi = split_emit(J, IRTI(IR_HIOP), nref, nref); } #else if (st == IRT_NUM || st == IRT_FLOAT) { /* FP to 64 bit int conv. */ hi = split_emit(J, IRTI(IR_HIOP), nir->op1, nref); } #endif else if (st == IRT_I64 || st == IRT_U64) { /* 64/64 bit cast. */ /* Drop cast, since assembler doesn't care. But fwd both parts. */ hi = hiref; goto fwdlo; } else if ((ir->op2 & IRCONV_SEXT)) { /* Sign-extend to 64 bit. */ IRRef k31 = lj_ir_kint(J, 31); nir = IR(nref); /* May have been reallocated. */ ir->prev = nir->op1; /* Pass through loword. */ nir->o = IR_BSAR; /* hi = bsar(lo, 31). */ nir->op2 = k31; hi = nref; } else { /* Zero-extend to 64 bit. */ hi = lj_ir_kint(J, 0); goto fwdlo; } break; } case IR_CALLXS: goto split_call; case IR_PHI: { IRRef hiref2; if ((irref_isk(nir->op1) && irref_isk(nir->op2)) || nir->op1 == nir->op2) J->cur.nins--; /* Drop useless PHIs. */ hiref2 = hisubst[ir->op2]; if (!((irref_isk(hiref) && irref_isk(hiref2)) || hiref == hiref2)) split_emit(J, IRTI(IR_PHI), hiref, hiref2); break; } case IR_HIOP: J->cur.nins--; /* Drop joining HIOP. */ ir->prev = nir->op1; hi = nir->op2; break; default: lua_assert(ir->o <= IR_NE); /* Comparisons. */ split_emit(J, IRTGI(IR_HIOP), hiref, hisubst[ir->op2]); break; } } else #endif #if LJ_SOFTFP if (ir->o == IR_SLOAD) { if ((nir->op2 & IRSLOAD_CONVERT)) { /* Convert from number to int. */ nir->op2 &= ~IRSLOAD_CONVERT; if (!(nir->op2 & IRSLOAD_TYPECHECK)) nir->t.irt = IRT_INT; /* Drop guard. */ split_emit(J, IRT(IR_HIOP, IRT_SOFTFP), nref, nref); ir->prev = split_num2int(J, nref, nref+1, irt_isguard(ir->t)); } } else if (ir->o == IR_TOBIT) { IRRef tmp, op1 = ir->op1; J->cur.nins--; #if LJ_LE tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), oir[op1].prev, hisubst[op1]); #else tmp = split_emit(J, IRT(IR_CARG, IRT_NIL), hisubst[op1], oir[op1].prev); #endif ir->prev = split_emit(J, IRTI(IR_CALLN), tmp, IRCALL_lj_vm_tobit); } else if (ir->o == IR_TOSTR) { if (hisubst[ir->op1]) { if (irref_isk(ir->op1)) nir->op1 = ir->op1; else split_emit(J, IRT(IR_HIOP, IRT_NIL), hisubst[ir->op1], nref); } } else if (ir->o == IR_HREF || ir->o == IR_NEWREF) { if (irref_isk(ir->op2) && hisubst[ir->op2]) nir->op2 = ir->op2; } else #endif if (ir->o == IR_CONV) { /* See above, too. */ IRType st = (IRType)(ir->op2 & IRCONV_SRCMASK); #if LJ_32 && LJ_HASFFI if (st == IRT_I64 || st == IRT_U64) { /* Conversion from 64 bit int. */ #if LJ_SOFTFP if (irt_isfloat(ir->t)) { split_call_l(J, hisubst, oir, ir, st == IRT_I64 ? IRCALL_fp64_l2f : IRCALL_fp64_ul2f); J->cur.nins--; /* Drop unused HIOP. */ } #else if (irt_isfp(ir->t)) { /* 64 bit integer to FP conversion. */ ir->prev = split_emit(J, IRT(IR_HIOP, irt_type(ir->t)), hisubst[ir->op1], nref); } #endif else { /* Truncate to lower 32 bits. */ fwdlo: ir->prev = nir->op1; /* Forward loword. */ /* Replace with NOP to avoid messing up the snapshot logic. */ nir->ot = IRT(IR_NOP, IRT_NIL); nir->op1 = nir->op2 = 0; } } #endif #if LJ_SOFTFP && LJ_32 && LJ_HASFFI else if (irt_isfloat(ir->t)) { if (st == IRT_NUM) { split_call_l(J, hisubst, oir, ir, IRCALL_softfp_d2f); J->cur.nins--; /* Drop unused HIOP. */ } else { nir->o = IR_CALLN; nir->op2 = st == IRT_INT ? IRCALL_softfp_i2f : IRCALL_softfp_ui2f; } } else if (st == IRT_FLOAT) { nir->o = IR_CALLN; nir->op2 = irt_isint(ir->t) ? IRCALL_softfp_f2i : IRCALL_softfp_f2ui; } else #endif #if LJ_SOFTFP if (st == IRT_NUM || (LJ_32 && LJ_HASFFI && st == IRT_FLOAT)) { if (irt_isguard(ir->t)) { lua_assert(st == IRT_NUM && irt_isint(ir->t)); J->cur.nins--; ir->prev = split_num2int(J, nir->op1, hisubst[ir->op1], 1); } else { split_call_l(J, hisubst, oir, ir, #if LJ_32 && LJ_HASFFI st == IRT_NUM ? (irt_isint(ir->t) ? IRCALL_softfp_d2i : IRCALL_softfp_d2ui) : (irt_isint(ir->t) ? IRCALL_softfp_f2i : IRCALL_softfp_f2ui) #else IRCALL_softfp_d2i #endif ); J->cur.nins--; /* Drop unused HIOP. */ } } #endif } else if (ir->o == IR_CALLXS) { IRRef hiref; split_call: hiref = hisubst[ir->op1]; if (hiref) { IROpT ot = nir->ot; IRRef op2 = nir->op2; nir->ot = IRT(IR_CARG, IRT_NIL); #if LJ_LE nir->op2 = hiref; #else nir->op2 = nir->op1; nir->op1 = hiref; #endif ir->prev = nref = split_emit(J, ot, nref, op2); } if (LJ_SOFTFP ? irt_is64(ir->t) : irt_isint64(ir->t)) hi = split_emit(J, IRT(IR_HIOP, (LJ_SOFTFP && irt_isnum(ir->t)) ? IRT_SOFTFP : IRT_INT), nref, nref); } else if (ir->o == IR_CARG) { IRRef hiref = hisubst[ir->op1]; if (hiref) { IRRef op2 = nir->op2; #if LJ_LE nir->op2 = hiref; #else nir->op2 = nir->op1; nir->op1 = hiref; #endif ir->prev = nref = split_emit(J, IRT(IR_CARG, IRT_NIL), nref, op2); nir = IR(nref); } hiref = hisubst[ir->op2]; if (hiref) { #if !LJ_TARGET_X86 int carg = 0; IRIns *cir; for (cir = IR(nir->op1); cir->o == IR_CARG; cir = IR(cir->op1)) carg++; if ((carg & 1) == 0) { /* Align 64 bit arguments. */ IRRef op2 = nir->op2; nir->op2 = REF_NIL; nref = split_emit(J, IRT(IR_CARG, IRT_NIL), nref, op2); nir = IR(nref); } #endif #if LJ_BE { IRRef tmp = nir->op2; nir->op2 = hiref; hiref = tmp; } #endif ir->prev = split_emit(J, IRT(IR_CARG, IRT_NIL), nref, hiref); } } else if (ir->o == IR_CNEWI) { if (hisubst[ir->op2]) split_emit(J, IRT(IR_HIOP, IRT_NIL), nref, hisubst[ir->op2]); } else if (ir->o == IR_LOOP) { J->loopref = nref; /* Needed by assembler. */ } hisubst[ref] = hi; /* Store hiword substitution. */ } if (snref == nins) { /* Substitution for last snapshot. */ snap->ref = J->cur.nins; split_subst_snap(J, snap, oir); } /* Add PHI marks. */ for (ref = J->cur.nins-1; ref >= REF_FIRST; ref--) { IRIns *ir = IR(ref); if (ir->o != IR_PHI) break; if (!irref_isk(ir->op1)) irt_setphi(IR(ir->op1)->t); if (ir->op2 > J->loopref) irt_setphi(IR(ir->op2)->t); } } /* Protected callback for split pass. */ static TValue *cpsplit(lua_State *L, lua_CFunction dummy, void *ud) { jit_State *J = (jit_State *)ud; split_ir(J); UNUSED(L); UNUSED(dummy); return NULL; } #if defined(LUA_USE_ASSERT) || LJ_SOFTFP /* Slow, but sure way to check whether a SPLIT pass is needed. */ static int split_needsplit(jit_State *J) { IRIns *ir, *irend; IRRef ref; for (ir = IR(REF_FIRST), irend = IR(J->cur.nins); ir < irend; ir++) if (LJ_SOFTFP ? irt_is64orfp(ir->t) : irt_isint64(ir->t)) return 1; if (LJ_SOFTFP) { for (ref = J->chain[IR_SLOAD]; ref; ref = IR(ref)->prev) if ((IR(ref)->op2 & IRSLOAD_CONVERT)) return 1; if (J->chain[IR_TOBIT]) return 1; } for (ref = J->chain[IR_CONV]; ref; ref = IR(ref)->prev) { IRType st = (IR(ref)->op2 & IRCONV_SRCMASK); if ((LJ_SOFTFP && (st == IRT_NUM || st == IRT_FLOAT)) || st == IRT_I64 || st == IRT_U64) return 1; } return 0; /* Nope. */ } #endif /* SPLIT pass. */ void lj_opt_split(jit_State *J) { #if LJ_SOFTFP if (!J->needsplit) J->needsplit = split_needsplit(J); #else lua_assert(J->needsplit >= split_needsplit(J)); /* Verify flag. */ #endif if (J->needsplit) { int errcode = lj_vm_cpcall(J->L, NULL, J, cpsplit); if (errcode) { /* Completely reset the trace to avoid inconsistent dump on abort. */ J->cur.nins = J->cur.nk = REF_BASE; J->cur.nsnap = 0; lj_err_throw(J->L, errcode); /* Propagate errors. */ } } } #undef IR #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_str.c0000644000175000017500000002277013122010155016342 0ustar philphil/* ** String handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #include #define lj_str_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_state.h" #include "lj_char.h" /* -- String interning ---------------------------------------------------- */ /* Ordered compare of strings. Assumes string data is 4-byte aligned. */ int32_t LJ_FASTCALL lj_str_cmp(GCstr *a, GCstr *b) { MSize i, n = a->len > b->len ? b->len : a->len; for (i = 0; i < n; i += 4) { /* Note: innocuous access up to end of string + 3. */ uint32_t va = *(const uint32_t *)(strdata(a)+i); uint32_t vb = *(const uint32_t *)(strdata(b)+i); if (va != vb) { #if LJ_LE va = lj_bswap(va); vb = lj_bswap(vb); #endif i -= n; if ((int32_t)i >= -3) { va >>= 32+(i<<3); vb >>= 32+(i<<3); if (va == vb) break; } return va < vb ? -1 : 1; } } return (int32_t)(a->len - b->len); } /* Fast string data comparison. Caveat: unaligned access to 1st string! */ static LJ_AINLINE int str_fastcmp(const char *a, const char *b, MSize len) { MSize i = 0; lua_assert(len > 0); lua_assert((((uintptr_t)a+len-1) & (LJ_PAGESIZE-1)) <= LJ_PAGESIZE-4); do { /* Note: innocuous access up to end of string + 3. */ uint32_t v = lj_getu32(a+i) ^ *(const uint32_t *)(b+i); if (v) { i -= len; #if LJ_LE return (int32_t)i >= -3 ? (v << (32+(i<<3))) : 1; #else return (int32_t)i >= -3 ? (v >> (32+(i<<3))) : 1; #endif } i += 4; } while (i < len); return 0; } /* Resize the string hash table (grow and shrink). */ void lj_str_resize(lua_State *L, MSize newmask) { global_State *g = G(L); GCRef *newhash; MSize i; if (g->gc.state == GCSsweepstring || newmask >= LJ_MAX_STRTAB-1) return; /* No resizing during GC traversal or if already too big. */ newhash = lj_mem_newvec(L, newmask+1, GCRef); memset(newhash, 0, (newmask+1)*sizeof(GCRef)); for (i = g->strmask; i != ~(MSize)0; i--) { /* Rehash old table. */ GCobj *p = gcref(g->strhash[i]); while (p) { /* Follow each hash chain and reinsert all strings. */ MSize h = gco2str(p)->hash & newmask; GCobj *next = gcnext(p); /* NOBARRIER: The string table is a GC root. */ setgcrefr(p->gch.nextgc, newhash[h]); setgcref(newhash[h], p); p = next; } } lj_mem_freevec(g, g->strhash, g->strmask+1, GCRef); g->strmask = newmask; g->strhash = newhash; } /* Intern a string and return string object. */ GCstr *lj_str_new(lua_State *L, const char *str, size_t lenx) { global_State *g; GCstr *s; GCobj *o; MSize len = (MSize)lenx; MSize a, b, h = len; if (lenx >= LJ_MAX_STR) lj_err_msg(L, LJ_ERR_STROV); g = G(L); /* Compute string hash. Constants taken from lookup3 hash by Bob Jenkins. */ if (len >= 4) { /* Caveat: unaligned access! */ a = lj_getu32(str); h ^= lj_getu32(str+len-4); b = lj_getu32(str+(len>>1)-2); h ^= b; h -= lj_rol(b, 14); b += lj_getu32(str+(len>>2)-1); } else if (len > 0) { a = *(const uint8_t *)str; h ^= *(const uint8_t *)(str+len-1); b = *(const uint8_t *)(str+(len>>1)); h ^= b; h -= lj_rol(b, 14); } else { return &g->strempty; } a ^= h; a -= lj_rol(h, 11); b ^= a; b -= lj_rol(a, 25); h ^= b; h -= lj_rol(b, 16); /* Check if the string has already been interned. */ o = gcref(g->strhash[h & g->strmask]); if (LJ_LIKELY((((uintptr_t)str+len-1) & (LJ_PAGESIZE-1)) <= LJ_PAGESIZE-4)) { while (o != NULL) { GCstr *sx = gco2str(o); if (sx->len == len && str_fastcmp(str, strdata(sx), len) == 0) { /* Resurrect if dead. Can only happen with fixstring() (keywords). */ if (isdead(g, o)) flipwhite(o); return sx; /* Return existing string. */ } o = gcnext(o); } } else { /* Slow path: end of string is too close to a page boundary. */ while (o != NULL) { GCstr *sx = gco2str(o); if (sx->len == len && memcmp(str, strdata(sx), len) == 0) { /* Resurrect if dead. Can only happen with fixstring() (keywords). */ if (isdead(g, o)) flipwhite(o); return sx; /* Return existing string. */ } o = gcnext(o); } } /* Nope, create a new string. */ s = lj_mem_newt(L, sizeof(GCstr)+len+1, GCstr); newwhite(g, s); s->gct = ~LJ_TSTR; s->len = len; s->hash = h; s->reserved = 0; memcpy(strdatawr(s), str, len); strdatawr(s)[len] = '\0'; /* Zero-terminate string. */ /* Add it to string hash table. */ h &= g->strmask; s->nextgc = g->strhash[h]; /* NOBARRIER: The string table is a GC root. */ setgcref(g->strhash[h], obj2gco(s)); if (g->strnum++ > g->strmask) /* Allow a 100% load factor. */ lj_str_resize(L, (g->strmask<<1)+1); /* Grow string table. */ return s; /* Return newly interned string. */ } void LJ_FASTCALL lj_str_free(global_State *g, GCstr *s) { g->strnum--; lj_mem_free(g, s, sizestring(s)); } /* -- Type conversions ---------------------------------------------------- */ /* Print number to buffer. Canonicalizes non-finite values. */ size_t LJ_FASTCALL lj_str_bufnum(char *s, cTValue *o) { if (LJ_LIKELY((o->u32.hi << 1) < 0xffe00000)) { /* Finite? */ lua_Number n = o->n; #if __BIONIC__ if (tvismzero(o)) { s[0] = '-'; s[1] = '0'; return 2; } #endif return (size_t)lua_number2str(s, n); } else if (((o->u32.hi & 0x000fffff) | o->u32.lo) != 0) { s[0] = 'n'; s[1] = 'a'; s[2] = 'n'; return 3; } else if ((o->u32.hi & 0x80000000) == 0) { s[0] = 'i'; s[1] = 'n'; s[2] = 'f'; return 3; } else { s[0] = '-'; s[1] = 'i'; s[2] = 'n'; s[3] = 'f'; return 4; } } /* Print integer to buffer. Returns pointer to start. */ char * LJ_FASTCALL lj_str_bufint(char *p, int32_t k) { uint32_t u = (uint32_t)(k < 0 ? -k : k); p += 1+10; do { *--p = (char)('0' + u % 10); } while (u /= 10); if (k < 0) *--p = '-'; return p; } /* Convert number to string. */ GCstr * LJ_FASTCALL lj_str_fromnum(lua_State *L, const lua_Number *np) { char buf[LJ_STR_NUMBUF]; size_t len = lj_str_bufnum(buf, (TValue *)np); return lj_str_new(L, buf, len); } /* Convert integer to string. */ GCstr * LJ_FASTCALL lj_str_fromint(lua_State *L, int32_t k) { char s[1+10]; char *p = lj_str_bufint(s, k); return lj_str_new(L, p, (size_t)(s+sizeof(s)-p)); } GCstr * LJ_FASTCALL lj_str_fromnumber(lua_State *L, cTValue *o) { return tvisint(o) ? lj_str_fromint(L, intV(o)) : lj_str_fromnum(L, &o->n); } /* -- String formatting --------------------------------------------------- */ static void addstr(lua_State *L, SBuf *sb, const char *str, MSize len) { char *p; MSize i; if (sb->n + len > sb->sz) { MSize sz = sb->sz * 2; while (sb->n + len > sz) sz = sz * 2; lj_str_resizebuf(L, sb, sz); } p = sb->buf + sb->n; sb->n += len; for (i = 0; i < len; i++) p[i] = str[i]; } static void addchar(lua_State *L, SBuf *sb, int c) { if (sb->n + 1 > sb->sz) { MSize sz = sb->sz * 2; lj_str_resizebuf(L, sb, sz); } sb->buf[sb->n++] = (char)c; } /* Push formatted message as a string object to Lua stack. va_list variant. */ const char *lj_str_pushvf(lua_State *L, const char *fmt, va_list argp) { SBuf *sb = &G(L)->tmpbuf; lj_str_needbuf(L, sb, (MSize)strlen(fmt)); lj_str_resetbuf(sb); for (;;) { const char *e = strchr(fmt, '%'); if (e == NULL) break; addstr(L, sb, fmt, (MSize)(e-fmt)); /* This function only handles %s, %c, %d, %f and %p formats. */ switch (e[1]) { case 's': { const char *s = va_arg(argp, char *); if (s == NULL) s = "(null)"; addstr(L, sb, s, (MSize)strlen(s)); break; } case 'c': addchar(L, sb, va_arg(argp, int)); break; case 'd': { char buf[LJ_STR_INTBUF]; char *p = lj_str_bufint(buf, va_arg(argp, int32_t)); addstr(L, sb, p, (MSize)(buf+LJ_STR_INTBUF-p)); break; } case 'f': { char buf[LJ_STR_NUMBUF]; TValue tv; MSize len; tv.n = (lua_Number)(va_arg(argp, LUAI_UACNUMBER)); len = (MSize)lj_str_bufnum(buf, &tv); addstr(L, sb, buf, len); break; } case 'p': { #define FMTP_CHARS (2*sizeof(ptrdiff_t)) char buf[2+FMTP_CHARS]; ptrdiff_t p = (ptrdiff_t)(va_arg(argp, void *)); ptrdiff_t i, lasti = 2+FMTP_CHARS; if (p == 0) { addstr(L, sb, "NULL", 4); break; } #if LJ_64 /* Shorten output for 64 bit pointers. */ lasti = 2+2*4+((p >> 32) ? 2+2*(lj_fls((uint32_t)(p >> 32))>>3) : 0); #endif buf[0] = '0'; buf[1] = 'x'; for (i = lasti-1; i >= 2; i--, p >>= 4) buf[i] = "0123456789abcdef"[(p & 15)]; addstr(L, sb, buf, (MSize)lasti); break; } case '%': addchar(L, sb, '%'); break; default: addchar(L, sb, '%'); addchar(L, sb, e[1]); break; } fmt = e+2; } addstr(L, sb, fmt, (MSize)strlen(fmt)); setstrV(L, L->top, lj_str_new(L, sb->buf, sb->n)); incr_top(L); return strVdata(L->top - 1); } /* Push formatted message as a string object to Lua stack. Vararg variant. */ const char *lj_str_pushf(lua_State *L, const char *fmt, ...) { const char *msg; va_list argp; va_start(argp, fmt); msg = lj_str_pushvf(L, fmt, argp); va_end(argp); return msg; } /* -- Buffer handling ----------------------------------------------------- */ char *lj_str_needbuf(lua_State *L, SBuf *sb, MSize sz) { if (sz > sb->sz) { if (sz < LJ_MIN_SBUF) sz = LJ_MIN_SBUF; lj_str_resizebuf(L, sb, sz); } return sb->buf; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_state.h0000644000175000017500000000202513122010155016646 0ustar philphil/* ** State and stack handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_STATE_H #define _LJ_STATE_H #include "lj_obj.h" #define incr_top(L) \ (++L->top >= tvref(L->maxstack) && (lj_state_growstack1(L), 0)) #define savestack(L, p) ((char *)(p) - mref(L->stack, char)) #define restorestack(L, n) ((TValue *)(mref(L->stack, char) + (n))) LJ_FUNC void lj_state_relimitstack(lua_State *L); LJ_FUNC void lj_state_shrinkstack(lua_State *L, MSize used); LJ_FUNCA void LJ_FASTCALL lj_state_growstack(lua_State *L, MSize need); LJ_FUNC void LJ_FASTCALL lj_state_growstack1(lua_State *L); static LJ_AINLINE void lj_state_checkstack(lua_State *L, MSize need) { if ((mref(L->maxstack, char) - (char *)L->top) <= (ptrdiff_t)need*(ptrdiff_t)sizeof(TValue)) lj_state_growstack(L, need); } LJ_FUNC lua_State *lj_state_new(lua_State *L); LJ_FUNC void LJ_FASTCALL lj_state_free(global_State *g, lua_State *L); #if LJ_64 LJ_FUNC lua_State *lj_state_newstate(lua_Alloc f, void *ud); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_str.h0000644000175000017500000000326713122010155016347 0ustar philphil/* ** String handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_STR_H #define _LJ_STR_H #include #include "lj_obj.h" /* String interning. */ LJ_FUNC int32_t LJ_FASTCALL lj_str_cmp(GCstr *a, GCstr *b); LJ_FUNC void lj_str_resize(lua_State *L, MSize newmask); LJ_FUNCA GCstr *lj_str_new(lua_State *L, const char *str, size_t len); LJ_FUNC void LJ_FASTCALL lj_str_free(global_State *g, GCstr *s); #define lj_str_newz(L, s) (lj_str_new(L, s, strlen(s))) #define lj_str_newlit(L, s) (lj_str_new(L, "" s, sizeof(s)-1)) /* Type conversions. */ LJ_FUNC size_t LJ_FASTCALL lj_str_bufnum(char *s, cTValue *o); LJ_FUNC char * LJ_FASTCALL lj_str_bufint(char *p, int32_t k); LJ_FUNCA GCstr * LJ_FASTCALL lj_str_fromnum(lua_State *L, const lua_Number *np); LJ_FUNC GCstr * LJ_FASTCALL lj_str_fromint(lua_State *L, int32_t k); LJ_FUNCA GCstr * LJ_FASTCALL lj_str_fromnumber(lua_State *L, cTValue *o); #define LJ_STR_INTBUF (1+10) #define LJ_STR_NUMBUF LUAI_MAXNUMBER2STR /* String formatting. */ LJ_FUNC const char *lj_str_pushvf(lua_State *L, const char *fmt, va_list argp); LJ_FUNC const char *lj_str_pushf(lua_State *L, const char *fmt, ...) #if defined(__GNUC__) __attribute__ ((format (printf, 2, 3))) #endif ; /* Resizable string buffers. Struct definition in lj_obj.h. */ LJ_FUNC char *lj_str_needbuf(lua_State *L, SBuf *sb, MSize sz); #define lj_str_initbuf(sb) ((sb)->buf = NULL, (sb)->sz = 0) #define lj_str_resetbuf(sb) ((sb)->n = 0) #define lj_str_resizebuf(L, sb, size) \ ((sb)->buf = (char *)lj_mem_realloc(L, (sb)->buf, (sb)->sz, (size)), \ (sb)->sz = (size)) #define lj_str_freebuf(g, sb) lj_mem_free(g, (void *)(sb)->buf, (sb)->sz) #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_err.h0000644000175000017500000000273013122010155016321 0ustar philphil/* ** Error handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_ERR_H #define _LJ_ERR_H #include #include "lj_obj.h" typedef enum { #define ERRDEF(name, msg) \ LJ_ERR_##name, LJ_ERR_##name##_ = LJ_ERR_##name + sizeof(msg)-1, #include "lj_errmsg.h" LJ_ERR__MAX } ErrMsg; LJ_DATA const char *lj_err_allmsg; #define err2msg(em) (lj_err_allmsg+(int)(em)) LJ_FUNC GCstr *lj_err_str(lua_State *L, ErrMsg em); LJ_FUNCA_NORET void LJ_FASTCALL lj_err_throw(lua_State *L, int errcode); LJ_FUNC_NORET void lj_err_mem(lua_State *L); LJ_FUNC_NORET void lj_err_run(lua_State *L); LJ_FUNC_NORET void lj_err_msg(lua_State *L, ErrMsg em); LJ_FUNC_NORET void lj_err_lex(lua_State *L, GCstr *src, const char *tok, BCLine line, ErrMsg em, va_list argp); LJ_FUNC_NORET void lj_err_optype(lua_State *L, cTValue *o, ErrMsg opm); LJ_FUNC_NORET void lj_err_comp(lua_State *L, cTValue *o1, cTValue *o2); LJ_FUNC_NORET void lj_err_optype_call(lua_State *L, TValue *o); LJ_FUNC_NORET void lj_err_callermsg(lua_State *L, const char *msg); LJ_FUNC_NORET void lj_err_callerv(lua_State *L, ErrMsg em, ...); LJ_FUNC_NORET void lj_err_caller(lua_State *L, ErrMsg em); LJ_FUNC_NORET void lj_err_arg(lua_State *L, int narg, ErrMsg em); LJ_FUNC_NORET void lj_err_argv(lua_State *L, int narg, ErrMsg em, ...); LJ_FUNC_NORET void lj_err_argtype(lua_State *L, int narg, const char *xname); LJ_FUNC_NORET void lj_err_argt(lua_State *L, int narg, int tt); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/luajit.c0000644000175000017500000003472013122010155016333 0ustar philphil/* ** LuaJIT frontend. Runs commands, scripts, read-eval-print (REPL) etc. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #include #include #include #define luajit_c #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "luajit.h" #include "lj_arch.h" #if LJ_TARGET_POSIX #include #define lua_stdin_is_tty() isatty(0) #elif LJ_TARGET_WINDOWS #include #ifdef __BORLANDC__ #define lua_stdin_is_tty() isatty(_fileno(stdin)) #else #define lua_stdin_is_tty() _isatty(_fileno(stdin)) #endif #else #define lua_stdin_is_tty() 1 #endif #if !LJ_TARGET_CONSOLE #include #endif static lua_State *globalL = NULL; static const char *progname = LUA_PROGNAME; #if !LJ_TARGET_CONSOLE static void lstop(lua_State *L, lua_Debug *ar) { (void)ar; /* unused arg. */ lua_sethook(L, NULL, 0, 0); /* Avoid luaL_error -- a C hook doesn't add an extra frame. */ luaL_where(L, 0); lua_pushfstring(L, "%sinterrupted!", lua_tostring(L, -1)); lua_error(L); } static void laction(int i) { signal(i, SIG_DFL); /* if another SIGINT happens before lstop, terminate process (default action) */ lua_sethook(globalL, lstop, LUA_MASKCALL | LUA_MASKRET | LUA_MASKCOUNT, 1); } #endif static void print_usage(void) { fprintf(stderr, "usage: %s [options]... [script [args]...].\n" "Available options are:\n" " -e chunk Execute string " LUA_QL("chunk") ".\n" " -l name Require library " LUA_QL("name") ".\n" " -b ... Save or list bytecode.\n" " -j cmd Perform LuaJIT control command.\n" " -O[opt] Control LuaJIT optimizations.\n" " -i Enter interactive mode after executing " LUA_QL("script") ".\n" " -v Show version information.\n" " -E Ignore environment variables.\n" " -- Stop handling options.\n" " - Execute stdin and stop handling options.\n" , progname); fflush(stderr); } static void l_message(const char *pname, const char *msg) { if (pname) fprintf(stderr, "%s: ", pname); fprintf(stderr, "%s\n", msg); fflush(stderr); } static int report(lua_State *L, int status) { if (status && !lua_isnil(L, -1)) { const char *msg = lua_tostring(L, -1); if (msg == NULL) msg = "(error object is not a string)"; l_message(progname, msg); lua_pop(L, 1); } return status; } static int traceback(lua_State *L) { if (!lua_isstring(L, 1)) { /* Non-string error object? Try metamethod. */ if (lua_isnoneornil(L, 1) || !luaL_callmeta(L, 1, "__tostring") || !lua_isstring(L, -1)) return 1; /* Return non-string error object. */ lua_remove(L, 1); /* Replace object by result of __tostring metamethod. */ } luaL_traceback(L, L, lua_tostring(L, 1), 1); return 1; } static int docall(lua_State *L, int narg, int clear) { int status; int base = lua_gettop(L) - narg; /* function index */ lua_pushcfunction(L, traceback); /* push traceback function */ lua_insert(L, base); /* put it under chunk and args */ #if !LJ_TARGET_CONSOLE signal(SIGINT, laction); #endif status = lua_pcall(L, narg, (clear ? 0 : LUA_MULTRET), base); #if !LJ_TARGET_CONSOLE signal(SIGINT, SIG_DFL); #endif lua_remove(L, base); /* remove traceback function */ /* force a complete garbage collection in case of errors */ if (status != 0) lua_gc(L, LUA_GCCOLLECT, 0); return status; } static void print_version(void) { fputs(LUAJIT_VERSION " -- " LUAJIT_COPYRIGHT ". " LUAJIT_URL "\n", stdout); } static void print_jit_status(lua_State *L) { int n; const char *s; lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); lua_getfield(L, -1, "jit"); /* Get jit.* module table. */ lua_remove(L, -2); lua_getfield(L, -1, "status"); lua_remove(L, -2); n = lua_gettop(L); lua_call(L, 0, LUA_MULTRET); fputs(lua_toboolean(L, n) ? "JIT: ON" : "JIT: OFF", stdout); for (n++; (s = lua_tostring(L, n)); n++) { putc(' ', stdout); fputs(s, stdout); } putc('\n', stdout); } static int getargs(lua_State *L, char **argv, int n) { int narg; int i; int argc = 0; while (argv[argc]) argc++; /* count total number of arguments */ narg = argc - (n + 1); /* number of arguments to the script */ luaL_checkstack(L, narg + 3, "too many arguments to script"); for (i = n+1; i < argc; i++) lua_pushstring(L, argv[i]); lua_createtable(L, narg, n + 1); for (i = 0; i < argc; i++) { lua_pushstring(L, argv[i]); lua_rawseti(L, -2, i - n); } return narg; } static int dofile(lua_State *L, const char *name) { int status = luaL_loadfile(L, name) || docall(L, 0, 1); return report(L, status); } static int dostring(lua_State *L, const char *s, const char *name) { int status = luaL_loadbuffer(L, s, strlen(s), name) || docall(L, 0, 1); return report(L, status); } static int dolibrary(lua_State *L, const char *name) { lua_getglobal(L, "require"); lua_pushstring(L, name); return report(L, docall(L, 1, 1)); } static void write_prompt(lua_State *L, int firstline) { const char *p; lua_getfield(L, LUA_GLOBALSINDEX, firstline ? "_PROMPT" : "_PROMPT2"); p = lua_tostring(L, -1); if (p == NULL) p = firstline ? LUA_PROMPT : LUA_PROMPT2; fputs(p, stdout); fflush(stdout); lua_pop(L, 1); /* remove global */ } static int incomplete(lua_State *L, int status) { if (status == LUA_ERRSYNTAX) { size_t lmsg; const char *msg = lua_tolstring(L, -1, &lmsg); const char *tp = msg + lmsg - (sizeof(LUA_QL("")) - 1); if (strstr(msg, LUA_QL("")) == tp) { lua_pop(L, 1); return 1; } } return 0; /* else... */ } static int pushline(lua_State *L, int firstline) { char buf[LUA_MAXINPUT]; write_prompt(L, firstline); if (fgets(buf, LUA_MAXINPUT, stdin)) { size_t len = strlen(buf); if (len > 0 && buf[len-1] == '\n') buf[len-1] = '\0'; if (firstline && buf[0] == '=') lua_pushfstring(L, "return %s", buf+1); else lua_pushstring(L, buf); return 1; } return 0; } static int loadline(lua_State *L) { int status; lua_settop(L, 0); if (!pushline(L, 1)) return -1; /* no input */ for (;;) { /* repeat until gets a complete line */ status = luaL_loadbuffer(L, lua_tostring(L, 1), lua_strlen(L, 1), "=stdin"); if (!incomplete(L, status)) break; /* cannot try to add lines? */ if (!pushline(L, 0)) /* no more input? */ return -1; lua_pushliteral(L, "\n"); /* add a new line... */ lua_insert(L, -2); /* ...between the two lines */ lua_concat(L, 3); /* join them */ } lua_remove(L, 1); /* remove line */ return status; } static void dotty(lua_State *L) { int status; const char *oldprogname = progname; progname = NULL; while ((status = loadline(L)) != -1) { if (status == 0) status = docall(L, 0, 0); report(L, status); if (status == 0 && lua_gettop(L) > 0) { /* any result to print? */ lua_getglobal(L, "print"); lua_insert(L, 1); if (lua_pcall(L, lua_gettop(L)-1, 0, 0) != 0) l_message(progname, lua_pushfstring(L, "error calling " LUA_QL("print") " (%s)", lua_tostring(L, -1))); } } lua_settop(L, 0); /* clear stack */ fputs("\n", stdout); fflush(stdout); progname = oldprogname; } static int handle_script(lua_State *L, char **argv, int n) { int status; const char *fname; int narg = getargs(L, argv, n); /* collect arguments */ lua_setglobal(L, "arg"); fname = argv[n]; if (strcmp(fname, "-") == 0 && strcmp(argv[n-1], "--") != 0) fname = NULL; /* stdin */ status = luaL_loadfile(L, fname); lua_insert(L, -(narg+1)); if (status == 0) status = docall(L, narg, 0); else lua_pop(L, narg); return report(L, status); } /* Load add-on module. */ static int loadjitmodule(lua_State *L) { lua_getglobal(L, "require"); lua_pushliteral(L, "jit."); lua_pushvalue(L, -3); lua_concat(L, 2); if (lua_pcall(L, 1, 1, 0)) { const char *msg = lua_tostring(L, -1); if (msg && !strncmp(msg, "module ", 7)) goto nomodule; return report(L, 1); } lua_getfield(L, -1, "start"); if (lua_isnil(L, -1)) { nomodule: l_message(progname, "unknown luaJIT command or jit.* modules not installed"); return 1; } lua_remove(L, -2); /* Drop module table. */ return 0; } /* Run command with options. */ static int runcmdopt(lua_State *L, const char *opt) { int narg = 0; if (opt && *opt) { for (;;) { /* Split arguments. */ const char *p = strchr(opt, ','); narg++; if (!p) break; if (p == opt) lua_pushnil(L); else lua_pushlstring(L, opt, (size_t)(p - opt)); opt = p + 1; } if (*opt) lua_pushstring(L, opt); else lua_pushnil(L); } return report(L, lua_pcall(L, narg, 0, 0)); } /* JIT engine control command: try jit library first or load add-on module. */ static int dojitcmd(lua_State *L, const char *cmd) { const char *opt = strchr(cmd, '='); lua_pushlstring(L, cmd, opt ? (size_t)(opt - cmd) : strlen(cmd)); lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); lua_getfield(L, -1, "jit"); /* Get jit.* module table. */ lua_remove(L, -2); lua_pushvalue(L, -2); lua_gettable(L, -2); /* Lookup library function. */ if (!lua_isfunction(L, -1)) { lua_pop(L, 2); /* Drop non-function and jit.* table, keep module name. */ if (loadjitmodule(L)) return 1; } else { lua_remove(L, -2); /* Drop jit.* table. */ } lua_remove(L, -2); /* Drop module name. */ return runcmdopt(L, opt ? opt+1 : opt); } /* Optimization flags. */ static int dojitopt(lua_State *L, const char *opt) { lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); lua_getfield(L, -1, "jit.opt"); /* Get jit.opt.* module table. */ lua_remove(L, -2); lua_getfield(L, -1, "start"); lua_remove(L, -2); return runcmdopt(L, opt); } /* Save or list bytecode. */ static int dobytecode(lua_State *L, char **argv) { int narg = 0; lua_pushliteral(L, "bcsave"); if (loadjitmodule(L)) return 1; if (argv[0][2]) { narg++; argv[0][1] = '-'; lua_pushstring(L, argv[0]+1); } for (argv++; *argv != NULL; narg++, argv++) lua_pushstring(L, *argv); return report(L, lua_pcall(L, narg, 0, 0)); } /* check that argument has no extra characters at the end */ #define notail(x) {if ((x)[2] != '\0') return -1;} #define FLAGS_INTERACTIVE 1 #define FLAGS_VERSION 2 #define FLAGS_EXEC 4 #define FLAGS_OPTION 8 #define FLAGS_NOENV 16 static int collectargs(char **argv, int *flags) { int i; for (i = 1; argv[i] != NULL; i++) { if (argv[i][0] != '-') /* Not an option? */ return i; switch (argv[i][1]) { /* Check option. */ case '-': notail(argv[i]); return (argv[i+1] != NULL ? i+1 : 0); case '\0': return i; case 'i': notail(argv[i]); *flags |= FLAGS_INTERACTIVE; /* fallthrough */ case 'v': notail(argv[i]); *flags |= FLAGS_VERSION; break; case 'e': *flags |= FLAGS_EXEC; case 'j': /* LuaJIT extension */ case 'l': *flags |= FLAGS_OPTION; if (argv[i][2] == '\0') { i++; if (argv[i] == NULL) return -1; } break; case 'O': break; /* LuaJIT extension */ case 'b': /* LuaJIT extension */ if (*flags) return -1; *flags |= FLAGS_EXEC; return 0; case 'E': *flags |= FLAGS_NOENV; break; default: return -1; /* invalid option */ } } return 0; } static int runargs(lua_State *L, char **argv, int n) { int i; for (i = 1; i < n; i++) { if (argv[i] == NULL) continue; lua_assert(argv[i][0] == '-'); switch (argv[i][1]) { /* option */ case 'e': { const char *chunk = argv[i] + 2; if (*chunk == '\0') chunk = argv[++i]; lua_assert(chunk != NULL); if (dostring(L, chunk, "=(command line)") != 0) return 1; break; } case 'l': { const char *filename = argv[i] + 2; if (*filename == '\0') filename = argv[++i]; lua_assert(filename != NULL); if (dolibrary(L, filename)) return 1; /* stop if file fails */ break; } case 'j': { /* LuaJIT extension */ const char *cmd = argv[i] + 2; if (*cmd == '\0') cmd = argv[++i]; lua_assert(cmd != NULL); if (dojitcmd(L, cmd)) return 1; break; } case 'O': /* LuaJIT extension */ if (dojitopt(L, argv[i] + 2)) return 1; break; case 'b': /* LuaJIT extension */ return dobytecode(L, argv+i); default: break; } } return 0; } static int handle_luainit(lua_State *L) { #if LJ_TARGET_CONSOLE const char *init = NULL; #else const char *init = getenv(LUA_INIT); #endif if (init == NULL) return 0; /* status OK */ else if (init[0] == '@') return dofile(L, init+1); else return dostring(L, init, "=" LUA_INIT); } static struct Smain { char **argv; int argc; int status; } smain; static int pmain(lua_State *L) { struct Smain *s = &smain; char **argv = s->argv; int script; int flags = 0; globalL = L; if (argv[0] && argv[0][0]) progname = argv[0]; LUAJIT_VERSION_SYM(); /* linker-enforced version check */ script = collectargs(argv, &flags); if (script < 0) { /* invalid args? */ print_usage(); s->status = 1; return 0; } if ((flags & FLAGS_NOENV)) { lua_pushboolean(L, 1); lua_setfield(L, LUA_REGISTRYINDEX, "LUA_NOENV"); } lua_gc(L, LUA_GCSTOP, 0); /* stop collector during initialization */ luaL_openlibs(L); /* open libraries */ lua_gc(L, LUA_GCRESTART, -1); if (!(flags & FLAGS_NOENV)) { s->status = handle_luainit(L); if (s->status != 0) return 0; } if ((flags & FLAGS_VERSION)) print_version(); s->status = runargs(L, argv, (script > 0) ? script : s->argc); if (s->status != 0) return 0; if (script) { s->status = handle_script(L, argv, script); if (s->status != 0) return 0; } if ((flags & FLAGS_INTERACTIVE)) { print_jit_status(L); dotty(L); } else if (script == 0 && !(flags & (FLAGS_EXEC|FLAGS_VERSION))) { if (lua_stdin_is_tty()) { print_version(); print_jit_status(L); dotty(L); } else { dofile(L, NULL); /* executes stdin as a file */ } } return 0; } int main(int argc, char **argv) { int status; lua_State *L = lua_open(); /* create state */ if (L == NULL) { l_message(argv[0], "cannot create state: not enough memory"); return EXIT_FAILURE; } smain.argc = argc; smain.argv = argv; status = lua_cpcall(L, pmain, NULL); report(L, status); lua_close(L); return (status || smain.status) ? EXIT_FAILURE : EXIT_SUCCESS; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_vmmath.c0000644000175000017500000000621413122010155017021 0ustar philphil/* ** Math helper functions for assembler VM. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_vmmath_c #define LUA_CORE #include #include #include "lj_obj.h" #include "lj_ir.h" #include "lj_vm.h" /* -- Helper functions for generated machine code ------------------------- */ #if LJ_TARGET_X86ORX64 /* Wrapper functions to avoid linker issues on OSX. */ LJ_FUNCA double lj_vm_sinh(double x) { return sinh(x); } LJ_FUNCA double lj_vm_cosh(double x) { return cosh(x); } LJ_FUNCA double lj_vm_tanh(double x) { return tanh(x); } #endif #if !LJ_TARGET_X86ORX64 double lj_vm_foldarith(double x, double y, int op) { switch (op) { case IR_ADD - IR_ADD: return x+y; break; case IR_SUB - IR_ADD: return x-y; break; case IR_MUL - IR_ADD: return x*y; break; case IR_DIV - IR_ADD: return x/y; break; case IR_MOD - IR_ADD: return x-lj_vm_floor(x/y)*y; break; case IR_POW - IR_ADD: return pow(x, y); break; case IR_NEG - IR_ADD: return -x; break; case IR_ABS - IR_ADD: return fabs(x); break; #if LJ_HASJIT case IR_ATAN2 - IR_ADD: return atan2(x, y); break; case IR_LDEXP - IR_ADD: return ldexp(x, (int)y); break; case IR_MIN - IR_ADD: return x > y ? y : x; break; case IR_MAX - IR_ADD: return x < y ? y : x; break; #endif default: return x; } } #endif #if LJ_HASJIT #ifdef LUAJIT_NO_LOG2 double lj_vm_log2(double a) { return log(a) * 1.4426950408889634074; } #endif #ifdef LUAJIT_NO_EXP2 double lj_vm_exp2(double a) { return exp(a * 0.6931471805599453); } #endif #if !(LJ_TARGET_ARM || LJ_TARGET_PPC) int32_t LJ_FASTCALL lj_vm_modi(int32_t a, int32_t b) { uint32_t y, ua, ub; lua_assert(b != 0); /* This must be checked before using this function. */ ua = a < 0 ? (uint32_t)-a : (uint32_t)a; ub = b < 0 ? (uint32_t)-b : (uint32_t)b; y = ua % ub; if (y != 0 && (a^b) < 0) y = y - ub; if (((int32_t)y^b) < 0) y = (uint32_t)-(int32_t)y; return (int32_t)y; } #endif #if !LJ_TARGET_X86ORX64 /* Unsigned x^k. */ static double lj_vm_powui(double x, uint32_t k) { double y; lua_assert(k != 0); for (; (k & 1) == 0; k >>= 1) x *= x; y = x; if ((k >>= 1) != 0) { for (;;) { x *= x; if (k == 1) break; if (k & 1) y *= x; k >>= 1; } y *= x; } return y; } /* Signed x^k. */ double lj_vm_powi(double x, int32_t k) { if (k > 1) return lj_vm_powui(x, (uint32_t)k); else if (k == 1) return x; else if (k == 0) return 1.0; else return 1.0 / lj_vm_powui(x, (uint32_t)-k); } /* Computes fpm(x) for extended math functions. */ double lj_vm_foldfpm(double x, int fpm) { switch (fpm) { case IRFPM_FLOOR: return lj_vm_floor(x); case IRFPM_CEIL: return lj_vm_ceil(x); case IRFPM_TRUNC: return lj_vm_trunc(x); case IRFPM_SQRT: return sqrt(x); case IRFPM_EXP: return exp(x); case IRFPM_EXP2: return lj_vm_exp2(x); case IRFPM_LOG: return log(x); case IRFPM_LOG2: return lj_vm_log2(x); case IRFPM_LOG10: return log10(x); case IRFPM_SIN: return sin(x); case IRFPM_COS: return cos(x); case IRFPM_TAN: return tan(x); default: lua_assert(0); } return 0; } #endif #if LJ_HASFFI int lj_vm_errno(void) { return errno; } #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_record.h0000644000175000017500000000305213122010155017005 0ustar philphil/* ** Trace recorder (bytecode -> SSA IR). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_RECORD_H #define _LJ_RECORD_H #include "lj_obj.h" #include "lj_jit.h" #if LJ_HASJIT /* Context for recording an indexed load/store. */ typedef struct RecordIndex { TValue tabv; /* Runtime value of table (or indexed object). */ TValue keyv; /* Runtime value of key. */ TValue valv; /* Runtime value of stored value. */ TValue mobjv; /* Runtime value of metamethod object. */ GCtab *mtv; /* Runtime value of metatable object. */ cTValue *oldv; /* Runtime value of previously stored value. */ TRef tab; /* Table (or indexed object) reference. */ TRef key; /* Key reference. */ TRef val; /* Value reference for a store or 0 for a load. */ TRef mt; /* Metatable reference. */ TRef mobj; /* Metamethod object reference. */ int idxchain; /* Index indirections left or 0 for raw lookup. */ } RecordIndex; LJ_FUNC int lj_record_objcmp(jit_State *J, TRef a, TRef b, cTValue *av, cTValue *bv); LJ_FUNC TRef lj_record_constify(jit_State *J, cTValue *o); LJ_FUNC void lj_record_call(jit_State *J, BCReg func, ptrdiff_t nargs); LJ_FUNC void lj_record_tailcall(jit_State *J, BCReg func, ptrdiff_t nargs); LJ_FUNC void lj_record_ret(jit_State *J, BCReg rbase, ptrdiff_t gotresults); LJ_FUNC int lj_record_mm_lookup(jit_State *J, RecordIndex *ix, MMS mm); LJ_FUNC TRef lj_record_idx(jit_State *J, RecordIndex *ix); LJ_FUNC void lj_record_ins(jit_State *J); LJ_FUNC void lj_record_setup(jit_State *J); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_alloc.c0000644000175000017500000011731013122010155016617 0ustar philphil/* ** Bundled memory allocator. ** ** Beware: this is a HEAVILY CUSTOMIZED version of dlmalloc. ** The original bears the following remark: ** ** This is a version (aka dlmalloc) of malloc/free/realloc written by ** Doug Lea and released to the public domain, as explained at ** http://creativecommons.org/licenses/publicdomain. ** ** * Version pre-2.8.4 Wed Mar 29 19:46:29 2006 (dl at gee) ** ** No additional copyright is claimed over the customizations. ** Please do NOT bother the original author about this version here! ** ** If you want to use dlmalloc in another project, you should get ** the original from: ftp://gee.cs.oswego.edu/pub/misc/ ** For thread-safe derivatives, take a look at: ** - ptmalloc: http://www.malloc.de/ ** - nedmalloc: http://www.nedprod.com/programs/portable/nedmalloc/ */ #define lj_alloc_c #define LUA_CORE /* To get the mremap prototype. Must be defined before any system includes. */ #if defined(__linux__) && !defined(_GNU_SOURCE) #define _GNU_SOURCE #endif #include "lj_def.h" #include "lj_arch.h" #include "lj_alloc.h" #ifndef LUAJIT_USE_SYSMALLOC #define MAX_SIZE_T (~(size_t)0) #define MALLOC_ALIGNMENT ((size_t)8U) #define DEFAULT_GRANULARITY ((size_t)128U * (size_t)1024U) #define DEFAULT_TRIM_THRESHOLD ((size_t)2U * (size_t)1024U * (size_t)1024U) #define DEFAULT_MMAP_THRESHOLD ((size_t)128U * (size_t)1024U) #define MAX_RELEASE_CHECK_RATE 255 /* ------------------- size_t and alignment properties -------------------- */ /* The byte and bit size of a size_t */ #define SIZE_T_SIZE (sizeof(size_t)) #define SIZE_T_BITSIZE (sizeof(size_t) << 3) /* Some constants coerced to size_t */ /* Annoying but necessary to avoid errors on some platforms */ #define SIZE_T_ZERO ((size_t)0) #define SIZE_T_ONE ((size_t)1) #define SIZE_T_TWO ((size_t)2) #define TWO_SIZE_T_SIZES (SIZE_T_SIZE<<1) #define FOUR_SIZE_T_SIZES (SIZE_T_SIZE<<2) #define SIX_SIZE_T_SIZES (FOUR_SIZE_T_SIZES+TWO_SIZE_T_SIZES) /* The bit mask value corresponding to MALLOC_ALIGNMENT */ #define CHUNK_ALIGN_MASK (MALLOC_ALIGNMENT - SIZE_T_ONE) /* the number of bytes to offset an address to align it */ #define align_offset(A)\ ((((size_t)(A) & CHUNK_ALIGN_MASK) == 0)? 0 :\ ((MALLOC_ALIGNMENT - ((size_t)(A) & CHUNK_ALIGN_MASK)) & CHUNK_ALIGN_MASK)) /* -------------------------- MMAP support ------------------------------- */ #define MFAIL ((void *)(MAX_SIZE_T)) #define CMFAIL ((char *)(MFAIL)) /* defined for convenience */ #define IS_DIRECT_BIT (SIZE_T_ONE) #if LJ_TARGET_WINDOWS #define WIN32_LEAN_AND_MEAN #include #if LJ_64 /* Undocumented, but hey, that's what we all love so much about Windows. */ typedef long (*PNTAVM)(HANDLE handle, void **addr, ULONG zbits, size_t *size, ULONG alloctype, ULONG prot); static PNTAVM ntavm; /* Number of top bits of the lower 32 bits of an address that must be zero. ** Apparently 0 gives us full 64 bit addresses and 1 gives us the lower 2GB. */ #define NTAVM_ZEROBITS 1 static void INIT_MMAP(void) { ntavm = (PNTAVM)GetProcAddress(GetModuleHandleA("ntdll.dll"), "NtAllocateVirtualMemory"); } /* Win64 32 bit MMAP via NtAllocateVirtualMemory. */ static LJ_AINLINE void *CALL_MMAP(size_t size) { DWORD olderr = GetLastError(); void *ptr = NULL; long st = ntavm(INVALID_HANDLE_VALUE, &ptr, NTAVM_ZEROBITS, &size, MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE); SetLastError(olderr); return st == 0 ? ptr : MFAIL; } /* For direct MMAP, use MEM_TOP_DOWN to minimize interference */ static LJ_AINLINE void *DIRECT_MMAP(size_t size) { DWORD olderr = GetLastError(); void *ptr = NULL; long st = ntavm(INVALID_HANDLE_VALUE, &ptr, NTAVM_ZEROBITS, &size, MEM_RESERVE|MEM_COMMIT|MEM_TOP_DOWN, PAGE_READWRITE); SetLastError(olderr); return st == 0 ? ptr : MFAIL; } #else #define INIT_MMAP() ((void)0) /* Win32 MMAP via VirtualAlloc */ static LJ_AINLINE void *CALL_MMAP(size_t size) { DWORD olderr = GetLastError(); void *ptr = VirtualAlloc(0, size, MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE); SetLastError(olderr); return ptr ? ptr : MFAIL; } /* For direct MMAP, use MEM_TOP_DOWN to minimize interference */ static LJ_AINLINE void *DIRECT_MMAP(size_t size) { DWORD olderr = GetLastError(); void *ptr = VirtualAlloc(0, size, MEM_RESERVE|MEM_COMMIT|MEM_TOP_DOWN, PAGE_READWRITE); SetLastError(olderr); return ptr ? ptr : MFAIL; } #endif /* This function supports releasing coalesed segments */ static LJ_AINLINE int CALL_MUNMAP(void *ptr, size_t size) { DWORD olderr = GetLastError(); MEMORY_BASIC_INFORMATION minfo; char *cptr = (char *)ptr; while (size) { if (VirtualQuery(cptr, &minfo, sizeof(minfo)) == 0) return -1; if (minfo.BaseAddress != cptr || minfo.AllocationBase != cptr || minfo.State != MEM_COMMIT || minfo.RegionSize > size) return -1; if (VirtualFree(cptr, 0, MEM_RELEASE) == 0) return -1; cptr += minfo.RegionSize; size -= minfo.RegionSize; } SetLastError(olderr); return 0; } #else #include #include #define MMAP_PROT (PROT_READ|PROT_WRITE) #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) #define MAP_ANONYMOUS MAP_ANON #endif #define MMAP_FLAGS (MAP_PRIVATE|MAP_ANONYMOUS) #if LJ_64 /* 64 bit mode needs special support for allocating memory in the lower 2GB. */ #if defined(MAP_32BIT) #if defined(__sun__) #define MMAP_REGION_START ((uintptr_t)0x1000) #else /* Actually this only gives us max. 1GB in current Linux kernels. */ #define MMAP_REGION_START ((uintptr_t)0) #endif static LJ_AINLINE void *CALL_MMAP(size_t size) { int olderr = errno; void *ptr = mmap((void *)MMAP_REGION_START, size, MMAP_PROT, MAP_32BIT|MMAP_FLAGS, -1, 0); errno = olderr; return ptr; } #elif LJ_TARGET_OSX || LJ_TARGET_PS4 || defined(__FreeBSD__) || defined(__FreeBSD_kernel__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__DragonFly__) || defined(__sun__) || LJ_TARGET_CYGWIN /* OSX and FreeBSD mmap() use a naive first-fit linear search. ** That's perfect for us. Except that -pagezero_size must be set for OSX, ** otherwise the lower 4GB are blocked. And the 32GB RLIMIT_DATA needs ** to be reduced to 250MB on FreeBSD. */ #if LJ_TARGET_OSX || defined(__DragonFly__) #define MMAP_REGION_START ((uintptr_t)0x10000) #elif LJ_TARGET_PS4 #define MMAP_REGION_START ((uintptr_t)0x4000) #else #define MMAP_REGION_START ((uintptr_t)0x10000000) #endif #define MMAP_REGION_END ((uintptr_t)0x80000000) #if (defined(__FreeBSD__) || defined(__FreeBSD_kernel__)) && !LJ_TARGET_PS4 #include #endif static LJ_AINLINE void *CALL_MMAP(size_t size) { int olderr = errno; /* Hint for next allocation. Doesn't need to be thread-safe. */ static uintptr_t alloc_hint = MMAP_REGION_START; int retry = 0; #if (defined(__FreeBSD__) || defined(__FreeBSD_kernel__)) && !LJ_TARGET_PS4 static int rlimit_modified = 0; if (LJ_UNLIKELY(rlimit_modified == 0)) { struct rlimit rlim; rlim.rlim_cur = rlim.rlim_max = MMAP_REGION_START; setrlimit(RLIMIT_DATA, &rlim); /* Ignore result. May fail below. */ rlimit_modified = 1; } #endif for (;;) { void *p = mmap((void *)alloc_hint, size, MMAP_PROT, MMAP_FLAGS, -1, 0); if ((uintptr_t)p >= MMAP_REGION_START && (uintptr_t)p + size < MMAP_REGION_END) { alloc_hint = (uintptr_t)p + size; errno = olderr; return p; } if (p != CMFAIL) munmap(p, size); #if defined(__sun__) || defined(__DragonFly__) alloc_hint += 0x1000000; /* Need near-exhaustive linear scan. */ if (alloc_hint + size < MMAP_REGION_END) continue; #endif if (retry) break; retry = 1; alloc_hint = MMAP_REGION_START; } errno = olderr; return CMFAIL; } #else #error "NYI: need an equivalent of MAP_32BIT for this 64 bit OS" #endif #else /* 32 bit mode is easy. */ static LJ_AINLINE void *CALL_MMAP(size_t size) { int olderr = errno; void *ptr = mmap(NULL, size, MMAP_PROT, MMAP_FLAGS, -1, 0); errno = olderr; return ptr; } #endif #define INIT_MMAP() ((void)0) #define DIRECT_MMAP(s) CALL_MMAP(s) static LJ_AINLINE int CALL_MUNMAP(void *ptr, size_t size) { int olderr = errno; int ret = munmap(ptr, size); errno = olderr; return ret; } #if LJ_TARGET_LINUX /* Need to define _GNU_SOURCE to get the mremap prototype. */ static LJ_AINLINE void *CALL_MREMAP_(void *ptr, size_t osz, size_t nsz, int flags) { int olderr = errno; ptr = mremap(ptr, osz, nsz, flags); errno = olderr; return ptr; } #define CALL_MREMAP(addr, osz, nsz, mv) CALL_MREMAP_((addr), (osz), (nsz), (mv)) #define CALL_MREMAP_NOMOVE 0 #define CALL_MREMAP_MAYMOVE 1 #if LJ_64 #define CALL_MREMAP_MV CALL_MREMAP_NOMOVE #else #define CALL_MREMAP_MV CALL_MREMAP_MAYMOVE #endif #endif #endif #ifndef CALL_MREMAP #define CALL_MREMAP(addr, osz, nsz, mv) ((void)osz, MFAIL) #endif /* ----------------------- Chunk representations ------------------------ */ struct malloc_chunk { size_t prev_foot; /* Size of previous chunk (if free). */ size_t head; /* Size and inuse bits. */ struct malloc_chunk *fd; /* double links -- used only if free. */ struct malloc_chunk *bk; }; typedef struct malloc_chunk mchunk; typedef struct malloc_chunk *mchunkptr; typedef struct malloc_chunk *sbinptr; /* The type of bins of chunks */ typedef size_t bindex_t; /* Described below */ typedef unsigned int binmap_t; /* Described below */ typedef unsigned int flag_t; /* The type of various bit flag sets */ /* ------------------- Chunks sizes and alignments ----------------------- */ #define MCHUNK_SIZE (sizeof(mchunk)) #define CHUNK_OVERHEAD (SIZE_T_SIZE) /* Direct chunks need a second word of overhead ... */ #define DIRECT_CHUNK_OVERHEAD (TWO_SIZE_T_SIZES) /* ... and additional padding for fake next-chunk at foot */ #define DIRECT_FOOT_PAD (FOUR_SIZE_T_SIZES) /* The smallest size we can malloc is an aligned minimal chunk */ #define MIN_CHUNK_SIZE\ ((MCHUNK_SIZE + CHUNK_ALIGN_MASK) & ~CHUNK_ALIGN_MASK) /* conversion from malloc headers to user pointers, and back */ #define chunk2mem(p) ((void *)((char *)(p) + TWO_SIZE_T_SIZES)) #define mem2chunk(mem) ((mchunkptr)((char *)(mem) - TWO_SIZE_T_SIZES)) /* chunk associated with aligned address A */ #define align_as_chunk(A) (mchunkptr)((A) + align_offset(chunk2mem(A))) /* Bounds on request (not chunk) sizes. */ #define MAX_REQUEST ((~MIN_CHUNK_SIZE+1) << 2) #define MIN_REQUEST (MIN_CHUNK_SIZE - CHUNK_OVERHEAD - SIZE_T_ONE) /* pad request bytes into a usable size */ #define pad_request(req) \ (((req) + CHUNK_OVERHEAD + CHUNK_ALIGN_MASK) & ~CHUNK_ALIGN_MASK) /* pad request, checking for minimum (but not maximum) */ #define request2size(req) \ (((req) < MIN_REQUEST)? MIN_CHUNK_SIZE : pad_request(req)) /* ------------------ Operations on head and foot fields ----------------- */ #define PINUSE_BIT (SIZE_T_ONE) #define CINUSE_BIT (SIZE_T_TWO) #define INUSE_BITS (PINUSE_BIT|CINUSE_BIT) /* Head value for fenceposts */ #define FENCEPOST_HEAD (INUSE_BITS|SIZE_T_SIZE) /* extraction of fields from head words */ #define cinuse(p) ((p)->head & CINUSE_BIT) #define pinuse(p) ((p)->head & PINUSE_BIT) #define chunksize(p) ((p)->head & ~(INUSE_BITS)) #define clear_pinuse(p) ((p)->head &= ~PINUSE_BIT) #define clear_cinuse(p) ((p)->head &= ~CINUSE_BIT) /* Treat space at ptr +/- offset as a chunk */ #define chunk_plus_offset(p, s) ((mchunkptr)(((char *)(p)) + (s))) #define chunk_minus_offset(p, s) ((mchunkptr)(((char *)(p)) - (s))) /* Ptr to next or previous physical malloc_chunk. */ #define next_chunk(p) ((mchunkptr)(((char *)(p)) + ((p)->head & ~INUSE_BITS))) #define prev_chunk(p) ((mchunkptr)(((char *)(p)) - ((p)->prev_foot) )) /* extract next chunk's pinuse bit */ #define next_pinuse(p) ((next_chunk(p)->head) & PINUSE_BIT) /* Get/set size at footer */ #define get_foot(p, s) (((mchunkptr)((char *)(p) + (s)))->prev_foot) #define set_foot(p, s) (((mchunkptr)((char *)(p) + (s)))->prev_foot = (s)) /* Set size, pinuse bit, and foot */ #define set_size_and_pinuse_of_free_chunk(p, s)\ ((p)->head = (s|PINUSE_BIT), set_foot(p, s)) /* Set size, pinuse bit, foot, and clear next pinuse */ #define set_free_with_pinuse(p, s, n)\ (clear_pinuse(n), set_size_and_pinuse_of_free_chunk(p, s)) #define is_direct(p)\ (!((p)->head & PINUSE_BIT) && ((p)->prev_foot & IS_DIRECT_BIT)) /* Get the internal overhead associated with chunk p */ #define overhead_for(p)\ (is_direct(p)? DIRECT_CHUNK_OVERHEAD : CHUNK_OVERHEAD) /* ---------------------- Overlaid data structures ----------------------- */ struct malloc_tree_chunk { /* The first four fields must be compatible with malloc_chunk */ size_t prev_foot; size_t head; struct malloc_tree_chunk *fd; struct malloc_tree_chunk *bk; struct malloc_tree_chunk *child[2]; struct malloc_tree_chunk *parent; bindex_t index; }; typedef struct malloc_tree_chunk tchunk; typedef struct malloc_tree_chunk *tchunkptr; typedef struct malloc_tree_chunk *tbinptr; /* The type of bins of trees */ /* A little helper macro for trees */ #define leftmost_child(t) ((t)->child[0] != 0? (t)->child[0] : (t)->child[1]) /* ----------------------------- Segments -------------------------------- */ struct malloc_segment { char *base; /* base address */ size_t size; /* allocated size */ struct malloc_segment *next; /* ptr to next segment */ }; typedef struct malloc_segment msegment; typedef struct malloc_segment *msegmentptr; /* ---------------------------- malloc_state ----------------------------- */ /* Bin types, widths and sizes */ #define NSMALLBINS (32U) #define NTREEBINS (32U) #define SMALLBIN_SHIFT (3U) #define SMALLBIN_WIDTH (SIZE_T_ONE << SMALLBIN_SHIFT) #define TREEBIN_SHIFT (8U) #define MIN_LARGE_SIZE (SIZE_T_ONE << TREEBIN_SHIFT) #define MAX_SMALL_SIZE (MIN_LARGE_SIZE - SIZE_T_ONE) #define MAX_SMALL_REQUEST (MAX_SMALL_SIZE - CHUNK_ALIGN_MASK - CHUNK_OVERHEAD) struct malloc_state { binmap_t smallmap; binmap_t treemap; size_t dvsize; size_t topsize; mchunkptr dv; mchunkptr top; size_t trim_check; size_t release_checks; mchunkptr smallbins[(NSMALLBINS+1)*2]; tbinptr treebins[NTREEBINS]; msegment seg; }; typedef struct malloc_state *mstate; #define is_initialized(M) ((M)->top != 0) /* -------------------------- system alloc setup ------------------------- */ /* page-align a size */ #define page_align(S)\ (((S) + (LJ_PAGESIZE - SIZE_T_ONE)) & ~(LJ_PAGESIZE - SIZE_T_ONE)) /* granularity-align a size */ #define granularity_align(S)\ (((S) + (DEFAULT_GRANULARITY - SIZE_T_ONE))\ & ~(DEFAULT_GRANULARITY - SIZE_T_ONE)) #if LJ_TARGET_WINDOWS #define mmap_align(S) granularity_align(S) #else #define mmap_align(S) page_align(S) #endif /* True if segment S holds address A */ #define segment_holds(S, A)\ ((char *)(A) >= S->base && (char *)(A) < S->base + S->size) /* Return segment holding given address */ static msegmentptr segment_holding(mstate m, char *addr) { msegmentptr sp = &m->seg; for (;;) { if (addr >= sp->base && addr < sp->base + sp->size) return sp; if ((sp = sp->next) == 0) return 0; } } /* Return true if segment contains a segment link */ static int has_segment_link(mstate m, msegmentptr ss) { msegmentptr sp = &m->seg; for (;;) { if ((char *)sp >= ss->base && (char *)sp < ss->base + ss->size) return 1; if ((sp = sp->next) == 0) return 0; } } /* TOP_FOOT_SIZE is padding at the end of a segment, including space that may be needed to place segment records and fenceposts when new noncontiguous segments are added. */ #define TOP_FOOT_SIZE\ (align_offset(chunk2mem(0))+pad_request(sizeof(struct malloc_segment))+MIN_CHUNK_SIZE) /* ---------------------------- Indexing Bins ---------------------------- */ #define is_small(s) (((s) >> SMALLBIN_SHIFT) < NSMALLBINS) #define small_index(s) ((s) >> SMALLBIN_SHIFT) #define small_index2size(i) ((i) << SMALLBIN_SHIFT) #define MIN_SMALL_INDEX (small_index(MIN_CHUNK_SIZE)) /* addressing by index. See above about smallbin repositioning */ #define smallbin_at(M, i) ((sbinptr)((char *)&((M)->smallbins[(i)<<1]))) #define treebin_at(M,i) (&((M)->treebins[i])) /* assign tree index for size S to variable I */ #define compute_tree_index(S, I)\ {\ unsigned int X = (unsigned int)(S >> TREEBIN_SHIFT);\ if (X == 0) {\ I = 0;\ } else if (X > 0xFFFF) {\ I = NTREEBINS-1;\ } else {\ unsigned int K = lj_fls(X);\ I = (bindex_t)((K << 1) + ((S >> (K + (TREEBIN_SHIFT-1)) & 1)));\ }\ } /* Bit representing maximum resolved size in a treebin at i */ #define bit_for_tree_index(i) \ (i == NTREEBINS-1)? (SIZE_T_BITSIZE-1) : (((i) >> 1) + TREEBIN_SHIFT - 2) /* Shift placing maximum resolved bit in a treebin at i as sign bit */ #define leftshift_for_tree_index(i) \ ((i == NTREEBINS-1)? 0 : \ ((SIZE_T_BITSIZE-SIZE_T_ONE) - (((i) >> 1) + TREEBIN_SHIFT - 2))) /* The size of the smallest chunk held in bin with index i */ #define minsize_for_tree_index(i) \ ((SIZE_T_ONE << (((i) >> 1) + TREEBIN_SHIFT)) | \ (((size_t)((i) & SIZE_T_ONE)) << (((i) >> 1) + TREEBIN_SHIFT - 1))) /* ------------------------ Operations on bin maps ----------------------- */ /* bit corresponding to given index */ #define idx2bit(i) ((binmap_t)(1) << (i)) /* Mark/Clear bits with given index */ #define mark_smallmap(M,i) ((M)->smallmap |= idx2bit(i)) #define clear_smallmap(M,i) ((M)->smallmap &= ~idx2bit(i)) #define smallmap_is_marked(M,i) ((M)->smallmap & idx2bit(i)) #define mark_treemap(M,i) ((M)->treemap |= idx2bit(i)) #define clear_treemap(M,i) ((M)->treemap &= ~idx2bit(i)) #define treemap_is_marked(M,i) ((M)->treemap & idx2bit(i)) /* mask with all bits to left of least bit of x on */ #define left_bits(x) ((x<<1) | (~(x<<1)+1)) /* Set cinuse bit and pinuse bit of next chunk */ #define set_inuse(M,p,s)\ ((p)->head = (((p)->head & PINUSE_BIT)|s|CINUSE_BIT),\ ((mchunkptr)(((char *)(p)) + (s)))->head |= PINUSE_BIT) /* Set cinuse and pinuse of this chunk and pinuse of next chunk */ #define set_inuse_and_pinuse(M,p,s)\ ((p)->head = (s|PINUSE_BIT|CINUSE_BIT),\ ((mchunkptr)(((char *)(p)) + (s)))->head |= PINUSE_BIT) /* Set size, cinuse and pinuse bit of this chunk */ #define set_size_and_pinuse_of_inuse_chunk(M, p, s)\ ((p)->head = (s|PINUSE_BIT|CINUSE_BIT)) /* ----------------------- Operations on smallbins ----------------------- */ /* Link a free chunk into a smallbin */ #define insert_small_chunk(M, P, S) {\ bindex_t I = small_index(S);\ mchunkptr B = smallbin_at(M, I);\ mchunkptr F = B;\ if (!smallmap_is_marked(M, I))\ mark_smallmap(M, I);\ else\ F = B->fd;\ B->fd = P;\ F->bk = P;\ P->fd = F;\ P->bk = B;\ } /* Unlink a chunk from a smallbin */ #define unlink_small_chunk(M, P, S) {\ mchunkptr F = P->fd;\ mchunkptr B = P->bk;\ bindex_t I = small_index(S);\ if (F == B) {\ clear_smallmap(M, I);\ } else {\ F->bk = B;\ B->fd = F;\ }\ } /* Unlink the first chunk from a smallbin */ #define unlink_first_small_chunk(M, B, P, I) {\ mchunkptr F = P->fd;\ if (B == F) {\ clear_smallmap(M, I);\ } else {\ B->fd = F;\ F->bk = B;\ }\ } /* Replace dv node, binning the old one */ /* Used only when dvsize known to be small */ #define replace_dv(M, P, S) {\ size_t DVS = M->dvsize;\ if (DVS != 0) {\ mchunkptr DV = M->dv;\ insert_small_chunk(M, DV, DVS);\ }\ M->dvsize = S;\ M->dv = P;\ } /* ------------------------- Operations on trees ------------------------- */ /* Insert chunk into tree */ #define insert_large_chunk(M, X, S) {\ tbinptr *H;\ bindex_t I;\ compute_tree_index(S, I);\ H = treebin_at(M, I);\ X->index = I;\ X->child[0] = X->child[1] = 0;\ if (!treemap_is_marked(M, I)) {\ mark_treemap(M, I);\ *H = X;\ X->parent = (tchunkptr)H;\ X->fd = X->bk = X;\ } else {\ tchunkptr T = *H;\ size_t K = S << leftshift_for_tree_index(I);\ for (;;) {\ if (chunksize(T) != S) {\ tchunkptr *C = &(T->child[(K >> (SIZE_T_BITSIZE-SIZE_T_ONE)) & 1]);\ K <<= 1;\ if (*C != 0) {\ T = *C;\ } else {\ *C = X;\ X->parent = T;\ X->fd = X->bk = X;\ break;\ }\ } else {\ tchunkptr F = T->fd;\ T->fd = F->bk = X;\ X->fd = F;\ X->bk = T;\ X->parent = 0;\ break;\ }\ }\ }\ } #define unlink_large_chunk(M, X) {\ tchunkptr XP = X->parent;\ tchunkptr R;\ if (X->bk != X) {\ tchunkptr F = X->fd;\ R = X->bk;\ F->bk = R;\ R->fd = F;\ } else {\ tchunkptr *RP;\ if (((R = *(RP = &(X->child[1]))) != 0) ||\ ((R = *(RP = &(X->child[0]))) != 0)) {\ tchunkptr *CP;\ while ((*(CP = &(R->child[1])) != 0) ||\ (*(CP = &(R->child[0])) != 0)) {\ R = *(RP = CP);\ }\ *RP = 0;\ }\ }\ if (XP != 0) {\ tbinptr *H = treebin_at(M, X->index);\ if (X == *H) {\ if ((*H = R) == 0) \ clear_treemap(M, X->index);\ } else {\ if (XP->child[0] == X) \ XP->child[0] = R;\ else \ XP->child[1] = R;\ }\ if (R != 0) {\ tchunkptr C0, C1;\ R->parent = XP;\ if ((C0 = X->child[0]) != 0) {\ R->child[0] = C0;\ C0->parent = R;\ }\ if ((C1 = X->child[1]) != 0) {\ R->child[1] = C1;\ C1->parent = R;\ }\ }\ }\ } /* Relays to large vs small bin operations */ #define insert_chunk(M, P, S)\ if (is_small(S)) { insert_small_chunk(M, P, S)\ } else { tchunkptr TP = (tchunkptr)(P); insert_large_chunk(M, TP, S); } #define unlink_chunk(M, P, S)\ if (is_small(S)) { unlink_small_chunk(M, P, S)\ } else { tchunkptr TP = (tchunkptr)(P); unlink_large_chunk(M, TP); } /* ----------------------- Direct-mmapping chunks ----------------------- */ static void *direct_alloc(size_t nb) { size_t mmsize = mmap_align(nb + SIX_SIZE_T_SIZES + CHUNK_ALIGN_MASK); if (LJ_LIKELY(mmsize > nb)) { /* Check for wrap around 0 */ char *mm = (char *)(DIRECT_MMAP(mmsize)); if (mm != CMFAIL) { size_t offset = align_offset(chunk2mem(mm)); size_t psize = mmsize - offset - DIRECT_FOOT_PAD; mchunkptr p = (mchunkptr)(mm + offset); p->prev_foot = offset | IS_DIRECT_BIT; p->head = psize|CINUSE_BIT; chunk_plus_offset(p, psize)->head = FENCEPOST_HEAD; chunk_plus_offset(p, psize+SIZE_T_SIZE)->head = 0; return chunk2mem(p); } } return NULL; } static mchunkptr direct_resize(mchunkptr oldp, size_t nb) { size_t oldsize = chunksize(oldp); if (is_small(nb)) /* Can't shrink direct regions below small size */ return NULL; /* Keep old chunk if big enough but not too big */ if (oldsize >= nb + SIZE_T_SIZE && (oldsize - nb) <= (DEFAULT_GRANULARITY >> 1)) { return oldp; } else { size_t offset = oldp->prev_foot & ~IS_DIRECT_BIT; size_t oldmmsize = oldsize + offset + DIRECT_FOOT_PAD; size_t newmmsize = mmap_align(nb + SIX_SIZE_T_SIZES + CHUNK_ALIGN_MASK); char *cp = (char *)CALL_MREMAP((char *)oldp - offset, oldmmsize, newmmsize, CALL_MREMAP_MV); if (cp != CMFAIL) { mchunkptr newp = (mchunkptr)(cp + offset); size_t psize = newmmsize - offset - DIRECT_FOOT_PAD; newp->head = psize|CINUSE_BIT; chunk_plus_offset(newp, psize)->head = FENCEPOST_HEAD; chunk_plus_offset(newp, psize+SIZE_T_SIZE)->head = 0; return newp; } } return NULL; } /* -------------------------- mspace management -------------------------- */ /* Initialize top chunk and its size */ static void init_top(mstate m, mchunkptr p, size_t psize) { /* Ensure alignment */ size_t offset = align_offset(chunk2mem(p)); p = (mchunkptr)((char *)p + offset); psize -= offset; m->top = p; m->topsize = psize; p->head = psize | PINUSE_BIT; /* set size of fake trailing chunk holding overhead space only once */ chunk_plus_offset(p, psize)->head = TOP_FOOT_SIZE; m->trim_check = DEFAULT_TRIM_THRESHOLD; /* reset on each update */ } /* Initialize bins for a new mstate that is otherwise zeroed out */ static void init_bins(mstate m) { /* Establish circular links for smallbins */ bindex_t i; for (i = 0; i < NSMALLBINS; i++) { sbinptr bin = smallbin_at(m,i); bin->fd = bin->bk = bin; } } /* Allocate chunk and prepend remainder with chunk in successor base. */ static void *prepend_alloc(mstate m, char *newbase, char *oldbase, size_t nb) { mchunkptr p = align_as_chunk(newbase); mchunkptr oldfirst = align_as_chunk(oldbase); size_t psize = (size_t)((char *)oldfirst - (char *)p); mchunkptr q = chunk_plus_offset(p, nb); size_t qsize = psize - nb; set_size_and_pinuse_of_inuse_chunk(m, p, nb); /* consolidate remainder with first chunk of old base */ if (oldfirst == m->top) { size_t tsize = m->topsize += qsize; m->top = q; q->head = tsize | PINUSE_BIT; } else if (oldfirst == m->dv) { size_t dsize = m->dvsize += qsize; m->dv = q; set_size_and_pinuse_of_free_chunk(q, dsize); } else { if (!cinuse(oldfirst)) { size_t nsize = chunksize(oldfirst); unlink_chunk(m, oldfirst, nsize); oldfirst = chunk_plus_offset(oldfirst, nsize); qsize += nsize; } set_free_with_pinuse(q, qsize, oldfirst); insert_chunk(m, q, qsize); } return chunk2mem(p); } /* Add a segment to hold a new noncontiguous region */ static void add_segment(mstate m, char *tbase, size_t tsize) { /* Determine locations and sizes of segment, fenceposts, old top */ char *old_top = (char *)m->top; msegmentptr oldsp = segment_holding(m, old_top); char *old_end = oldsp->base + oldsp->size; size_t ssize = pad_request(sizeof(struct malloc_segment)); char *rawsp = old_end - (ssize + FOUR_SIZE_T_SIZES + CHUNK_ALIGN_MASK); size_t offset = align_offset(chunk2mem(rawsp)); char *asp = rawsp + offset; char *csp = (asp < (old_top + MIN_CHUNK_SIZE))? old_top : asp; mchunkptr sp = (mchunkptr)csp; msegmentptr ss = (msegmentptr)(chunk2mem(sp)); mchunkptr tnext = chunk_plus_offset(sp, ssize); mchunkptr p = tnext; /* reset top to new space */ init_top(m, (mchunkptr)tbase, tsize - TOP_FOOT_SIZE); /* Set up segment record */ set_size_and_pinuse_of_inuse_chunk(m, sp, ssize); *ss = m->seg; /* Push current record */ m->seg.base = tbase; m->seg.size = tsize; m->seg.next = ss; /* Insert trailing fenceposts */ for (;;) { mchunkptr nextp = chunk_plus_offset(p, SIZE_T_SIZE); p->head = FENCEPOST_HEAD; if ((char *)(&(nextp->head)) < old_end) p = nextp; else break; } /* Insert the rest of old top into a bin as an ordinary free chunk */ if (csp != old_top) { mchunkptr q = (mchunkptr)old_top; size_t psize = (size_t)(csp - old_top); mchunkptr tn = chunk_plus_offset(q, psize); set_free_with_pinuse(q, psize, tn); insert_chunk(m, q, psize); } } /* -------------------------- System allocation -------------------------- */ static void *alloc_sys(mstate m, size_t nb) { char *tbase = CMFAIL; size_t tsize = 0; /* Directly map large chunks */ if (LJ_UNLIKELY(nb >= DEFAULT_MMAP_THRESHOLD)) { void *mem = direct_alloc(nb); if (mem != 0) return mem; } { size_t req = nb + TOP_FOOT_SIZE + SIZE_T_ONE; size_t rsize = granularity_align(req); if (LJ_LIKELY(rsize > nb)) { /* Fail if wraps around zero */ char *mp = (char *)(CALL_MMAP(rsize)); if (mp != CMFAIL) { tbase = mp; tsize = rsize; } } } if (tbase != CMFAIL) { msegmentptr sp = &m->seg; /* Try to merge with an existing segment */ while (sp != 0 && tbase != sp->base + sp->size) sp = sp->next; if (sp != 0 && segment_holds(sp, m->top)) { /* append */ sp->size += tsize; init_top(m, m->top, m->topsize + tsize); } else { sp = &m->seg; while (sp != 0 && sp->base != tbase + tsize) sp = sp->next; if (sp != 0) { char *oldbase = sp->base; sp->base = tbase; sp->size += tsize; return prepend_alloc(m, tbase, oldbase, nb); } else { add_segment(m, tbase, tsize); } } if (nb < m->topsize) { /* Allocate from new or extended top space */ size_t rsize = m->topsize -= nb; mchunkptr p = m->top; mchunkptr r = m->top = chunk_plus_offset(p, nb); r->head = rsize | PINUSE_BIT; set_size_and_pinuse_of_inuse_chunk(m, p, nb); return chunk2mem(p); } } return NULL; } /* ----------------------- system deallocation -------------------------- */ /* Unmap and unlink any mmapped segments that don't contain used chunks */ static size_t release_unused_segments(mstate m) { size_t released = 0; size_t nsegs = 0; msegmentptr pred = &m->seg; msegmentptr sp = pred->next; while (sp != 0) { char *base = sp->base; size_t size = sp->size; msegmentptr next = sp->next; nsegs++; { mchunkptr p = align_as_chunk(base); size_t psize = chunksize(p); /* Can unmap if first chunk holds entire segment and not pinned */ if (!cinuse(p) && (char *)p + psize >= base + size - TOP_FOOT_SIZE) { tchunkptr tp = (tchunkptr)p; if (p == m->dv) { m->dv = 0; m->dvsize = 0; } else { unlink_large_chunk(m, tp); } if (CALL_MUNMAP(base, size) == 0) { released += size; /* unlink obsoleted record */ sp = pred; sp->next = next; } else { /* back out if cannot unmap */ insert_large_chunk(m, tp, psize); } } } pred = sp; sp = next; } /* Reset check counter */ m->release_checks = nsegs > MAX_RELEASE_CHECK_RATE ? nsegs : MAX_RELEASE_CHECK_RATE; return released; } static int alloc_trim(mstate m, size_t pad) { size_t released = 0; if (pad < MAX_REQUEST && is_initialized(m)) { pad += TOP_FOOT_SIZE; /* ensure enough room for segment overhead */ if (m->topsize > pad) { /* Shrink top space in granularity-size units, keeping at least one */ size_t unit = DEFAULT_GRANULARITY; size_t extra = ((m->topsize - pad + (unit - SIZE_T_ONE)) / unit - SIZE_T_ONE) * unit; msegmentptr sp = segment_holding(m, (char *)m->top); if (sp->size >= extra && !has_segment_link(m, sp)) { /* can't shrink if pinned */ size_t newsize = sp->size - extra; /* Prefer mremap, fall back to munmap */ if ((CALL_MREMAP(sp->base, sp->size, newsize, CALL_MREMAP_NOMOVE) != MFAIL) || (CALL_MUNMAP(sp->base + newsize, extra) == 0)) { released = extra; } } if (released != 0) { sp->size -= released; init_top(m, m->top, m->topsize - released); } } /* Unmap any unused mmapped segments */ released += release_unused_segments(m); /* On failure, disable autotrim to avoid repeated failed future calls */ if (released == 0 && m->topsize > m->trim_check) m->trim_check = MAX_SIZE_T; } return (released != 0)? 1 : 0; } /* ---------------------------- malloc support --------------------------- */ /* allocate a large request from the best fitting chunk in a treebin */ static void *tmalloc_large(mstate m, size_t nb) { tchunkptr v = 0; size_t rsize = ~nb+1; /* Unsigned negation */ tchunkptr t; bindex_t idx; compute_tree_index(nb, idx); if ((t = *treebin_at(m, idx)) != 0) { /* Traverse tree for this bin looking for node with size == nb */ size_t sizebits = nb << leftshift_for_tree_index(idx); tchunkptr rst = 0; /* The deepest untaken right subtree */ for (;;) { tchunkptr rt; size_t trem = chunksize(t) - nb; if (trem < rsize) { v = t; if ((rsize = trem) == 0) break; } rt = t->child[1]; t = t->child[(sizebits >> (SIZE_T_BITSIZE-SIZE_T_ONE)) & 1]; if (rt != 0 && rt != t) rst = rt; if (t == 0) { t = rst; /* set t to least subtree holding sizes > nb */ break; } sizebits <<= 1; } } if (t == 0 && v == 0) { /* set t to root of next non-empty treebin */ binmap_t leftbits = left_bits(idx2bit(idx)) & m->treemap; if (leftbits != 0) t = *treebin_at(m, lj_ffs(leftbits)); } while (t != 0) { /* find smallest of tree or subtree */ size_t trem = chunksize(t) - nb; if (trem < rsize) { rsize = trem; v = t; } t = leftmost_child(t); } /* If dv is a better fit, return NULL so malloc will use it */ if (v != 0 && rsize < (size_t)(m->dvsize - nb)) { mchunkptr r = chunk_plus_offset(v, nb); unlink_large_chunk(m, v); if (rsize < MIN_CHUNK_SIZE) { set_inuse_and_pinuse(m, v, (rsize + nb)); } else { set_size_and_pinuse_of_inuse_chunk(m, v, nb); set_size_and_pinuse_of_free_chunk(r, rsize); insert_chunk(m, r, rsize); } return chunk2mem(v); } return NULL; } /* allocate a small request from the best fitting chunk in a treebin */ static void *tmalloc_small(mstate m, size_t nb) { tchunkptr t, v; mchunkptr r; size_t rsize; bindex_t i = lj_ffs(m->treemap); v = t = *treebin_at(m, i); rsize = chunksize(t) - nb; while ((t = leftmost_child(t)) != 0) { size_t trem = chunksize(t) - nb; if (trem < rsize) { rsize = trem; v = t; } } r = chunk_plus_offset(v, nb); unlink_large_chunk(m, v); if (rsize < MIN_CHUNK_SIZE) { set_inuse_and_pinuse(m, v, (rsize + nb)); } else { set_size_and_pinuse_of_inuse_chunk(m, v, nb); set_size_and_pinuse_of_free_chunk(r, rsize); replace_dv(m, r, rsize); } return chunk2mem(v); } /* ----------------------------------------------------------------------- */ void *lj_alloc_create(void) { size_t tsize = DEFAULT_GRANULARITY; char *tbase; INIT_MMAP(); tbase = (char *)(CALL_MMAP(tsize)); if (tbase != CMFAIL) { size_t msize = pad_request(sizeof(struct malloc_state)); mchunkptr mn; mchunkptr msp = align_as_chunk(tbase); mstate m = (mstate)(chunk2mem(msp)); memset(m, 0, msize); msp->head = (msize|PINUSE_BIT|CINUSE_BIT); m->seg.base = tbase; m->seg.size = tsize; m->release_checks = MAX_RELEASE_CHECK_RATE; init_bins(m); mn = next_chunk(mem2chunk(m)); init_top(m, mn, (size_t)((tbase + tsize) - (char *)mn) - TOP_FOOT_SIZE); return m; } return NULL; } void lj_alloc_destroy(void *msp) { mstate ms = (mstate)msp; msegmentptr sp = &ms->seg; while (sp != 0) { char *base = sp->base; size_t size = sp->size; sp = sp->next; CALL_MUNMAP(base, size); } } static LJ_NOINLINE void *lj_alloc_malloc(void *msp, size_t nsize) { mstate ms = (mstate)msp; void *mem; size_t nb; if (nsize <= MAX_SMALL_REQUEST) { bindex_t idx; binmap_t smallbits; nb = (nsize < MIN_REQUEST)? MIN_CHUNK_SIZE : pad_request(nsize); idx = small_index(nb); smallbits = ms->smallmap >> idx; if ((smallbits & 0x3U) != 0) { /* Remainderless fit to a smallbin. */ mchunkptr b, p; idx += ~smallbits & 1; /* Uses next bin if idx empty */ b = smallbin_at(ms, idx); p = b->fd; unlink_first_small_chunk(ms, b, p, idx); set_inuse_and_pinuse(ms, p, small_index2size(idx)); mem = chunk2mem(p); return mem; } else if (nb > ms->dvsize) { if (smallbits != 0) { /* Use chunk in next nonempty smallbin */ mchunkptr b, p, r; size_t rsize; binmap_t leftbits = (smallbits << idx) & left_bits(idx2bit(idx)); bindex_t i = lj_ffs(leftbits); b = smallbin_at(ms, i); p = b->fd; unlink_first_small_chunk(ms, b, p, i); rsize = small_index2size(i) - nb; /* Fit here cannot be remainderless if 4byte sizes */ if (SIZE_T_SIZE != 4 && rsize < MIN_CHUNK_SIZE) { set_inuse_and_pinuse(ms, p, small_index2size(i)); } else { set_size_and_pinuse_of_inuse_chunk(ms, p, nb); r = chunk_plus_offset(p, nb); set_size_and_pinuse_of_free_chunk(r, rsize); replace_dv(ms, r, rsize); } mem = chunk2mem(p); return mem; } else if (ms->treemap != 0 && (mem = tmalloc_small(ms, nb)) != 0) { return mem; } } } else if (nsize >= MAX_REQUEST) { nb = MAX_SIZE_T; /* Too big to allocate. Force failure (in sys alloc) */ } else { nb = pad_request(nsize); if (ms->treemap != 0 && (mem = tmalloc_large(ms, nb)) != 0) { return mem; } } if (nb <= ms->dvsize) { size_t rsize = ms->dvsize - nb; mchunkptr p = ms->dv; if (rsize >= MIN_CHUNK_SIZE) { /* split dv */ mchunkptr r = ms->dv = chunk_plus_offset(p, nb); ms->dvsize = rsize; set_size_and_pinuse_of_free_chunk(r, rsize); set_size_and_pinuse_of_inuse_chunk(ms, p, nb); } else { /* exhaust dv */ size_t dvs = ms->dvsize; ms->dvsize = 0; ms->dv = 0; set_inuse_and_pinuse(ms, p, dvs); } mem = chunk2mem(p); return mem; } else if (nb < ms->topsize) { /* Split top */ size_t rsize = ms->topsize -= nb; mchunkptr p = ms->top; mchunkptr r = ms->top = chunk_plus_offset(p, nb); r->head = rsize | PINUSE_BIT; set_size_and_pinuse_of_inuse_chunk(ms, p, nb); mem = chunk2mem(p); return mem; } return alloc_sys(ms, nb); } static LJ_NOINLINE void *lj_alloc_free(void *msp, void *ptr) { if (ptr != 0) { mchunkptr p = mem2chunk(ptr); mstate fm = (mstate)msp; size_t psize = chunksize(p); mchunkptr next = chunk_plus_offset(p, psize); if (!pinuse(p)) { size_t prevsize = p->prev_foot; if ((prevsize & IS_DIRECT_BIT) != 0) { prevsize &= ~IS_DIRECT_BIT; psize += prevsize + DIRECT_FOOT_PAD; CALL_MUNMAP((char *)p - prevsize, psize); return NULL; } else { mchunkptr prev = chunk_minus_offset(p, prevsize); psize += prevsize; p = prev; /* consolidate backward */ if (p != fm->dv) { unlink_chunk(fm, p, prevsize); } else if ((next->head & INUSE_BITS) == INUSE_BITS) { fm->dvsize = psize; set_free_with_pinuse(p, psize, next); return NULL; } } } if (!cinuse(next)) { /* consolidate forward */ if (next == fm->top) { size_t tsize = fm->topsize += psize; fm->top = p; p->head = tsize | PINUSE_BIT; if (p == fm->dv) { fm->dv = 0; fm->dvsize = 0; } if (tsize > fm->trim_check) alloc_trim(fm, 0); return NULL; } else if (next == fm->dv) { size_t dsize = fm->dvsize += psize; fm->dv = p; set_size_and_pinuse_of_free_chunk(p, dsize); return NULL; } else { size_t nsize = chunksize(next); psize += nsize; unlink_chunk(fm, next, nsize); set_size_and_pinuse_of_free_chunk(p, psize); if (p == fm->dv) { fm->dvsize = psize; return NULL; } } } else { set_free_with_pinuse(p, psize, next); } if (is_small(psize)) { insert_small_chunk(fm, p, psize); } else { tchunkptr tp = (tchunkptr)p; insert_large_chunk(fm, tp, psize); if (--fm->release_checks == 0) release_unused_segments(fm); } } return NULL; } static LJ_NOINLINE void *lj_alloc_realloc(void *msp, void *ptr, size_t nsize) { if (nsize >= MAX_REQUEST) { return NULL; } else { mstate m = (mstate)msp; mchunkptr oldp = mem2chunk(ptr); size_t oldsize = chunksize(oldp); mchunkptr next = chunk_plus_offset(oldp, oldsize); mchunkptr newp = 0; size_t nb = request2size(nsize); /* Try to either shrink or extend into top. Else malloc-copy-free */ if (is_direct(oldp)) { newp = direct_resize(oldp, nb); /* this may return NULL. */ } else if (oldsize >= nb) { /* already big enough */ size_t rsize = oldsize - nb; newp = oldp; if (rsize >= MIN_CHUNK_SIZE) { mchunkptr rem = chunk_plus_offset(newp, nb); set_inuse(m, newp, nb); set_inuse(m, rem, rsize); lj_alloc_free(m, chunk2mem(rem)); } } else if (next == m->top && oldsize + m->topsize > nb) { /* Expand into top */ size_t newsize = oldsize + m->topsize; size_t newtopsize = newsize - nb; mchunkptr newtop = chunk_plus_offset(oldp, nb); set_inuse(m, oldp, nb); newtop->head = newtopsize |PINUSE_BIT; m->top = newtop; m->topsize = newtopsize; newp = oldp; } if (newp != 0) { return chunk2mem(newp); } else { void *newmem = lj_alloc_malloc(m, nsize); if (newmem != 0) { size_t oc = oldsize - overhead_for(oldp); memcpy(newmem, ptr, oc < nsize ? oc : nsize); lj_alloc_free(m, ptr); } return newmem; } } } void *lj_alloc_f(void *msp, void *ptr, size_t osize, size_t nsize) { (void)osize; if (nsize == 0) { return lj_alloc_free(msp, ptr); } else if (ptr == NULL) { return lj_alloc_malloc(msp, nsize); } else { return lj_alloc_realloc(msp, ptr, nsize); } } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/vm_mips.dasc0000644000175000017500000034761513122010155017217 0ustar philphil|// Low-level VM code for MIPS CPUs. |// Bytecode interpreter, fast functions and helper functions. |// Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h | |.arch mips |.section code_op, code_sub | |.actionlist build_actionlist |.globals GLOB_ |.globalnames globnames |.externnames extnames | |// Note: The ragged indentation of the instructions is intentional. |// The starting columns indicate data dependencies. | |//----------------------------------------------------------------------- | |// Fixed register assignments for the interpreter. |// Don't use: r0 = 0, r26/r27 = reserved, r28 = gp, r29 = sp, r31 = ra | |// The following must be C callee-save (but BASE is often refetched). |.define BASE, r16 // Base of current Lua stack frame. |.define KBASE, r17 // Constants of current Lua function. |.define PC, r18 // Next PC. |.define DISPATCH, r19 // Opcode dispatch table. |.define LREG, r20 // Register holding lua_State (also in SAVE_L). |.define MULTRES, r21 // Size of multi-result: (nresults+1)*8. |// NYI: r22 currently unused. | |.define JGL, r30 // On-trace: global_State + 32768. | |// Constants for type-comparisons, stores and conversions. C callee-save. |.define TISNIL, r30 |.define TOBIT, f30 // 2^52 + 2^51. | |// The following temporaries are not saved across C calls, except for RA. |.define RA, r23 // Callee-save. |.define RB, r8 |.define RC, r9 |.define RD, r10 |.define INS, r11 | |.define AT, r1 // Assembler temporary. |.define TMP0, r12 |.define TMP1, r13 |.define TMP2, r14 |.define TMP3, r15 | |// Calling conventions. |.define CFUNCADDR, r25 |.define CARG1, r4 |.define CARG2, r5 |.define CARG3, r6 |.define CARG4, r7 | |.define CRET1, r2 |.define CRET2, r3 | |.define FARG1, f12 |.define FARG2, f14 | |.define FRET1, f0 |.define FRET2, f2 | |// Stack layout while in interpreter. Must match with lj_frame.h. |.define CFRAME_SPACE, 112 // Delta for sp. | |.define SAVE_ERRF, 124(sp) // 32 bit C frame info. |.define SAVE_NRES, 120(sp) |.define SAVE_CFRAME, 116(sp) |.define SAVE_L, 112(sp) |//----- 8 byte aligned, ^^^^ 16 byte register save area, owned by interpreter. |.define SAVE_GPR_, 72 // .. 72+10*4: 32 bit GPR saves. |.define SAVE_FPR_, 24 // .. 24+6*8: 64 bit FPR saves. |.define SAVE_PC, 20(sp) |.define ARG5, 16(sp) |.define CSAVE_4, 12(sp) |.define CSAVE_3, 8(sp) |.define CSAVE_2, 4(sp) |.define CSAVE_1, 0(sp) |//----- 8 byte aligned, ^^^^ 16 byte register save area, owned by callee. | |.define ARG5_OFS, 16 |.define SAVE_MULTRES, ARG5 | |.macro saveregs | addiu sp, sp, -CFRAME_SPACE | sw ra, SAVE_GPR_+9*4(sp) | sw r30, SAVE_GPR_+8*4(sp) | sdc1 f30, SAVE_FPR_+5*8(sp) | sw r23, SAVE_GPR_+7*4(sp) | sw r22, SAVE_GPR_+6*4(sp) | sdc1 f28, SAVE_FPR_+4*8(sp) | sw r21, SAVE_GPR_+5*4(sp) | sw r20, SAVE_GPR_+4*4(sp) | sdc1 f26, SAVE_FPR_+3*8(sp) | sw r19, SAVE_GPR_+3*4(sp) | sw r18, SAVE_GPR_+2*4(sp) | sdc1 f24, SAVE_FPR_+2*8(sp) | sw r17, SAVE_GPR_+1*4(sp) | sw r16, SAVE_GPR_+0*4(sp) | sdc1 f22, SAVE_FPR_+1*8(sp) | sdc1 f20, SAVE_FPR_+0*8(sp) |.endmacro | |.macro restoreregs_ret | lw ra, SAVE_GPR_+9*4(sp) | lw r30, SAVE_GPR_+8*4(sp) | ldc1 f30, SAVE_FPR_+5*8(sp) | lw r23, SAVE_GPR_+7*4(sp) | lw r22, SAVE_GPR_+6*4(sp) | ldc1 f28, SAVE_FPR_+4*8(sp) | lw r21, SAVE_GPR_+5*4(sp) | lw r20, SAVE_GPR_+4*4(sp) | ldc1 f26, SAVE_FPR_+3*8(sp) | lw r19, SAVE_GPR_+3*4(sp) | lw r18, SAVE_GPR_+2*4(sp) | ldc1 f24, SAVE_FPR_+2*8(sp) | lw r17, SAVE_GPR_+1*4(sp) | lw r16, SAVE_GPR_+0*4(sp) | ldc1 f22, SAVE_FPR_+1*8(sp) | ldc1 f20, SAVE_FPR_+0*8(sp) | jr ra | addiu sp, sp, CFRAME_SPACE |.endmacro | |// Type definitions. Some of these are only used for documentation. |.type L, lua_State, LREG |.type GL, global_State |.type TVALUE, TValue |.type GCOBJ, GCobj |.type STR, GCstr |.type TAB, GCtab |.type LFUNC, GCfuncL |.type CFUNC, GCfuncC |.type PROTO, GCproto |.type UPVAL, GCupval |.type NODE, Node |.type NARGS8, int |.type TRACE, GCtrace | |//----------------------------------------------------------------------- | |// Trap for not-yet-implemented parts. |.macro NYI; .long 0xf0f0f0f0; .endmacro | |// Macros to mark delay slots. |.macro ., a; a; .endmacro |.macro ., a,b; a,b; .endmacro |.macro ., a,b,c; a,b,c; .endmacro | |//----------------------------------------------------------------------- | |// Endian-specific defines. |.define FRAME_PC, LJ_ENDIAN_SELECT(-4,-8) |.define FRAME_FUNC, LJ_ENDIAN_SELECT(-8,-4) |.define HI, LJ_ENDIAN_SELECT(4,0) |.define LO, LJ_ENDIAN_SELECT(0,4) |.define OFS_RD, LJ_ENDIAN_SELECT(2,0) |.define OFS_RA, LJ_ENDIAN_SELECT(1,2) |.define OFS_OP, LJ_ENDIAN_SELECT(0,3) | |// Instruction decode. |.macro decode_OP1, dst, ins; andi dst, ins, 0xff; .endmacro |.macro decode_OP4a, dst, ins; andi dst, ins, 0xff; .endmacro |.macro decode_OP4b, dst; sll dst, dst, 2; .endmacro |.macro decode_RC4a, dst, ins; srl dst, ins, 14; .endmacro |.macro decode_RC4b, dst; andi dst, dst, 0x3fc; .endmacro |.macro decode_RD4b, dst; sll dst, dst, 2; .endmacro |.macro decode_RA8a, dst, ins; srl dst, ins, 5; .endmacro |.macro decode_RA8b, dst; andi dst, dst, 0x7f8; .endmacro |.macro decode_RB8a, dst, ins; srl dst, ins, 21; .endmacro |.macro decode_RB8b, dst; andi dst, dst, 0x7f8; .endmacro |.macro decode_RD8a, dst, ins; srl dst, ins, 16; .endmacro |.macro decode_RD8b, dst; sll dst, dst, 3; .endmacro |.macro decode_RDtoRC8, dst, src; andi dst, src, 0x7f8; .endmacro | |// Instruction fetch. |.macro ins_NEXT1 | lw INS, 0(PC) | addiu PC, PC, 4 |.endmacro |// Instruction decode+dispatch. |.macro ins_NEXT2 | decode_OP4a TMP1, INS | decode_OP4b TMP1 | addu TMP0, DISPATCH, TMP1 | decode_RD8a RD, INS | lw AT, 0(TMP0) | decode_RA8a RA, INS | decode_RD8b RD | jr AT | decode_RA8b RA |.endmacro |.macro ins_NEXT | ins_NEXT1 | ins_NEXT2 |.endmacro | |// Instruction footer. |.if 1 | // Replicated dispatch. Less unpredictable branches, but higher I-Cache use. | .define ins_next, ins_NEXT | .define ins_next_, ins_NEXT | .define ins_next1, ins_NEXT1 | .define ins_next2, ins_NEXT2 |.else | // Common dispatch. Lower I-Cache use, only one (very) unpredictable branch. | // Affects only certain kinds of benchmarks (and only with -j off). | .macro ins_next | b ->ins_next | .endmacro | .macro ins_next1 | .endmacro | .macro ins_next2 | b ->ins_next | .endmacro | .macro ins_next_ | ->ins_next: | ins_NEXT | .endmacro |.endif | |// Call decode and dispatch. |.macro ins_callt | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | lw PC, LFUNC:RB->pc | lw INS, 0(PC) | addiu PC, PC, 4 | decode_OP4a TMP1, INS | decode_RA8a RA, INS | decode_OP4b TMP1 | decode_RA8b RA | addu TMP0, DISPATCH, TMP1 | lw TMP0, 0(TMP0) | jr TMP0 | addu RA, RA, BASE |.endmacro | |.macro ins_call | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, PC = caller PC | sw PC, FRAME_PC(BASE) | ins_callt |.endmacro | |//----------------------------------------------------------------------- | |.macro branch_RD | srl TMP0, RD, 1 | lui AT, (-(BCBIAS_J*4 >> 16) & 65535) | addu TMP0, TMP0, AT | addu PC, PC, TMP0 |.endmacro | |// Assumes DISPATCH is relative to GL. #define DISPATCH_GL(field) (GG_DISP2G + (int)offsetof(global_State, field)) #define DISPATCH_J(field) (GG_DISP2J + (int)offsetof(jit_State, field)) #define GG_DISP2GOT (GG_OFS(got) - GG_OFS(dispatch)) #define DISPATCH_GOT(name) (GG_DISP2GOT + 4*LJ_GOT_##name) | #define PC2PROTO(field) ((int)offsetof(GCproto, field)-(int)sizeof(GCproto)) | |.macro load_got, func | lw CFUNCADDR, DISPATCH_GOT(func)(DISPATCH) |.endmacro |// Much faster. Sadly, there's no easy way to force the required code layout. |// .macro call_intern, func; bal extern func; .endmacro |.macro call_intern, func; jalr CFUNCADDR; .endmacro |.macro call_extern; jalr CFUNCADDR; .endmacro |.macro jmp_extern; jr CFUNCADDR; .endmacro | |.macro hotcheck, delta, target | srl TMP1, PC, 1 | andi TMP1, TMP1, 126 | addu TMP1, TMP1, DISPATCH | lhu TMP2, GG_DISP2HOT(TMP1) | addiu TMP2, TMP2, -delta | bltz TMP2, target |. sh TMP2, GG_DISP2HOT(TMP1) |.endmacro | |.macro hotloop | hotcheck HOTCOUNT_LOOP, ->vm_hotloop |.endmacro | |.macro hotcall | hotcheck HOTCOUNT_CALL, ->vm_hotcall |.endmacro | |// Set current VM state. Uses TMP0. |.macro li_vmstate, st; li TMP0, ~LJ_VMST_..st; .endmacro |.macro st_vmstate; sw TMP0, DISPATCH_GL(vmstate)(DISPATCH); .endmacro | |// Move table write barrier back. Overwrites mark and tmp. |.macro barrierback, tab, mark, tmp, target | lw tmp, DISPATCH_GL(gc.grayagain)(DISPATCH) | andi mark, mark, ~LJ_GC_BLACK & 255 // black2gray(tab) | sw tab, DISPATCH_GL(gc.grayagain)(DISPATCH) | sb mark, tab->marked | b target |. sw tmp, tab->gclist |.endmacro | |//----------------------------------------------------------------------- /* Generate subroutines used by opcodes and other parts of the VM. */ /* The .code_sub section should be last to help static branch prediction. */ static void build_subroutines(BuildCtx *ctx) { |.code_sub | |//----------------------------------------------------------------------- |//-- Return handling ---------------------------------------------------- |//----------------------------------------------------------------------- | |->vm_returnp: | // See vm_return. Also: TMP2 = previous base. | andi AT, PC, FRAME_P | beqz AT, ->cont_dispatch |. li TMP1, LJ_TTRUE | | // Return from pcall or xpcall fast func. | lw PC, FRAME_PC(TMP2) // Fetch PC of previous frame. | move BASE, TMP2 // Restore caller base. | // Prepending may overwrite the pcall frame, so do it at the end. | sw TMP1, FRAME_PC(RA) // Prepend true to results. | addiu RA, RA, -8 | |->vm_returnc: | addiu RD, RD, 8 // RD = (nresults+1)*8. | andi TMP0, PC, FRAME_TYPE | beqz RD, ->vm_unwind_c_eh |. li CRET1, LUA_YIELD | beqz TMP0, ->BC_RET_Z // Handle regular return to Lua. |. move MULTRES, RD | |->vm_return: | // BASE = base, RA = resultptr, RD/MULTRES = (nresults+1)*8, PC = return | // TMP0 = PC & FRAME_TYPE | li TMP2, -8 | xori AT, TMP0, FRAME_C | and TMP2, PC, TMP2 | bnez AT, ->vm_returnp | subu TMP2, BASE, TMP2 // TMP2 = previous base. | | addiu TMP1, RD, -8 | sw TMP2, L->base | li_vmstate C | lw TMP2, SAVE_NRES | addiu BASE, BASE, -8 | st_vmstate | beqz TMP1, >2 |. sll TMP2, TMP2, 3 |1: | addiu TMP1, TMP1, -8 | ldc1 f0, 0(RA) | addiu RA, RA, 8 | sdc1 f0, 0(BASE) | bnez TMP1, <1 |. addiu BASE, BASE, 8 | |2: | bne TMP2, RD, >6 |3: |. sw BASE, L->top // Store new top. | |->vm_leave_cp: | lw TMP0, SAVE_CFRAME // Restore previous C frame. | move CRET1, r0 // Ok return status for vm_pcall. | sw TMP0, L->cframe | |->vm_leave_unw: | restoreregs_ret | |6: | lw TMP1, L->maxstack | slt AT, TMP2, RD | bnez AT, >7 // Less results wanted? | // More results wanted. Check stack size and fill up results with nil. |. slt AT, BASE, TMP1 | beqz AT, >8 |. nop | sw TISNIL, HI(BASE) | addiu RD, RD, 8 | b <2 |. addiu BASE, BASE, 8 | |7: // Less results wanted. | subu TMP0, RD, TMP2 | subu TMP0, BASE, TMP0 // Either keep top or shrink it. | b <3 |. movn BASE, TMP0, TMP2 // LUA_MULTRET+1 case? | |8: // Corner case: need to grow stack for filling up results. | // This can happen if: | // - A C function grows the stack (a lot). | // - The GC shrinks the stack in between. | // - A return back from a lua_call() with (high) nresults adjustment. | load_got lj_state_growstack | move MULTRES, RD | srl CARG2, TMP2, 3 | call_intern lj_state_growstack // (lua_State *L, int n) |. move CARG1, L | lw TMP2, SAVE_NRES | lw BASE, L->top // Need the (realloced) L->top in BASE. | move RD, MULTRES | b <2 |. sll TMP2, TMP2, 3 | |->vm_unwind_c: // Unwind C stack, return from vm_pcall. | // (void *cframe, int errcode) | move sp, CARG1 | move CRET1, CARG2 |->vm_unwind_c_eh: // Landing pad for external unwinder. | lw L, SAVE_L | li TMP0, ~LJ_VMST_C | lw GL:TMP1, L->glref | b ->vm_leave_unw |. sw TMP0, GL:TMP1->vmstate | |->vm_unwind_ff: // Unwind C stack, return from ff pcall. | // (void *cframe) | li AT, -4 | and sp, CARG1, AT |->vm_unwind_ff_eh: // Landing pad for external unwinder. | lw L, SAVE_L | lui TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | li TISNIL, LJ_TNIL | lw BASE, L->base | lw DISPATCH, L->glref // Setup pointer to dispatch table. | mtc1 TMP3, TOBIT | li TMP1, LJ_TFALSE | li_vmstate INTERP | lw PC, FRAME_PC(BASE) // Fetch PC of previous frame. | cvt.d.s TOBIT, TOBIT | addiu RA, BASE, -8 // Results start at BASE-8. | addiu DISPATCH, DISPATCH, GG_G2DISP | sw TMP1, HI(RA) // Prepend false to error message. | st_vmstate | b ->vm_returnc |. li RD, 16 // 2 results: false + error message. | |//----------------------------------------------------------------------- |//-- Grow stack for calls ----------------------------------------------- |//----------------------------------------------------------------------- | |->vm_growstack_c: // Grow stack for C function. | b >2 |. li CARG2, LUA_MINSTACK | |->vm_growstack_l: // Grow stack for Lua function. | // BASE = new base, RA = BASE+framesize*8, RC = nargs*8, PC = first PC | addu RC, BASE, RC | subu RA, RA, BASE | sw BASE, L->base | addiu PC, PC, 4 // Must point after first instruction. | sw RC, L->top | srl CARG2, RA, 3 |2: | // L->base = new base, L->top = top | load_got lj_state_growstack | sw PC, SAVE_PC | call_intern lj_state_growstack // (lua_State *L, int n) |. move CARG1, L | lw BASE, L->base | lw RC, L->top | lw LFUNC:RB, FRAME_FUNC(BASE) | subu RC, RC, BASE | // BASE = new base, RB = LFUNC/CFUNC, RC = nargs*8, FRAME_PC(BASE) = PC | ins_callt // Just retry the call. | |//----------------------------------------------------------------------- |//-- Entry points into the assembler VM --------------------------------- |//----------------------------------------------------------------------- | |->vm_resume: // Setup C frame and resume thread. | // (lua_State *L, TValue *base, int nres1 = 0, ptrdiff_t ef = 0) | saveregs | move L, CARG1 | lw DISPATCH, L->glref // Setup pointer to dispatch table. | move BASE, CARG2 | lbu TMP1, L->status | sw L, SAVE_L | li PC, FRAME_CP | addiu TMP0, sp, CFRAME_RESUME | addiu DISPATCH, DISPATCH, GG_G2DISP | sw r0, SAVE_NRES | sw r0, SAVE_ERRF | sw TMP0, L->cframe | sw r0, SAVE_CFRAME | beqz TMP1, >3 |. sw CARG1, SAVE_PC // Any value outside of bytecode is ok. | | // Resume after yield (like a return). | move RA, BASE | lw BASE, L->base | lw TMP1, L->top | lw PC, FRAME_PC(BASE) | lui TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | subu RD, TMP1, BASE | mtc1 TMP3, TOBIT | sb r0, L->status | cvt.d.s TOBIT, TOBIT | li_vmstate INTERP | addiu RD, RD, 8 | st_vmstate | move MULTRES, RD | andi TMP0, PC, FRAME_TYPE | beqz TMP0, ->BC_RET_Z |. li TISNIL, LJ_TNIL | b ->vm_return |. nop | |->vm_pcall: // Setup protected C frame and enter VM. | // (lua_State *L, TValue *base, int nres1, ptrdiff_t ef) | saveregs | sw CARG4, SAVE_ERRF | b >1 |. li PC, FRAME_CP | |->vm_call: // Setup C frame and enter VM. | // (lua_State *L, TValue *base, int nres1) | saveregs | li PC, FRAME_C | |1: // Entry point for vm_pcall above (PC = ftype). | lw TMP1, L:CARG1->cframe | sw CARG3, SAVE_NRES | move L, CARG1 | sw CARG1, SAVE_L | move BASE, CARG2 | sw sp, L->cframe // Add our C frame to cframe chain. | lw DISPATCH, L->glref // Setup pointer to dispatch table. | sw CARG1, SAVE_PC // Any value outside of bytecode is ok. | sw TMP1, SAVE_CFRAME | addiu DISPATCH, DISPATCH, GG_G2DISP | |3: // Entry point for vm_cpcall/vm_resume (BASE = base, PC = ftype). | lw TMP2, L->base // TMP2 = old base (used in vmeta_call). | lui TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | lw TMP1, L->top | mtc1 TMP3, TOBIT | addu PC, PC, BASE | subu NARGS8:RC, TMP1, BASE | subu PC, PC, TMP2 // PC = frame delta + frame type | cvt.d.s TOBIT, TOBIT | li_vmstate INTERP | li TISNIL, LJ_TNIL | st_vmstate | |->vm_call_dispatch: | // TMP2 = old base, BASE = new base, RC = nargs*8, PC = caller PC | lw TMP0, FRAME_PC(BASE) | li AT, LJ_TFUNC | bne TMP0, AT, ->vmeta_call |. lw LFUNC:RB, FRAME_FUNC(BASE) | |->vm_call_dispatch_f: | ins_call | // BASE = new base, RB = func, RC = nargs*8, PC = caller PC | |->vm_cpcall: // Setup protected C frame, call C. | // (lua_State *L, lua_CFunction func, void *ud, lua_CPFunction cp) | saveregs | move L, CARG1 | lw TMP0, L:CARG1->stack | sw CARG1, SAVE_L | lw TMP1, L->top | sw CARG1, SAVE_PC // Any value outside of bytecode is ok. | subu TMP0, TMP0, TMP1 // Compute -savestack(L, L->top). | lw TMP1, L->cframe | sw sp, L->cframe // Add our C frame to cframe chain. | sw TMP0, SAVE_NRES // Neg. delta means cframe w/o frame. | sw r0, SAVE_ERRF // No error function. | move CFUNCADDR, CARG4 | jalr CARG4 // (lua_State *L, lua_CFunction func, void *ud) |. sw TMP1, SAVE_CFRAME | move BASE, CRET1 | lw DISPATCH, L->glref // Setup pointer to dispatch table. | li PC, FRAME_CP | bnez CRET1, <3 // Else continue with the call. |. addiu DISPATCH, DISPATCH, GG_G2DISP | b ->vm_leave_cp // No base? Just remove C frame. |. nop | |//----------------------------------------------------------------------- |//-- Metamethod handling ------------------------------------------------ |//----------------------------------------------------------------------- | |// The lj_meta_* functions (except for lj_meta_cat) don't reallocate the |// stack, so BASE doesn't need to be reloaded across these calls. | |//-- Continuation dispatch ---------------------------------------------- | |->cont_dispatch: | // BASE = meta base, RA = resultptr, RD = (nresults+1)*8 | lw TMP0, -16+LO(BASE) // Continuation. | move RB, BASE | move BASE, TMP2 // Restore caller BASE. | lw LFUNC:TMP1, FRAME_FUNC(TMP2) |.if FFI | sltiu AT, TMP0, 2 |.endif | lw PC, -16+HI(RB) // Restore PC from [cont|PC]. | addu TMP2, RA, RD | lw TMP1, LFUNC:TMP1->pc |.if FFI | bnez AT, >1 |.endif |. sw TISNIL, -8+HI(TMP2) // Ensure one valid arg. | // BASE = base, RA = resultptr, RB = meta base | jr TMP0 // Jump to continuation. |. lw KBASE, PC2PROTO(k)(TMP1) | |.if FFI |1: | bnez TMP0, ->cont_ffi_callback // cont = 1: return from FFI callback. | // cont = 0: tailcall from C function. |. addiu TMP1, RB, -16 | b ->vm_call_tail |. subu RC, TMP1, BASE |.endif | |->cont_cat: // RA = resultptr, RB = meta base | lw INS, -4(PC) | addiu CARG2, RB, -16 | ldc1 f0, 0(RA) | decode_RB8a MULTRES, INS | decode_RA8a RA, INS | decode_RB8b MULTRES | decode_RA8b RA | addu TMP1, BASE, MULTRES | sw BASE, L->base | subu CARG3, CARG2, TMP1 | bne TMP1, CARG2, ->BC_CAT_Z |. sdc1 f0, 0(CARG2) | addu RA, BASE, RA | b ->cont_nop |. sdc1 f0, 0(RA) | |//-- Table indexing metamethods ----------------------------------------- | |->vmeta_tgets1: | addiu CARG3, DISPATCH, DISPATCH_GL(tmptv) | li TMP0, LJ_TSTR | sw STR:RC, LO(CARG3) | b >1 |. sw TMP0, HI(CARG3) | |->vmeta_tgets: | addiu CARG2, DISPATCH, DISPATCH_GL(tmptv) | li TMP0, LJ_TTAB | sw TAB:RB, LO(CARG2) | addiu CARG3, DISPATCH, DISPATCH_GL(tmptv2) | sw TMP0, HI(CARG2) | li TMP1, LJ_TSTR | sw STR:RC, LO(CARG3) | b >1 |. sw TMP1, HI(CARG3) | |->vmeta_tgetb: // TMP0 = index | mtc1 TMP0, f0 | cvt.d.w f0, f0 | addiu CARG3, DISPATCH, DISPATCH_GL(tmptv) | sdc1 f0, 0(CARG3) | |->vmeta_tgetv: |1: | load_got lj_meta_tget | sw BASE, L->base | sw PC, SAVE_PC | call_intern lj_meta_tget // (lua_State *L, TValue *o, TValue *k) |. move CARG1, L | // Returns TValue * (finished) or NULL (metamethod). | beqz CRET1, >3 |. addiu TMP1, BASE, -FRAME_CONT | ldc1 f0, 0(CRET1) | ins_next1 | sdc1 f0, 0(RA) | ins_next2 | |3: // Call __index metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k | lw BASE, L->top | sw PC, -16+HI(BASE) // [cont|PC] | subu PC, BASE, TMP1 | lw LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | b ->vm_call_dispatch_f |. li NARGS8:RC, 16 // 2 args for func(t, k). | |//----------------------------------------------------------------------- | |->vmeta_tsets1: | addiu CARG3, DISPATCH, DISPATCH_GL(tmptv) | li TMP0, LJ_TSTR | sw STR:RC, LO(CARG3) | b >1 |. sw TMP0, HI(CARG3) | |->vmeta_tsets: | addiu CARG2, DISPATCH, DISPATCH_GL(tmptv) | li TMP0, LJ_TTAB | sw TAB:RB, LO(CARG2) | addiu CARG3, DISPATCH, DISPATCH_GL(tmptv2) | sw TMP0, HI(CARG2) | li TMP1, LJ_TSTR | sw STR:RC, LO(CARG3) | b >1 |. sw TMP1, HI(CARG3) | |->vmeta_tsetb: // TMP0 = index | mtc1 TMP0, f0 | cvt.d.w f0, f0 | addiu CARG3, DISPATCH, DISPATCH_GL(tmptv) | sdc1 f0, 0(CARG3) | |->vmeta_tsetv: |1: | load_got lj_meta_tset | sw BASE, L->base | sw PC, SAVE_PC | call_intern lj_meta_tset // (lua_State *L, TValue *o, TValue *k) |. move CARG1, L | // Returns TValue * (finished) or NULL (metamethod). | beqz CRET1, >3 |. ldc1 f0, 0(RA) | // NOBARRIER: lj_meta_tset ensures the table is not black. | ins_next1 | sdc1 f0, 0(CRET1) | ins_next2 | |3: // Call __newindex metamethod. | // BASE = base, L->top = new base, stack = cont/func/t/k/(v) | addiu TMP1, BASE, -FRAME_CONT | lw BASE, L->top | sw PC, -16+HI(BASE) // [cont|PC] | subu PC, BASE, TMP1 | lw LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | sdc1 f0, 16(BASE) // Copy value to third argument. | b ->vm_call_dispatch_f |. li NARGS8:RC, 24 // 3 args for func(t, k, v) | |//-- Comparison metamethods --------------------------------------------- | |->vmeta_comp: | // CARG2, CARG3 are already set by BC_ISLT/BC_ISGE/BC_ISLE/BC_ISGT. | load_got lj_meta_comp | addiu PC, PC, -4 | sw BASE, L->base | sw PC, SAVE_PC | decode_OP1 CARG4, INS | call_intern lj_meta_comp // (lua_State *L, TValue *o1, *o2, int op) |. move CARG1, L | // Returns 0/1 or TValue * (metamethod). |3: | sltiu AT, CRET1, 2 | beqz AT, ->vmeta_binop | negu TMP2, CRET1 |4: | lhu RD, OFS_RD(PC) | addiu PC, PC, 4 | lui TMP1, (-(BCBIAS_J*4 >> 16) & 65535) | sll RD, RD, 2 | addu RD, RD, TMP1 | and RD, RD, TMP2 | addu PC, PC, RD |->cont_nop: | ins_next | |->cont_ra: // RA = resultptr | lbu TMP1, -4+OFS_RA(PC) | ldc1 f0, 0(RA) | sll TMP1, TMP1, 3 | addu TMP1, BASE, TMP1 | b ->cont_nop |. sdc1 f0, 0(TMP1) | |->cont_condt: // RA = resultptr | lw TMP0, HI(RA) | sltiu AT, TMP0, LJ_TISTRUECOND | b <4 |. negu TMP2, AT // Branch if result is true. | |->cont_condf: // RA = resultptr | lw TMP0, HI(RA) | sltiu AT, TMP0, LJ_TISTRUECOND | b <4 |. addiu TMP2, AT, -1 // Branch if result is false. | |->vmeta_equal: | // CARG2, CARG3, CARG4 are already set by BC_ISEQV/BC_ISNEV. | load_got lj_meta_equal | addiu PC, PC, -4 | sw BASE, L->base | sw PC, SAVE_PC | call_intern lj_meta_equal // (lua_State *L, GCobj *o1, *o2, int ne) |. move CARG1, L | // Returns 0/1 or TValue * (metamethod). | b <3 |. nop | |->vmeta_equal_cd: |.if FFI | load_got lj_meta_equal_cd | move CARG2, INS | addiu PC, PC, -4 | sw BASE, L->base | sw PC, SAVE_PC | call_intern lj_meta_equal_cd // (lua_State *L, BCIns op) |. move CARG1, L | // Returns 0/1 or TValue * (metamethod). | b <3 |. nop |.endif | |//-- Arithmetic metamethods --------------------------------------------- | |->vmeta_unm: | move CARG4, CARG3 | |->vmeta_arith: | load_got lj_meta_arith | decode_OP1 TMP0, INS | sw BASE, L->base | sw PC, SAVE_PC | move CARG2, RA | sw TMP0, ARG5 | call_intern lj_meta_arith // (lua_State *L, TValue *ra,*rb,*rc, BCReg op) |. move CARG1, L | // Returns NULL (finished) or TValue * (metamethod). | beqz CRET1, ->cont_nop |. nop | | // Call metamethod for binary op. |->vmeta_binop: | // BASE = old base, CRET1 = new base, stack = cont/func/o1/o2 | subu TMP1, CRET1, BASE | sw PC, -16+HI(CRET1) // [cont|PC] | move TMP2, BASE | addiu PC, TMP1, FRAME_CONT | move BASE, CRET1 | b ->vm_call_dispatch |. li NARGS8:RC, 16 // 2 args for func(o1, o2). | |->vmeta_len: | // CARG2 already set by BC_LEN. #if LJ_52 | move MULTRES, CARG1 #endif | load_got lj_meta_len | sw BASE, L->base | sw PC, SAVE_PC | call_intern lj_meta_len // (lua_State *L, TValue *o) |. move CARG1, L | // Returns NULL (retry) or TValue * (metamethod base). #if LJ_52 | bnez CRET1, ->vmeta_binop // Binop call for compatibility. |. nop | b ->BC_LEN_Z |. move CARG1, MULTRES #else | b ->vmeta_binop // Binop call for compatibility. |. nop #endif | |//-- Call metamethod ---------------------------------------------------- | |->vmeta_call: // Resolve and call __call metamethod. | // TMP2 = old base, BASE = new base, RC = nargs*8 | load_got lj_meta_call | sw TMP2, L->base // This is the callers base! | addiu CARG2, BASE, -8 | sw PC, SAVE_PC | addu CARG3, BASE, RC | move MULTRES, NARGS8:RC | call_intern lj_meta_call // (lua_State *L, TValue *func, TValue *top) |. move CARG1, L | lw LFUNC:RB, FRAME_FUNC(BASE) // Guaranteed to be a function here. | addiu NARGS8:RC, MULTRES, 8 // Got one more argument now. | ins_call | |->vmeta_callt: // Resolve __call for BC_CALLT. | // BASE = old base, RA = new base, RC = nargs*8 | load_got lj_meta_call | sw BASE, L->base | addiu CARG2, RA, -8 | sw PC, SAVE_PC | addu CARG3, RA, RC | move MULTRES, NARGS8:RC | call_intern lj_meta_call // (lua_State *L, TValue *func, TValue *top) |. move CARG1, L | lw TMP1, FRAME_PC(BASE) | lw LFUNC:RB, FRAME_FUNC(RA) // Guaranteed to be a function here. | b ->BC_CALLT_Z |. addiu NARGS8:RC, MULTRES, 8 // Got one more argument now. | |//-- Argument coercion for 'for' statement ------------------------------ | |->vmeta_for: | load_got lj_meta_for | sw BASE, L->base | move CARG2, RA | sw PC, SAVE_PC | move MULTRES, INS | call_intern lj_meta_for // (lua_State *L, TValue *base) |. move CARG1, L |.if JIT | decode_OP1 TMP0, MULTRES | li AT, BC_JFORI |.endif | decode_RA8a RA, MULTRES | decode_RD8a RD, MULTRES | decode_RA8b RA |.if JIT | beq TMP0, AT, =>BC_JFORI |. decode_RD8b RD | b =>BC_FORI |. nop |.else | b =>BC_FORI |. decode_RD8b RD |.endif | |//----------------------------------------------------------------------- |//-- Fast functions ----------------------------------------------------- |//----------------------------------------------------------------------- | |.macro .ffunc, name |->ff_ .. name: |.endmacro | |.macro .ffunc_1, name |->ff_ .. name: | beqz NARGS8:RC, ->fff_fallback |. lw CARG3, HI(BASE) | lw CARG1, LO(BASE) |.endmacro | |.macro .ffunc_2, name |->ff_ .. name: | sltiu AT, NARGS8:RC, 16 | lw CARG3, HI(BASE) | bnez AT, ->fff_fallback |. lw CARG4, 8+HI(BASE) | lw CARG1, LO(BASE) | lw CARG2, 8+LO(BASE) |.endmacro | |.macro .ffunc_n, name // Caveat: has delay slot! |->ff_ .. name: | lw CARG3, HI(BASE) | beqz NARGS8:RC, ->fff_fallback |. ldc1 FARG1, 0(BASE) | sltiu AT, CARG3, LJ_TISNUM | beqz AT, ->fff_fallback |.endmacro | |.macro .ffunc_nn, name // Caveat: has delay slot! |->ff_ .. name: | sltiu AT, NARGS8:RC, 16 | lw CARG3, HI(BASE) | bnez AT, ->fff_fallback |. lw CARG4, 8+HI(BASE) | ldc1 FARG1, 0(BASE) | ldc1 FARG2, 8(BASE) | sltiu TMP0, CARG3, LJ_TISNUM | sltiu TMP1, CARG4, LJ_TISNUM | and TMP0, TMP0, TMP1 | beqz TMP0, ->fff_fallback |.endmacro | |// Inlined GC threshold check. Caveat: uses TMP0 and TMP1 and has delay slot! |.macro ffgccheck | lw TMP0, DISPATCH_GL(gc.total)(DISPATCH) | lw TMP1, DISPATCH_GL(gc.threshold)(DISPATCH) | subu AT, TMP0, TMP1 | bgezal AT, ->fff_gcstep |.endmacro | |//-- Base library: checks ----------------------------------------------- | |.ffunc_1 assert | sltiu AT, CARG3, LJ_TISTRUECOND | beqz AT, ->fff_fallback |. addiu RA, BASE, -8 | lw PC, FRAME_PC(BASE) | addiu RD, NARGS8:RC, 8 // Compute (nresults+1)*8. | addu TMP2, RA, NARGS8:RC | sw CARG3, HI(RA) | addiu TMP1, BASE, 8 | beq BASE, TMP2, ->fff_res // Done if exactly 1 argument. |. sw CARG1, LO(RA) |1: | ldc1 f0, 0(TMP1) | sdc1 f0, -8(TMP1) | bne TMP1, TMP2, <1 |. addiu TMP1, TMP1, 8 | b ->fff_res |. nop | |.ffunc type | lw CARG3, HI(BASE) | li TMP1, LJ_TISNUM | beqz NARGS8:RC, ->fff_fallback |. sltiu TMP0, CARG3, LJ_TISNUM | movz TMP1, CARG3, TMP0 | not TMP1, TMP1 | sll TMP1, TMP1, 3 | addu TMP1, CFUNC:RB, TMP1 | b ->fff_resn |. ldc1 FRET1, CFUNC:TMP1->upvalue | |//-- Base library: getters and setters --------------------------------- | |.ffunc_1 getmetatable | li AT, LJ_TTAB | bne CARG3, AT, >6 |. li AT, LJ_TUDATA |1: // Field metatable must be at same offset for GCtab and GCudata! | lw TAB:CARG1, TAB:CARG1->metatable |2: | lw STR:RC, DISPATCH_GL(gcroot[GCROOT_MMNAME+MM_metatable])(DISPATCH) | beqz TAB:CARG1, ->fff_restv |. li CARG3, LJ_TNIL | lw TMP0, TAB:CARG1->hmask | li CARG3, LJ_TTAB // Use metatable as default result. | lw TMP1, STR:RC->hash | lw NODE:TMP2, TAB:CARG1->node | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | sll TMP0, TMP1, 5 | sll TMP1, TMP1, 3 | subu TMP1, TMP0, TMP1 | addu NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) | li AT, LJ_TSTR |3: // Rearranged logic, because we expect _not_ to find the key. | lw CARG4, offsetof(Node, key)+HI(NODE:TMP2) | lw TMP0, offsetof(Node, key)+LO(NODE:TMP2) | lw NODE:TMP3, NODE:TMP2->next | bne CARG4, AT, >4 |. lw CARG2, offsetof(Node, val)+HI(NODE:TMP2) | beq TMP0, STR:RC, >5 |. lw TMP1, offsetof(Node, val)+LO(NODE:TMP2) |4: | beqz NODE:TMP3, ->fff_restv // Not found, keep default result. |. move NODE:TMP2, NODE:TMP3 | b <3 |. nop |5: | beq CARG2, TISNIL, ->fff_restv // Ditto for nil value. |. nop | move CARG3, CARG2 // Return value of mt.__metatable. | b ->fff_restv |. move CARG1, TMP1 | |6: | beq CARG3, AT, <1 |. sltiu TMP0, CARG3, LJ_TISNUM | li TMP1, LJ_TISNUM | movz TMP1, CARG3, TMP0 | not TMP1, TMP1 | sll TMP1, TMP1, 2 | addu TMP1, DISPATCH, TMP1 | b <2 |. lw TAB:CARG1, DISPATCH_GL(gcroot[GCROOT_BASEMT])(TMP1) | |.ffunc_2 setmetatable | // Fast path: no mt for table yet and not clearing the mt. | li AT, LJ_TTAB | bne CARG3, AT, ->fff_fallback |. addiu CARG4, CARG4, -LJ_TTAB | lw TAB:TMP1, TAB:CARG1->metatable | lbu TMP3, TAB:CARG1->marked | or AT, CARG4, TAB:TMP1 | bnez AT, ->fff_fallback |. andi AT, TMP3, LJ_GC_BLACK // isblack(table) | beqz AT, ->fff_restv |. sw TAB:CARG2, TAB:CARG1->metatable | barrierback TAB:CARG1, TMP3, TMP0, ->fff_restv | |.ffunc rawget | lw CARG4, HI(BASE) | sltiu AT, NARGS8:RC, 16 | lw TAB:CARG2, LO(BASE) | load_got lj_tab_get | addiu CARG4, CARG4, -LJ_TTAB | or AT, AT, CARG4 | bnez AT, ->fff_fallback | addiu CARG3, BASE, 8 | call_intern lj_tab_get // (lua_State *L, GCtab *t, cTValue *key) |. move CARG1, L | // Returns cTValue *. | b ->fff_resn |. ldc1 FRET1, 0(CRET1) | |//-- Base library: conversions ------------------------------------------ | |.ffunc tonumber | // Only handles the number case inline (without a base argument). | lw CARG1, HI(BASE) | xori AT, NARGS8:RC, 8 | sltiu CARG1, CARG1, LJ_TISNUM | movn CARG1, r0, AT | beqz CARG1, ->fff_fallback // Exactly one number argument. |. ldc1 FRET1, 0(BASE) | b ->fff_resn |. nop | |.ffunc_1 tostring | // Only handles the string or number case inline. | li AT, LJ_TSTR | // A __tostring method in the string base metatable is ignored. | beq CARG3, AT, ->fff_restv // String key? | // Handle numbers inline, unless a number base metatable is present. |. lw TMP1, DISPATCH_GL(gcroot[GCROOT_BASEMT_NUM])(DISPATCH) | sltiu TMP0, CARG3, LJ_TISNUM | sltiu TMP1, TMP1, 1 | and TMP0, TMP0, TMP1 | beqz TMP0, ->fff_fallback |. sw BASE, L->base // Add frame since C call can throw. | ffgccheck |. sw PC, SAVE_PC // Redundant (but a defined value). | load_got lj_str_fromnum | move CARG1, L | call_intern lj_str_fromnum // (lua_State *L, lua_Number *np) |. move CARG2, BASE | // Returns GCstr *. | li CARG3, LJ_TSTR | b ->fff_restv |. move CARG1, CRET1 | |//-- Base library: iterators ------------------------------------------- | |.ffunc next | lw CARG1, HI(BASE) | lw TAB:CARG2, LO(BASE) | beqz NARGS8:RC, ->fff_fallback |. addu TMP2, BASE, NARGS8:RC | li AT, LJ_TTAB | sw TISNIL, HI(TMP2) // Set missing 2nd arg to nil. | bne CARG1, AT, ->fff_fallback |. lw PC, FRAME_PC(BASE) | load_got lj_tab_next | sw BASE, L->base // Add frame since C call can throw. | sw BASE, L->top // Dummy frame length is ok. | addiu CARG3, BASE, 8 | sw PC, SAVE_PC | call_intern lj_tab_next // (lua_State *L, GCtab *t, TValue *key) |. move CARG1, L | // Returns 0 at end of traversal. | beqz CRET1, ->fff_restv // End of traversal: return nil. |. li CARG3, LJ_TNIL | ldc1 f0, 8(BASE) // Copy key and value to results. | addiu RA, BASE, -8 | ldc1 f2, 16(BASE) | li RD, (2+1)*8 | sdc1 f0, 0(RA) | b ->fff_res |. sdc1 f2, 8(RA) | |.ffunc_1 pairs | li AT, LJ_TTAB | bne CARG3, AT, ->fff_fallback |. lw PC, FRAME_PC(BASE) #if LJ_52 | lw TAB:TMP2, TAB:CARG1->metatable | ldc1 f0, CFUNC:RB->upvalue[0] | bnez TAB:TMP2, ->fff_fallback #else | ldc1 f0, CFUNC:RB->upvalue[0] #endif |. addiu RA, BASE, -8 | sw TISNIL, 8+HI(BASE) | li RD, (3+1)*8 | b ->fff_res |. sdc1 f0, 0(RA) | |.ffunc ipairs_aux | sltiu AT, NARGS8:RC, 16 | lw CARG3, HI(BASE) | lw TAB:CARG1, LO(BASE) | lw CARG4, 8+HI(BASE) | bnez AT, ->fff_fallback |. ldc1 FARG2, 8(BASE) | addiu CARG3, CARG3, -LJ_TTAB | sltiu AT, CARG4, LJ_TISNUM | li TMP0, 1 | movn AT, r0, CARG3 | mtc1 TMP0, FARG1 | beqz AT, ->fff_fallback |. lw PC, FRAME_PC(BASE) | cvt.w.d FRET1, FARG2 | cvt.d.w FARG1, FARG1 | lw TMP0, TAB:CARG1->asize | lw TMP1, TAB:CARG1->array | mfc1 TMP2, FRET1 | addiu RA, BASE, -8 | add.d FARG2, FARG2, FARG1 | addiu TMP2, TMP2, 1 | sltu AT, TMP2, TMP0 | sll TMP3, TMP2, 3 | addu TMP3, TMP1, TMP3 | beqz AT, >2 // Not in array part? |. sdc1 FARG2, 0(RA) | lw TMP2, HI(TMP3) | ldc1 f0, 0(TMP3) |1: | beq TMP2, TISNIL, ->fff_res // End of iteration, return 0 results. |. li RD, (0+1)*8 | li RD, (2+1)*8 | b ->fff_res |. sdc1 f0, 8(RA) |2: // Check for empty hash part first. Otherwise call C function. | lw TMP0, TAB:CARG1->hmask | load_got lj_tab_getinth | beqz TMP0, ->fff_res |. li RD, (0+1)*8 | call_intern lj_tab_getinth // (GCtab *t, int32_t key) |. move CARG2, TMP2 | // Returns cTValue * or NULL. | beqz CRET1, ->fff_res |. li RD, (0+1)*8 | lw TMP2, HI(CRET1) | b <1 |. ldc1 f0, 0(CRET1) | |.ffunc_1 ipairs | li AT, LJ_TTAB | bne CARG3, AT, ->fff_fallback |. lw PC, FRAME_PC(BASE) #if LJ_52 | lw TAB:TMP2, TAB:CARG1->metatable | ldc1 f0, CFUNC:RB->upvalue[0] | bnez TAB:TMP2, ->fff_fallback #else | ldc1 f0, CFUNC:RB->upvalue[0] #endif |. addiu RA, BASE, -8 | sw r0, 8+HI(BASE) | sw r0, 8+LO(BASE) | li RD, (3+1)*8 | b ->fff_res |. sdc1 f0, 0(RA) | |//-- Base library: catch errors ---------------------------------------- | |.ffunc pcall | lbu TMP3, DISPATCH_GL(hookmask)(DISPATCH) | beqz NARGS8:RC, ->fff_fallback | move TMP2, BASE | addiu BASE, BASE, 8 | // Remember active hook before pcall. | srl TMP3, TMP3, HOOK_ACTIVE_SHIFT | andi TMP3, TMP3, 1 | addiu PC, TMP3, 8+FRAME_PCALL | b ->vm_call_dispatch |. addiu NARGS8:RC, NARGS8:RC, -8 | |.ffunc xpcall | sltiu AT, NARGS8:RC, 16 | lw CARG4, 8+HI(BASE) | bnez AT, ->fff_fallback |. ldc1 FARG2, 8(BASE) | ldc1 FARG1, 0(BASE) | lbu TMP1, DISPATCH_GL(hookmask)(DISPATCH) | li AT, LJ_TFUNC | move TMP2, BASE | bne CARG4, AT, ->fff_fallback // Traceback must be a function. | addiu BASE, BASE, 16 | // Remember active hook before pcall. | srl TMP3, TMP3, HOOK_ACTIVE_SHIFT | sdc1 FARG2, 0(TMP2) // Swap function and traceback. | andi TMP3, TMP3, 1 | sdc1 FARG1, 8(TMP2) | addiu PC, TMP3, 16+FRAME_PCALL | b ->vm_call_dispatch |. addiu NARGS8:RC, NARGS8:RC, -16 | |//-- Coroutine library -------------------------------------------------- | |.macro coroutine_resume_wrap, resume |.if resume |.ffunc_1 coroutine_resume | li AT, LJ_TTHREAD | bne CARG3, AT, ->fff_fallback |.else |.ffunc coroutine_wrap_aux | lw L:CARG1, CFUNC:RB->upvalue[0].gcr |.endif | lbu TMP0, L:CARG1->status | lw TMP1, L:CARG1->cframe | lw CARG2, L:CARG1->top | lw TMP2, L:CARG1->base | addiu TMP3, TMP0, -LUA_YIELD | bgtz TMP3, ->fff_fallback // st > LUA_YIELD? |. xor TMP2, TMP2, CARG2 | bnez TMP1, ->fff_fallback // cframe != 0? |. or AT, TMP2, TMP0 | lw TMP0, L:CARG1->maxstack | beqz AT, ->fff_fallback // base == top && st == 0? |. lw PC, FRAME_PC(BASE) | addu TMP2, CARG2, NARGS8:RC | sltu AT, TMP0, TMP2 | bnez AT, ->fff_fallback // Stack overflow? |. sw PC, SAVE_PC | sw BASE, L->base |1: |.if resume | addiu BASE, BASE, 8 // Keep resumed thread in stack for GC. | addiu NARGS8:RC, NARGS8:RC, -8 | addiu TMP2, TMP2, -8 |.endif | sw TMP2, L:CARG1->top | addu TMP1, BASE, NARGS8:RC | move CARG3, CARG2 | sw BASE, L->top |2: // Move args to coroutine. | ldc1 f0, 0(BASE) | sltu AT, BASE, TMP1 | beqz AT, >3 |. addiu BASE, BASE, 8 | sdc1 f0, 0(CARG3) | b <2 |. addiu CARG3, CARG3, 8 |3: | bal ->vm_resume // (lua_State *L, TValue *base, 0, 0) |. move L:RA, L:CARG1 | // Returns thread status. |4: | lw TMP2, L:RA->base | sltiu AT, CRET1, LUA_YIELD+1 | lw TMP3, L:RA->top | li_vmstate INTERP | lw BASE, L->base | st_vmstate | beqz AT, >8 |. subu RD, TMP3, TMP2 | lw TMP0, L->maxstack | beqz RD, >6 // No results? |. addu TMP1, BASE, RD | sltu AT, TMP0, TMP1 | bnez AT, >9 // Need to grow stack? |. addu TMP3, TMP2, RD | sw TMP2, L:RA->top // Clear coroutine stack. | move TMP1, BASE |5: // Move results from coroutine. | ldc1 f0, 0(TMP2) | addiu TMP2, TMP2, 8 | sltu AT, TMP2, TMP3 | sdc1 f0, 0(TMP1) | bnez AT, <5 |. addiu TMP1, TMP1, 8 |6: | andi TMP0, PC, FRAME_TYPE |.if resume | li TMP1, LJ_TTRUE | addiu RA, BASE, -8 | sw TMP1, -8+HI(BASE) // Prepend true to results. | addiu RD, RD, 16 |.else | move RA, BASE | addiu RD, RD, 8 |.endif |7: | sw PC, SAVE_PC | beqz TMP0, ->BC_RET_Z |. move MULTRES, RD | b ->vm_return |. nop | |8: // Coroutine returned with error (at co->top-1). |.if resume | addiu TMP3, TMP3, -8 | li TMP1, LJ_TFALSE | ldc1 f0, 0(TMP3) | sw TMP3, L:RA->top // Remove error from coroutine stack. | li RD, (2+1)*8 | sw TMP1, -8+HI(BASE) // Prepend false to results. | addiu RA, BASE, -8 | sdc1 f0, 0(BASE) // Copy error message. | b <7 |. andi TMP0, PC, FRAME_TYPE |.else | load_got lj_ffh_coroutine_wrap_err | move CARG2, L:RA | call_intern lj_ffh_coroutine_wrap_err // (lua_State *L, lua_State *co) |. move CARG1, L |.endif | |9: // Handle stack expansion on return from yield. | load_got lj_state_growstack | srl CARG2, RD, 3 | call_intern lj_state_growstack // (lua_State *L, int n) |. move CARG1, L | b <4 |. li CRET1, 0 |.endmacro | | coroutine_resume_wrap 1 // coroutine.resume | coroutine_resume_wrap 0 // coroutine.wrap | |.ffunc coroutine_yield | lw TMP0, L->cframe | addu TMP1, BASE, NARGS8:RC | sw BASE, L->base | andi TMP0, TMP0, CFRAME_RESUME | sw TMP1, L->top | beqz TMP0, ->fff_fallback |. li CRET1, LUA_YIELD | sw r0, L->cframe | b ->vm_leave_unw |. sb CRET1, L->status | |//-- Math library ------------------------------------------------------- | |.ffunc_n math_abs |. abs.d FRET1, FARG1 |->fff_resn: | lw PC, FRAME_PC(BASE) | addiu RA, BASE, -8 | b ->fff_res1 |. sdc1 FRET1, -8(BASE) | |->fff_restv: | // CARG3/CARG1 = TValue result. | lw PC, FRAME_PC(BASE) | sw CARG3, -8+HI(BASE) | addiu RA, BASE, -8 | sw CARG1, -8+LO(BASE) |->fff_res1: | // RA = results, PC = return. | li RD, (1+1)*8 |->fff_res: | // RA = results, RD = (nresults+1)*8, PC = return. | andi TMP0, PC, FRAME_TYPE | bnez TMP0, ->vm_return |. move MULTRES, RD | lw INS, -4(PC) | decode_RB8a RB, INS | decode_RB8b RB |5: | sltu AT, RD, RB | bnez AT, >6 // More results expected? |. decode_RA8a TMP0, INS | decode_RA8b TMP0 | ins_next1 | // Adjust BASE. KBASE is assumed to be set for the calling frame. | subu BASE, RA, TMP0 | ins_next2 | |6: // Fill up results with nil. | addu TMP1, RA, RD | addiu RD, RD, 8 | b <5 |. sw TISNIL, -8+HI(TMP1) | |.macro math_extern, func |->ff_math_ .. func: | lw CARG3, HI(BASE) | beqz NARGS8:RC, ->fff_fallback |. load_got func | sltiu AT, CARG3, LJ_TISNUM | beqz AT, ->fff_fallback |. nop | call_extern |. ldc1 FARG1, 0(BASE) | b ->fff_resn |. nop |.endmacro | |.macro math_extern2, func | .ffunc_nn math_ .. func |. load_got func | call_extern |. nop | b ->fff_resn |. nop |.endmacro | |.macro math_round, func | .ffunc_n math_ .. func |. nop | bal ->vm_ .. func |. nop | b ->fff_resn |. nop |.endmacro | | math_round floor | math_round ceil | |.ffunc math_log | lw CARG3, HI(BASE) | li AT, 8 | bne NARGS8:RC, AT, ->fff_fallback // Exactly 1 argument. |. load_got log | sltiu AT, CARG3, LJ_TISNUM | beqz AT, ->fff_fallback |. nop | call_extern |. ldc1 FARG1, 0(BASE) | b ->fff_resn |. nop | | math_extern log10 | math_extern exp | math_extern sin | math_extern cos | math_extern tan | math_extern asin | math_extern acos | math_extern atan | math_extern sinh | math_extern cosh | math_extern tanh | math_extern2 pow | math_extern2 atan2 | math_extern2 fmod | |.ffunc_n math_sqrt |. sqrt.d FRET1, FARG1 | b ->fff_resn |. nop | |->ff_math_deg: |.ffunc_n math_rad |. ldc1 FARG2, CFUNC:RB->upvalue[0] | b ->fff_resn |. mul.d FRET1, FARG1, FARG2 | |.ffunc_nn math_ldexp | cvt.w.d FARG2, FARG2 | load_got ldexp | mfc1 CARG3, FARG2 | call_extern |. nop | b ->fff_resn |. nop | |.ffunc_n math_frexp | load_got frexp | lw PC, FRAME_PC(BASE) | call_extern |. addiu CARG3, DISPATCH, DISPATCH_GL(tmptv) | lw TMP1, DISPATCH_GL(tmptv)(DISPATCH) | addiu RA, BASE, -8 | mtc1 TMP1, FARG2 | sdc1 FRET1, 0(RA) | cvt.d.w FARG2, FARG2 | sdc1 FARG2, 8(RA) | b ->fff_res |. li RD, (2+1)*8 | |.ffunc_n math_modf | load_got modf | lw PC, FRAME_PC(BASE) | call_extern |. addiu CARG3, BASE, -8 | addiu RA, BASE, -8 | sdc1 FRET1, 0(BASE) | b ->fff_res |. li RD, (2+1)*8 | |.macro math_minmax, name, ismax |->ff_ .. name: | lw CARG3, HI(BASE) | beqz NARGS8:RC, ->fff_fallback |. ldc1 FRET1, 0(BASE) | sltiu AT, CARG3, LJ_TISNUM | beqz AT, ->fff_fallback |. addu TMP2, BASE, NARGS8:RC | addiu TMP1, BASE, 8 | beq TMP1, TMP2, ->fff_resn |1: |. lw CARG3, HI(TMP1) | ldc1 FARG1, 0(TMP1) | addiu TMP1, TMP1, 8 | sltiu AT, CARG3, LJ_TISNUM | beqz AT, ->fff_fallback |.if ismax |. c.olt.d FARG1, FRET1 |.else |. c.olt.d FRET1, FARG1 |.endif | bne TMP1, TMP2, <1 |. movf.d FRET1, FARG1 | b ->fff_resn |. nop |.endmacro | | math_minmax math_min, 0 | math_minmax math_max, 1 | |//-- String library ----------------------------------------------------- | |.ffunc_1 string_len | li AT, LJ_TSTR | bne CARG3, AT, ->fff_fallback |. nop | b ->fff_resi |. lw CRET1, STR:CARG1->len | |.ffunc string_byte // Only handle the 1-arg case here. | lw CARG3, HI(BASE) | lw STR:CARG1, LO(BASE) | xori AT, NARGS8:RC, 8 | addiu CARG3, CARG3, -LJ_TSTR | or AT, AT, CARG3 | bnez AT, ->fff_fallback // Need exactly 1 string argument. |. nop | lw TMP0, STR:CARG1->len | lbu TMP1, STR:CARG1[1] // Access is always ok (NUL at end). | addiu RA, BASE, -8 | sltu RD, r0, TMP0 | mtc1 TMP1, f0 | addiu RD, RD, 1 | cvt.d.w f0, f0 | lw PC, FRAME_PC(BASE) | sll RD, RD, 3 // RD = ((str->len != 0)+1)*8 | b ->fff_res |. sdc1 f0, 0(RA) | |.ffunc string_char // Only handle the 1-arg case here. | ffgccheck |. nop | lw CARG3, HI(BASE) | ldc1 FARG1, 0(BASE) | li AT, 8 | bne NARGS8:RC, AT, ->fff_fallback // Exactly 1 argument. |. sltiu AT, CARG3, LJ_TISNUM | beqz AT, ->fff_fallback |. li CARG3, 1 | cvt.w.d FARG1, FARG1 | addiu CARG2, sp, ARG5_OFS | sltiu AT, TMP0, 256 | mfc1 TMP0, FARG1 | beqz AT, ->fff_fallback |. sw TMP0, ARG5 |->fff_newstr: | load_got lj_str_new | sw BASE, L->base | sw PC, SAVE_PC | call_intern lj_str_new // (lua_State *L, char *str, size_t l) |. move CARG1, L | // Returns GCstr *. | lw BASE, L->base | move CARG1, CRET1 | b ->fff_restv |. li CARG3, LJ_TSTR | |.ffunc string_sub | ffgccheck |. nop | addiu AT, NARGS8:RC, -16 | lw CARG3, 16+HI(BASE) | ldc1 f0, 16(BASE) | lw TMP0, HI(BASE) | lw STR:CARG1, LO(BASE) | bltz AT, ->fff_fallback | lw CARG2, 8+HI(BASE) | ldc1 f2, 8(BASE) | beqz AT, >1 |. li CARG4, -1 | cvt.w.d f0, f0 | sltiu AT, CARG3, LJ_TISNUM | beqz AT, ->fff_fallback |. mfc1 CARG4, f0 |1: | sltiu AT, CARG2, LJ_TISNUM | beqz AT, ->fff_fallback |. li AT, LJ_TSTR | cvt.w.d f2, f2 | bne TMP0, AT, ->fff_fallback |. lw CARG2, STR:CARG1->len | mfc1 CARG3, f2 | // STR:CARG1 = str, CARG2 = str->len, CARG3 = start, CARG4 = end | slt AT, CARG4, r0 | addiu TMP0, CARG2, 1 | addu TMP1, CARG4, TMP0 | slt TMP3, CARG3, r0 | movn CARG4, TMP1, AT // if (end < 0) end += len+1 | addu TMP1, CARG3, TMP0 | movn CARG3, TMP1, TMP3 // if (start < 0) start += len+1 | li TMP2, 1 | slt AT, CARG4, r0 | slt TMP3, r0, CARG3 | movn CARG4, r0, AT // if (end < 0) end = 0 | movz CARG3, TMP2, TMP3 // if (start < 1) start = 1 | slt AT, CARG2, CARG4 | movn CARG4, CARG2, AT // if (end > len) end = len | addu CARG2, STR:CARG1, CARG3 | subu CARG3, CARG4, CARG3 // len = end - start | addiu CARG2, CARG2, sizeof(GCstr)-1 | bgez CARG3, ->fff_newstr |. addiu CARG3, CARG3, 1 // len++ |->fff_emptystr: // Return empty string. | addiu STR:CARG1, DISPATCH, DISPATCH_GL(strempty) | b ->fff_restv |. li CARG3, LJ_TSTR | |.ffunc string_rep // Only handle the 1-char case inline. | ffgccheck |. nop | lw TMP0, HI(BASE) | addiu AT, NARGS8:RC, -16 // Exactly 2 arguments. | lw CARG4, 8+HI(BASE) | lw STR:CARG1, LO(BASE) | addiu TMP0, TMP0, -LJ_TSTR | ldc1 f0, 8(BASE) | or AT, AT, TMP0 | bnez AT, ->fff_fallback |. sltiu AT, CARG4, LJ_TISNUM | cvt.w.d f0, f0 | beqz AT, ->fff_fallback |. lw TMP0, STR:CARG1->len | mfc1 CARG3, f0 | lw TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | li AT, 1 | blez CARG3, ->fff_emptystr // Count <= 0? |. sltu AT, AT, TMP0 | beqz TMP0, ->fff_emptystr // Zero length string? |. sltu TMP0, TMP1, CARG3 | or AT, AT, TMP0 | lw CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | bnez AT, ->fff_fallback // Fallback for > 1-char strings. |. lbu TMP0, STR:CARG1[1] | addu TMP2, CARG2, CARG3 |1: // Fill buffer with char. Yes, this is suboptimal code (do you care?). | addiu TMP2, TMP2, -1 | sltu AT, CARG2, TMP2 | bnez AT, <1 |. sb TMP0, 0(TMP2) | b ->fff_newstr |. nop | |.ffunc string_reverse | ffgccheck |. nop | lw CARG3, HI(BASE) | lw STR:CARG1, LO(BASE) | beqz NARGS8:RC, ->fff_fallback |. li AT, LJ_TSTR | bne CARG3, AT, ->fff_fallback |. lw TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | lw CARG3, STR:CARG1->len | addiu CARG1, STR:CARG1, #STR | lw CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | sltu AT, TMP1, CARG3 | bnez AT, ->fff_fallback |. addu TMP3, CARG1, CARG3 | addu CARG4, CARG2, CARG3 |1: // Reverse string copy. | lbu TMP1, 0(CARG1) | sltu AT, CARG1, TMP3 | beqz AT, ->fff_newstr |. addiu CARG1, CARG1, 1 | addiu CARG4, CARG4, -1 | b <1 | sb TMP1, 0(CARG4) | |.macro ffstring_case, name, lo | .ffunc name | ffgccheck |. nop | lw CARG3, HI(BASE) | lw STR:CARG1, LO(BASE) | beqz NARGS8:RC, ->fff_fallback |. li AT, LJ_TSTR | bne CARG3, AT, ->fff_fallback |. lw TMP1, DISPATCH_GL(tmpbuf.sz)(DISPATCH) | lw CARG3, STR:CARG1->len | addiu CARG1, STR:CARG1, #STR | lw CARG2, DISPATCH_GL(tmpbuf.buf)(DISPATCH) | sltu AT, TMP1, CARG3 | bnez AT, ->fff_fallback |. addu TMP3, CARG1, CARG3 | move CARG4, CARG2 |1: // ASCII case conversion. | lbu TMP1, 0(CARG1) | sltu AT, CARG1, TMP3 | beqz AT, ->fff_newstr |. addiu TMP0, TMP1, -lo | xori TMP2, TMP1, 0x20 | sltiu AT, TMP0, 26 | movn TMP1, TMP2, AT | addiu CARG1, CARG1, 1 | sb TMP1, 0(CARG4) | b <1 |. addiu CARG4, CARG4, 1 |.endmacro | |ffstring_case string_lower, 65 |ffstring_case string_upper, 97 | |//-- Table library ------------------------------------------------------ | |.ffunc_1 table_getn | li AT, LJ_TTAB | bne CARG3, AT, ->fff_fallback |. load_got lj_tab_len | call_intern lj_tab_len // (GCtab *t) |. nop | // Returns uint32_t (but less than 2^31). | b ->fff_resi |. nop | |//-- Bit library -------------------------------------------------------- | |.macro .ffunc_bit, name | .ffunc_n bit_..name |. add.d FARG1, FARG1, TOBIT | mfc1 CRET1, FARG1 |.endmacro | |.macro .ffunc_bit_op, name, ins | .ffunc_bit name | addiu TMP1, BASE, 8 | addu TMP2, BASE, NARGS8:RC |1: | lw CARG4, HI(TMP1) | beq TMP1, TMP2, ->fff_resi |. ldc1 FARG1, 0(TMP1) | sltiu AT, CARG4, LJ_TISNUM | beqz AT, ->fff_fallback | add.d FARG1, FARG1, TOBIT | mfc1 CARG2, FARG1 | ins CRET1, CRET1, CARG2 | b <1 |. addiu TMP1, TMP1, 8 |.endmacro | |.ffunc_bit_op band, and |.ffunc_bit_op bor, or |.ffunc_bit_op bxor, xor | |.ffunc_bit bswap | srl TMP0, CRET1, 24 | srl TMP2, CRET1, 8 | sll TMP1, CRET1, 24 | andi TMP2, TMP2, 0xff00 | or TMP0, TMP0, TMP1 | andi CRET1, CRET1, 0xff00 | or TMP0, TMP0, TMP2 | sll CRET1, CRET1, 8 | b ->fff_resi |. or CRET1, TMP0, CRET1 | |.ffunc_bit bnot | b ->fff_resi |. not CRET1, CRET1 | |.macro .ffunc_bit_sh, name, ins, shmod | .ffunc_nn bit_..name |. add.d FARG1, FARG1, TOBIT | add.d FARG2, FARG2, TOBIT | mfc1 CARG1, FARG1 | mfc1 CARG2, FARG2 |.if shmod == 1 | li AT, 32 | subu TMP0, AT, CARG2 | sllv CARG2, CARG1, CARG2 | srlv CARG1, CARG1, TMP0 |.elif shmod == 2 | li AT, 32 | subu TMP0, AT, CARG2 | srlv CARG2, CARG1, CARG2 | sllv CARG1, CARG1, TMP0 |.endif | b ->fff_resi |. ins CRET1, CARG1, CARG2 |.endmacro | |.ffunc_bit_sh lshift, sllv, 0 |.ffunc_bit_sh rshift, srlv, 0 |.ffunc_bit_sh arshift, srav, 0 |// Can't use rotrv, since it's only in MIPS32R2. |.ffunc_bit_sh rol, or, 1 |.ffunc_bit_sh ror, or, 2 | |.ffunc_bit tobit |->fff_resi: | mtc1 CRET1, FRET1 | b ->fff_resn |. cvt.d.w FRET1, FRET1 | |//----------------------------------------------------------------------- | |->fff_fallback: // Call fast function fallback handler. | // BASE = new base, RB = CFUNC, RC = nargs*8 | lw TMP3, CFUNC:RB->f | addu TMP1, BASE, NARGS8:RC | lw PC, FRAME_PC(BASE) // Fallback may overwrite PC. | addiu TMP0, TMP1, 8*LUA_MINSTACK | lw TMP2, L->maxstack | sw PC, SAVE_PC // Redundant (but a defined value). | sltu AT, TMP2, TMP0 | sw BASE, L->base | sw TMP1, L->top | bnez AT, >5 // Need to grow stack. |. move CFUNCADDR, TMP3 | jalr TMP3 // (lua_State *L) |. move CARG1, L | // Either throws an error, or recovers and returns -1, 0 or nresults+1. | lw BASE, L->base | sll RD, CRET1, 3 | bgtz CRET1, ->fff_res // Returned nresults+1? |. addiu RA, BASE, -8 |1: // Returned 0 or -1: retry fast path. | lw TMP0, L->top | lw LFUNC:RB, FRAME_FUNC(BASE) | bnez CRET1, ->vm_call_tail // Returned -1? |. subu NARGS8:RC, TMP0, BASE | ins_callt // Returned 0: retry fast path. | |// Reconstruct previous base for vmeta_call during tailcall. |->vm_call_tail: | andi TMP0, PC, FRAME_TYPE | li AT, -4 | bnez TMP0, >3 |. and TMP1, PC, AT | lbu TMP1, OFS_RA(PC) | sll TMP1, TMP1, 3 | addiu TMP1, TMP1, 8 |3: | b ->vm_call_dispatch // Resolve again for tailcall. |. subu TMP2, BASE, TMP1 | |5: // Grow stack for fallback handler. | load_got lj_state_growstack | li CARG2, LUA_MINSTACK | call_intern lj_state_growstack // (lua_State *L, int n) |. move CARG1, L | lw BASE, L->base | b <1 |. li CRET1, 0 // Force retry. | |->fff_gcstep: // Call GC step function. | // BASE = new base, RC = nargs*8 | move MULTRES, ra | load_got lj_gc_step | sw BASE, L->base | addu TMP0, BASE, NARGS8:RC | sw PC, SAVE_PC // Redundant (but a defined value). | sw TMP0, L->top | call_intern lj_gc_step // (lua_State *L) |. move CARG1, L | lw BASE, L->base | move ra, MULTRES | lw TMP0, L->top | lw CFUNC:RB, FRAME_FUNC(BASE) | jr ra |. subu NARGS8:RC, TMP0, BASE | |//----------------------------------------------------------------------- |//-- Special dispatch targets ------------------------------------------- |//----------------------------------------------------------------------- | |->vm_record: // Dispatch target for recording phase. |.if JIT | lbu TMP3, DISPATCH_GL(hookmask)(DISPATCH) | andi AT, TMP3, HOOK_VMEVENT // No recording while in vmevent. | bnez AT, >5 | // Decrement the hookcount for consistency, but always do the call. |. lw TMP2, DISPATCH_GL(hookcount)(DISPATCH) | andi AT, TMP3, HOOK_ACTIVE | bnez AT, >1 |. addiu TMP2, TMP2, -1 | andi AT, TMP3, LUA_MASKLINE|LUA_MASKCOUNT | beqz AT, >1 |. nop | b >1 |. sw TMP2, DISPATCH_GL(hookcount)(DISPATCH) |.endif | |->vm_rethook: // Dispatch target for return hooks. | lbu TMP3, DISPATCH_GL(hookmask)(DISPATCH) | andi AT, TMP3, HOOK_ACTIVE // Hook already active? | beqz AT, >1 |5: // Re-dispatch to static ins. |. lw AT, GG_DISP2STATIC(TMP0) // Assumes TMP0 holds DISPATCH+OP*4. | jr AT |. nop | |->vm_inshook: // Dispatch target for instr/line hooks. | lbu TMP3, DISPATCH_GL(hookmask)(DISPATCH) | lw TMP2, DISPATCH_GL(hookcount)(DISPATCH) | andi AT, TMP3, HOOK_ACTIVE // Hook already active? | bnez AT, <5 |. andi AT, TMP3, LUA_MASKLINE|LUA_MASKCOUNT | beqz AT, <5 |. addiu TMP2, TMP2, -1 | beqz TMP2, >1 |. sw TMP2, DISPATCH_GL(hookcount)(DISPATCH) | andi AT, TMP3, LUA_MASKLINE | beqz AT, <5 |1: |. load_got lj_dispatch_ins | sw MULTRES, SAVE_MULTRES | move CARG2, PC | sw BASE, L->base | // SAVE_PC must hold the _previous_ PC. The callee updates it with PC. | call_intern lj_dispatch_ins // (lua_State *L, const BCIns *pc) |. move CARG1, L |3: | lw BASE, L->base |4: // Re-dispatch to static ins. | lw INS, -4(PC) | decode_OP4a TMP1, INS | decode_OP4b TMP1 | addu TMP0, DISPATCH, TMP1 | decode_RD8a RD, INS | lw AT, GG_DISP2STATIC(TMP0) | decode_RA8a RA, INS | decode_RD8b RD | jr AT | decode_RA8b RA | |->cont_hook: // Continue from hook yield. | addiu PC, PC, 4 | b <4 |. lw MULTRES, -24+LO(RB) // Restore MULTRES for *M ins. | |->vm_hotloop: // Hot loop counter underflow. |.if JIT | lw LFUNC:TMP1, FRAME_FUNC(BASE) | addiu CARG1, DISPATCH, GG_DISP2J | sw PC, SAVE_PC | lw TMP1, LFUNC:TMP1->pc | move CARG2, PC | sw L, DISPATCH_J(L)(DISPATCH) | lbu TMP1, PC2PROTO(framesize)(TMP1) | load_got lj_trace_hot | sw BASE, L->base | sll TMP1, TMP1, 3 | addu TMP1, BASE, TMP1 | call_intern lj_trace_hot // (jit_State *J, const BCIns *pc) |. sw TMP1, L->top | b <3 |. nop |.endif | |->vm_callhook: // Dispatch target for call hooks. |.if JIT | b >1 |.endif |. move CARG2, PC | |->vm_hotcall: // Hot call counter underflow. |.if JIT | ori CARG2, PC, 1 |1: |.endif | load_got lj_dispatch_call | addu TMP0, BASE, RC | sw PC, SAVE_PC | sw BASE, L->base | subu RA, RA, BASE | sw TMP0, L->top | call_intern lj_dispatch_call // (lua_State *L, const BCIns *pc) |. move CARG1, L | // Returns ASMFunction. | lw BASE, L->base | lw TMP0, L->top | sw r0, SAVE_PC // Invalidate for subsequent line hook. | subu NARGS8:RC, TMP0, BASE | addu RA, BASE, RA | lw LFUNC:RB, FRAME_FUNC(BASE) | jr CRET1 |. lw INS, -4(PC) | |//----------------------------------------------------------------------- |//-- Trace exit handler ------------------------------------------------- |//----------------------------------------------------------------------- | |.macro savex_, a, b | sdc1 f..a, 16+a*8(sp) | sw r..a, 16+32*8+a*4(sp) | sw r..b, 16+32*8+b*4(sp) |.endmacro | |->vm_exit_handler: |.if JIT | addiu sp, sp, -(16+32*8+32*4) | savex_ 0, 1 | savex_ 2, 3 | savex_ 4, 5 | savex_ 6, 7 | savex_ 8, 9 | savex_ 10, 11 | savex_ 12, 13 | savex_ 14, 15 | savex_ 16, 17 | savex_ 18, 19 | savex_ 20, 21 | savex_ 22, 23 | savex_ 24, 25 | savex_ 26, 27 | sdc1 f28, 16+28*8(sp) | sw r28, 16+32*8+28*4(sp) | sdc1 f30, 16+30*8(sp) | sw r30, 16+32*8+30*4(sp) | sw r0, 16+32*8+31*4(sp) // Clear RID_TMP. | li_vmstate EXIT | addiu TMP2, sp, 16+32*8+32*4 // Recompute original value of sp. | addiu DISPATCH, JGL, -GG_DISP2G-32768 | lw TMP1, 0(TMP2) // Load exit number. | st_vmstate | sw TMP2, 16+32*8+29*4(sp) // Store sp in RID_SP. | lw L, DISPATCH_GL(jit_L)(DISPATCH) | lw BASE, DISPATCH_GL(jit_base)(DISPATCH) | load_got lj_trace_exit | sw L, DISPATCH_J(L)(DISPATCH) | sw ra, DISPATCH_J(parent)(DISPATCH) // Store trace number. | sw TMP1, DISPATCH_J(exitno)(DISPATCH) // Store exit number. | addiu CARG1, DISPATCH, GG_DISP2J | sw BASE, L->base | call_intern lj_trace_exit // (jit_State *J, ExitState *ex) |. addiu CARG2, sp, 16 | // Returns MULTRES (unscaled) or negated error code. | lw TMP1, L->cframe | li AT, -4 | lw BASE, L->base | and sp, TMP1, AT | lw PC, SAVE_PC // Get SAVE_PC. | b >1 |. sw L, SAVE_L // Set SAVE_L (on-trace resume/yield). |.endif |->vm_exit_interp: |.if JIT | // CRET1 = MULTRES or negated error code, BASE, PC and JGL set. | lw L, SAVE_L | addiu DISPATCH, JGL, -GG_DISP2G-32768 |1: | bltz CRET1, >3 // Check for error from exit. |. lw LFUNC:TMP1, FRAME_FUNC(BASE) | lui TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | sll MULTRES, CRET1, 3 | li TISNIL, LJ_TNIL | sw MULTRES, SAVE_MULTRES | mtc1 TMP3, TOBIT | lw TMP1, LFUNC:TMP1->pc | sw r0, DISPATCH_GL(jit_L)(DISPATCH) | lw KBASE, PC2PROTO(k)(TMP1) | cvt.d.s TOBIT, TOBIT | // Modified copy of ins_next which handles function header dispatch, too. | lw INS, 0(PC) | addiu PC, PC, 4 | // Assumes TISNIL == ~LJ_VMST_INTERP == -1 | sw TISNIL, DISPATCH_GL(vmstate)(DISPATCH) | decode_OP4a TMP1, INS | decode_OP4b TMP1 | sltiu TMP2, TMP1, BC_FUNCF*4 // Function header? | addu TMP0, DISPATCH, TMP1 | decode_RD8a RD, INS | lw AT, 0(TMP0) | decode_RA8a RA, INS | beqz TMP2, >2 |. decode_RA8b RA | jr AT |. decode_RD8b RD |2: | addiu RC, MULTRES, -8 | jr AT |. addu RA, RA, BASE | |3: // Rethrow error from the right C frame. | load_got lj_err_throw | negu CARG2, CRET1 | call_intern lj_err_throw // (lua_State *L, int errcode) |. move CARG1, L |.endif | |//----------------------------------------------------------------------- |//-- Math helper functions ---------------------------------------------- |//----------------------------------------------------------------------- | |// Modifies AT, TMP0, FRET1, FRET2, f4. Keeps all others incl. FARG1. |.macro vm_round, func | lui TMP0, 0x4330 // Hiword of 2^52 (double). | mtc1 r0, f4 | mtc1 TMP0, f5 | abs.d FRET2, FARG1 // |x| | mfc1 AT, f13 | c.olt.d 0, FRET2, f4 | add.d FRET1, FRET2, f4 // (|x| + 2^52) - 2^52 | bc1f 0, >1 // Truncate only if |x| < 2^52. |. sub.d FRET1, FRET1, f4 | slt AT, AT, r0 |.if "func" == "ceil" | lui TMP0, 0xbff0 // Hiword of -1 (double). Preserves -0. |.else | lui TMP0, 0x3ff0 // Hiword of +1 (double). |.endif |.if "func" == "trunc" | mtc1 TMP0, f5 | c.olt.d 0, FRET2, FRET1 // |x| < result? | sub.d FRET2, FRET1, f4 | movt.d FRET1, FRET2, 0 // If yes, subtract +1. | neg.d FRET2, FRET1 | jr ra |. movn.d FRET1, FRET2, AT // Merge sign bit back in. |.else | neg.d FRET2, FRET1 | mtc1 TMP0, f5 | movn.d FRET1, FRET2, AT // Merge sign bit back in. |.if "func" == "ceil" | c.olt.d 0, FRET1, FARG1 // x > result? |.else | c.olt.d 0, FARG1, FRET1 // x < result? |.endif | sub.d FRET2, FRET1, f4 // If yes, subtract +-1. | jr ra |. movt.d FRET1, FRET2, 0 |.endif |1: | jr ra |. mov.d FRET1, FARG1 |.endmacro | |->vm_floor: | vm_round floor |->vm_ceil: | vm_round ceil |->vm_trunc: |.if JIT | vm_round trunc |.endif | |//----------------------------------------------------------------------- |//-- Miscellaneous functions -------------------------------------------- |//----------------------------------------------------------------------- | |//----------------------------------------------------------------------- |//-- FFI helper functions ----------------------------------------------- |//----------------------------------------------------------------------- | |// Handler for callback functions. Callback slot number in r1, g in r2. |->vm_ffi_callback: |.if FFI |.type CTSTATE, CTState, PC | saveregs | lw CTSTATE, GL:r2->ctype_state | addiu DISPATCH, r2, GG_G2DISP | load_got lj_ccallback_enter | sw r1, CTSTATE->cb.slot | sw CARG1, CTSTATE->cb.gpr[0] | sw CARG2, CTSTATE->cb.gpr[1] | sdc1 FARG1, CTSTATE->cb.fpr[0] | sw CARG3, CTSTATE->cb.gpr[2] | sw CARG4, CTSTATE->cb.gpr[3] | sdc1 FARG2, CTSTATE->cb.fpr[1] | addiu TMP0, sp, CFRAME_SPACE+16 | sw TMP0, CTSTATE->cb.stack | sw r0, SAVE_PC // Any value outside of bytecode is ok. | move CARG2, sp | call_intern lj_ccallback_enter // (CTState *cts, void *cf) |. move CARG1, CTSTATE | // Returns lua_State *. | lw BASE, L:CRET1->base | lw RC, L:CRET1->top | move L, CRET1 | lui TMP3, 0x59c0 // TOBIT = 2^52 + 2^51 (float). | lw LFUNC:RB, FRAME_FUNC(BASE) | mtc1 TMP3, TOBIT | li_vmstate INTERP | li TISNIL, LJ_TNIL | subu RC, RC, BASE | st_vmstate | cvt.d.s TOBIT, TOBIT | ins_callt |.endif | |->cont_ffi_callback: // Return from FFI callback. |.if FFI | load_got lj_ccallback_leave | lw CTSTATE, DISPATCH_GL(ctype_state)(DISPATCH) | sw BASE, L->base | sw RB, L->top | sw L, CTSTATE->L | move CARG2, RA | call_intern lj_ccallback_leave // (CTState *cts, TValue *o) |. move CARG1, CTSTATE | lw CRET1, CTSTATE->cb.gpr[0] | ldc1 FRET1, CTSTATE->cb.fpr[0] | lw CRET2, CTSTATE->cb.gpr[1] | b ->vm_leave_unw |. ldc1 FRET2, CTSTATE->cb.fpr[1] |.endif | |->vm_ffi_call: // Call C function via FFI. | // Caveat: needs special frame unwinding, see below. |.if FFI | .type CCSTATE, CCallState, CARG1 | lw TMP1, CCSTATE->spadj | lbu CARG2, CCSTATE->nsp | move TMP2, sp | subu sp, sp, TMP1 | sw ra, -4(TMP2) | sll CARG2, CARG2, 2 | sw r16, -8(TMP2) | sw CCSTATE, -12(TMP2) | move r16, TMP2 | addiu TMP1, CCSTATE, offsetof(CCallState, stack) | addiu TMP2, sp, 16 | beqz CARG2, >2 |. addu TMP3, TMP1, CARG2 |1: | lw TMP0, 0(TMP1) | addiu TMP1, TMP1, 4 | sltu AT, TMP1, TMP3 | sw TMP0, 0(TMP2) | bnez AT, <1 |. addiu TMP2, TMP2, 4 |2: | lw CFUNCADDR, CCSTATE->func | lw CARG2, CCSTATE->gpr[1] | lw CARG3, CCSTATE->gpr[2] | lw CARG4, CCSTATE->gpr[3] | ldc1 FARG1, CCSTATE->fpr[0] | ldc1 FARG2, CCSTATE->fpr[1] | jalr CFUNCADDR |. lw CARG1, CCSTATE->gpr[0] // Do this last, since CCSTATE is CARG1. | lw CCSTATE:TMP1, -12(r16) | lw TMP2, -8(r16) | lw ra, -4(r16) | sw CRET1, CCSTATE:TMP1->gpr[0] | sw CRET2, CCSTATE:TMP1->gpr[1] | sdc1 FRET1, CCSTATE:TMP1->fpr[0] | sdc1 FRET2, CCSTATE:TMP1->fpr[1] | move sp, r16 | jr ra |. move r16, TMP2 |.endif |// Note: vm_ffi_call must be the last function in this object file! | |//----------------------------------------------------------------------- } /* Generate the code for a single instruction. */ static void build_ins(BuildCtx *ctx, BCOp op, int defop) { int vk = 0; |=>defop: switch (op) { /* -- Comparison ops ---------------------------------------------------- */ /* Remember: all ops branch for a true comparison, fall through otherwise. */ case BC_ISLT: case BC_ISGE: case BC_ISLE: case BC_ISGT: | // RA = src1*8, RD = src2*8, JMP with RD = target | addu CARG2, BASE, RA | addu CARG3, BASE, RD | lw TMP0, HI(CARG2) | lw TMP1, HI(CARG3) | ldc1 f0, 0(CARG2) | ldc1 f2, 0(CARG3) | sltiu TMP0, TMP0, LJ_TISNUM | sltiu TMP1, TMP1, LJ_TISNUM | lhu TMP2, OFS_RD(PC) | and TMP0, TMP0, TMP1 | addiu PC, PC, 4 | beqz TMP0, ->vmeta_comp |. lui TMP1, (-(BCBIAS_J*4 >> 16) & 65535) | decode_RD4b TMP2 | addu TMP2, TMP2, TMP1 if (op == BC_ISLT || op == BC_ISGE) { | c.olt.d f0, f2 } else { | c.ole.d f0, f2 } if (op == BC_ISLT || op == BC_ISLE) { | movf TMP2, r0 } else { | movt TMP2, r0 } | addu PC, PC, TMP2 |1: | ins_next break; case BC_ISEQV: case BC_ISNEV: vk = op == BC_ISEQV; | // RA = src1*8, RD = src2*8, JMP with RD = target | addu RA, BASE, RA | addiu PC, PC, 4 | lw TMP0, HI(RA) | ldc1 f0, 0(RA) | addu RD, BASE, RD | lhu TMP2, -4+OFS_RD(PC) | lw TMP1, HI(RD) | ldc1 f2, 0(RD) | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | sltiu AT, TMP0, LJ_TISNUM | sltiu CARG1, TMP1, LJ_TISNUM | decode_RD4b TMP2 | and AT, AT, CARG1 | beqz AT, >5 |. addu TMP2, TMP2, TMP3 | c.eq.d f0, f2 if (vk) { | movf TMP2, r0 } else { | movt TMP2, r0 } |1: | addu PC, PC, TMP2 | ins_next |5: // Either or both types are not numbers. | lw CARG2, LO(RA) | lw CARG3, LO(RD) |.if FFI | li TMP3, LJ_TCDATA | beq TMP0, TMP3, ->vmeta_equal_cd |.endif |. sltiu AT, TMP0, LJ_TISPRI // Not a primitive? |.if FFI | beq TMP1, TMP3, ->vmeta_equal_cd |.endif |. xor TMP3, CARG2, CARG3 // Same tv? | xor TMP1, TMP1, TMP0 // Same type? | sltiu CARG1, TMP0, LJ_TISTABUD+1 // Table or userdata? | movz TMP3, r0, AT // Ignore tv if primitive. | movn CARG1, r0, TMP1 // Tab/ud and same type? | or AT, TMP1, TMP3 // Same type && (pri||same tv). | movz CARG1, r0, AT | beqz CARG1, <1 // Done if not tab/ud or not same type or same tv. if (vk) { |. movn TMP2, r0, AT } else { |. movz TMP2, r0, AT } | // Different tables or userdatas. Need to check __eq metamethod. | // Field metatable must be at same offset for GCtab and GCudata! | lw TAB:TMP1, TAB:CARG2->metatable | beqz TAB:TMP1, <1 // No metatable? |. nop | lbu TMP1, TAB:TMP1->nomm | andi TMP1, TMP1, 1<vmeta_equal // Handle __eq metamethod. |. li CARG4, 1-vk // ne = 0 or 1. break; case BC_ISEQS: case BC_ISNES: vk = op == BC_ISEQS; | // RA = src*8, RD = str_const*8 (~), JMP with RD = target | addu RA, BASE, RA | addiu PC, PC, 4 | lw TMP0, HI(RA) | srl RD, RD, 1 | lw STR:TMP3, LO(RA) | subu RD, KBASE, RD | lhu TMP2, -4+OFS_RD(PC) |.if FFI | li AT, LJ_TCDATA | beq TMP0, AT, ->vmeta_equal_cd |.endif |. lw STR:TMP1, -4(RD) // KBASE-4-str_const*4 | addiu TMP0, TMP0, -LJ_TSTR | decode_RD4b TMP2 | xor TMP1, STR:TMP1, STR:TMP3 | or TMP0, TMP0, TMP1 | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | addu TMP2, TMP2, TMP3 if (vk) { | movn TMP2, r0, TMP0 } else { | movz TMP2, r0, TMP0 } | addu PC, PC, TMP2 | ins_next break; case BC_ISEQN: case BC_ISNEN: vk = op == BC_ISEQN; | // RA = src*8, RD = num_const*8, JMP with RD = target | addu RA, BASE, RA | addiu PC, PC, 4 | lw TMP0, HI(RA) | ldc1 f0, 0(RA) | addu RD, KBASE, RD | lhu TMP2, -4+OFS_RD(PC) | ldc1 f2, 0(RD) | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | sltiu AT, TMP0, LJ_TISNUM | decode_RD4b TMP2 |.if FFI | beqz AT, >5 |.else | beqz AT, >1 |.endif |. addu TMP2, TMP2, TMP3 | c.eq.d f0, f2 if (vk) { | movf TMP2, r0 | addu PC, PC, TMP2 |1: } else { | movt TMP2, r0 |1: | addu PC, PC, TMP2 } | ins_next |.if FFI |5: | li AT, LJ_TCDATA | beq TMP0, AT, ->vmeta_equal_cd |. nop | b <1 |. nop |.endif break; case BC_ISEQP: case BC_ISNEP: vk = op == BC_ISEQP; | // RA = src*8, RD = primitive_type*8 (~), JMP with RD = target | addu RA, BASE, RA | srl TMP1, RD, 3 | lw TMP0, HI(RA) | lhu TMP2, OFS_RD(PC) | not TMP1, TMP1 | addiu PC, PC, 4 |.if FFI | li AT, LJ_TCDATA | beq TMP0, AT, ->vmeta_equal_cd |.endif |. xor TMP0, TMP0, TMP1 | decode_RD4b TMP2 | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | addu TMP2, TMP2, TMP3 if (vk) { | movn TMP2, r0, TMP0 } else { | movz TMP2, r0, TMP0 } | addu PC, PC, TMP2 | ins_next break; /* -- Unary test and copy ops ------------------------------------------- */ case BC_ISTC: case BC_ISFC: case BC_IST: case BC_ISF: | // RA = dst*8 or unused, RD = src*8, JMP with RD = target | addu RD, BASE, RD | lhu TMP2, OFS_RD(PC) | lw TMP0, HI(RD) | addiu PC, PC, 4 if (op == BC_IST || op == BC_ISF) { | sltiu TMP0, TMP0, LJ_TISTRUECOND | decode_RD4b TMP2 | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | addu TMP2, TMP2, TMP3 if (op == BC_IST) { | movz TMP2, r0, TMP0 } else { | movn TMP2, r0, TMP0 } | addu PC, PC, TMP2 } else { | sltiu TMP0, TMP0, LJ_TISTRUECOND | ldc1 f0, 0(RD) if (op == BC_ISTC) { | beqz TMP0, >1 } else { | bnez TMP0, >1 } |. addu RA, BASE, RA | decode_RD4b TMP2 | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | addu TMP2, TMP2, TMP3 | sdc1 f0, 0(RA) | addu PC, PC, TMP2 |1: } | ins_next break; /* -- Unary ops --------------------------------------------------------- */ case BC_MOV: | // RA = dst*8, RD = src*8 | addu RD, BASE, RD | addu RA, BASE, RA | ldc1 f0, 0(RD) | ins_next1 | sdc1 f0, 0(RA) | ins_next2 break; case BC_NOT: | // RA = dst*8, RD = src*8 | addu RD, BASE, RD | addu RA, BASE, RA | lw TMP0, HI(RD) | li TMP1, LJ_TFALSE | sltiu TMP0, TMP0, LJ_TISTRUECOND | addiu TMP1, TMP0, LJ_TTRUE | ins_next1 | sw TMP1, HI(RA) | ins_next2 break; case BC_UNM: | // RA = dst*8, RD = src*8 | addu CARG3, BASE, RD | addu RA, BASE, RA | lw TMP0, HI(CARG3) | ldc1 f0, 0(CARG3) | sltiu AT, TMP0, LJ_TISNUM | beqz AT, ->vmeta_unm |. neg.d f0, f0 | ins_next1 | sdc1 f0, 0(RA) | ins_next2 break; case BC_LEN: | // RA = dst*8, RD = src*8 | addu CARG2, BASE, RD | addu RA, BASE, RA | lw TMP0, HI(CARG2) | lw CARG1, LO(CARG2) | li AT, LJ_TSTR | bne TMP0, AT, >2 |. li AT, LJ_TTAB | lw CRET1, STR:CARG1->len |1: | mtc1 CRET1, f0 | cvt.d.w f0, f0 | ins_next1 | sdc1 f0, 0(RA) | ins_next2 |2: | bne TMP0, AT, ->vmeta_len |. nop #if LJ_52 | lw TAB:TMP2, TAB:CARG1->metatable | bnez TAB:TMP2, >9 |. nop |3: #endif |->BC_LEN_Z: | load_got lj_tab_len | call_intern lj_tab_len // (GCtab *t) |. nop | // Returns uint32_t (but less than 2^31). | b <1 |. nop #if LJ_52 |9: | lbu TMP0, TAB:TMP2->nomm | andi TMP0, TMP0, 1<vmeta_len |. nop #endif break; /* -- Binary ops -------------------------------------------------------- */ |.macro ins_arithpre ||vk = ((int)op - BC_ADDVN) / (BC_ADDNV-BC_ADDVN); | decode_RB8a RB, INS | decode_RB8b RB | decode_RDtoRC8 RC, RD | // RA = dst*8, RB = src1*8, RC = src2*8 | num_const*8 ||switch (vk) { ||case 0: | addu CARG3, BASE, RB | addu CARG4, KBASE, RC | lw TMP1, HI(CARG3) | ldc1 f20, 0(CARG3) | ldc1 f22, 0(CARG4) | sltiu AT, TMP1, LJ_TISNUM || break; ||case 1: | addu CARG4, BASE, RB | addu CARG3, KBASE, RC | lw TMP1, HI(CARG4) | ldc1 f22, 0(CARG4) | ldc1 f20, 0(CARG3) | sltiu AT, TMP1, LJ_TISNUM || break; ||default: | addu CARG3, BASE, RB | addu CARG4, BASE, RC | lw TMP1, HI(CARG3) | lw TMP2, HI(CARG4) | ldc1 f20, 0(CARG3) | ldc1 f22, 0(CARG4) | sltiu AT, TMP1, LJ_TISNUM | sltiu TMP0, TMP2, LJ_TISNUM | and AT, AT, TMP0 || break; ||} | beqz AT, ->vmeta_arith |. addu RA, BASE, RA |.endmacro | |.macro fpmod, a, b, c |->BC_MODVN_Z: | bal ->vm_floor // floor(b/c) |. div.d FARG1, b, c | mul.d a, FRET1, c | sub.d a, b, a // b - floor(b/c)*c |.endmacro | |.macro ins_arith, ins | ins_arithpre |.if "ins" == "fpmod_" | b ->BC_MODVN_Z // Avoid 3 copies. It's slow anyway. |. nop |.else | ins f0, f20, f22 | ins_next1 | sdc1 f0, 0(RA) | ins_next2 |.endif |.endmacro case BC_ADDVN: case BC_ADDNV: case BC_ADDVV: | ins_arith add.d break; case BC_SUBVN: case BC_SUBNV: case BC_SUBVV: | ins_arith sub.d break; case BC_MULVN: case BC_MULNV: case BC_MULVV: | ins_arith mul.d break; case BC_DIVVN: case BC_DIVNV: case BC_DIVVV: | ins_arith div.d break; case BC_MODVN: | ins_arith fpmod break; case BC_MODNV: case BC_MODVV: | ins_arith fpmod_ break; case BC_POW: | decode_RB8a RB, INS | decode_RB8b RB | decode_RDtoRC8 RC, RD | addu CARG3, BASE, RB | addu CARG4, BASE, RC | lw TMP1, HI(CARG3) | lw TMP2, HI(CARG4) | ldc1 FARG1, 0(CARG3) | ldc1 FARG2, 0(CARG4) | sltiu AT, TMP1, LJ_TISNUM | sltiu TMP0, TMP2, LJ_TISNUM | and AT, AT, TMP0 | load_got pow | beqz AT, ->vmeta_arith |. addu RA, BASE, RA | call_extern |. nop | ins_next1 | sdc1 FRET1, 0(RA) | ins_next2 break; case BC_CAT: | // RA = dst*8, RB = src_start*8, RC = src_end*8 | decode_RB8a RB, INS | decode_RB8b RB | decode_RDtoRC8 RC, RD | subu CARG3, RC, RB | sw BASE, L->base | addu CARG2, BASE, RC | move MULTRES, RB |->BC_CAT_Z: | load_got lj_meta_cat | srl CARG3, CARG3, 3 | sw PC, SAVE_PC | call_intern lj_meta_cat // (lua_State *L, TValue *top, int left) |. move CARG1, L | // Returns NULL (finished) or TValue * (metamethod). | bnez CRET1, ->vmeta_binop |. lw BASE, L->base | addu RB, BASE, MULTRES | ldc1 f0, 0(RB) | addu RA, BASE, RA | ins_next1 | sdc1 f0, 0(RA) // Copy result from RB to RA. | ins_next2 break; /* -- Constant ops ------------------------------------------------------ */ case BC_KSTR: | // RA = dst*8, RD = str_const*8 (~) | srl TMP1, RD, 1 | subu TMP1, KBASE, TMP1 | ins_next1 | lw TMP0, -4(TMP1) // KBASE-4-str_const*4 | addu RA, BASE, RA | li TMP2, LJ_TSTR | sw TMP0, LO(RA) | sw TMP2, HI(RA) | ins_next2 break; case BC_KCDATA: |.if FFI | // RA = dst*8, RD = cdata_const*8 (~) | srl TMP1, RD, 1 | subu TMP1, KBASE, TMP1 | ins_next1 | lw TMP0, -4(TMP1) // KBASE-4-cdata_const*4 | addu RA, BASE, RA | li TMP2, LJ_TCDATA | sw TMP0, LO(RA) | sw TMP2, HI(RA) | ins_next2 |.endif break; case BC_KSHORT: | // RA = dst*8, RD = int16_literal*8 | sra RD, INS, 16 | mtc1 RD, f0 | addu RA, BASE, RA | cvt.d.w f0, f0 | ins_next1 | sdc1 f0, 0(RA) | ins_next2 break; case BC_KNUM: | // RA = dst*8, RD = num_const*8 | addu RD, KBASE, RD | addu RA, BASE, RA | ldc1 f0, 0(RD) | ins_next1 | sdc1 f0, 0(RA) | ins_next2 break; case BC_KPRI: | // RA = dst*8, RD = primitive_type*8 (~) | srl TMP1, RD, 3 | addu RA, BASE, RA | not TMP0, TMP1 | ins_next1 | sw TMP0, HI(RA) | ins_next2 break; case BC_KNIL: | // RA = base*8, RD = end*8 | addu RA, BASE, RA | sw TISNIL, HI(RA) | addiu RA, RA, 8 | addu RD, BASE, RD |1: | sw TISNIL, HI(RA) | slt AT, RA, RD | bnez AT, <1 |. addiu RA, RA, 8 | ins_next_ break; /* -- Upvalue and function ops ------------------------------------------ */ case BC_UGET: | // RA = dst*8, RD = uvnum*8 | lw LFUNC:RB, FRAME_FUNC(BASE) | srl RD, RD, 1 | addu RD, RD, LFUNC:RB | lw UPVAL:RB, LFUNC:RD->uvptr | ins_next1 | lw TMP1, UPVAL:RB->v | ldc1 f0, 0(TMP1) | addu RA, BASE, RA | sdc1 f0, 0(RA) | ins_next2 break; case BC_USETV: | // RA = uvnum*8, RD = src*8 | lw LFUNC:RB, FRAME_FUNC(BASE) | srl RA, RA, 1 | addu RD, BASE, RD | addu RA, RA, LFUNC:RB | ldc1 f0, 0(RD) | lw UPVAL:RB, LFUNC:RA->uvptr | lbu TMP3, UPVAL:RB->marked | lw CARG2, UPVAL:RB->v | andi TMP3, TMP3, LJ_GC_BLACK // isblack(uv) | lbu TMP0, UPVAL:RB->closed | lw TMP2, HI(RD) | sdc1 f0, 0(CARG2) | li AT, LJ_GC_BLACK|1 | or TMP3, TMP3, TMP0 | beq TMP3, AT, >2 // Upvalue is closed and black? |. addiu TMP2, TMP2, -(LJ_TNUMX+1) |1: | ins_next | |2: // Check if new value is collectable. | sltiu AT, TMP2, LJ_TISGCV - (LJ_TNUMX+1) | beqz AT, <1 // tvisgcv(v) |. lw TMP1, LO(RD) | lbu TMP3, GCOBJ:TMP1->gch.marked | andi TMP3, TMP3, LJ_GC_WHITES // iswhite(v) | beqz TMP3, <1 |. load_got lj_gc_barrieruv | // Crossed a write barrier. Move the barrier forward. | call_intern lj_gc_barrieruv // (global_State *g, TValue *tv) |. addiu CARG1, DISPATCH, GG_DISP2G | b <1 |. nop break; case BC_USETS: | // RA = uvnum*8, RD = str_const*8 (~) | lw LFUNC:RB, FRAME_FUNC(BASE) | srl RA, RA, 1 | srl TMP1, RD, 1 | addu RA, RA, LFUNC:RB | subu TMP1, KBASE, TMP1 | lw UPVAL:RB, LFUNC:RA->uvptr | lw STR:TMP1, -4(TMP1) // KBASE-4-str_const*4 | lbu TMP2, UPVAL:RB->marked | lw CARG2, UPVAL:RB->v | lbu TMP3, STR:TMP1->marked | andi AT, TMP2, LJ_GC_BLACK // isblack(uv) | lbu TMP2, UPVAL:RB->closed | li TMP0, LJ_TSTR | sw STR:TMP1, LO(CARG2) | bnez AT, >2 |. sw TMP0, HI(CARG2) |1: | ins_next | |2: // Check if string is white and ensure upvalue is closed. | beqz TMP2, <1 |. andi AT, TMP3, LJ_GC_WHITES // iswhite(str) | beqz AT, <1 |. load_got lj_gc_barrieruv | // Crossed a write barrier. Move the barrier forward. | call_intern lj_gc_barrieruv // (global_State *g, TValue *tv) |. addiu CARG1, DISPATCH, GG_DISP2G | b <1 |. nop break; case BC_USETN: | // RA = uvnum*8, RD = num_const*8 | lw LFUNC:RB, FRAME_FUNC(BASE) | srl RA, RA, 1 | addu RD, KBASE, RD | addu RA, RA, LFUNC:RB | ldc1 f0, 0(RD) | lw UPVAL:RB, LFUNC:RA->uvptr | ins_next1 | lw TMP1, UPVAL:RB->v | sdc1 f0, 0(TMP1) | ins_next2 break; case BC_USETP: | // RA = uvnum*8, RD = primitive_type*8 (~) | lw LFUNC:RB, FRAME_FUNC(BASE) | srl RA, RA, 1 | srl TMP0, RD, 3 | addu RA, RA, LFUNC:RB | not TMP0, TMP0 | lw UPVAL:RB, LFUNC:RA->uvptr | ins_next1 | lw TMP1, UPVAL:RB->v | sw TMP0, HI(TMP1) | ins_next2 break; case BC_UCLO: | // RA = level*8, RD = target | lw TMP2, L->openupval | branch_RD // Do this first since RD is not saved. | load_got lj_func_closeuv | sw BASE, L->base | beqz TMP2, >1 |. move CARG1, L | call_intern lj_func_closeuv // (lua_State *L, TValue *level) |. addu CARG2, BASE, RA | lw BASE, L->base |1: | ins_next break; case BC_FNEW: | // RA = dst*8, RD = proto_const*8 (~) (holding function prototype) | srl TMP1, RD, 1 | load_got lj_func_newL_gc | subu TMP1, KBASE, TMP1 | lw CARG3, FRAME_FUNC(BASE) | lw CARG2, -4(TMP1) // KBASE-4-tab_const*4 | sw BASE, L->base | sw PC, SAVE_PC | // (lua_State *L, GCproto *pt, GCfuncL *parent) | call_intern lj_func_newL_gc |. move CARG1, L | // Returns GCfuncL *. | lw BASE, L->base | li TMP0, LJ_TFUNC | ins_next1 | addu RA, BASE, RA | sw TMP0, HI(RA) | sw LFUNC:CRET1, LO(RA) | ins_next2 break; /* -- Table ops --------------------------------------------------------- */ case BC_TNEW: case BC_TDUP: | // RA = dst*8, RD = (hbits|asize)*8 | tab_const*8 (~) | lw TMP0, DISPATCH_GL(gc.total)(DISPATCH) | lw TMP1, DISPATCH_GL(gc.threshold)(DISPATCH) | sw BASE, L->base | sw PC, SAVE_PC | sltu AT, TMP0, TMP1 | beqz AT, >5 |1: if (op == BC_TNEW) { | load_got lj_tab_new | srl CARG2, RD, 3 | andi CARG2, CARG2, 0x7ff | li TMP0, 0x801 | addiu AT, CARG2, -0x7ff | srl CARG3, RD, 14 | movz CARG2, TMP0, AT | // (lua_State *L, int32_t asize, uint32_t hbits) | call_intern lj_tab_new |. move CARG1, L | // Returns Table *. } else { | load_got lj_tab_dup | srl TMP1, RD, 1 | subu TMP1, KBASE, TMP1 | move CARG1, L | call_intern lj_tab_dup // (lua_State *L, Table *kt) |. lw CARG2, -4(TMP1) // KBASE-4-str_const*4 | // Returns Table *. } | lw BASE, L->base | ins_next1 | addu RA, BASE, RA | li TMP0, LJ_TTAB | sw TAB:CRET1, LO(RA) | sw TMP0, HI(RA) | ins_next2 |5: | load_got lj_gc_step_fixtop | move MULTRES, RD | call_intern lj_gc_step_fixtop // (lua_State *L) |. move CARG1, L | b <1 |. move RD, MULTRES break; case BC_GGET: | // RA = dst*8, RD = str_const*8 (~) case BC_GSET: | // RA = src*8, RD = str_const*8 (~) | lw LFUNC:TMP2, FRAME_FUNC(BASE) | srl TMP1, RD, 1 | subu TMP1, KBASE, TMP1 | lw TAB:RB, LFUNC:TMP2->env | lw STR:RC, -4(TMP1) // KBASE-4-str_const*4 if (op == BC_GGET) { | b ->BC_TGETS_Z } else { | b ->BC_TSETS_Z } |. addu RA, BASE, RA break; case BC_TGETV: | // RA = dst*8, RB = table*8, RC = key*8 | decode_RB8a RB, INS | decode_RB8b RB | decode_RDtoRC8 RC, RD | addu CARG2, BASE, RB | addu CARG3, BASE, RC | lw TMP1, HI(CARG2) | lw TMP2, HI(CARG3) | lw TAB:RB, LO(CARG2) | li AT, LJ_TTAB | ldc1 f0, 0(CARG3) | bne TMP1, AT, ->vmeta_tgetv |. addu RA, BASE, RA | sltiu AT, TMP2, LJ_TISNUM | beqz AT, >5 |. li AT, LJ_TSTR | | // Convert number key to integer, check for integerness and range. | cvt.w.d f2, f0 | lw TMP0, TAB:RB->asize | mfc1 TMP2, f2 | cvt.d.w f4, f2 | lw TMP1, TAB:RB->array | c.eq.d f0, f4 | sltu AT, TMP2, TMP0 | movf AT, r0 | sll TMP2, TMP2, 3 | beqz AT, ->vmeta_tgetv // Integer key and in array part? |. addu TMP2, TMP1, TMP2 | lw TMP0, HI(TMP2) | beq TMP0, TISNIL, >2 |. ldc1 f0, 0(TMP2) |1: | ins_next1 | sdc1 f0, 0(RA) | ins_next2 | |2: // Check for __index if table value is nil. | lw TAB:TMP2, TAB:RB->metatable | beqz TAB:TMP2, <1 // No metatable: done. |. nop | lbu TMP0, TAB:TMP2->nomm | andi TMP0, TMP0, 1<vmeta_tgetv |. nop | |5: | bne TMP2, AT, ->vmeta_tgetv |. lw STR:RC, LO(CARG3) | b ->BC_TGETS_Z // String key? |. nop break; case BC_TGETS: | // RA = dst*8, RB = table*8, RC = str_const*4 (~) | decode_RB8a RB, INS | decode_RB8b RB | addu CARG2, BASE, RB | decode_RC4a RC, INS | lw TMP0, HI(CARG2) | decode_RC4b RC | li AT, LJ_TTAB | lw TAB:RB, LO(CARG2) | subu CARG3, KBASE, RC | lw STR:RC, -4(CARG3) // KBASE-4-str_const*4 | bne TMP0, AT, ->vmeta_tgets1 |. addu RA, BASE, RA |->BC_TGETS_Z: | // TAB:RB = GCtab *, STR:RC = GCstr *, RA = dst*8 | lw TMP0, TAB:RB->hmask | lw TMP1, STR:RC->hash | lw NODE:TMP2, TAB:RB->node | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | sll TMP0, TMP1, 5 | sll TMP1, TMP1, 3 | subu TMP1, TMP0, TMP1 | addu NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) |1: | lw CARG1, offsetof(Node, key)+HI(NODE:TMP2) | lw TMP0, offsetof(Node, key)+LO(NODE:TMP2) | lw NODE:TMP1, NODE:TMP2->next | lw CARG2, offsetof(Node, val)+HI(NODE:TMP2) | addiu CARG1, CARG1, -LJ_TSTR | xor TMP0, TMP0, STR:RC | or AT, CARG1, TMP0 | bnez AT, >4 |. lw TAB:TMP3, TAB:RB->metatable | beq CARG2, TISNIL, >5 // Key found, but nil value? |. lw CARG1, offsetof(Node, val)+LO(NODE:TMP2) |3: | ins_next1 | sw CARG2, HI(RA) | sw CARG1, LO(RA) | ins_next2 | |4: // Follow hash chain. | bnez NODE:TMP1, <1 |. move NODE:TMP2, NODE:TMP1 | // End of hash chain: key not found, nil result. | |5: // Check for __index if table value is nil. | beqz TAB:TMP3, <3 // No metatable: done. |. li CARG2, LJ_TNIL | lbu TMP0, TAB:TMP3->nomm | andi TMP0, TMP0, 1<vmeta_tgets |. nop break; case BC_TGETB: | // RA = dst*8, RB = table*8, RC = index*8 | decode_RB8a RB, INS | decode_RB8b RB | addu CARG2, BASE, RB | decode_RDtoRC8 RC, RD | lw CARG1, HI(CARG2) | li AT, LJ_TTAB | lw TAB:RB, LO(CARG2) | addu RA, BASE, RA | bne CARG1, AT, ->vmeta_tgetb |. srl TMP0, RC, 3 | lw TMP1, TAB:RB->asize | lw TMP2, TAB:RB->array | sltu AT, TMP0, TMP1 | beqz AT, ->vmeta_tgetb |. addu RC, TMP2, RC | lw TMP1, HI(RC) | beq TMP1, TISNIL, >5 |. ldc1 f0, 0(RC) |1: | ins_next1 | sdc1 f0, 0(RA) | ins_next2 | |5: // Check for __index if table value is nil. | lw TAB:TMP2, TAB:RB->metatable | beqz TAB:TMP2, <1 // No metatable: done. |. nop | lbu TMP1, TAB:TMP2->nomm | andi TMP1, TMP1, 1<vmeta_tgetb // Caveat: preserve TMP0! |. nop break; case BC_TSETV: | // RA = src*8, RB = table*8, RC = key*8 | decode_RB8a RB, INS | decode_RB8b RB | decode_RDtoRC8 RC, RD | addu CARG2, BASE, RB | addu CARG3, BASE, RC | lw TMP1, HI(CARG2) | lw TMP2, HI(CARG3) | lw TAB:RB, LO(CARG2) | li AT, LJ_TTAB | ldc1 f0, 0(CARG3) | bne TMP1, AT, ->vmeta_tsetv |. addu RA, BASE, RA | sltiu AT, TMP2, LJ_TISNUM | beqz AT, >5 |. li AT, LJ_TSTR | | // Convert number key to integer, check for integerness and range. | cvt.w.d f2, f0 | lw TMP0, TAB:RB->asize | mfc1 TMP2, f2 | cvt.d.w f4, f2 | lw TMP1, TAB:RB->array | c.eq.d f0, f4 | sltu AT, TMP2, TMP0 | movf AT, r0 | sll TMP2, TMP2, 3 | beqz AT, ->vmeta_tsetv // Integer key and in array part? |. addu TMP1, TMP1, TMP2 | lbu TMP3, TAB:RB->marked | lw TMP0, HI(TMP1) | beq TMP0, TISNIL, >3 |. ldc1 f0, 0(RA) |1: | andi AT, TMP3, LJ_GC_BLACK // isblack(table) | bnez AT, >7 |. sdc1 f0, 0(TMP1) |2: | ins_next | |3: // Check for __newindex if previous value is nil. | lw TAB:TMP2, TAB:RB->metatable | beqz TAB:TMP2, <1 // No metatable: done. |. nop | lbu TMP2, TAB:TMP2->nomm | andi TMP2, TMP2, 1<vmeta_tsetv |. nop | |5: | bne TMP2, AT, ->vmeta_tsetv |. lw STR:RC, LO(CARG3) | b ->BC_TSETS_Z // String key? |. nop | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0, <2 break; case BC_TSETS: | // RA = src*8, RB = table*8, RC = str_const*8 (~) | decode_RB8a RB, INS | decode_RB8b RB | addu CARG2, BASE, RB | decode_RC4a RC, INS | lw TMP0, HI(CARG2) | decode_RC4b RC | li AT, LJ_TTAB | subu CARG3, KBASE, RC | lw TAB:RB, LO(CARG2) | lw STR:RC, -4(CARG3) // KBASE-4-str_const*4 | bne TMP0, AT, ->vmeta_tsets1 |. addu RA, BASE, RA |->BC_TSETS_Z: | // TAB:RB = GCtab *, STR:RC = GCstr *, RA = BASE+src*8 | lw TMP0, TAB:RB->hmask | lw TMP1, STR:RC->hash | lw NODE:TMP2, TAB:RB->node | sb r0, TAB:RB->nomm // Clear metamethod cache. | and TMP1, TMP1, TMP0 // idx = str->hash & tab->hmask | sll TMP0, TMP1, 5 | sll TMP1, TMP1, 3 | subu TMP1, TMP0, TMP1 | addu NODE:TMP2, NODE:TMP2, TMP1 // node = tab->node + (idx*32-idx*8) | ldc1 f20, 0(RA) |1: | lw CARG1, offsetof(Node, key)+HI(NODE:TMP2) | lw TMP0, offsetof(Node, key)+LO(NODE:TMP2) | li AT, LJ_TSTR | lw NODE:TMP1, NODE:TMP2->next | bne CARG1, AT, >5 |. lw CARG2, offsetof(Node, val)+HI(NODE:TMP2) | bne TMP0, STR:RC, >5 |. lbu TMP3, TAB:RB->marked | beq CARG2, TISNIL, >4 // Key found, but nil value? |. lw TAB:TMP0, TAB:RB->metatable |2: | andi AT, TMP3, LJ_GC_BLACK // isblack(table) | bnez AT, >7 |. sdc1 f20, NODE:TMP2->val |3: | ins_next | |4: // Check for __newindex if previous value is nil. | beqz TAB:TMP0, <2 // No metatable: done. |. nop | lbu TMP0, TAB:TMP0->nomm | andi TMP0, TMP0, 1<vmeta_tsets |. nop | |5: // Follow hash chain. | bnez NODE:TMP1, <1 |. move NODE:TMP2, NODE:TMP1 | // End of hash chain: key not found, add a new one | | // But check for __newindex first. | lw TAB:TMP2, TAB:RB->metatable | beqz TAB:TMP2, >6 // No metatable: continue. |. addiu CARG3, DISPATCH, DISPATCH_GL(tmptv) | lbu TMP0, TAB:TMP2->nomm | andi TMP0, TMP0, 1<vmeta_tsets // 'no __newindex' flag NOT set: check. |. li AT, LJ_TSTR |6: | load_got lj_tab_newkey | sw STR:RC, LO(CARG3) | sw AT, HI(CARG3) | sw BASE, L->base | move CARG2, TAB:RB | sw PC, SAVE_PC | call_intern lj_tab_newkey // (lua_State *L, GCtab *t, TValue *k |. move CARG1, L | // Returns TValue *. | lw BASE, L->base | b <3 // No 2nd write barrier needed. |. sdc1 f20, 0(CRET1) | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0, <3 break; case BC_TSETB: | // RA = src*8, RB = table*8, RC = index*8 | decode_RB8a RB, INS | decode_RB8b RB | addu CARG2, BASE, RB | decode_RDtoRC8 RC, RD | lw CARG1, HI(CARG2) | li AT, LJ_TTAB | lw TAB:RB, LO(CARG2) | addu RA, BASE, RA | bne CARG1, AT, ->vmeta_tsetb |. srl TMP0, RC, 3 | lw TMP1, TAB:RB->asize | lw TMP2, TAB:RB->array | sltu AT, TMP0, TMP1 | beqz AT, ->vmeta_tsetb |. addu RC, TMP2, RC | lw TMP1, HI(RC) | lbu TMP3, TAB:RB->marked | beq TMP1, TISNIL, >5 |. ldc1 f0, 0(RA) |1: | andi AT, TMP3, LJ_GC_BLACK // isblack(table) | bnez AT, >7 |. sdc1 f0, 0(RC) |2: | ins_next | |5: // Check for __newindex if previous value is nil. | lw TAB:TMP2, TAB:RB->metatable | beqz TAB:TMP2, <1 // No metatable: done. |. nop | lbu TMP1, TAB:TMP2->nomm | andi TMP1, TMP1, 1<vmeta_tsetb // Caveat: preserve TMP0! |. nop | |7: // Possible table write barrier for the value. Skip valiswhite check. | barrierback TAB:RB, TMP3, TMP0, <2 break; case BC_TSETM: | // RA = base*8 (table at base-1), RD = num_const*8 (start index) | addu RA, BASE, RA |1: | addu TMP3, KBASE, RD | lw TAB:CARG2, -8+LO(RA) // Guaranteed to be a table. | addiu TMP0, MULTRES, -8 | lw TMP3, LO(TMP3) // Integer constant is in lo-word. | beqz TMP0, >4 // Nothing to copy? |. srl CARG3, TMP0, 3 | addu CARG3, CARG3, TMP3 | lw TMP2, TAB:CARG2->asize | sll TMP1, TMP3, 3 | lbu TMP3, TAB:CARG2->marked | lw CARG1, TAB:CARG2->array | sltu AT, TMP2, CARG3 | bnez AT, >5 |. addu TMP2, RA, TMP0 | addu TMP1, TMP1, CARG1 | andi TMP0, TMP3, LJ_GC_BLACK // isblack(table) |3: // Copy result slots to table. | ldc1 f0, 0(RA) | addiu RA, RA, 8 | sltu AT, RA, TMP2 | sdc1 f0, 0(TMP1) | bnez AT, <3 |. addiu TMP1, TMP1, 8 | bnez TMP0, >7 |. nop |4: | ins_next | |5: // Need to resize array part. | load_got lj_tab_reasize | sw BASE, L->base | sw PC, SAVE_PC | move BASE, RD | call_intern lj_tab_reasize // (lua_State *L, GCtab *t, int nasize) |. move CARG1, L | // Must not reallocate the stack. | move RD, BASE | b <1 |. lw BASE, L->base // Reload BASE for lack of a saved register. | |7: // Possible table write barrier for any value. Skip valiswhite check. | barrierback TAB:CARG2, TMP3, TMP0, <4 break; /* -- Calls and vararg handling ----------------------------------------- */ case BC_CALLM: | // RA = base*8, (RB = (nresults+1)*8,) RC = extra_nargs*8 | decode_RDtoRC8 NARGS8:RC, RD | b ->BC_CALL_Z |. addu NARGS8:RC, NARGS8:RC, MULTRES break; case BC_CALL: | // RA = base*8, (RB = (nresults+1)*8,) RC = (nargs+1)*8 | decode_RDtoRC8 NARGS8:RC, RD |->BC_CALL_Z: | move TMP2, BASE | addu BASE, BASE, RA | li AT, LJ_TFUNC | lw TMP0, HI(BASE) | lw LFUNC:RB, LO(BASE) | addiu BASE, BASE, 8 | bne TMP0, AT, ->vmeta_call |. addiu NARGS8:RC, NARGS8:RC, -8 | ins_call break; case BC_CALLMT: | // RA = base*8, (RB = 0,) RC = extra_nargs*8 | addu NARGS8:RD, NARGS8:RD, MULTRES // BC_CALLT gets RC from RD. | // Fall through. Assumes BC_CALLT follows. break; case BC_CALLT: | // RA = base*8, (RB = 0,) RC = (nargs+1)*8 | addu RA, BASE, RA | li AT, LJ_TFUNC | lw TMP0, HI(RA) | lw LFUNC:RB, LO(RA) | move NARGS8:RC, RD | lw TMP1, FRAME_PC(BASE) | addiu RA, RA, 8 | bne TMP0, AT, ->vmeta_callt |. addiu NARGS8:RC, NARGS8:RC, -8 |->BC_CALLT_Z: | andi TMP0, TMP1, FRAME_TYPE // Caveat: preserve TMP0 until the 'or'. | lbu TMP3, LFUNC:RB->ffid | bnez TMP0, >7 |. xori TMP2, TMP1, FRAME_VARG |1: | sw LFUNC:RB, FRAME_FUNC(BASE) // Copy function down, but keep PC. | sltiu AT, TMP3, 2 // (> FF_C) Calling a fast function? | move TMP2, BASE | beqz NARGS8:RC, >3 |. move TMP3, NARGS8:RC |2: | ldc1 f0, 0(RA) | addiu RA, RA, 8 | addiu TMP3, TMP3, -8 | sdc1 f0, 0(TMP2) | bnez TMP3, <2 |. addiu TMP2, TMP2, 8 |3: | or TMP0, TMP0, AT | beqz TMP0, >5 |. nop |4: | ins_callt | |5: // Tailcall to a fast function with a Lua frame below. | lw INS, -4(TMP1) | decode_RA8a RA, INS | decode_RA8b RA | subu TMP1, BASE, RA | lw LFUNC:TMP1, -8+FRAME_FUNC(TMP1) | lw TMP1, LFUNC:TMP1->pc | b <4 |. lw KBASE, PC2PROTO(k)(TMP1) // Need to prepare KBASE. | |7: // Tailcall from a vararg function. | andi AT, TMP2, FRAME_TYPEP | bnez AT, <1 // Vararg frame below? |. subu TMP2, BASE, TMP2 // Relocate BASE down. | move BASE, TMP2 | lw TMP1, FRAME_PC(TMP2) | b <1 |. andi TMP0, TMP1, FRAME_TYPE break; case BC_ITERC: | // RA = base*8, (RB = (nresults+1)*8, RC = (nargs+1)*8 ((2+1)*8)) | move TMP2, BASE | addu BASE, BASE, RA | li AT, LJ_TFUNC | lw TMP1, -24+HI(BASE) | lw LFUNC:RB, -24+LO(BASE) | ldc1 f2, -8(BASE) | ldc1 f0, -16(BASE) | sw TMP1, HI(BASE) // Copy callable. | sw LFUNC:RB, LO(BASE) | sdc1 f2, 16(BASE) // Copy control var. | sdc1 f0, 8(BASE) // Copy state. | addiu BASE, BASE, 8 | bne TMP1, AT, ->vmeta_call |. li NARGS8:RC, 16 // Iterators get 2 arguments. | ins_call break; case BC_ITERN: | // RA = base*8, (RB = (nresults+1)*8, RC = (nargs+1)*8 (2+1)*8) |.if JIT | // NYI: add hotloop, record BC_ITERN. |.endif | addu RA, BASE, RA | lw TAB:RB, -16+LO(RA) | lw RC, -8+LO(RA) // Get index from control var. | lw TMP0, TAB:RB->asize | lw TMP1, TAB:RB->array | addiu PC, PC, 4 |1: // Traverse array part. | sltu AT, RC, TMP0 | beqz AT, >5 // Index points after array part? |. sll TMP3, RC, 3 | addu TMP3, TMP1, TMP3 | lw TMP2, HI(TMP3) | ldc1 f0, 0(TMP3) | mtc1 RC, f2 | lhu RD, -4+OFS_RD(PC) | beq TMP2, TISNIL, <1 // Skip holes in array part. |. addiu RC, RC, 1 | cvt.d.w f2, f2 | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | sdc1 f0, 8(RA) | decode_RD4b RD | addu RD, RD, TMP3 | sw RC, -8+LO(RA) // Update control var. | addu PC, PC, RD | sdc1 f2, 0(RA) |3: | ins_next | |5: // Traverse hash part. | lw TMP1, TAB:RB->hmask | subu RC, RC, TMP0 | lw TMP2, TAB:RB->node |6: | sltu AT, TMP1, RC // End of iteration? Branch to ITERL+1. | bnez AT, <3 |. sll TMP3, RC, 5 | sll RB, RC, 3 | subu TMP3, TMP3, RB | addu NODE:TMP3, TMP3, TMP2 | lw RB, HI(NODE:TMP3) | ldc1 f0, 0(NODE:TMP3) | lhu RD, -4+OFS_RD(PC) | beq RB, TISNIL, <6 // Skip holes in hash part. |. addiu RC, RC, 1 | ldc1 f2, NODE:TMP3->key | lui TMP3, (-(BCBIAS_J*4 >> 16) & 65535) | sdc1 f0, 8(RA) | addu RC, RC, TMP0 | decode_RD4b RD | addu RD, RD, TMP3 | sdc1 f2, 0(RA) | addu PC, PC, RD | b <3 |. sw RC, -8+LO(RA) // Update control var. break; case BC_ISNEXT: | // RA = base*8, RD = target (points to ITERN) | addu RA, BASE, RA | srl TMP0, RD, 1 | lw CARG1, -24+HI(RA) | lw CFUNC:CARG2, -24+LO(RA) | addu TMP0, PC, TMP0 | lw CARG3, -16+HI(RA) | lw CARG4, -8+HI(RA) | li AT, LJ_TFUNC | bne CARG1, AT, >5 |. lui TMP2, (-(BCBIAS_J*4 >> 16) & 65535) | lbu CARG2, CFUNC:CARG2->ffid | addiu CARG3, CARG3, -LJ_TTAB | addiu CARG4, CARG4, -LJ_TNIL | or CARG3, CARG3, CARG4 | addiu CARG2, CARG2, -FF_next_N | or CARG2, CARG2, CARG3 | bnez CARG2, >5 |. lui TMP1, 0xfffe | addu PC, TMP0, TMP2 | ori TMP1, TMP1, 0x7fff | sw r0, -8+LO(RA) // Initialize control var. | sw TMP1, -8+HI(RA) |1: | ins_next |5: // Despecialize bytecode if any of the checks fail. | li TMP3, BC_JMP | li TMP1, BC_ITERC | sb TMP3, -4+OFS_OP(PC) | addu PC, TMP0, TMP2 | b <1 |. sb TMP1, OFS_OP(PC) break; case BC_VARG: | // RA = base*8, RB = (nresults+1)*8, RC = numparams*8 | lw TMP0, FRAME_PC(BASE) | decode_RDtoRC8 RC, RD | decode_RB8a RB, INS | addu RC, BASE, RC | decode_RB8b RB | addu RA, BASE, RA | addiu RC, RC, FRAME_VARG | addu TMP2, RA, RB | addiu TMP3, BASE, -8 // TMP3 = vtop | subu RC, RC, TMP0 // RC = vbase | // Note: RC may now be even _above_ BASE if nargs was < numparams. | beqz RB, >5 // Copy all varargs? |. subu TMP1, TMP3, RC | addiu TMP2, TMP2, -16 |1: // Copy vararg slots to destination slots. | lw CARG1, HI(RC) | sltu AT, RC, TMP3 | lw CARG2, LO(RC) | addiu RC, RC, 8 | movz CARG1, TISNIL, AT | sw CARG1, HI(RA) | sw CARG2, LO(RA) | sltu AT, RA, TMP2 | bnez AT, <1 |. addiu RA, RA, 8 |3: | ins_next | |5: // Copy all varargs. | lw TMP0, L->maxstack | blez TMP1, <3 // No vararg slots? |. li MULTRES, 8 // MULTRES = (0+1)*8 | addu TMP2, RA, TMP1 | sltu AT, TMP0, TMP2 | bnez AT, >7 |. addiu MULTRES, TMP1, 8 |6: | ldc1 f0, 0(RC) | addiu RC, RC, 8 | sdc1 f0, 0(RA) | sltu AT, RC, TMP3 | bnez AT, <6 // More vararg slots? |. addiu RA, RA, 8 | b <3 |. nop | |7: // Grow stack for varargs. | load_got lj_state_growstack | sw RA, L->top | subu RA, RA, BASE | sw BASE, L->base | subu BASE, RC, BASE // Need delta, because BASE may change. | sw PC, SAVE_PC | srl CARG2, TMP1, 3 | call_intern lj_state_growstack // (lua_State *L, int n) |. move CARG1, L | move RC, BASE | lw BASE, L->base | addu RA, BASE, RA | addu RC, BASE, RC | b <6 |. addiu TMP3, BASE, -8 break; /* -- Returns ----------------------------------------------------------- */ case BC_RETM: | // RA = results*8, RD = extra_nresults*8 | addu RD, RD, MULTRES // MULTRES >= 8, so RD >= 8. | // Fall through. Assumes BC_RET follows. break; case BC_RET: | // RA = results*8, RD = (nresults+1)*8 | lw PC, FRAME_PC(BASE) | addu RA, BASE, RA | move MULTRES, RD |1: | andi TMP0, PC, FRAME_TYPE | bnez TMP0, ->BC_RETV_Z |. xori TMP1, PC, FRAME_VARG | |->BC_RET_Z: | // BASE = base, RA = resultptr, RD = (nresults+1)*8, PC = return | lw INS, -4(PC) | addiu TMP2, BASE, -8 | addiu RC, RD, -8 | decode_RA8a TMP0, INS | decode_RB8a RB, INS | decode_RA8b TMP0 | decode_RB8b RB | addu TMP3, TMP2, RB | beqz RC, >3 |. subu BASE, TMP2, TMP0 |2: | ldc1 f0, 0(RA) | addiu RA, RA, 8 | addiu RC, RC, -8 | sdc1 f0, 0(TMP2) | bnez RC, <2 |. addiu TMP2, TMP2, 8 |3: | addiu TMP3, TMP3, -8 |5: | sltu AT, TMP2, TMP3 | bnez AT, >6 |. lw LFUNC:TMP1, FRAME_FUNC(BASE) | ins_next1 | lw TMP1, LFUNC:TMP1->pc | lw KBASE, PC2PROTO(k)(TMP1) | ins_next2 | |6: // Fill up results with nil. | sw TISNIL, HI(TMP2) | b <5 |. addiu TMP2, TMP2, 8 | |->BC_RETV_Z: // Non-standard return case. | andi TMP2, TMP1, FRAME_TYPEP | bnez TMP2, ->vm_return |. nop | // Return from vararg function: relocate BASE down. | subu BASE, BASE, TMP1 | b <1 |. lw PC, FRAME_PC(BASE) break; case BC_RET0: case BC_RET1: | // RA = results*8, RD = (nresults+1)*8 | lw PC, FRAME_PC(BASE) | addu RA, BASE, RA | move MULTRES, RD | andi TMP0, PC, FRAME_TYPE | bnez TMP0, ->BC_RETV_Z |. xori TMP1, PC, FRAME_VARG | | lw INS, -4(PC) | addiu TMP2, BASE, -8 if (op == BC_RET1) { | ldc1 f0, 0(RA) } | decode_RB8a RB, INS | decode_RA8a RA, INS | decode_RB8b RB | decode_RA8b RA if (op == BC_RET1) { | sdc1 f0, 0(TMP2) } | subu BASE, TMP2, RA |5: | sltu AT, RD, RB | bnez AT, >6 |. lw LFUNC:TMP1, FRAME_FUNC(BASE) | ins_next1 | lw TMP1, LFUNC:TMP1->pc | lw KBASE, PC2PROTO(k)(TMP1) | ins_next2 | |6: // Fill up results with nil. | addiu TMP2, TMP2, 8 | addiu RD, RD, 8 | b <5 if (op == BC_RET1) { |. sw TISNIL, HI(TMP2) } else { |. sw TISNIL, -8+HI(TMP2) } break; /* -- Loops and branches ------------------------------------------------ */ case BC_FORL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IFORL follows. break; case BC_JFORI: case BC_JFORL: #if !LJ_HASJIT break; #endif case BC_FORI: case BC_IFORL: | // RA = base*8, RD = target (after end of loop or start of loop) vk = (op == BC_IFORL || op == BC_JFORL); | addu RA, BASE, RA if (vk) { | ldc1 f0, FORL_IDX*8(RA) | ldc1 f4, FORL_STEP*8(RA) | ldc1 f2, FORL_STOP*8(RA) | lw TMP3, FORL_STEP*8+HI(RA) | add.d f0, f0, f4 | sdc1 f0, FORL_IDX*8(RA) } else { | lw TMP1, FORL_IDX*8+HI(RA) | lw TMP3, FORL_STEP*8+HI(RA) | lw TMP2, FORL_STOP*8+HI(RA) | sltiu TMP1, TMP1, LJ_TISNUM | sltiu TMP0, TMP3, LJ_TISNUM | sltiu TMP2, TMP2, LJ_TISNUM | and TMP1, TMP1, TMP0 | and TMP1, TMP1, TMP2 | ldc1 f0, FORL_IDX*8(RA) | beqz TMP1, ->vmeta_for |. ldc1 f2, FORL_STOP*8(RA) } if (op != BC_JFORL) { | srl RD, RD, 1 | lui TMP0, (-(BCBIAS_J*4 >> 16) & 65535) } | c.le.d 0, f0, f2 | c.le.d 1, f2, f0 | sdc1 f0, FORL_EXT*8(RA) if (op == BC_JFORI) { | li TMP1, 1 | li TMP2, 1 | addu TMP0, RD, TMP0 | slt TMP3, TMP3, r0 | movf TMP1, r0, 0 | addu PC, PC, TMP0 | movf TMP2, r0, 1 | lhu RD, -4+OFS_RD(PC) | movn TMP1, TMP2, TMP3 | bnez TMP1, =>BC_JLOOP |. decode_RD8b RD } else if (op == BC_JFORL) { | li TMP1, 1 | li TMP2, 1 | slt TMP3, TMP3, r0 | movf TMP1, r0, 0 | movf TMP2, r0, 1 | movn TMP1, TMP2, TMP3 | bnez TMP1, =>BC_JLOOP |. nop } else { | addu TMP1, RD, TMP0 | slt TMP3, TMP3, r0 | move TMP2, TMP1 if (op == BC_FORI) { | movt TMP1, r0, 0 | movt TMP2, r0, 1 } else { | movf TMP1, r0, 0 | movf TMP2, r0, 1 } | movn TMP1, TMP2, TMP3 | addu PC, PC, TMP1 } | ins_next break; case BC_ITERL: |.if JIT | hotloop |.endif | // Fall through. Assumes BC_IITERL follows. break; case BC_JITERL: #if !LJ_HASJIT break; #endif case BC_IITERL: | // RA = base*8, RD = target | addu RA, BASE, RA | lw TMP1, HI(RA) | beq TMP1, TISNIL, >1 // Stop if iterator returned nil. |. lw TMP2, LO(RA) if (op == BC_JITERL) { | sw TMP1, -8+HI(RA) | b =>BC_JLOOP |. sw TMP2, -8+LO(RA) } else { | branch_RD // Otherwise save control var + branch. | sw TMP1, -8+HI(RA) | sw TMP2, -8+LO(RA) } |1: | ins_next break; case BC_LOOP: | // RA = base*8, RD = target (loop extent) | // Note: RA/RD is only used by trace recorder to determine scope/extent | // This opcode does NOT jump, it's only purpose is to detect a hot loop. |.if JIT | hotloop |.endif | // Fall through. Assumes BC_ILOOP follows. break; case BC_ILOOP: | // RA = base*8, RD = target (loop extent) | ins_next break; case BC_JLOOP: |.if JIT | // RA = base*8 (ignored), RD = traceno*8 | lw TMP1, DISPATCH_J(trace)(DISPATCH) | srl RD, RD, 1 | li AT, 0 | addu TMP1, TMP1, RD | // Traces on MIPS don't store the trace number, so use 0. | sw AT, DISPATCH_GL(vmstate)(DISPATCH) | lw TRACE:TMP2, 0(TMP1) | sw BASE, DISPATCH_GL(jit_base)(DISPATCH) | sw L, DISPATCH_GL(jit_L)(DISPATCH) | lw TMP2, TRACE:TMP2->mcode | jr TMP2 |. addiu JGL, DISPATCH, GG_DISP2G+32768 |.endif break; case BC_JMP: | // RA = base*8 (only used by trace recorder), RD = target | branch_RD | ins_next break; /* -- Function headers -------------------------------------------------- */ case BC_FUNCF: |.if JIT | hotcall |.endif case BC_FUNCV: /* NYI: compiled vararg functions. */ | // Fall through. Assumes BC_IFUNCF/BC_IFUNCV follow. break; case BC_JFUNCF: #if !LJ_HASJIT break; #endif case BC_IFUNCF: | // BASE = new base, RA = BASE+framesize*8, RB = LFUNC, RC = nargs*8 | lw TMP2, L->maxstack | lbu TMP1, -4+PC2PROTO(numparams)(PC) | lw KBASE, -4+PC2PROTO(k)(PC) | sltu AT, TMP2, RA | bnez AT, ->vm_growstack_l |. sll TMP1, TMP1, 3 if (op != BC_JFUNCF) { | ins_next1 } |2: | sltu AT, NARGS8:RC, TMP1 // Check for missing parameters. | bnez AT, >3 |. addu AT, BASE, NARGS8:RC if (op == BC_JFUNCF) { | decode_RD8a RD, INS | b =>BC_JLOOP |. decode_RD8b RD } else { | ins_next2 } | |3: // Clear missing parameters. | sw TISNIL, HI(AT) | b <2 |. addiu NARGS8:RC, NARGS8:RC, 8 break; case BC_JFUNCV: #if !LJ_HASJIT break; #endif | NYI // NYI: compiled vararg functions break; /* NYI: compiled vararg functions. */ case BC_IFUNCV: | // BASE = new base, RA = BASE+framesize*8, RB = LFUNC, RC = nargs*8 | addu TMP1, BASE, RC | lw TMP2, L->maxstack | addu TMP0, RA, RC | sw LFUNC:RB, LO(TMP1) // Store copy of LFUNC. | addiu TMP3, RC, 8+FRAME_VARG | sltu AT, TMP0, TMP2 | lw KBASE, -4+PC2PROTO(k)(PC) | beqz AT, ->vm_growstack_l |. sw TMP3, HI(TMP1) // Store delta + FRAME_VARG. | lbu TMP2, -4+PC2PROTO(numparams)(PC) | move RA, BASE | move RC, TMP1 | ins_next1 | beqz TMP2, >3 |. addiu BASE, TMP1, 8 |1: | lw TMP0, HI(RA) | lw TMP3, LO(RA) | sltu AT, RA, RC // Less args than parameters? | move CARG1, TMP0 | movz TMP0, TISNIL, AT // Clear missing parameters. | movn CARG1, TISNIL, AT // Clear old fixarg slot (help the GC). | sw TMP3, 8+LO(TMP1) | addiu TMP2, TMP2, -1 | sw TMP0, 8+HI(TMP1) | addiu TMP1, TMP1, 8 | sw CARG1, HI(RA) | bnez TMP2, <1 |. addiu RA, RA, 8 |3: | ins_next2 break; case BC_FUNCC: case BC_FUNCCW: | // BASE = new base, RA = BASE+framesize*8, RB = CFUNC, RC = nargs*8 if (op == BC_FUNCC) { | lw CFUNCADDR, CFUNC:RB->f } else { | lw CFUNCADDR, DISPATCH_GL(wrapf)(DISPATCH) } | addu TMP1, RA, NARGS8:RC | lw TMP2, L->maxstack | addu RC, BASE, NARGS8:RC | sw BASE, L->base | sltu AT, TMP2, TMP1 | sw RC, L->top | li_vmstate C if (op == BC_FUNCCW) { | lw CARG2, CFUNC:RB->f } | bnez AT, ->vm_growstack_c // Need to grow stack. |. move CARG1, L | jalr CFUNCADDR // (lua_State *L [, lua_CFunction f]) |. st_vmstate | // Returns nresults. | lw BASE, L->base | sll RD, CRET1, 3 | lw TMP1, L->top | li_vmstate INTERP | lw PC, FRAME_PC(BASE) // Fetch PC of caller. | subu RA, TMP1, RD // RA = L->top - nresults*8 | b ->vm_returnc |. st_vmstate break; /* ---------------------------------------------------------------------- */ default: fprintf(stderr, "Error: undefined opcode BC_%s\n", bc_names[op]); exit(2); break; } } static int build_backend(BuildCtx *ctx) { int op; dasm_growpc(Dst, BC__MAX); build_subroutines(ctx); |.code_op for (op = 0; op < BC__MAX; op++) build_ins(ctx, (BCOp)op, op); return BC__MAX; } /* Emit pseudo frame-info for all assembler functions. */ static void emit_asm_debug(BuildCtx *ctx) { int fcofs = (int)((uint8_t *)ctx->glob[GLOB_vm_ffi_call] - ctx->code); int i; switch (ctx->mode) { case BUILD_elfasm: fprintf(ctx->fp, "\t.section .debug_frame,\"\",@progbits\n"); fprintf(ctx->fp, ".Lframe0:\n" "\t.4byte .LECIE0-.LSCIE0\n" ".LSCIE0:\n" "\t.4byte 0xffffffff\n" "\t.byte 0x1\n" "\t.string \"\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 31\n" "\t.byte 0xc\n\t.uleb128 29\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE0:\n\n"); fprintf(ctx->fp, ".LSFDE0:\n" "\t.4byte .LEFDE0-.LASFDE0\n" ".LASFDE0:\n" "\t.4byte .Lframe0\n" "\t.4byte .Lbegin\n" "\t.4byte %d\n" "\t.byte 0xe\n\t.uleb128 %d\n" "\t.byte 0x9f\n\t.sleb128 1\n" "\t.byte 0x9e\n\t.sleb128 2\n", fcofs, CFRAME_SIZE); for (i = 23; i >= 16; i--) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n", 0x80+i, 26-i); for (i = 30; i >= 20; i -= 2) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n", 0x80+32+i, 42-i); fprintf(ctx->fp, "\t.align 2\n" ".LEFDE0:\n\n"); #if LJ_HASFFI fprintf(ctx->fp, ".LSFDE1:\n" "\t.4byte .LEFDE1-.LASFDE1\n" ".LASFDE1:\n" "\t.4byte .Lframe0\n" "\t.4byte lj_vm_ffi_call\n" "\t.4byte %d\n" "\t.byte 0x9f\n\t.uleb128 1\n" "\t.byte 0x90\n\t.uleb128 2\n" "\t.byte 0xd\n\t.uleb128 0x10\n" "\t.align 2\n" ".LEFDE1:\n\n", (int)ctx->codesz - fcofs); #endif fprintf(ctx->fp, "\t.section .eh_frame,\"aw\",@progbits\n"); fprintf(ctx->fp, "\t.globl lj_err_unwind_dwarf\n" ".Lframe1:\n" "\t.4byte .LECIE1-.LSCIE1\n" ".LSCIE1:\n" "\t.4byte 0\n" "\t.byte 0x1\n" "\t.string \"zPR\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 31\n" "\t.uleb128 6\n" /* augmentation length */ "\t.byte 0\n" "\t.4byte lj_err_unwind_dwarf\n" "\t.byte 0\n" "\t.byte 0xc\n\t.uleb128 29\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE1:\n\n"); fprintf(ctx->fp, ".LSFDE2:\n" "\t.4byte .LEFDE2-.LASFDE2\n" ".LASFDE2:\n" "\t.4byte .LASFDE2-.Lframe1\n" "\t.4byte .Lbegin\n" "\t.4byte %d\n" "\t.uleb128 0\n" /* augmentation length */ "\t.byte 0xe\n\t.uleb128 %d\n" "\t.byte 0x9f\n\t.sleb128 1\n" "\t.byte 0x9e\n\t.sleb128 2\n", fcofs, CFRAME_SIZE); for (i = 23; i >= 16; i--) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n", 0x80+i, 26-i); for (i = 30; i >= 20; i -= 2) fprintf(ctx->fp, "\t.byte %d\n\t.uleb128 %d\n", 0x80+32+i, 42-i); fprintf(ctx->fp, "\t.align 2\n" ".LEFDE2:\n\n"); #if LJ_HASFFI fprintf(ctx->fp, ".Lframe2:\n" "\t.4byte .LECIE2-.LSCIE2\n" ".LSCIE2:\n" "\t.4byte 0\n" "\t.byte 0x1\n" "\t.string \"zR\"\n" "\t.uleb128 0x1\n" "\t.sleb128 -4\n" "\t.byte 31\n" "\t.uleb128 1\n" /* augmentation length */ "\t.byte 0\n" "\t.byte 0xc\n\t.uleb128 29\n\t.uleb128 0\n" "\t.align 2\n" ".LECIE2:\n\n"); fprintf(ctx->fp, ".LSFDE3:\n" "\t.4byte .LEFDE3-.LASFDE3\n" ".LASFDE3:\n" "\t.4byte .LASFDE3-.Lframe2\n" "\t.4byte lj_vm_ffi_call\n" "\t.4byte %d\n" "\t.uleb128 0\n" /* augmentation length */ "\t.byte 0x9f\n\t.uleb128 1\n" "\t.byte 0x90\n\t.uleb128 2\n" "\t.byte 0xd\n\t.uleb128 0x10\n" "\t.align 2\n" ".LEFDE3:\n\n", (int)ctx->codesz - fcofs); #endif break; default: break; } } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_err.c0000644000175000017500000005656113122010155016327 0ustar philphil/* ** Error handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_err_c #define LUA_CORE #include "lj_obj.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_str.h" #include "lj_func.h" #include "lj_state.h" #include "lj_frame.h" #include "lj_ff.h" #include "lj_trace.h" #include "lj_vm.h" /* ** LuaJIT can either use internal or external frame unwinding: ** ** - Internal frame unwinding (INT) is free-standing and doesn't require ** any OS or library support. ** ** - External frame unwinding (EXT) uses the system-provided unwind handler. ** ** Pros and Cons: ** ** - EXT requires unwind tables for *all* functions on the C stack between ** the pcall/catch and the error/throw. This is the default on x64, ** but needs to be manually enabled on x86/PPC for non-C++ code. ** ** - INT is faster when actually throwing errors (but this happens rarely). ** Setting up error handlers is zero-cost in any case. ** ** - EXT provides full interoperability with C++ exceptions. You can throw ** Lua errors or C++ exceptions through a mix of Lua frames and C++ frames. ** C++ destructors are called as needed. C++ exceptions caught by pcall ** are converted to the string "C++ exception". Lua errors can be caught ** with catch (...) in C++. ** ** - INT has only limited support for automatically catching C++ exceptions ** on POSIX systems using DWARF2 stack unwinding. Other systems may use ** the wrapper function feature. Lua errors thrown through C++ frames ** cannot be caught by C++ code and C++ destructors are not run. ** ** EXT is the default on x64 systems, INT is the default on all other systems. ** ** EXT can be manually enabled on POSIX systems using GCC and DWARF2 stack ** unwinding with -DLUAJIT_UNWIND_EXTERNAL. *All* C code must be compiled ** with -funwind-tables (or -fexceptions). This includes LuaJIT itself (set ** TARGET_CFLAGS), all of your C/Lua binding code, all loadable C modules ** and all C libraries that have callbacks which may be used to call back ** into Lua. C++ code must *not* be compiled with -fno-exceptions. ** ** EXT cannot be enabled on WIN32 since system exceptions use code-driven SEH. ** EXT is mandatory on WIN64 since the calling convention has an abundance ** of callee-saved registers (rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15). ** The POSIX/x64 interpreter only saves r12/r13 for INT (e.g. PS4). */ #if defined(__GNUC__) && (LJ_TARGET_X64 || defined(LUAJIT_UNWIND_EXTERNAL)) && !LJ_NO_UNWIND #define LJ_UNWIND_EXT 1 #elif LJ_TARGET_X64 && LJ_TARGET_WINDOWS #define LJ_UNWIND_EXT 1 #endif /* -- Error messages ------------------------------------------------------ */ /* Error message strings. */ LJ_DATADEF const char *lj_err_allmsg = #define ERRDEF(name, msg) msg "\0" #include "lj_errmsg.h" ; /* -- Internal frame unwinding -------------------------------------------- */ /* Unwind Lua stack and move error message to new top. */ LJ_NOINLINE static void unwindstack(lua_State *L, TValue *top) { lj_func_closeuv(L, top); if (top < L->top-1) { copyTV(L, top, L->top-1); L->top = top+1; } lj_state_relimitstack(L); } /* Unwind until stop frame. Optionally cleanup frames. */ static void *err_unwind(lua_State *L, void *stopcf, int errcode) { TValue *frame = L->base-1; void *cf = L->cframe; while (cf) { int32_t nres = cframe_nres(cframe_raw(cf)); if (nres < 0) { /* C frame without Lua frame? */ TValue *top = restorestack(L, -nres); if (frame < top) { /* Frame reached? */ if (errcode) { L->cframe = cframe_prev(cf); L->base = frame+1; unwindstack(L, top); } return cf; } } if (frame <= tvref(L->stack)) break; switch (frame_typep(frame)) { case FRAME_LUA: /* Lua frame. */ case FRAME_LUAP: frame = frame_prevl(frame); break; case FRAME_C: /* C frame. */ #if LJ_HASFFI unwind_c: #endif #if LJ_UNWIND_EXT if (errcode) { L->cframe = cframe_prev(cf); L->base = frame_prevd(frame) + 1; unwindstack(L, frame); } else if (cf != stopcf) { cf = cframe_prev(cf); frame = frame_prevd(frame); break; } return NULL; /* Continue unwinding. */ #else UNUSED(stopcf); cf = cframe_prev(cf); frame = frame_prevd(frame); break; #endif case FRAME_CP: /* Protected C frame. */ if (cframe_canyield(cf)) { /* Resume? */ if (errcode) { hook_leave(G(L)); /* Assumes nobody uses coroutines inside hooks. */ L->cframe = NULL; L->status = (uint8_t)errcode; } return cf; } if (errcode) { L->cframe = cframe_prev(cf); L->base = frame_prevd(frame) + 1; unwindstack(L, frame); } return cf; case FRAME_CONT: /* Continuation frame. */ #if LJ_HASFFI if ((frame-1)->u32.lo == LJ_CONT_FFI_CALLBACK) goto unwind_c; #endif case FRAME_VARG: /* Vararg frame. */ frame = frame_prevd(frame); break; case FRAME_PCALL: /* FF pcall() frame. */ case FRAME_PCALLH: /* FF pcall() frame inside hook. */ if (errcode) { if (errcode == LUA_YIELD) { frame = frame_prevd(frame); break; } if (frame_typep(frame) == FRAME_PCALL) hook_leave(G(L)); L->cframe = cf; L->base = frame_prevd(frame) + 1; unwindstack(L, L->base); } return (void *)((intptr_t)cf | CFRAME_UNWIND_FF); } } /* No C frame. */ if (errcode) { L->cframe = NULL; L->base = tvref(L->stack)+1; unwindstack(L, L->base); if (G(L)->panic) G(L)->panic(L); exit(EXIT_FAILURE); } return L; /* Anything non-NULL will do. */ } /* -- External frame unwinding -------------------------------------------- */ #if defined(__GNUC__) && !LJ_NO_UNWIND && !LJ_ABI_WIN /* ** We have to use our own definitions instead of the mandatory (!) unwind.h, ** since various OS, distros and compilers mess up the header installation. */ typedef struct _Unwind_Exception { uint64_t exclass; void (*excleanup)(int, struct _Unwind_Exception *); uintptr_t p1, p2; } __attribute__((__aligned__)) _Unwind_Exception; typedef struct _Unwind_Context _Unwind_Context; #define _URC_OK 0 #define _URC_FATAL_PHASE1_ERROR 3 #define _URC_HANDLER_FOUND 6 #define _URC_INSTALL_CONTEXT 7 #define _URC_CONTINUE_UNWIND 8 #define _URC_FAILURE 9 #if !LJ_TARGET_ARM extern uintptr_t _Unwind_GetCFA(_Unwind_Context *); extern void _Unwind_SetGR(_Unwind_Context *, int, uintptr_t); extern void _Unwind_SetIP(_Unwind_Context *, uintptr_t); extern void _Unwind_DeleteException(_Unwind_Exception *); extern int _Unwind_RaiseException(_Unwind_Exception *); #define _UA_SEARCH_PHASE 1 #define _UA_CLEANUP_PHASE 2 #define _UA_HANDLER_FRAME 4 #define _UA_FORCE_UNWIND 8 #define LJ_UEXCLASS 0x4c55414a49543200ULL /* LUAJIT2\0 */ #define LJ_UEXCLASS_MAKE(c) (LJ_UEXCLASS | (uint64_t)(c)) #define LJ_UEXCLASS_CHECK(cl) (((cl) ^ LJ_UEXCLASS) <= 0xff) #define LJ_UEXCLASS_ERRCODE(cl) ((int)((cl) & 0xff)) /* DWARF2 personality handler referenced from interpreter .eh_frame. */ LJ_FUNCA int lj_err_unwind_dwarf(int version, int actions, uint64_t uexclass, _Unwind_Exception *uex, _Unwind_Context *ctx) { void *cf; lua_State *L; if (version != 1) return _URC_FATAL_PHASE1_ERROR; UNUSED(uexclass); cf = (void *)_Unwind_GetCFA(ctx); L = cframe_L(cf); if ((actions & _UA_SEARCH_PHASE)) { #if LJ_UNWIND_EXT if (err_unwind(L, cf, 0) == NULL) return _URC_CONTINUE_UNWIND; #endif if (!LJ_UEXCLASS_CHECK(uexclass)) { setstrV(L, L->top++, lj_err_str(L, LJ_ERR_ERRCPP)); } return _URC_HANDLER_FOUND; } if ((actions & _UA_CLEANUP_PHASE)) { int errcode; if (LJ_UEXCLASS_CHECK(uexclass)) { errcode = LJ_UEXCLASS_ERRCODE(uexclass); } else { if ((actions & _UA_HANDLER_FRAME)) _Unwind_DeleteException(uex); errcode = LUA_ERRRUN; } #if LJ_UNWIND_EXT cf = err_unwind(L, cf, errcode); if ((actions & _UA_FORCE_UNWIND)) { return _URC_CONTINUE_UNWIND; } else if (cf) { _Unwind_SetGR(ctx, LJ_TARGET_EHRETREG, errcode); _Unwind_SetIP(ctx, (uintptr_t)(cframe_unwind_ff(cf) ? lj_vm_unwind_ff_eh : lj_vm_unwind_c_eh)); return _URC_INSTALL_CONTEXT; } #if LJ_TARGET_X86ORX64 else if ((actions & _UA_HANDLER_FRAME)) { /* Workaround for ancient libgcc bug. Still present in RHEL 5.5. :-/ ** Real fix: http://gcc.gnu.org/viewcvs/trunk/gcc/unwind-dw2.c?r1=121165&r2=124837&pathrev=153877&diff_format=h */ _Unwind_SetGR(ctx, LJ_TARGET_EHRETREG, errcode); _Unwind_SetIP(ctx, (uintptr_t)lj_vm_unwind_rethrow); return _URC_INSTALL_CONTEXT; } #endif #else /* This is not the proper way to escape from the unwinder. We get away with ** it on non-x64 because the interpreter restores all callee-saved regs. */ lj_err_throw(L, errcode); #endif } return _URC_CONTINUE_UNWIND; } #if LJ_UNWIND_EXT #if LJ_TARGET_OSX || defined(__OpenBSD__) /* Sorry, no thread safety for OSX. Complain to Apple, not me. */ static _Unwind_Exception static_uex; #else static __thread _Unwind_Exception static_uex; #endif /* Raise DWARF2 exception. */ static void err_raise_ext(int errcode) { static_uex.exclass = LJ_UEXCLASS_MAKE(errcode); static_uex.excleanup = NULL; _Unwind_RaiseException(&static_uex); } #endif #else extern void _Unwind_DeleteException(void *); extern int __gnu_unwind_frame (void *, _Unwind_Context *); extern int _Unwind_VRS_Set(_Unwind_Context *, int, uint32_t, int, void *); extern int _Unwind_VRS_Get(_Unwind_Context *, int, uint32_t, int, void *); static inline uint32_t _Unwind_GetGR(_Unwind_Context *ctx, int r) { uint32_t v; _Unwind_VRS_Get(ctx, 0, r, 0, &v); return v; } static inline void _Unwind_SetGR(_Unwind_Context *ctx, int r, uint32_t v) { _Unwind_VRS_Set(ctx, 0, r, 0, &v); } #define _US_VIRTUAL_UNWIND_FRAME 0 #define _US_UNWIND_FRAME_STARTING 1 #define _US_ACTION_MASK 3 #define _US_FORCE_UNWIND 8 /* ARM unwinder personality handler referenced from interpreter .ARM.extab. */ LJ_FUNCA int lj_err_unwind_arm(int state, void *ucb, _Unwind_Context *ctx) { void *cf = (void *)_Unwind_GetGR(ctx, 13); lua_State *L = cframe_L(cf); if ((state & _US_ACTION_MASK) == _US_VIRTUAL_UNWIND_FRAME) { setstrV(L, L->top++, lj_err_str(L, LJ_ERR_ERRCPP)); return _URC_HANDLER_FOUND; } if ((state&(_US_ACTION_MASK|_US_FORCE_UNWIND)) == _US_UNWIND_FRAME_STARTING) { _Unwind_DeleteException(ucb); _Unwind_SetGR(ctx, 15, (uint32_t)(void *)lj_err_throw); _Unwind_SetGR(ctx, 0, (uint32_t)L); _Unwind_SetGR(ctx, 1, (uint32_t)LUA_ERRRUN); return _URC_INSTALL_CONTEXT; } if (__gnu_unwind_frame(ucb, ctx) != _URC_OK) return _URC_FAILURE; return _URC_CONTINUE_UNWIND; } #endif #elif LJ_TARGET_X64 && LJ_ABI_WIN /* ** Someone in Redmond owes me several days of my life. A lot of this is ** undocumented or just plain wrong on MSDN. Some of it can be gathered ** from 3rd party docs or must be found by trial-and-error. They really ** don't want you to write your own language-specific exception handler ** or to interact gracefully with MSVC. :-( ** ** Apparently MSVC doesn't call C++ destructors for foreign exceptions ** unless you compile your C++ code with /EHa. Unfortunately this means ** catch (...) also catches things like access violations. The use of ** _set_se_translator doesn't really help, because it requires /EHa, too. */ #define WIN32_LEAN_AND_MEAN #include /* Taken from: http://www.nynaeve.net/?p=99 */ typedef struct UndocumentedDispatcherContext { ULONG64 ControlPc; ULONG64 ImageBase; PRUNTIME_FUNCTION FunctionEntry; ULONG64 EstablisherFrame; ULONG64 TargetIp; PCONTEXT ContextRecord; void (*LanguageHandler)(void); PVOID HandlerData; PUNWIND_HISTORY_TABLE HistoryTable; ULONG ScopeIndex; ULONG Fill0; } UndocumentedDispatcherContext; /* Another wild guess. */ extern void __DestructExceptionObject(EXCEPTION_RECORD *rec, int nothrow); #ifdef MINGW_SDK_INIT /* Workaround for broken MinGW64 declaration. */ VOID RtlUnwindEx_FIXED(PVOID,PVOID,PVOID,PVOID,PVOID,PVOID) asm("RtlUnwindEx"); #define RtlUnwindEx RtlUnwindEx_FIXED #endif #define LJ_MSVC_EXCODE ((DWORD)0xe06d7363) #define LJ_GCC_EXCODE ((DWORD)0x20474343) #define LJ_EXCODE ((DWORD)0xe24c4a00) #define LJ_EXCODE_MAKE(c) (LJ_EXCODE | (DWORD)(c)) #define LJ_EXCODE_CHECK(cl) (((cl) ^ LJ_EXCODE) <= 0xff) #define LJ_EXCODE_ERRCODE(cl) ((int)((cl) & 0xff)) /* Win64 exception handler for interpreter frame. */ LJ_FUNCA EXCEPTION_DISPOSITION lj_err_unwind_win64(EXCEPTION_RECORD *rec, void *cf, CONTEXT *ctx, UndocumentedDispatcherContext *dispatch) { lua_State *L = cframe_L(cf); int errcode = LJ_EXCODE_CHECK(rec->ExceptionCode) ? LJ_EXCODE_ERRCODE(rec->ExceptionCode) : LUA_ERRRUN; if ((rec->ExceptionFlags & 6)) { /* EH_UNWINDING|EH_EXIT_UNWIND */ /* Unwind internal frames. */ err_unwind(L, cf, errcode); } else { void *cf2 = err_unwind(L, cf, 0); if (cf2) { /* We catch it, so start unwinding the upper frames. */ if (rec->ExceptionCode == LJ_MSVC_EXCODE || rec->ExceptionCode == LJ_GCC_EXCODE) { #if LJ_TARGET_WINDOWS __DestructExceptionObject(rec, 1); #endif setstrV(L, L->top++, lj_err_str(L, LJ_ERR_ERRCPP)); } else if (!LJ_EXCODE_CHECK(rec->ExceptionCode)) { /* Don't catch access violations etc. */ return ExceptionContinueSearch; } /* Unwind the stack and call all handlers for all lower C frames ** (including ourselves) again with EH_UNWINDING set. Then set ** rsp = cf, rax = errcode and jump to the specified target. */ RtlUnwindEx(cf, (void *)((cframe_unwind_ff(cf2) && errcode != LUA_YIELD) ? lj_vm_unwind_ff_eh : lj_vm_unwind_c_eh), rec, (void *)(uintptr_t)errcode, ctx, dispatch->HistoryTable); /* RtlUnwindEx should never return. */ } } return ExceptionContinueSearch; } /* Raise Windows exception. */ static void err_raise_ext(int errcode) { RaiseException(LJ_EXCODE_MAKE(errcode), 1 /* EH_NONCONTINUABLE */, 0, NULL); } #endif /* -- Error handling ------------------------------------------------------ */ /* Throw error. Find catch frame, unwind stack and continue. */ LJ_NOINLINE void LJ_FASTCALL lj_err_throw(lua_State *L, int errcode) { global_State *g = G(L); lj_trace_abort(g); setgcrefnull(g->jit_L); L->status = 0; #if LJ_UNWIND_EXT err_raise_ext(errcode); /* ** A return from this function signals a corrupt C stack that cannot be ** unwound. We have no choice but to call the panic function and exit. ** ** Usually this is caused by a C function without unwind information. ** This should never happen on x64, but may happen if you've manually ** enabled LUAJIT_UNWIND_EXTERNAL and forgot to recompile *every* ** non-C++ file with -funwind-tables. */ if (G(L)->panic) G(L)->panic(L); #else { void *cf = err_unwind(L, NULL, errcode); if (cframe_unwind_ff(cf)) lj_vm_unwind_ff(cframe_raw(cf)); else lj_vm_unwind_c(cframe_raw(cf), errcode); } #endif exit(EXIT_FAILURE); } /* Return string object for error message. */ LJ_NOINLINE GCstr *lj_err_str(lua_State *L, ErrMsg em) { return lj_str_newz(L, err2msg(em)); } /* Out-of-memory error. */ LJ_NOINLINE void lj_err_mem(lua_State *L) { if (L->status == LUA_ERRERR+1) /* Don't touch the stack during lua_open. */ lj_vm_unwind_c(L->cframe, LUA_ERRMEM); setstrV(L, L->top++, lj_err_str(L, LJ_ERR_ERRMEM)); lj_err_throw(L, LUA_ERRMEM); } /* Find error function for runtime errors. Requires an extra stack traversal. */ static ptrdiff_t finderrfunc(lua_State *L) { cTValue *frame = L->base-1, *bot = tvref(L->stack); void *cf = L->cframe; while (frame > bot && cf) { while (cframe_nres(cframe_raw(cf)) < 0) { /* cframe without frame? */ if (frame >= restorestack(L, -cframe_nres(cf))) break; if (cframe_errfunc(cf) >= 0) /* Error handler not inherited (-1)? */ return cframe_errfunc(cf); cf = cframe_prev(cf); /* Else unwind cframe and continue searching. */ if (cf == NULL) return 0; } switch (frame_typep(frame)) { case FRAME_LUA: case FRAME_LUAP: frame = frame_prevl(frame); break; case FRAME_C: cf = cframe_prev(cf); /* fallthrough */ case FRAME_VARG: frame = frame_prevd(frame); break; case FRAME_CONT: #if LJ_HASFFI if ((frame-1)->u32.lo == LJ_CONT_FFI_CALLBACK) cf = cframe_prev(cf); #endif frame = frame_prevd(frame); break; case FRAME_CP: if (cframe_canyield(cf)) return 0; if (cframe_errfunc(cf) >= 0) return cframe_errfunc(cf); frame = frame_prevd(frame); break; case FRAME_PCALL: case FRAME_PCALLH: if (frame_ftsz(frame) >= (ptrdiff_t)(2*sizeof(TValue))) /* xpcall? */ return savestack(L, frame-1); /* Point to xpcall's errorfunc. */ return 0; default: lua_assert(0); return 0; } } return 0; } /* Runtime error. */ LJ_NOINLINE void lj_err_run(lua_State *L) { ptrdiff_t ef = finderrfunc(L); if (ef) { TValue *errfunc = restorestack(L, ef); TValue *top = L->top; lj_trace_abort(G(L)); if (!tvisfunc(errfunc) || L->status == LUA_ERRERR) { setstrV(L, top-1, lj_err_str(L, LJ_ERR_ERRERR)); lj_err_throw(L, LUA_ERRERR); } L->status = LUA_ERRERR; copyTV(L, top, top-1); copyTV(L, top-1, errfunc); L->top = top+1; lj_vm_call(L, top, 1+1); /* Stack: |errfunc|msg| -> |msg| */ } lj_err_throw(L, LUA_ERRRUN); } /* Formatted runtime error message. */ LJ_NORET LJ_NOINLINE static void err_msgv(lua_State *L, ErrMsg em, ...) { const char *msg; va_list argp; va_start(argp, em); if (curr_funcisL(L)) L->top = curr_topL(L); msg = lj_str_pushvf(L, err2msg(em), argp); va_end(argp); lj_debug_addloc(L, msg, L->base-1, NULL); lj_err_run(L); } /* Non-vararg variant for better calling conventions. */ LJ_NOINLINE void lj_err_msg(lua_State *L, ErrMsg em) { err_msgv(L, em); } /* Lexer error. */ LJ_NOINLINE void lj_err_lex(lua_State *L, GCstr *src, const char *tok, BCLine line, ErrMsg em, va_list argp) { char buff[LUA_IDSIZE]; const char *msg; lj_debug_shortname(buff, src); msg = lj_str_pushvf(L, err2msg(em), argp); msg = lj_str_pushf(L, "%s:%d: %s", buff, line, msg); if (tok) lj_str_pushf(L, err2msg(LJ_ERR_XNEAR), msg, tok); lj_err_throw(L, LUA_ERRSYNTAX); } /* Typecheck error for operands. */ LJ_NOINLINE void lj_err_optype(lua_State *L, cTValue *o, ErrMsg opm) { const char *tname = lj_typename(o); const char *opname = err2msg(opm); if (curr_funcisL(L)) { GCproto *pt = curr_proto(L); const BCIns *pc = cframe_Lpc(L) - 1; const char *oname = NULL; const char *kind = lj_debug_slotname(pt, pc, (BCReg)(o-L->base), &oname); if (kind) err_msgv(L, LJ_ERR_BADOPRT, opname, kind, oname, tname); } err_msgv(L, LJ_ERR_BADOPRV, opname, tname); } /* Typecheck error for ordered comparisons. */ LJ_NOINLINE void lj_err_comp(lua_State *L, cTValue *o1, cTValue *o2) { const char *t1 = lj_typename(o1); const char *t2 = lj_typename(o2); err_msgv(L, t1 == t2 ? LJ_ERR_BADCMPV : LJ_ERR_BADCMPT, t1, t2); /* This assumes the two "boolean" entries are commoned by the C compiler. */ } /* Typecheck error for __call. */ LJ_NOINLINE void lj_err_optype_call(lua_State *L, TValue *o) { /* Gross hack if lua_[p]call or pcall/xpcall fail for a non-callable object: ** L->base still points to the caller. So add a dummy frame with L instead ** of a function. See lua_getstack(). */ const BCIns *pc = cframe_Lpc(L); if (((ptrdiff_t)pc & FRAME_TYPE) != FRAME_LUA) { const char *tname = lj_typename(o); setframe_pc(o, pc); setframe_gc(o, obj2gco(L)); L->top = L->base = o+1; err_msgv(L, LJ_ERR_BADCALL, tname); } lj_err_optype(L, o, LJ_ERR_OPCALL); } /* Error in context of caller. */ LJ_NOINLINE void lj_err_callermsg(lua_State *L, const char *msg) { TValue *frame = L->base-1; TValue *pframe = NULL; if (frame_islua(frame)) { pframe = frame_prevl(frame); } else if (frame_iscont(frame)) { #if LJ_HASFFI if ((frame-1)->u32.lo == LJ_CONT_FFI_CALLBACK) { pframe = frame; frame = NULL; } else #endif { pframe = frame_prevd(frame); #if LJ_HASFFI /* Remove frame for FFI metamethods. */ if (frame_func(frame)->c.ffid >= FF_ffi_meta___index && frame_func(frame)->c.ffid <= FF_ffi_meta___tostring) { L->base = pframe+1; L->top = frame; setcframe_pc(cframe_raw(L->cframe), frame_contpc(frame)); } #endif } } lj_debug_addloc(L, msg, pframe, frame); lj_err_run(L); } /* Formatted error in context of caller. */ LJ_NOINLINE void lj_err_callerv(lua_State *L, ErrMsg em, ...) { const char *msg; va_list argp; va_start(argp, em); msg = lj_str_pushvf(L, err2msg(em), argp); va_end(argp); lj_err_callermsg(L, msg); } /* Error in context of caller. */ LJ_NOINLINE void lj_err_caller(lua_State *L, ErrMsg em) { lj_err_callermsg(L, err2msg(em)); } /* Argument error message. */ LJ_NORET LJ_NOINLINE static void err_argmsg(lua_State *L, int narg, const char *msg) { const char *fname = "?"; const char *ftype = lj_debug_funcname(L, L->base - 1, &fname); if (narg < 0 && narg > LUA_REGISTRYINDEX) narg = (int)(L->top - L->base) + narg + 1; if (ftype && ftype[3] == 'h' && --narg == 0) /* Check for "method". */ msg = lj_str_pushf(L, err2msg(LJ_ERR_BADSELF), fname, msg); else msg = lj_str_pushf(L, err2msg(LJ_ERR_BADARG), narg, fname, msg); lj_err_callermsg(L, msg); } /* Formatted argument error. */ LJ_NOINLINE void lj_err_argv(lua_State *L, int narg, ErrMsg em, ...) { const char *msg; va_list argp; va_start(argp, em); msg = lj_str_pushvf(L, err2msg(em), argp); va_end(argp); err_argmsg(L, narg, msg); } /* Argument error. */ LJ_NOINLINE void lj_err_arg(lua_State *L, int narg, ErrMsg em) { err_argmsg(L, narg, err2msg(em)); } /* Typecheck error for arguments. */ LJ_NOINLINE void lj_err_argtype(lua_State *L, int narg, const char *xname) { const char *tname, *msg; if (narg <= LUA_REGISTRYINDEX) { if (narg >= LUA_GLOBALSINDEX) { tname = lj_obj_itypename[~LJ_TTAB]; } else { GCfunc *fn = curr_func(L); int idx = LUA_GLOBALSINDEX - narg; if (idx <= fn->c.nupvalues) tname = lj_typename(&fn->c.upvalue[idx-1]); else tname = lj_obj_typename[0]; } } else { TValue *o = narg < 0 ? L->top + narg : L->base + narg-1; tname = o < L->top ? lj_typename(o) : lj_obj_typename[0]; } msg = lj_str_pushf(L, err2msg(LJ_ERR_BADTYPE), xname, tname); err_argmsg(L, narg, msg); } /* Typecheck error for arguments. */ LJ_NOINLINE void lj_err_argt(lua_State *L, int narg, int tt) { lj_err_argtype(L, narg, lj_obj_typename[tt+1]); } /* -- Public error handling API ------------------------------------------- */ LUA_API lua_CFunction lua_atpanic(lua_State *L, lua_CFunction panicf) { lua_CFunction old = G(L)->panic; G(L)->panic = panicf; return old; } /* Forwarders for the public API (C calling convention and no LJ_NORET). */ LUA_API int lua_error(lua_State *L) { lj_err_run(L); return 0; /* unreachable */ } LUALIB_API int luaL_argerror(lua_State *L, int narg, const char *msg) { err_argmsg(L, narg, msg); return 0; /* unreachable */ } LUALIB_API int luaL_typerror(lua_State *L, int narg, const char *xname) { lj_err_argtype(L, narg, xname); return 0; /* unreachable */ } LUALIB_API void luaL_where(lua_State *L, int level) { int size; cTValue *frame = lj_debug_frame(L, level, &size); lj_debug_addloc(L, "", frame, size ? frame+size : NULL); } LUALIB_API int luaL_error(lua_State *L, const char *fmt, ...) { const char *msg; va_list argp; va_start(argp, fmt); msg = lj_str_pushvf(L, fmt, argp); va_end(argp); lj_err_callermsg(L, msg); return 0; /* unreachable */ } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_iropt.h0000644000175000017500000001350113122010155016664 0ustar philphil/* ** Common header for IR emitter and optimizations. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_IROPT_H #define _LJ_IROPT_H #include #include "lj_obj.h" #include "lj_jit.h" #if LJ_HASJIT /* IR emitter. */ LJ_FUNC void LJ_FASTCALL lj_ir_growtop(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_ir_emit(jit_State *J); /* Save current IR in J->fold.ins, but do not emit it (yet). */ static LJ_AINLINE void lj_ir_set_(jit_State *J, uint16_t ot, IRRef1 a, IRRef1 b) { J->fold.ins.ot = ot; J->fold.ins.op1 = a; J->fold.ins.op2 = b; } #define lj_ir_set(J, ot, a, b) \ lj_ir_set_(J, (uint16_t)(ot), (IRRef1)(a), (IRRef1)(b)) /* Get ref of next IR instruction and optionally grow IR. ** Note: this may invalidate all IRIns*! */ static LJ_AINLINE IRRef lj_ir_nextins(jit_State *J) { IRRef ref = J->cur.nins; if (LJ_UNLIKELY(ref >= J->irtoplim)) lj_ir_growtop(J); J->cur.nins = ref + 1; return ref; } /* Interning of constants. */ LJ_FUNC TRef LJ_FASTCALL lj_ir_kint(jit_State *J, int32_t k); LJ_FUNC void lj_ir_k64_freeall(jit_State *J); LJ_FUNC TRef lj_ir_k64(jit_State *J, IROp op, cTValue *tv); LJ_FUNC cTValue *lj_ir_k64_find(jit_State *J, uint64_t u64); LJ_FUNC TRef lj_ir_knum_u64(jit_State *J, uint64_t u64); LJ_FUNC TRef lj_ir_knumint(jit_State *J, lua_Number n); LJ_FUNC TRef lj_ir_kint64(jit_State *J, uint64_t u64); LJ_FUNC TRef lj_ir_kgc(jit_State *J, GCobj *o, IRType t); LJ_FUNC TRef lj_ir_kptr_(jit_State *J, IROp op, void *ptr); LJ_FUNC TRef lj_ir_knull(jit_State *J, IRType t); LJ_FUNC TRef lj_ir_kslot(jit_State *J, TRef key, IRRef slot); #if LJ_64 #define lj_ir_kintp(J, k) lj_ir_kint64(J, (uint64_t)(k)) #else #define lj_ir_kintp(J, k) lj_ir_kint(J, (int32_t)(k)) #endif static LJ_AINLINE TRef lj_ir_knum(jit_State *J, lua_Number n) { TValue tv; tv.n = n; return lj_ir_knum_u64(J, tv.u64); } #define lj_ir_kstr(J, str) lj_ir_kgc(J, obj2gco((str)), IRT_STR) #define lj_ir_ktab(J, tab) lj_ir_kgc(J, obj2gco((tab)), IRT_TAB) #define lj_ir_kfunc(J, func) lj_ir_kgc(J, obj2gco((func)), IRT_FUNC) #define lj_ir_kptr(J, ptr) lj_ir_kptr_(J, IR_KPTR, (ptr)) #define lj_ir_kkptr(J, ptr) lj_ir_kptr_(J, IR_KKPTR, (ptr)) /* Special FP constants. */ #define lj_ir_knum_zero(J) lj_ir_knum_u64(J, U64x(00000000,00000000)) #define lj_ir_knum_one(J) lj_ir_knum_u64(J, U64x(3ff00000,00000000)) #define lj_ir_knum_tobit(J) lj_ir_knum_u64(J, U64x(43380000,00000000)) /* Special 128 bit SIMD constants. */ #define lj_ir_knum_abs(J) lj_ir_k64(J, IR_KNUM, LJ_KSIMD(J, LJ_KSIMD_ABS)) #define lj_ir_knum_neg(J) lj_ir_k64(J, IR_KNUM, LJ_KSIMD(J, LJ_KSIMD_NEG)) /* Access to constants. */ LJ_FUNC void lj_ir_kvalue(lua_State *L, TValue *tv, const IRIns *ir); /* Convert IR operand types. */ LJ_FUNC TRef LJ_FASTCALL lj_ir_tonumber(jit_State *J, TRef tr); LJ_FUNC TRef LJ_FASTCALL lj_ir_tonum(jit_State *J, TRef tr); LJ_FUNC TRef LJ_FASTCALL lj_ir_tostr(jit_State *J, TRef tr); /* Miscellaneous IR ops. */ LJ_FUNC int lj_ir_numcmp(lua_Number a, lua_Number b, IROp op); LJ_FUNC int lj_ir_strcmp(GCstr *a, GCstr *b, IROp op); LJ_FUNC void lj_ir_rollback(jit_State *J, IRRef ref); /* Emit IR instructions with on-the-fly optimizations. */ LJ_FUNC TRef LJ_FASTCALL lj_opt_fold(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_cse(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_cselim(jit_State *J, IRRef lim); /* Special return values for the fold functions. */ enum { NEXTFOLD, /* Couldn't fold, pass on. */ RETRYFOLD, /* Retry fold with modified fins. */ KINTFOLD, /* Return ref for int constant in fins->i. */ FAILFOLD, /* Guard would always fail. */ DROPFOLD, /* Guard eliminated. */ MAX_FOLD }; #define INTFOLD(k) ((J->fold.ins.i = (k)), (TRef)KINTFOLD) #define INT64FOLD(k) (lj_ir_kint64(J, (k))) #define CONDFOLD(cond) ((TRef)FAILFOLD + (TRef)(cond)) #define LEFTFOLD (J->fold.ins.op1) #define RIGHTFOLD (J->fold.ins.op2) #define CSEFOLD (lj_opt_cse(J)) #define EMITFOLD (lj_ir_emit(J)) /* Load/store forwarding. */ LJ_FUNC TRef LJ_FASTCALL lj_opt_fwd_aload(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_fwd_hload(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_fwd_uload(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_fwd_fload(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_fwd_xload(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_fwd_tab_len(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_fwd_hrefk(jit_State *J); LJ_FUNC int LJ_FASTCALL lj_opt_fwd_href_nokey(jit_State *J); LJ_FUNC int LJ_FASTCALL lj_opt_fwd_tptr(jit_State *J, IRRef lim); LJ_FUNC int lj_opt_fwd_wasnonnil(jit_State *J, IROpT loadop, IRRef xref); /* Dead-store elimination. */ LJ_FUNC TRef LJ_FASTCALL lj_opt_dse_ahstore(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_dse_ustore(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_dse_fstore(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_dse_xstore(jit_State *J); /* Narrowing. */ LJ_FUNC TRef LJ_FASTCALL lj_opt_narrow_convert(jit_State *J); LJ_FUNC TRef LJ_FASTCALL lj_opt_narrow_index(jit_State *J, TRef key); LJ_FUNC TRef LJ_FASTCALL lj_opt_narrow_toint(jit_State *J, TRef tr); LJ_FUNC TRef LJ_FASTCALL lj_opt_narrow_tobit(jit_State *J, TRef tr); #if LJ_HASFFI LJ_FUNC TRef LJ_FASTCALL lj_opt_narrow_cindex(jit_State *J, TRef key); #endif LJ_FUNC TRef lj_opt_narrow_arith(jit_State *J, TRef rb, TRef rc, TValue *vb, TValue *vc, IROp op); LJ_FUNC TRef lj_opt_narrow_unm(jit_State *J, TRef rc, TValue *vc); LJ_FUNC TRef lj_opt_narrow_mod(jit_State *J, TRef rb, TRef rc, TValue *vb, TValue *vc); LJ_FUNC TRef lj_opt_narrow_pow(jit_State *J, TRef rb, TRef rc, TValue *vb, TValue *vc); LJ_FUNC IRType lj_opt_narrow_forl(jit_State *J, cTValue *forbase); /* Optimization passes. */ LJ_FUNC void lj_opt_dce(jit_State *J); LJ_FUNC int lj_opt_loop(jit_State *J); #if LJ_SOFTFP || (LJ_32 && LJ_HASFFI) LJ_FUNC void lj_opt_split(jit_State *J); #else #define lj_opt_split(J) UNUSED(J) #endif LJ_FUNC void lj_opt_sink(jit_State *J); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lib_debug.c0000644000175000017500000002243713122010155016761 0ustar philphil/* ** Debug library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lib_debug_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_lib.h" /* ------------------------------------------------------------------------ */ #define LJLIB_MODULE_debug LJLIB_CF(debug_getregistry) { copyTV(L, L->top++, registry(L)); return 1; } LJLIB_CF(debug_getmetatable) { lj_lib_checkany(L, 1); if (!lua_getmetatable(L, 1)) { setnilV(L->top-1); } return 1; } LJLIB_CF(debug_setmetatable) { lj_lib_checktabornil(L, 2); L->top = L->base+2; lua_setmetatable(L, 1); #if !LJ_52 setboolV(L->top-1, 1); #endif return 1; } LJLIB_CF(debug_getfenv) { lj_lib_checkany(L, 1); lua_getfenv(L, 1); return 1; } LJLIB_CF(debug_setfenv) { lj_lib_checktab(L, 2); L->top = L->base+2; if (!lua_setfenv(L, 1)) lj_err_caller(L, LJ_ERR_SETFENV); return 1; } /* ------------------------------------------------------------------------ */ static void settabss(lua_State *L, const char *i, const char *v) { lua_pushstring(L, v); lua_setfield(L, -2, i); } static void settabsi(lua_State *L, const char *i, int v) { lua_pushinteger(L, v); lua_setfield(L, -2, i); } static void settabsb(lua_State *L, const char *i, int v) { lua_pushboolean(L, v); lua_setfield(L, -2, i); } static lua_State *getthread(lua_State *L, int *arg) { if (L->base < L->top && tvisthread(L->base)) { *arg = 1; return threadV(L->base); } else { *arg = 0; return L; } } static void treatstackoption(lua_State *L, lua_State *L1, const char *fname) { if (L == L1) { lua_pushvalue(L, -2); lua_remove(L, -3); } else lua_xmove(L1, L, 1); lua_setfield(L, -2, fname); } LJLIB_CF(debug_getinfo) { lj_Debug ar; int arg, opt_f = 0, opt_L = 0; lua_State *L1 = getthread(L, &arg); const char *options = luaL_optstring(L, arg+2, "flnSu"); if (lua_isnumber(L, arg+1)) { if (!lua_getstack(L1, (int)lua_tointeger(L, arg+1), (lua_Debug *)&ar)) { setnilV(L->top-1); return 1; } } else if (L->base+arg < L->top && tvisfunc(L->base+arg)) { options = lua_pushfstring(L, ">%s", options); setfuncV(L1, L1->top++, funcV(L->base+arg)); } else { lj_err_arg(L, arg+1, LJ_ERR_NOFUNCL); } if (!lj_debug_getinfo(L1, options, &ar, 1)) lj_err_arg(L, arg+2, LJ_ERR_INVOPT); lua_createtable(L, 0, 16); /* Create result table. */ for (; *options; options++) { switch (*options) { case 'S': settabss(L, "source", ar.source); settabss(L, "short_src", ar.short_src); settabsi(L, "linedefined", ar.linedefined); settabsi(L, "lastlinedefined", ar.lastlinedefined); settabss(L, "what", ar.what); break; case 'l': settabsi(L, "currentline", ar.currentline); break; case 'u': settabsi(L, "nups", ar.nups); settabsi(L, "nparams", ar.nparams); settabsb(L, "isvararg", ar.isvararg); break; case 'n': settabss(L, "name", ar.name); settabss(L, "namewhat", ar.namewhat); break; case 'f': opt_f = 1; break; case 'L': opt_L = 1; break; default: break; } } if (opt_L) treatstackoption(L, L1, "activelines"); if (opt_f) treatstackoption(L, L1, "func"); return 1; /* Return result table. */ } LJLIB_CF(debug_getlocal) { int arg; lua_State *L1 = getthread(L, &arg); lua_Debug ar; const char *name; int slot = lj_lib_checkint(L, arg+2); if (tvisfunc(L->base+arg)) { L->top = L->base+arg+1; lua_pushstring(L, lua_getlocal(L, NULL, slot)); return 1; } if (!lua_getstack(L1, lj_lib_checkint(L, arg+1), &ar)) lj_err_arg(L, arg+1, LJ_ERR_LVLRNG); name = lua_getlocal(L1, &ar, slot); if (name) { lua_xmove(L1, L, 1); lua_pushstring(L, name); lua_pushvalue(L, -2); return 2; } else { setnilV(L->top-1); return 1; } } LJLIB_CF(debug_setlocal) { int arg; lua_State *L1 = getthread(L, &arg); lua_Debug ar; TValue *tv; if (!lua_getstack(L1, lj_lib_checkint(L, arg+1), &ar)) lj_err_arg(L, arg+1, LJ_ERR_LVLRNG); tv = lj_lib_checkany(L, arg+3); copyTV(L1, L1->top++, tv); lua_pushstring(L, lua_setlocal(L1, &ar, lj_lib_checkint(L, arg+2))); return 1; } static int debug_getupvalue(lua_State *L, int get) { int32_t n = lj_lib_checkint(L, 2); const char *name; lj_lib_checkfunc(L, 1); name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n); if (name) { lua_pushstring(L, name); if (!get) return 1; copyTV(L, L->top, L->top-2); L->top++; return 2; } return 0; } LJLIB_CF(debug_getupvalue) { return debug_getupvalue(L, 1); } LJLIB_CF(debug_setupvalue) { lj_lib_checkany(L, 3); return debug_getupvalue(L, 0); } LJLIB_CF(debug_upvalueid) { GCfunc *fn = lj_lib_checkfunc(L, 1); int32_t n = lj_lib_checkint(L, 2) - 1; if ((uint32_t)n >= fn->l.nupvalues) lj_err_arg(L, 2, LJ_ERR_IDXRNG); setlightudV(L->top-1, isluafunc(fn) ? (void *)gcref(fn->l.uvptr[n]) : (void *)&fn->c.upvalue[n]); return 1; } LJLIB_CF(debug_upvaluejoin) { GCfunc *fn[2]; GCRef *p[2]; int i; for (i = 0; i < 2; i++) { int32_t n; fn[i] = lj_lib_checkfunc(L, 2*i+1); if (!isluafunc(fn[i])) lj_err_arg(L, 2*i+1, LJ_ERR_NOLFUNC); n = lj_lib_checkint(L, 2*i+2) - 1; if ((uint32_t)n >= fn[i]->l.nupvalues) lj_err_arg(L, 2*i+2, LJ_ERR_IDXRNG); p[i] = &fn[i]->l.uvptr[n]; } setgcrefr(*p[0], *p[1]); lj_gc_objbarrier(L, fn[0], gcref(*p[1])); return 0; } #if LJ_52 LJLIB_CF(debug_getuservalue) { TValue *o = L->base; if (o < L->top && tvisudata(o)) settabV(L, o, tabref(udataV(o)->env)); else setnilV(o); L->top = o+1; return 1; } LJLIB_CF(debug_setuservalue) { TValue *o = L->base; if (!(o < L->top && tvisudata(o))) lj_err_argt(L, 1, LUA_TUSERDATA); if (!(o+1 < L->top && tvistab(o+1))) lj_err_argt(L, 2, LUA_TTABLE); L->top = o+2; lua_setfenv(L, 1); return 1; } #endif /* ------------------------------------------------------------------------ */ static const char KEY_HOOK = 'h'; static void hookf(lua_State *L, lua_Debug *ar) { static const char *const hooknames[] = {"call", "return", "line", "count", "tail return"}; lua_pushlightuserdata(L, (void *)&KEY_HOOK); lua_rawget(L, LUA_REGISTRYINDEX); if (lua_isfunction(L, -1)) { lua_pushstring(L, hooknames[(int)ar->event]); if (ar->currentline >= 0) lua_pushinteger(L, ar->currentline); else lua_pushnil(L); lua_call(L, 2, 0); } } static int makemask(const char *smask, int count) { int mask = 0; if (strchr(smask, 'c')) mask |= LUA_MASKCALL; if (strchr(smask, 'r')) mask |= LUA_MASKRET; if (strchr(smask, 'l')) mask |= LUA_MASKLINE; if (count > 0) mask |= LUA_MASKCOUNT; return mask; } static char *unmakemask(int mask, char *smask) { int i = 0; if (mask & LUA_MASKCALL) smask[i++] = 'c'; if (mask & LUA_MASKRET) smask[i++] = 'r'; if (mask & LUA_MASKLINE) smask[i++] = 'l'; smask[i] = '\0'; return smask; } LJLIB_CF(debug_sethook) { int arg, mask, count; lua_Hook func; (void)getthread(L, &arg); if (lua_isnoneornil(L, arg+1)) { lua_settop(L, arg+1); func = NULL; mask = 0; count = 0; /* turn off hooks */ } else { const char *smask = luaL_checkstring(L, arg+2); luaL_checktype(L, arg+1, LUA_TFUNCTION); count = luaL_optint(L, arg+3, 0); func = hookf; mask = makemask(smask, count); } lua_pushlightuserdata(L, (void *)&KEY_HOOK); lua_pushvalue(L, arg+1); lua_rawset(L, LUA_REGISTRYINDEX); lua_sethook(L, func, mask, count); return 0; } LJLIB_CF(debug_gethook) { char buff[5]; int mask = lua_gethookmask(L); lua_Hook hook = lua_gethook(L); if (hook != NULL && hook != hookf) { /* external hook? */ lua_pushliteral(L, "external hook"); } else { lua_pushlightuserdata(L, (void *)&KEY_HOOK); lua_rawget(L, LUA_REGISTRYINDEX); /* get hook */ } lua_pushstring(L, unmakemask(mask, buff)); lua_pushinteger(L, lua_gethookcount(L)); return 3; } /* ------------------------------------------------------------------------ */ LJLIB_CF(debug_debug) { for (;;) { char buffer[250]; fputs("lua_debug> ", stderr); if (fgets(buffer, sizeof(buffer), stdin) == 0 || strcmp(buffer, "cont\n") == 0) return 0; if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") || lua_pcall(L, 0, 0, 0)) { fputs(lua_tostring(L, -1), stderr); fputs("\n", stderr); } lua_settop(L, 0); /* remove eventual returns */ } } /* ------------------------------------------------------------------------ */ #define LEVELS1 12 /* size of the first part of the stack */ #define LEVELS2 10 /* size of the second part of the stack */ LJLIB_CF(debug_traceback) { int arg; lua_State *L1 = getthread(L, &arg); const char *msg = lua_tostring(L, arg+1); if (msg == NULL && L->top > L->base+arg) L->top = L->base+arg+1; else luaL_traceback(L, L1, msg, lj_lib_optint(L, arg+2, (L == L1))); return 1; } /* ------------------------------------------------------------------------ */ #include "lj_libdef.h" LUALIB_API int luaopen_debug(lua_State *L) { LJ_LIB_REG(L, LUA_DBLIBNAME, debug); return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_target_mips.h0000644000175000017500000001641613122010155020055 0ustar philphil/* ** Definitions for MIPS CPUs. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_TARGET_MIPS_H #define _LJ_TARGET_MIPS_H /* -- Registers IDs ------------------------------------------------------- */ #define GPRDEF(_) \ _(R0) _(R1) _(R2) _(R3) _(R4) _(R5) _(R6) _(R7) \ _(R8) _(R9) _(R10) _(R11) _(R12) _(R13) _(R14) _(R15) \ _(R16) _(R17) _(R18) _(R19) _(R20) _(R21) _(R22) _(R23) \ _(R24) _(R25) _(SYS1) _(SYS2) _(R28) _(SP) _(R30) _(RA) #define FPRDEF(_) \ _(F0) _(F1) _(F2) _(F3) _(F4) _(F5) _(F6) _(F7) \ _(F8) _(F9) _(F10) _(F11) _(F12) _(F13) _(F14) _(F15) \ _(F16) _(F17) _(F18) _(F19) _(F20) _(F21) _(F22) _(F23) \ _(F24) _(F25) _(F26) _(F27) _(F28) _(F29) _(F30) _(F31) #define VRIDDEF(_) #define RIDENUM(name) RID_##name, enum { GPRDEF(RIDENUM) /* General-purpose registers (GPRs). */ FPRDEF(RIDENUM) /* Floating-point registers (FPRs). */ RID_MAX, RID_ZERO = RID_R0, RID_TMP = RID_RA, /* Calling conventions. */ RID_RET = RID_R2, #if LJ_LE RID_RETHI = RID_R3, RID_RETLO = RID_R2, #else RID_RETHI = RID_R2, RID_RETLO = RID_R3, #endif RID_FPRET = RID_F0, RID_CFUNCADDR = RID_R25, /* These definitions must match with the *.dasc file(s): */ RID_BASE = RID_R16, /* Interpreter BASE. */ RID_LPC = RID_R18, /* Interpreter PC. */ RID_DISPATCH = RID_R19, /* Interpreter DISPATCH table. */ RID_LREG = RID_R20, /* Interpreter L. */ RID_JGL = RID_R30, /* On-trace: global_State + 32768. */ /* Register ranges [min, max) and number of registers. */ RID_MIN_GPR = RID_R0, RID_MAX_GPR = RID_RA+1, RID_MIN_FPR = RID_F0, RID_MAX_FPR = RID_F31+1, RID_NUM_GPR = RID_MAX_GPR - RID_MIN_GPR, RID_NUM_FPR = RID_MAX_FPR - RID_MIN_FPR /* Only even regs are used. */ }; #define RID_NUM_KREF RID_NUM_GPR #define RID_MIN_KREF RID_R0 /* -- Register sets ------------------------------------------------------- */ /* Make use of all registers, except ZERO, TMP, SP, SYS1, SYS2 and JGL. */ #define RSET_FIXED \ (RID2RSET(RID_ZERO)|RID2RSET(RID_TMP)|RID2RSET(RID_SP)|\ RID2RSET(RID_SYS1)|RID2RSET(RID_SYS2)|RID2RSET(RID_JGL)) #define RSET_GPR (RSET_RANGE(RID_MIN_GPR, RID_MAX_GPR) - RSET_FIXED) #define RSET_FPR \ (RID2RSET(RID_F0)|RID2RSET(RID_F2)|RID2RSET(RID_F4)|RID2RSET(RID_F6)|\ RID2RSET(RID_F8)|RID2RSET(RID_F10)|RID2RSET(RID_F12)|RID2RSET(RID_F14)|\ RID2RSET(RID_F16)|RID2RSET(RID_F18)|RID2RSET(RID_F20)|RID2RSET(RID_F22)|\ RID2RSET(RID_F24)|RID2RSET(RID_F26)|RID2RSET(RID_F28)|RID2RSET(RID_F30)) #define RSET_ALL (RSET_GPR|RSET_FPR) #define RSET_INIT RSET_ALL #define RSET_SCRATCH_GPR \ (RSET_RANGE(RID_R1, RID_R15+1)|\ RID2RSET(RID_R24)|RID2RSET(RID_R25)|RID2RSET(RID_R28)) #define RSET_SCRATCH_FPR \ (RID2RSET(RID_F0)|RID2RSET(RID_F2)|RID2RSET(RID_F4)|RID2RSET(RID_F6)|\ RID2RSET(RID_F8)|RID2RSET(RID_F10)|RID2RSET(RID_F12)|RID2RSET(RID_F14)|\ RID2RSET(RID_F16)|RID2RSET(RID_F18)) #define RSET_SCRATCH (RSET_SCRATCH_GPR|RSET_SCRATCH_FPR) #define REGARG_FIRSTGPR RID_R4 #define REGARG_LASTGPR RID_R7 #define REGARG_NUMGPR 4 #define REGARG_FIRSTFPR RID_F12 #define REGARG_LASTFPR RID_F14 #define REGARG_NUMFPR 2 /* -- Spill slots --------------------------------------------------------- */ /* Spill slots are 32 bit wide. An even/odd pair is used for FPRs. ** ** SPS_FIXED: Available fixed spill slots in interpreter frame. ** This definition must match with the *.dasc file(s). ** ** SPS_FIRST: First spill slot for general use. */ #define SPS_FIXED 5 #define SPS_FIRST 4 #define SPOFS_TMP 0 #define sps_scale(slot) (4 * (int32_t)(slot)) #define sps_align(slot) (((slot) - SPS_FIXED + 1) & ~1) /* -- Exit state ---------------------------------------------------------- */ /* This definition must match with the *.dasc file(s). */ typedef struct { lua_Number fpr[RID_NUM_FPR]; /* Floating-point registers. */ int32_t gpr[RID_NUM_GPR]; /* General-purpose registers. */ int32_t spill[256]; /* Spill slots. */ } ExitState; /* Highest exit + 1 indicates stack check. */ #define EXITSTATE_CHECKEXIT 1 /* Return the address of a per-trace exit stub. */ static LJ_AINLINE uint32_t *exitstub_trace_addr_(uint32_t *p) { while (*p == 0x00000000) p++; /* Skip MIPSI_NOP. */ return p; } /* Avoid dependence on lj_jit.h if only including lj_target.h. */ #define exitstub_trace_addr(T, exitno) \ exitstub_trace_addr_((MCode *)((char *)(T)->mcode + (T)->szmcode)) /* -- Instructions -------------------------------------------------------- */ /* Instruction fields. */ #define MIPSF_S(r) ((r) << 21) #define MIPSF_T(r) ((r) << 16) #define MIPSF_D(r) ((r) << 11) #define MIPSF_R(r) ((r) << 21) #define MIPSF_H(r) ((r) << 16) #define MIPSF_G(r) ((r) << 11) #define MIPSF_F(r) ((r) << 6) #define MIPSF_A(n) ((n) << 6) #define MIPSF_M(n) ((n) << 11) typedef enum MIPSIns { /* Integer instructions. */ MIPSI_MOVE = 0x00000021, MIPSI_NOP = 0x00000000, MIPSI_LI = 0x24000000, MIPSI_LU = 0x34000000, MIPSI_LUI = 0x3c000000, MIPSI_ADDIU = 0x24000000, MIPSI_ANDI = 0x30000000, MIPSI_ORI = 0x34000000, MIPSI_XORI = 0x38000000, MIPSI_SLTI = 0x28000000, MIPSI_SLTIU = 0x2c000000, MIPSI_ADDU = 0x00000021, MIPSI_SUBU = 0x00000023, MIPSI_MUL = 0x70000002, MIPSI_AND = 0x00000024, MIPSI_OR = 0x00000025, MIPSI_XOR = 0x00000026, MIPSI_NOR = 0x00000027, MIPSI_SLT = 0x0000002a, MIPSI_SLTU = 0x0000002b, MIPSI_MOVZ = 0x0000000a, MIPSI_MOVN = 0x0000000b, MIPSI_SLL = 0x00000000, MIPSI_SRL = 0x00000002, MIPSI_SRA = 0x00000003, MIPSI_ROTR = 0x00200002, /* MIPS32R2 */ MIPSI_SLLV = 0x00000004, MIPSI_SRLV = 0x00000006, MIPSI_SRAV = 0x00000007, MIPSI_ROTRV = 0x00000046, /* MIPS32R2 */ MIPSI_SEB = 0x7c000420, /* MIPS32R2 */ MIPSI_SEH = 0x7c000620, /* MIPS32R2 */ MIPSI_WSBH = 0x7c0000a0, /* MIPS32R2 */ MIPSI_B = 0x10000000, MIPSI_J = 0x08000000, MIPSI_JAL = 0x0c000000, MIPSI_JR = 0x00000008, MIPSI_JALR = 0x0000f809, MIPSI_BEQ = 0x10000000, MIPSI_BNE = 0x14000000, MIPSI_BLEZ = 0x18000000, MIPSI_BGTZ = 0x1c000000, MIPSI_BLTZ = 0x04000000, MIPSI_BGEZ = 0x04010000, /* Load/store instructions. */ MIPSI_LW = 0x8c000000, MIPSI_SW = 0xac000000, MIPSI_LB = 0x80000000, MIPSI_SB = 0xa0000000, MIPSI_LH = 0x84000000, MIPSI_SH = 0xa4000000, MIPSI_LBU = 0x90000000, MIPSI_LHU = 0x94000000, MIPSI_LWC1 = 0xc4000000, MIPSI_SWC1 = 0xe4000000, MIPSI_LDC1 = 0xd4000000, MIPSI_SDC1 = 0xf4000000, /* FP instructions. */ MIPSI_MOV_S = 0x46000006, MIPSI_MOV_D = 0x46200006, MIPSI_MOVT_D = 0x46210011, MIPSI_MOVF_D = 0x46200011, MIPSI_ABS_D = 0x46200005, MIPSI_NEG_D = 0x46200007, MIPSI_ADD_D = 0x46200000, MIPSI_SUB_D = 0x46200001, MIPSI_MUL_D = 0x46200002, MIPSI_DIV_D = 0x46200003, MIPSI_SQRT_D = 0x46200004, MIPSI_ADD_S = 0x46000000, MIPSI_SUB_S = 0x46000001, MIPSI_CVT_D_S = 0x46000021, MIPSI_CVT_W_S = 0x46000024, MIPSI_CVT_S_D = 0x46200020, MIPSI_CVT_W_D = 0x46200024, MIPSI_CVT_S_W = 0x46800020, MIPSI_CVT_D_W = 0x46800021, MIPSI_TRUNC_W_S = 0x4600000d, MIPSI_TRUNC_W_D = 0x4620000d, MIPSI_FLOOR_W_S = 0x4600000f, MIPSI_FLOOR_W_D = 0x4620000f, MIPSI_MFC1 = 0x44000000, MIPSI_MTC1 = 0x44800000, MIPSI_BC1F = 0x45000000, MIPSI_BC1T = 0x45010000, MIPSI_C_EQ_D = 0x46200032, MIPSI_C_OLT_D = 0x46200034, MIPSI_C_ULT_D = 0x46200035, MIPSI_C_OLE_D = 0x46200036, MIPSI_C_ULE_D = 0x46200037, } MIPSIns; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ircall.h0000644000175000017500000002117413122010155017002 0ustar philphil/* ** IR CALL* instruction definitions. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_IRCALL_H #define _LJ_IRCALL_H #include "lj_obj.h" #include "lj_ir.h" #include "lj_jit.h" /* C call info for CALL* instructions. */ typedef struct CCallInfo { ASMFunction func; /* Function pointer. */ uint32_t flags; /* Number of arguments and flags. */ } CCallInfo; #define CCI_NARGS(ci) ((ci)->flags & 0xff) /* Extract # of args. */ #define CCI_NARGS_MAX 32 /* Max. # of args. */ #define CCI_OTSHIFT 16 #define CCI_OPTYPE(ci) ((ci)->flags >> CCI_OTSHIFT) /* Get op/type. */ #define CCI_OPSHIFT 24 #define CCI_OP(ci) ((ci)->flags >> CCI_OPSHIFT) /* Get op. */ #define CCI_CALL_N (IR_CALLN << CCI_OPSHIFT) #define CCI_CALL_L (IR_CALLL << CCI_OPSHIFT) #define CCI_CALL_S (IR_CALLS << CCI_OPSHIFT) #define CCI_CALL_FN (CCI_CALL_N|CCI_CC_FASTCALL) #define CCI_CALL_FL (CCI_CALL_L|CCI_CC_FASTCALL) #define CCI_CALL_FS (CCI_CALL_S|CCI_CC_FASTCALL) /* C call info flags. */ #define CCI_L 0x0100 /* Implicit L arg. */ #define CCI_CASTU64 0x0200 /* Cast u64 result to number. */ #define CCI_NOFPRCLOBBER 0x0400 /* Does not clobber any FPRs. */ #define CCI_VARARG 0x0800 /* Vararg function. */ #define CCI_CC_MASK 0x3000 /* Calling convention mask. */ #define CCI_CC_SHIFT 12 /* ORDER CC */ #define CCI_CC_CDECL 0x0000 /* Default cdecl calling convention. */ #define CCI_CC_THISCALL 0x1000 /* Thiscall calling convention. */ #define CCI_CC_FASTCALL 0x2000 /* Fastcall calling convention. */ #define CCI_CC_STDCALL 0x3000 /* Stdcall calling convention. */ /* Helpers for conditional function definitions. */ #define IRCALLCOND_ANY(x) x #if LJ_TARGET_X86ORX64 #define IRCALLCOND_FPMATH(x) NULL #else #define IRCALLCOND_FPMATH(x) x #endif #if LJ_SOFTFP #define IRCALLCOND_SOFTFP(x) x #if LJ_HASFFI #define IRCALLCOND_SOFTFP_FFI(x) x #else #define IRCALLCOND_SOFTFP_FFI(x) NULL #endif #else #define IRCALLCOND_SOFTFP(x) NULL #define IRCALLCOND_SOFTFP_FFI(x) NULL #endif #define LJ_NEED_FP64 (LJ_TARGET_ARM || LJ_TARGET_PPC || LJ_TARGET_MIPS) #if LJ_HASFFI && (LJ_SOFTFP || LJ_NEED_FP64) #define IRCALLCOND_FP64_FFI(x) x #else #define IRCALLCOND_FP64_FFI(x) NULL #endif #if LJ_HASFFI #define IRCALLCOND_FFI(x) x #if LJ_32 #define IRCALLCOND_FFI32(x) x #else #define IRCALLCOND_FFI32(x) NULL #endif #else #define IRCALLCOND_FFI(x) NULL #define IRCALLCOND_FFI32(x) NULL #endif #if LJ_SOFTFP #define ARG1_FP 2 /* Treat as 2 32 bit arguments. */ #else #define ARG1_FP 1 #endif #if LJ_32 #define ARG2_64 4 /* Treat as 4 32 bit arguments. */ #else #define ARG2_64 2 #endif /* Function definitions for CALL* instructions. */ #define IRCALLDEF(_) \ _(ANY, lj_str_cmp, 2, FN, INT, CCI_NOFPRCLOBBER) \ _(ANY, lj_str_new, 3, S, STR, CCI_L) \ _(ANY, lj_strscan_num, 2, FN, INT, 0) \ _(ANY, lj_str_fromint, 2, FN, STR, CCI_L) \ _(ANY, lj_str_fromnum, 2, FN, STR, CCI_L) \ _(ANY, lj_tab_new1, 2, FS, TAB, CCI_L) \ _(ANY, lj_tab_dup, 2, FS, TAB, CCI_L) \ _(ANY, lj_tab_newkey, 3, S, P32, CCI_L) \ _(ANY, lj_tab_len, 1, FL, INT, 0) \ _(ANY, lj_gc_step_jit, 2, FS, NIL, CCI_L) \ _(ANY, lj_gc_barrieruv, 2, FS, NIL, 0) \ _(ANY, lj_mem_newgco, 2, FS, P32, CCI_L) \ _(ANY, lj_math_random_step, 1, FS, NUM, CCI_CASTU64) \ _(ANY, lj_vm_modi, 2, FN, INT, 0) \ _(ANY, sinh, ARG1_FP, N, NUM, 0) \ _(ANY, cosh, ARG1_FP, N, NUM, 0) \ _(ANY, tanh, ARG1_FP, N, NUM, 0) \ _(ANY, fputc, 2, S, INT, 0) \ _(ANY, fwrite, 4, S, INT, 0) \ _(ANY, fflush, 1, S, INT, 0) \ /* ORDER FPM */ \ _(FPMATH, lj_vm_floor, ARG1_FP, N, NUM, 0) \ _(FPMATH, lj_vm_ceil, ARG1_FP, N, NUM, 0) \ _(FPMATH, lj_vm_trunc, ARG1_FP, N, NUM, 0) \ _(FPMATH, sqrt, ARG1_FP, N, NUM, 0) \ _(FPMATH, exp, ARG1_FP, N, NUM, 0) \ _(FPMATH, lj_vm_exp2, ARG1_FP, N, NUM, 0) \ _(FPMATH, log, ARG1_FP, N, NUM, 0) \ _(FPMATH, lj_vm_log2, ARG1_FP, N, NUM, 0) \ _(FPMATH, log10, ARG1_FP, N, NUM, 0) \ _(FPMATH, sin, ARG1_FP, N, NUM, 0) \ _(FPMATH, cos, ARG1_FP, N, NUM, 0) \ _(FPMATH, tan, ARG1_FP, N, NUM, 0) \ _(FPMATH, lj_vm_powi, ARG1_FP+1, N, NUM, 0) \ _(FPMATH, pow, ARG1_FP*2, N, NUM, 0) \ _(FPMATH, atan2, ARG1_FP*2, N, NUM, 0) \ _(FPMATH, ldexp, ARG1_FP+1, N, NUM, 0) \ _(SOFTFP, lj_vm_tobit, 2, N, INT, 0) \ _(SOFTFP, softfp_add, 4, N, NUM, 0) \ _(SOFTFP, softfp_sub, 4, N, NUM, 0) \ _(SOFTFP, softfp_mul, 4, N, NUM, 0) \ _(SOFTFP, softfp_div, 4, N, NUM, 0) \ _(SOFTFP, softfp_cmp, 4, N, NIL, 0) \ _(SOFTFP, softfp_i2d, 1, N, NUM, 0) \ _(SOFTFP, softfp_d2i, 2, N, INT, 0) \ _(SOFTFP_FFI, softfp_ui2d, 1, N, NUM, 0) \ _(SOFTFP_FFI, softfp_f2d, 1, N, NUM, 0) \ _(SOFTFP_FFI, softfp_d2ui, 2, N, INT, 0) \ _(SOFTFP_FFI, softfp_d2f, 2, N, FLOAT, 0) \ _(SOFTFP_FFI, softfp_i2f, 1, N, FLOAT, 0) \ _(SOFTFP_FFI, softfp_ui2f, 1, N, FLOAT, 0) \ _(SOFTFP_FFI, softfp_f2i, 1, N, INT, 0) \ _(SOFTFP_FFI, softfp_f2ui, 1, N, INT, 0) \ _(FP64_FFI, fp64_l2d, 2, N, NUM, 0) \ _(FP64_FFI, fp64_ul2d, 2, N, NUM, 0) \ _(FP64_FFI, fp64_l2f, 2, N, FLOAT, 0) \ _(FP64_FFI, fp64_ul2f, 2, N, FLOAT, 0) \ _(FP64_FFI, fp64_d2l, ARG1_FP, N, I64, 0) \ _(FP64_FFI, fp64_d2ul, ARG1_FP, N, U64, 0) \ _(FP64_FFI, fp64_f2l, 1, N, I64, 0) \ _(FP64_FFI, fp64_f2ul, 1, N, U64, 0) \ _(FFI, lj_carith_divi64, ARG2_64, N, I64, CCI_NOFPRCLOBBER) \ _(FFI, lj_carith_divu64, ARG2_64, N, U64, CCI_NOFPRCLOBBER) \ _(FFI, lj_carith_modi64, ARG2_64, N, I64, CCI_NOFPRCLOBBER) \ _(FFI, lj_carith_modu64, ARG2_64, N, U64, CCI_NOFPRCLOBBER) \ _(FFI, lj_carith_powi64, ARG2_64, N, I64, CCI_NOFPRCLOBBER) \ _(FFI, lj_carith_powu64, ARG2_64, N, U64, CCI_NOFPRCLOBBER) \ _(FFI, lj_cdata_setfin, 2, FN, P32, CCI_L) \ _(FFI, strlen, 1, L, INTP, 0) \ _(FFI, memcpy, 3, S, PTR, 0) \ _(FFI, memset, 3, S, PTR, 0) \ _(FFI, lj_vm_errno, 0, S, INT, CCI_NOFPRCLOBBER) \ _(FFI32, lj_carith_mul64, ARG2_64, N, I64, CCI_NOFPRCLOBBER) \ /* End of list. */ typedef enum { #define IRCALLENUM(cond, name, nargs, kind, type, flags) IRCALL_##name, IRCALLDEF(IRCALLENUM) #undef IRCALLENUM IRCALL__MAX } IRCallID; LJ_FUNC TRef lj_ir_call(jit_State *J, IRCallID id, ...); LJ_DATA const CCallInfo lj_ir_callinfo[IRCALL__MAX+1]; /* Soft-float declarations. */ #if LJ_SOFTFP #if LJ_TARGET_ARM #define softfp_add __aeabi_dadd #define softfp_sub __aeabi_dsub #define softfp_mul __aeabi_dmul #define softfp_div __aeabi_ddiv #define softfp_cmp __aeabi_cdcmple #define softfp_i2d __aeabi_i2d #define softfp_d2i __aeabi_d2iz #define softfp_ui2d __aeabi_ui2d #define softfp_f2d __aeabi_f2d #define softfp_d2ui __aeabi_d2uiz #define softfp_d2f __aeabi_d2f #define softfp_i2f __aeabi_i2f #define softfp_ui2f __aeabi_ui2f #define softfp_f2i __aeabi_f2iz #define softfp_f2ui __aeabi_f2uiz #define fp64_l2d __aeabi_l2d #define fp64_ul2d __aeabi_ul2d #define fp64_l2f __aeabi_l2f #define fp64_ul2f __aeabi_ul2f #if LJ_TARGET_IOS #define fp64_d2l __fixdfdi #define fp64_d2ul __fixunsdfdi #define fp64_f2l __fixsfdi #define fp64_f2ul __fixunssfdi #else #define fp64_d2l __aeabi_d2lz #define fp64_d2ul __aeabi_d2ulz #define fp64_f2l __aeabi_f2lz #define fp64_f2ul __aeabi_f2ulz #endif #else #error "Missing soft-float definitions for target architecture" #endif extern double softfp_add(double a, double b); extern double softfp_sub(double a, double b); extern double softfp_mul(double a, double b); extern double softfp_div(double a, double b); extern void softfp_cmp(double a, double b); extern double softfp_i2d(int32_t a); extern int32_t softfp_d2i(double a); #if LJ_HASFFI extern double softfp_ui2d(uint32_t a); extern double softfp_f2d(float a); extern uint32_t softfp_d2ui(double a); extern float softfp_d2f(double a); extern float softfp_i2f(int32_t a); extern float softfp_ui2f(uint32_t a); extern int32_t softfp_f2i(float a); extern uint32_t softfp_f2ui(float a); #endif #endif #if LJ_HASFFI && LJ_NEED_FP64 && !(LJ_TARGET_ARM && LJ_SOFTFP) #ifdef __GNUC__ #define fp64_l2d __floatdidf #define fp64_ul2d __floatundidf #define fp64_l2f __floatdisf #define fp64_ul2f __floatundisf #define fp64_d2l __fixdfdi #define fp64_d2ul __fixunsdfdi #define fp64_f2l __fixsfdi #define fp64_f2ul __fixunssfdi #else #error "Missing fp64 helper definitions for this compiler" #endif #endif #if LJ_HASFFI && (LJ_SOFTFP || LJ_NEED_FP64) extern double fp64_l2d(int64_t a); extern double fp64_ul2d(uint64_t a); extern float fp64_l2f(int64_t a); extern float fp64_ul2f(uint64_t a); extern int64_t fp64_d2l(double a); extern uint64_t fp64_d2ul(double a); extern int64_t fp64_f2l(float a); extern uint64_t fp64_f2ul(float a); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj.supp0000644000175000017500000000111513122010155016205 0ustar philphil# Valgrind suppression file for LuaJIT 2.0. { Optimized string compare Memcheck:Addr4 fun:lj_str_cmp } { Optimized string compare Memcheck:Addr1 fun:lj_str_cmp } { Optimized string compare Memcheck:Addr4 fun:lj_str_new } { Optimized string compare Memcheck:Addr1 fun:lj_str_new } { Optimized string compare Memcheck:Cond fun:lj_str_new } { Optimized string compare Memcheck:Addr4 fun:str_fastcmp } { Optimized string compare Memcheck:Addr1 fun:str_fastcmp } { Optimized string compare Memcheck:Cond fun:str_fastcmp } wcc-0.0.2/src/wsh/luajit-2.0/src/lua.hpp0000644000175000017500000000020713122010155016162 0ustar philphil// C++ wrapper for LuaJIT header files. extern "C" { #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "luajit.h" } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_cparse.h0000644000175000017500000000421313122010155017004 0ustar philphil/* ** C declaration parser. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CPARSE_H #define _LJ_CPARSE_H #include "lj_obj.h" #include "lj_ctype.h" #if LJ_HASFFI /* C parser limits. */ #define CPARSE_MAX_BUF 32768 /* Max. token buffer size. */ #define CPARSE_MAX_DECLSTACK 100 /* Max. declaration stack depth. */ #define CPARSE_MAX_DECLDEPTH 20 /* Max. recursive declaration depth. */ #define CPARSE_MAX_PACKSTACK 7 /* Max. pack pragma stack depth. */ /* Flags for C parser mode. */ #define CPARSE_MODE_MULTI 1 /* Process multiple declarations. */ #define CPARSE_MODE_ABSTRACT 2 /* Accept abstract declarators. */ #define CPARSE_MODE_DIRECT 4 /* Accept direct declarators. */ #define CPARSE_MODE_FIELD 8 /* Accept field width in bits, too. */ #define CPARSE_MODE_NOIMPLICIT 16 /* Reject implicit declarations. */ #define CPARSE_MODE_SKIP 32 /* Skip definitions, ignore errors. */ typedef int CPChar; /* C parser character. Unsigned ext. from char. */ typedef int CPToken; /* C parser token. */ /* C parser internal value representation. */ typedef struct CPValue { union { int32_t i32; /* Value for CTID_INT32. */ uint32_t u32; /* Value for CTID_UINT32. */ }; CTypeID id; /* C Type ID of the value. */ } CPValue; /* C parser state. */ typedef struct CPState { CPChar c; /* Current character. */ CPToken tok; /* Current token. */ CPValue val; /* Token value. */ GCstr *str; /* Interned string of identifier/keyword. */ CType *ct; /* C type table entry. */ const char *p; /* Current position in input buffer. */ SBuf sb; /* String buffer for tokens. */ lua_State *L; /* Lua state. */ CTState *cts; /* C type state. */ TValue *param; /* C type parameters. */ const char *srcname; /* Current source name. */ BCLine linenumber; /* Input line counter. */ int depth; /* Recursive declaration depth. */ uint32_t tmask; /* Type mask for next identifier. */ uint32_t mode; /* C parser mode. */ uint8_t packstack[CPARSE_MAX_PACKSTACK]; /* Stack for pack pragmas. */ uint8_t curpack; /* Current position in pack pragma stack. */ } CPState; LJ_FUNC int lj_cparse(CPState *cp); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_func.h0000644000175000017500000000141013122010155016456 0ustar philphil/* ** Function handling (prototypes, functions and upvalues). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_FUNC_H #define _LJ_FUNC_H #include "lj_obj.h" /* Prototypes. */ LJ_FUNC void LJ_FASTCALL lj_func_freeproto(global_State *g, GCproto *pt); /* Upvalues. */ LJ_FUNCA void LJ_FASTCALL lj_func_closeuv(lua_State *L, TValue *level); LJ_FUNC void LJ_FASTCALL lj_func_freeuv(global_State *g, GCupval *uv); /* Functions (closures). */ LJ_FUNC GCfunc *lj_func_newC(lua_State *L, MSize nelems, GCtab *env); LJ_FUNC GCfunc *lj_func_newL_empty(lua_State *L, GCproto *pt, GCtab *env); LJ_FUNCA GCfunc *lj_func_newL_gc(lua_State *L, GCproto *pt, GCfuncL *parent); LJ_FUNC void LJ_FASTCALL lj_func_free(global_State *g, GCfunc *c); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_obj.c0000644000175000017500000000167413122010155016304 0ustar philphil/* ** Miscellaneous object handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_obj_c #define LUA_CORE #include "lj_obj.h" /* Object type names. */ LJ_DATADEF const char *const lj_obj_typename[] = { /* ORDER LUA_T */ "no value", "nil", "boolean", "userdata", "number", "string", "table", "function", "userdata", "thread", "proto", "cdata" }; LJ_DATADEF const char *const lj_obj_itypename[] = { /* ORDER LJ_T */ "nil", "boolean", "boolean", "userdata", "string", "upval", "thread", "proto", "function", "trace", "cdata", "table", "userdata", "number" }; /* Compare two objects without calling metamethods. */ int lj_obj_equal(cTValue *o1, cTValue *o2) { if (itype(o1) == itype(o2)) { if (tvispri(o1)) return 1; if (!tvisnum(o1)) return gcrefeq(o1->gcr, o2->gcr); } else if (!tvisnumber(o1) || !tvisnumber(o2)) { return 0; } return numberVnum(o1) == numberVnum(o2); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_crecord.c0000644000175000017500000015164513122010155017157 0ustar philphil/* ** Trace recorder for C data operations. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_ffrecord_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT && LJ_HASFFI #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_frame.h" #include "lj_ctype.h" #include "lj_cdata.h" #include "lj_cparse.h" #include "lj_cconv.h" #include "lj_clib.h" #include "lj_ccall.h" #include "lj_ff.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_ircall.h" #include "lj_iropt.h" #include "lj_trace.h" #include "lj_record.h" #include "lj_ffrecord.h" #include "lj_snap.h" #include "lj_crecord.h" #include "lj_dispatch.h" /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) #define emitconv(a, dt, st, flags) \ emitir(IRT(IR_CONV, (dt)), (a), (st)|((dt) << 5)|(flags)) /* -- C type checks ------------------------------------------------------- */ static GCcdata *argv2cdata(jit_State *J, TRef tr, cTValue *o) { GCcdata *cd; TRef trtypeid; if (!tref_iscdata(tr)) lj_trace_err(J, LJ_TRERR_BADTYPE); cd = cdataV(o); /* Specialize to the CTypeID. */ trtypeid = emitir(IRT(IR_FLOAD, IRT_U16), tr, IRFL_CDATA_CTYPEID); emitir(IRTG(IR_EQ, IRT_INT), trtypeid, lj_ir_kint(J, (int32_t)cd->ctypeid)); return cd; } /* Specialize to the CTypeID held by a cdata constructor. */ static CTypeID crec_constructor(jit_State *J, GCcdata *cd, TRef tr) { CTypeID id; lua_assert(tref_iscdata(tr) && cd->ctypeid == CTID_CTYPEID); id = *(CTypeID *)cdataptr(cd); tr = emitir(IRT(IR_FLOAD, IRT_INT), tr, IRFL_CDATA_INT); emitir(IRTG(IR_EQ, IRT_INT), tr, lj_ir_kint(J, (int32_t)id)); return id; } static CTypeID argv2ctype(jit_State *J, TRef tr, cTValue *o) { if (tref_isstr(tr)) { GCstr *s = strV(o); CPState cp; CTypeID oldtop; /* Specialize to the string containing the C type declaration. */ emitir(IRTG(IR_EQ, IRT_STR), tr, lj_ir_kstr(J, s)); cp.L = J->L; cp.cts = ctype_ctsG(J2G(J)); oldtop = cp.cts->top; cp.srcname = strdata(s); cp.p = strdata(s); cp.param = NULL; cp.mode = CPARSE_MODE_ABSTRACT|CPARSE_MODE_NOIMPLICIT; if (lj_cparse(&cp) || cp.cts->top > oldtop) /* Avoid new struct defs. */ lj_trace_err(J, LJ_TRERR_BADTYPE); return cp.val.id; } else { GCcdata *cd = argv2cdata(J, tr, o); return cd->ctypeid == CTID_CTYPEID ? crec_constructor(J, cd, tr) : cd->ctypeid; } } /* Convert CType to IRType (if possible). */ static IRType crec_ct2irt(CTState *cts, CType *ct) { if (ctype_isenum(ct->info)) ct = ctype_child(cts, ct); if (LJ_LIKELY(ctype_isnum(ct->info))) { if ((ct->info & CTF_FP)) { if (ct->size == sizeof(double)) return IRT_NUM; else if (ct->size == sizeof(float)) return IRT_FLOAT; } else { uint32_t b = lj_fls(ct->size); if (b <= 3) return IRT_I8 + 2*b + ((ct->info & CTF_UNSIGNED) ? 1 : 0); } } else if (ctype_isptr(ct->info)) { return (LJ_64 && ct->size == 8) ? IRT_P64 : IRT_P32; } else if (ctype_iscomplex(ct->info)) { if (ct->size == 2*sizeof(double)) return IRT_NUM; else if (ct->size == 2*sizeof(float)) return IRT_FLOAT; } return IRT_CDATA; } /* -- Optimized memory fill and copy -------------------------------------- */ /* Maximum length and unroll of inlined copy/fill. */ #define CREC_COPY_MAXUNROLL 16 #define CREC_COPY_MAXLEN 128 #define CREC_FILL_MAXUNROLL 16 /* Number of windowed registers used for optimized memory copy. */ #if LJ_TARGET_X86 #define CREC_COPY_REGWIN 2 #elif LJ_TARGET_PPC || LJ_TARGET_MIPS #define CREC_COPY_REGWIN 8 #else #define CREC_COPY_REGWIN 4 #endif /* List of memory offsets for copy/fill. */ typedef struct CRecMemList { CTSize ofs; /* Offset in bytes. */ IRType tp; /* Type of load/store. */ TRef trofs; /* TRef of interned offset. */ TRef trval; /* TRef of load value. */ } CRecMemList; /* Generate copy list for element-wise struct copy. */ static MSize crec_copy_struct(CRecMemList *ml, CTState *cts, CType *ct) { CTypeID fid = ct->sib; MSize mlp = 0; while (fid) { CType *df = ctype_get(cts, fid); fid = df->sib; if (ctype_isfield(df->info)) { CType *cct; IRType tp; if (!gcref(df->name)) continue; /* Ignore unnamed fields. */ cct = ctype_rawchild(cts, df); /* Field type. */ tp = crec_ct2irt(cts, cct); if (tp == IRT_CDATA) return 0; /* NYI: aggregates. */ if (mlp >= CREC_COPY_MAXUNROLL) return 0; ml[mlp].ofs = df->size; ml[mlp].tp = tp; mlp++; if (ctype_iscomplex(cct->info)) { if (mlp >= CREC_COPY_MAXUNROLL) return 0; ml[mlp].ofs = df->size + (cct->size >> 1); ml[mlp].tp = tp; mlp++; } } else if (!ctype_isconstval(df->info)) { /* NYI: bitfields and sub-structures. */ return 0; } } return mlp; } /* Generate unrolled copy list, from highest to lowest step size/alignment. */ static MSize crec_copy_unroll(CRecMemList *ml, CTSize len, CTSize step, IRType tp) { CTSize ofs = 0; MSize mlp = 0; if (tp == IRT_CDATA) tp = IRT_U8 + 2*lj_fls(step); do { while (ofs + step <= len) { if (mlp >= CREC_COPY_MAXUNROLL) return 0; ml[mlp].ofs = ofs; ml[mlp].tp = tp; mlp++; ofs += step; } step >>= 1; tp -= 2; } while (ofs < len); return mlp; } /* ** Emit copy list with windowed loads/stores. ** LJ_TARGET_UNALIGNED: may emit unaligned loads/stores (not marked as such). */ static void crec_copy_emit(jit_State *J, CRecMemList *ml, MSize mlp, TRef trdst, TRef trsrc) { MSize i, j, rwin = 0; for (i = 0, j = 0; i < mlp; ) { TRef trofs = lj_ir_kintp(J, ml[i].ofs); TRef trsptr = emitir(IRT(IR_ADD, IRT_PTR), trsrc, trofs); ml[i].trval = emitir(IRT(IR_XLOAD, ml[i].tp), trsptr, 0); ml[i].trofs = trofs; i++; rwin += (LJ_SOFTFP && ml[i].tp == IRT_NUM) ? 2 : 1; if (rwin >= CREC_COPY_REGWIN || i >= mlp) { /* Flush buffered stores. */ rwin = 0; for ( ; j < i; j++) { TRef trdptr = emitir(IRT(IR_ADD, IRT_PTR), trdst, ml[j].trofs); emitir(IRT(IR_XSTORE, ml[j].tp), trdptr, ml[j].trval); } } } } /* Optimized memory copy. */ static void crec_copy(jit_State *J, TRef trdst, TRef trsrc, TRef trlen, CType *ct) { if (tref_isk(trlen)) { /* Length must be constant. */ CRecMemList ml[CREC_COPY_MAXUNROLL]; MSize mlp = 0; CTSize step = 1, len = (CTSize)IR(tref_ref(trlen))->i; IRType tp = IRT_CDATA; int needxbar = 0; if (len == 0) return; /* Shortcut. */ if (len > CREC_COPY_MAXLEN) goto fallback; if (ct) { CTState *cts = ctype_ctsG(J2G(J)); lua_assert(ctype_isarray(ct->info) || ctype_isstruct(ct->info)); if (ctype_isarray(ct->info)) { CType *cct = ctype_rawchild(cts, ct); tp = crec_ct2irt(cts, cct); if (tp == IRT_CDATA) goto rawcopy; step = lj_ir_type_size[tp]; lua_assert((len & (step-1)) == 0); } else if ((ct->info & CTF_UNION)) { step = (1u << ctype_align(ct->info)); goto rawcopy; } else { mlp = crec_copy_struct(ml, cts, ct); goto emitcopy; } } else { rawcopy: needxbar = 1; if (LJ_TARGET_UNALIGNED || step >= CTSIZE_PTR) step = CTSIZE_PTR; } mlp = crec_copy_unroll(ml, len, step, tp); emitcopy: if (mlp) { crec_copy_emit(J, ml, mlp, trdst, trsrc); if (needxbar) emitir(IRT(IR_XBAR, IRT_NIL), 0, 0); return; } } fallback: /* Call memcpy. Always needs a barrier to disable alias analysis. */ lj_ir_call(J, IRCALL_memcpy, trdst, trsrc, trlen); emitir(IRT(IR_XBAR, IRT_NIL), 0, 0); } /* Generate unrolled fill list, from highest to lowest step size/alignment. */ static MSize crec_fill_unroll(CRecMemList *ml, CTSize len, CTSize step) { CTSize ofs = 0; MSize mlp = 0; IRType tp = IRT_U8 + 2*lj_fls(step); do { while (ofs + step <= len) { if (mlp >= CREC_COPY_MAXUNROLL) return 0; ml[mlp].ofs = ofs; ml[mlp].tp = tp; mlp++; ofs += step; } step >>= 1; tp -= 2; } while (ofs < len); return mlp; } /* ** Emit stores for fill list. ** LJ_TARGET_UNALIGNED: may emit unaligned stores (not marked as such). */ static void crec_fill_emit(jit_State *J, CRecMemList *ml, MSize mlp, TRef trdst, TRef trfill) { MSize i; for (i = 0; i < mlp; i++) { TRef trofs = lj_ir_kintp(J, ml[i].ofs); TRef trdptr = emitir(IRT(IR_ADD, IRT_PTR), trdst, trofs); emitir(IRT(IR_XSTORE, ml[i].tp), trdptr, trfill); } } /* Optimized memory fill. */ static void crec_fill(jit_State *J, TRef trdst, TRef trlen, TRef trfill, CTSize step) { if (tref_isk(trlen)) { /* Length must be constant. */ CRecMemList ml[CREC_FILL_MAXUNROLL]; MSize mlp; CTSize len = (CTSize)IR(tref_ref(trlen))->i; if (len == 0) return; /* Shortcut. */ if (LJ_TARGET_UNALIGNED || step >= CTSIZE_PTR) step = CTSIZE_PTR; if (step * CREC_FILL_MAXUNROLL < len) goto fallback; mlp = crec_fill_unroll(ml, len, step); if (!mlp) goto fallback; if (tref_isk(trfill) || ml[0].tp != IRT_U8) trfill = emitconv(trfill, IRT_INT, IRT_U8, 0); if (ml[0].tp != IRT_U8) { /* Scatter U8 to U16/U32/U64. */ if (CTSIZE_PTR == 8 && ml[0].tp == IRT_U64) { if (tref_isk(trfill)) /* Pointless on x64 with zero-extended regs. */ trfill = emitconv(trfill, IRT_U64, IRT_U32, 0); trfill = emitir(IRT(IR_MUL, IRT_U64), trfill, lj_ir_kint64(J, U64x(01010101,01010101))); } else { trfill = emitir(IRTI(IR_MUL), trfill, lj_ir_kint(J, ml[0].tp == IRT_U16 ? 0x0101 : 0x01010101)); } } crec_fill_emit(J, ml, mlp, trdst, trfill); } else { fallback: /* Call memset. Always needs a barrier to disable alias analysis. */ lj_ir_call(J, IRCALL_memset, trdst, trfill, trlen); /* Note: arg order! */ } emitir(IRT(IR_XBAR, IRT_NIL), 0, 0); } /* -- Convert C type to C type -------------------------------------------- */ /* ** This code mirrors the code in lj_cconv.c. It performs the same steps ** for the trace recorder that lj_cconv.c does for the interpreter. ** ** One major difference is that we can get away with much fewer checks ** here. E.g. checks for casts, constness or correct types can often be ** omitted, even if they might fail. The interpreter subsequently throws ** an error, which aborts the trace. ** ** All operations are specialized to their C types, so the on-trace ** outcome must be the same as the outcome in the interpreter. If the ** interpreter doesn't throw an error, then the trace is correct, too. ** Care must be taken not to generate invalid (temporary) IR or to ** trigger asserts. */ /* Determine whether a passed number or cdata number is non-zero. */ static int crec_isnonzero(CType *s, void *p) { if (p == (void *)0) return 0; if (p == (void *)1) return 1; if ((s->info & CTF_FP)) { if (s->size == sizeof(float)) return (*(float *)p != 0); else return (*(double *)p != 0); } else { if (s->size == 1) return (*(uint8_t *)p != 0); else if (s->size == 2) return (*(uint16_t *)p != 0); else if (s->size == 4) return (*(uint32_t *)p != 0); else return (*(uint64_t *)p != 0); } } static TRef crec_ct_ct(jit_State *J, CType *d, CType *s, TRef dp, TRef sp, void *svisnz) { IRType dt = crec_ct2irt(ctype_ctsG(J2G(J)), d); IRType st = crec_ct2irt(ctype_ctsG(J2G(J)), s); CTSize dsize = d->size, ssize = s->size; CTInfo dinfo = d->info, sinfo = s->info; if (ctype_type(dinfo) > CT_MAYCONVERT || ctype_type(sinfo) > CT_MAYCONVERT) goto err_conv; /* ** Note: Unlike lj_cconv_ct_ct(), sp holds the _value_ of pointers and ** numbers up to 8 bytes. Otherwise sp holds a pointer. */ switch (cconv_idx2(dinfo, sinfo)) { /* Destination is a bool. */ case CCX(B, B): goto xstore; /* Source operand is already normalized. */ case CCX(B, I): case CCX(B, F): if (st != IRT_CDATA) { /* Specialize to the result of a comparison against 0. */ TRef zero = (st == IRT_NUM || st == IRT_FLOAT) ? lj_ir_knum(J, 0) : (st == IRT_I64 || st == IRT_U64) ? lj_ir_kint64(J, 0) : lj_ir_kint(J, 0); int isnz = crec_isnonzero(s, svisnz); emitir(IRTG(isnz ? IR_NE : IR_EQ, st), sp, zero); sp = lj_ir_kint(J, isnz); goto xstore; } goto err_nyi; /* Destination is an integer. */ case CCX(I, B): case CCX(I, I): conv_I_I: if (dt == IRT_CDATA || st == IRT_CDATA) goto err_nyi; /* Extend 32 to 64 bit integer. */ if (dsize == 8 && ssize < 8 && !(LJ_64 && (sinfo & CTF_UNSIGNED))) sp = emitconv(sp, dt, ssize < 4 ? IRT_INT : st, (sinfo & CTF_UNSIGNED) ? 0 : IRCONV_SEXT); else if (dsize < 8 && ssize == 8) /* Truncate from 64 bit integer. */ sp = emitconv(sp, dsize < 4 ? IRT_INT : dt, st, 0); else if (st == IRT_INT) sp = lj_opt_narrow_toint(J, sp); xstore: if (dt == IRT_I64 || dt == IRT_U64) lj_needsplit(J); if (dp == 0) return sp; emitir(IRT(IR_XSTORE, dt), dp, sp); break; case CCX(I, C): sp = emitir(IRT(IR_XLOAD, st), sp, 0); /* Load re. */ /* fallthrough */ case CCX(I, F): if (dt == IRT_CDATA || st == IRT_CDATA) goto err_nyi; sp = emitconv(sp, dsize < 4 ? IRT_INT : dt, st, IRCONV_TRUNC|IRCONV_ANY); goto xstore; case CCX(I, P): case CCX(I, A): sinfo = CTINFO(CT_NUM, CTF_UNSIGNED); ssize = CTSIZE_PTR; st = IRT_UINTP; if (((dsize ^ ssize) & 8) == 0) { /* Must insert no-op type conversion. */ sp = emitconv(sp, dsize < 4 ? IRT_INT : dt, IRT_PTR, 0); goto xstore; } goto conv_I_I; /* Destination is a floating-point number. */ case CCX(F, B): case CCX(F, I): conv_F_I: if (dt == IRT_CDATA || st == IRT_CDATA) goto err_nyi; sp = emitconv(sp, dt, ssize < 4 ? IRT_INT : st, 0); goto xstore; case CCX(F, C): sp = emitir(IRT(IR_XLOAD, st), sp, 0); /* Load re. */ /* fallthrough */ case CCX(F, F): conv_F_F: if (dt == IRT_CDATA || st == IRT_CDATA) goto err_nyi; if (dt != st) sp = emitconv(sp, dt, st, 0); goto xstore; /* Destination is a complex number. */ case CCX(C, I): case CCX(C, F): { /* Clear im. */ TRef ptr = emitir(IRT(IR_ADD, IRT_PTR), dp, lj_ir_kintp(J, (dsize >> 1))); emitir(IRT(IR_XSTORE, dt), ptr, lj_ir_knum(J, 0)); } /* Convert to re. */ if ((sinfo & CTF_FP)) goto conv_F_F; else goto conv_F_I; case CCX(C, C): if (dt == IRT_CDATA || st == IRT_CDATA) goto err_nyi; { TRef re, im, ptr; re = emitir(IRT(IR_XLOAD, st), sp, 0); ptr = emitir(IRT(IR_ADD, IRT_PTR), sp, lj_ir_kintp(J, (ssize >> 1))); im = emitir(IRT(IR_XLOAD, st), ptr, 0); if (dt != st) { re = emitconv(re, dt, st, 0); im = emitconv(im, dt, st, 0); } emitir(IRT(IR_XSTORE, dt), dp, re); ptr = emitir(IRT(IR_ADD, IRT_PTR), dp, lj_ir_kintp(J, (dsize >> 1))); emitir(IRT(IR_XSTORE, dt), ptr, im); } break; /* Destination is a vector. */ case CCX(V, I): case CCX(V, F): case CCX(V, C): case CCX(V, V): goto err_nyi; /* Destination is a pointer. */ case CCX(P, P): case CCX(P, A): case CCX(P, S): /* There are only 32 bit pointers/addresses on 32 bit machines. ** Also ok on x64, since all 32 bit ops clear the upper part of the reg. */ goto xstore; case CCX(P, I): if (st == IRT_CDATA) goto err_nyi; if (!LJ_64 && ssize == 8) /* Truncate from 64 bit integer. */ sp = emitconv(sp, IRT_U32, st, 0); goto xstore; case CCX(P, F): if (st == IRT_CDATA) goto err_nyi; /* The signed conversion is cheaper. x64 really has 47 bit pointers. */ sp = emitconv(sp, (LJ_64 && dsize == 8) ? IRT_I64 : IRT_U32, st, IRCONV_TRUNC|IRCONV_ANY); goto xstore; /* Destination is an array. */ case CCX(A, A): /* Destination is a struct/union. */ case CCX(S, S): if (dp == 0) goto err_conv; crec_copy(J, dp, sp, lj_ir_kint(J, dsize), d); break; default: err_conv: err_nyi: lj_trace_err(J, LJ_TRERR_NYICONV); break; } return 0; } /* -- Convert C type to TValue (load) ------------------------------------- */ static TRef crec_tv_ct(jit_State *J, CType *s, CTypeID sid, TRef sp) { CTState *cts = ctype_ctsG(J2G(J)); IRType t = crec_ct2irt(cts, s); CTInfo sinfo = s->info; if (ctype_isnum(sinfo)) { TRef tr; if (t == IRT_CDATA) goto err_nyi; /* NYI: copyval of >64 bit integers. */ tr = emitir(IRT(IR_XLOAD, t), sp, 0); if (t == IRT_FLOAT || t == IRT_U32) { /* Keep uint32_t/float as numbers. */ return emitconv(tr, IRT_NUM, t, 0); } else if (t == IRT_I64 || t == IRT_U64) { /* Box 64 bit integer. */ sp = tr; lj_needsplit(J); } else if ((sinfo & CTF_BOOL)) { /* Assume not equal to zero. Fixup and emit pending guard later. */ lj_ir_set(J, IRTGI(IR_NE), tr, lj_ir_kint(J, 0)); J->postproc = LJ_POST_FIXGUARD; return TREF_TRUE; } else { return tr; } } else if (ctype_isptr(sinfo) || ctype_isenum(sinfo)) { sp = emitir(IRT(IR_XLOAD, t), sp, 0); /* Box pointers and enums. */ } else if (ctype_isrefarray(sinfo) || ctype_isstruct(sinfo)) { cts->L = J->L; sid = lj_ctype_intern(cts, CTINFO_REF(sid), CTSIZE_PTR); /* Create ref. */ } else if (ctype_iscomplex(sinfo)) { /* Unbox/box complex. */ ptrdiff_t esz = (ptrdiff_t)(s->size >> 1); TRef ptr, tr1, tr2, dp; dp = emitir(IRTG(IR_CNEW, IRT_CDATA), lj_ir_kint(J, sid), TREF_NIL); tr1 = emitir(IRT(IR_XLOAD, t), sp, 0); ptr = emitir(IRT(IR_ADD, IRT_PTR), sp, lj_ir_kintp(J, esz)); tr2 = emitir(IRT(IR_XLOAD, t), ptr, 0); ptr = emitir(IRT(IR_ADD, IRT_PTR), dp, lj_ir_kintp(J, sizeof(GCcdata))); emitir(IRT(IR_XSTORE, t), ptr, tr1); ptr = emitir(IRT(IR_ADD, IRT_PTR), dp, lj_ir_kintp(J, sizeof(GCcdata)+esz)); emitir(IRT(IR_XSTORE, t), ptr, tr2); return dp; } else { /* NYI: copyval of vectors. */ err_nyi: lj_trace_err(J, LJ_TRERR_NYICONV); } /* Box pointer, ref, enum or 64 bit integer. */ return emitir(IRTG(IR_CNEWI, IRT_CDATA), lj_ir_kint(J, sid), sp); } /* -- Convert TValue to C type (store) ------------------------------------ */ static TRef crec_ct_tv(jit_State *J, CType *d, TRef dp, TRef sp, cTValue *sval) { CTState *cts = ctype_ctsG(J2G(J)); CTypeID sid = CTID_P_VOID; void *svisnz = 0; CType *s; if (LJ_LIKELY(tref_isinteger(sp))) { sid = CTID_INT32; svisnz = (void *)(intptr_t)(tvisint(sval)?(intV(sval)!=0):!tviszero(sval)); } else if (tref_isnum(sp)) { sid = CTID_DOUBLE; svisnz = (void *)(intptr_t)(tvisint(sval)?(intV(sval)!=0):!tviszero(sval)); } else if (tref_isbool(sp)) { sp = lj_ir_kint(J, tref_istrue(sp) ? 1 : 0); sid = CTID_BOOL; } else if (tref_isnil(sp)) { sp = lj_ir_kptr(J, NULL); } else if (tref_isudata(sp)) { GCudata *ud = udataV(sval); if (ud->udtype == UDTYPE_IO_FILE) { TRef tr = emitir(IRT(IR_FLOAD, IRT_U8), sp, IRFL_UDATA_UDTYPE); emitir(IRTGI(IR_EQ), tr, lj_ir_kint(J, UDTYPE_IO_FILE)); sp = emitir(IRT(IR_FLOAD, IRT_PTR), sp, IRFL_UDATA_FILE); } else { sp = emitir(IRT(IR_ADD, IRT_PTR), sp, lj_ir_kintp(J, sizeof(GCudata))); } } else if (tref_isstr(sp)) { if (ctype_isenum(d->info)) { /* Match string against enum constant. */ GCstr *str = strV(sval); CTSize ofs; CType *cct = lj_ctype_getfield(cts, d, str, &ofs); /* Specialize to the name of the enum constant. */ emitir(IRTG(IR_EQ, IRT_STR), sp, lj_ir_kstr(J, str)); if (cct && ctype_isconstval(cct->info)) { lua_assert(ctype_child(cts, cct)->size == 4); svisnz = (void *)(intptr_t)(ofs != 0); sp = lj_ir_kint(J, (int32_t)ofs); sid = ctype_cid(cct->info); } /* else: interpreter will throw. */ } else if (ctype_isrefarray(d->info)) { /* Copy string to array. */ lj_trace_err(J, LJ_TRERR_BADTYPE); /* NYI */ } else { /* Otherwise pass the string data as a const char[]. */ /* Don't use STRREF. It folds with SNEW, which loses the trailing NUL. */ sp = emitir(IRT(IR_ADD, IRT_PTR), sp, lj_ir_kintp(J, sizeof(GCstr))); sid = CTID_A_CCHAR; } } else { /* NYI: tref_istab(sp), tref_islightud(sp). */ IRType t; sid = argv2cdata(J, sp, sval)->ctypeid; s = ctype_raw(cts, sid); svisnz = cdataptr(cdataV(sval)); t = crec_ct2irt(cts, s); if (ctype_isptr(s->info)) { sp = emitir(IRT(IR_FLOAD, t), sp, IRFL_CDATA_PTR); if (ctype_isref(s->info)) { svisnz = *(void **)svisnz; s = ctype_rawchild(cts, s); if (ctype_isenum(s->info)) s = ctype_child(cts, s); t = crec_ct2irt(cts, s); } else { goto doconv; } } else if (t == IRT_I64 || t == IRT_U64) { sp = emitir(IRT(IR_FLOAD, t), sp, IRFL_CDATA_INT64); lj_needsplit(J); goto doconv; } else if (t == IRT_INT || t == IRT_U32) { if (ctype_isenum(s->info)) s = ctype_child(cts, s); sp = emitir(IRT(IR_FLOAD, t), sp, IRFL_CDATA_INT); goto doconv; } else { sp = emitir(IRT(IR_ADD, IRT_PTR), sp, lj_ir_kintp(J, sizeof(GCcdata))); } if (ctype_isnum(s->info) && t != IRT_CDATA) sp = emitir(IRT(IR_XLOAD, t), sp, 0); /* Load number value. */ goto doconv; } s = ctype_get(cts, sid); doconv: if (ctype_isenum(d->info)) d = ctype_child(cts, d); return crec_ct_ct(J, d, s, dp, sp, svisnz); } /* -- C data metamethods -------------------------------------------------- */ /* This would be rather difficult in FOLD, so do it here: ** (base+k)+(idx*sz)+ofs ==> (base+idx*sz)+(ofs+k) ** (base+(idx+k)*sz)+ofs ==> (base+idx*sz)+(ofs+k*sz) */ static TRef crec_reassoc_ofs(jit_State *J, TRef tr, ptrdiff_t *ofsp, MSize sz) { IRIns *ir = IR(tref_ref(tr)); if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD) && irref_isk(ir->op2) && (ir->o == IR_ADD || ir->o == IR_ADDOV || ir->o == IR_SUBOV)) { IRIns *irk = IR(ir->op2); ptrdiff_t k; if (LJ_64 && irk->o == IR_KINT64) k = (ptrdiff_t)ir_kint64(irk)->u64 * sz; else k = (ptrdiff_t)irk->i * sz; if (ir->o == IR_SUBOV) *ofsp -= k; else *ofsp += k; tr = ir->op1; /* Not a TRef, but the caller doesn't care. */ } return tr; } /* Record ctype __index/__newindex metamethods. */ static void crec_index_meta(jit_State *J, CTState *cts, CType *ct, RecordFFData *rd) { CTypeID id = ctype_typeid(cts, ct); cTValue *tv = lj_ctype_meta(cts, id, rd->data ? MM_newindex : MM_index); if (!tv) lj_trace_err(J, LJ_TRERR_BADTYPE); if (tvisfunc(tv)) { J->base[-1] = lj_ir_kfunc(J, funcV(tv)) | TREF_FRAME; rd->nres = -1; /* Pending tailcall. */ } else if (rd->data == 0 && tvistab(tv) && tref_isstr(J->base[1])) { /* Specialize to result of __index lookup. */ cTValue *o = lj_tab_get(J->L, tabV(tv), &rd->argv[1]); J->base[0] = lj_record_constify(J, o); if (!J->base[0]) lj_trace_err(J, LJ_TRERR_BADTYPE); /* Always specialize to the key. */ emitir(IRTG(IR_EQ, IRT_STR), J->base[1], lj_ir_kstr(J, strV(&rd->argv[1]))); } else { /* NYI: resolving of non-function metamethods. */ /* NYI: non-string keys for __index table. */ /* NYI: stores to __newindex table. */ lj_trace_err(J, LJ_TRERR_BADTYPE); } } void LJ_FASTCALL recff_cdata_index(jit_State *J, RecordFFData *rd) { TRef idx, ptr = J->base[0]; ptrdiff_t ofs = sizeof(GCcdata); GCcdata *cd = argv2cdata(J, ptr, &rd->argv[0]); CTState *cts = ctype_ctsG(J2G(J)); CType *ct = ctype_raw(cts, cd->ctypeid); CTypeID sid = 0; /* Resolve pointer or reference for cdata object. */ if (ctype_isptr(ct->info)) { IRType t = (LJ_64 && ct->size == 8) ? IRT_P64 : IRT_P32; if (ctype_isref(ct->info)) ct = ctype_rawchild(cts, ct); ptr = emitir(IRT(IR_FLOAD, t), ptr, IRFL_CDATA_PTR); ofs = 0; ptr = crec_reassoc_ofs(J, ptr, &ofs, 1); } again: idx = J->base[1]; if (tref_isnumber(idx)) { idx = lj_opt_narrow_cindex(J, idx); if (ctype_ispointer(ct->info)) { CTSize sz; integer_key: if ((ct->info & CTF_COMPLEX)) idx = emitir(IRT(IR_BAND, IRT_INTP), idx, lj_ir_kintp(J, 1)); sz = lj_ctype_size(cts, (sid = ctype_cid(ct->info))); idx = crec_reassoc_ofs(J, idx, &ofs, sz); #if LJ_TARGET_ARM || LJ_TARGET_PPC /* Hoist base add to allow fusion of index/shift into operands. */ if (LJ_LIKELY(J->flags & JIT_F_OPT_LOOP) && ofs #if LJ_TARGET_ARM && (sz == 1 || sz == 4) #endif ) { ptr = emitir(IRT(IR_ADD, IRT_PTR), ptr, lj_ir_kintp(J, ofs)); ofs = 0; } #endif idx = emitir(IRT(IR_MUL, IRT_INTP), idx, lj_ir_kintp(J, sz)); ptr = emitir(IRT(IR_ADD, IRT_PTR), idx, ptr); } } else if (tref_iscdata(idx)) { GCcdata *cdk = cdataV(&rd->argv[1]); CType *ctk = ctype_raw(cts, cdk->ctypeid); IRType t = crec_ct2irt(cts, ctk); if (ctype_ispointer(ct->info) && t >= IRT_I8 && t <= IRT_U64) { if (ctk->size == 8) { idx = emitir(IRT(IR_FLOAD, t), idx, IRFL_CDATA_INT64); } else if (ctk->size == 4) { idx = emitir(IRT(IR_FLOAD, t), idx, IRFL_CDATA_INT); } else { idx = emitir(IRT(IR_ADD, IRT_PTR), idx, lj_ir_kintp(J, sizeof(GCcdata))); idx = emitir(IRT(IR_XLOAD, t), idx, 0); } if (LJ_64 && ctk->size < sizeof(intptr_t) && !(ctk->info & CTF_UNSIGNED)) idx = emitconv(idx, IRT_INTP, IRT_INT, IRCONV_SEXT); if (!LJ_64 && ctk->size > sizeof(intptr_t)) { idx = emitconv(idx, IRT_INTP, t, 0); lj_needsplit(J); } goto integer_key; } } else if (tref_isstr(idx)) { GCstr *name = strV(&rd->argv[1]); if (cd && cd->ctypeid == CTID_CTYPEID) ct = ctype_raw(cts, crec_constructor(J, cd, ptr)); if (ctype_isstruct(ct->info)) { CTSize fofs; CType *fct; fct = lj_ctype_getfield(cts, ct, name, &fofs); if (fct) { /* Always specialize to the field name. */ emitir(IRTG(IR_EQ, IRT_STR), idx, lj_ir_kstr(J, name)); if (ctype_isconstval(fct->info)) { if (fct->size >= 0x80000000u && (ctype_child(cts, fct)->info & CTF_UNSIGNED)) { J->base[0] = lj_ir_knum(J, (lua_Number)(uint32_t)fct->size); return; } J->base[0] = lj_ir_kint(J, (int32_t)fct->size); return; /* Interpreter will throw for newindex. */ } else if (ctype_isbitfield(fct->info)) { lj_trace_err(J, LJ_TRERR_NYICONV); } else { lua_assert(ctype_isfield(fct->info)); sid = ctype_cid(fct->info); } ofs += (ptrdiff_t)fofs; } } else if (ctype_iscomplex(ct->info)) { if (name->len == 2 && ((strdata(name)[0] == 'r' && strdata(name)[1] == 'e') || (strdata(name)[0] == 'i' && strdata(name)[1] == 'm'))) { /* Always specialize to the field name. */ emitir(IRTG(IR_EQ, IRT_STR), idx, lj_ir_kstr(J, name)); if (strdata(name)[0] == 'i') ofs += (ct->size >> 1); sid = ctype_cid(ct->info); } } } if (!sid) { if (ctype_isptr(ct->info)) { /* Automatically perform '->'. */ CType *cct = ctype_rawchild(cts, ct); if (ctype_isstruct(cct->info)) { ct = cct; cd = NULL; if (tref_isstr(idx)) goto again; } } crec_index_meta(J, cts, ct, rd); return; } if (ofs) ptr = emitir(IRT(IR_ADD, IRT_PTR), ptr, lj_ir_kintp(J, ofs)); /* Resolve reference for field. */ ct = ctype_get(cts, sid); if (ctype_isref(ct->info)) { ptr = emitir(IRT(IR_XLOAD, IRT_PTR), ptr, 0); sid = ctype_cid(ct->info); ct = ctype_get(cts, sid); } while (ctype_isattrib(ct->info)) ct = ctype_child(cts, ct); /* Skip attributes. */ if (rd->data == 0) { /* __index metamethod. */ J->base[0] = crec_tv_ct(J, ct, sid, ptr); } else { /* __newindex metamethod. */ rd->nres = 0; J->needsnap = 1; crec_ct_tv(J, ct, ptr, J->base[2], &rd->argv[2]); } } /* Record setting a finalizer. */ static void crec_finalizer(jit_State *J, TRef trcd, cTValue *fin) { TRef trlo = lj_ir_call(J, IRCALL_lj_cdata_setfin, trcd); TRef trhi = emitir(IRT(IR_ADD, IRT_P32), trlo, lj_ir_kint(J, 4)); if (LJ_BE) { TRef tmp = trlo; trlo = trhi; trhi = tmp; } if (tvisfunc(fin)) { emitir(IRT(IR_XSTORE, IRT_P32), trlo, lj_ir_kfunc(J, funcV(fin))); emitir(IRTI(IR_XSTORE), trhi, lj_ir_kint(J, LJ_TFUNC)); } else if (tviscdata(fin)) { emitir(IRT(IR_XSTORE, IRT_P32), trlo, lj_ir_kgc(J, obj2gco(cdataV(fin)), IRT_CDATA)); emitir(IRTI(IR_XSTORE), trhi, lj_ir_kint(J, LJ_TCDATA)); } else { lj_trace_err(J, LJ_TRERR_BADTYPE); } J->needsnap = 1; } /* Record cdata allocation. */ static void crec_alloc(jit_State *J, RecordFFData *rd, CTypeID id) { CTState *cts = ctype_ctsG(J2G(J)); CTSize sz; CTInfo info = lj_ctype_info(cts, id, &sz); CType *d = ctype_raw(cts, id); TRef trid; if (!sz || sz > 128 || (info & CTF_VLA) || ctype_align(info) > CT_MEMALIGN) lj_trace_err(J, LJ_TRERR_NYICONV); /* NYI: large/special allocations. */ trid = lj_ir_kint(J, id); /* Use special instruction to box pointer or 32/64 bit integer. */ if (ctype_isptr(info) || (ctype_isinteger(info) && (sz == 4 || sz == 8))) { TRef sp = J->base[1] ? crec_ct_tv(J, d, 0, J->base[1], &rd->argv[1]) : ctype_isptr(info) ? lj_ir_kptr(J, NULL) : sz == 4 ? lj_ir_kint(J, 0) : (lj_needsplit(J), lj_ir_kint64(J, 0)); J->base[0] = emitir(IRTG(IR_CNEWI, IRT_CDATA), trid, sp); } else { TRef trcd = emitir(IRTG(IR_CNEW, IRT_CDATA), trid, TREF_NIL); cTValue *fin; J->base[0] = trcd; if (J->base[1] && !J->base[2] && !lj_cconv_multi_init(cts, d, &rd->argv[1])) { goto single_init; } else if (ctype_isarray(d->info)) { CType *dc = ctype_rawchild(cts, d); /* Array element type. */ CTSize ofs, esize = dc->size; TRef sp = 0; TValue tv; TValue *sval = &tv; MSize i; tv.u64 = 0; if (!(ctype_isnum(dc->info) || ctype_isptr(dc->info))) lj_trace_err(J, LJ_TRERR_NYICONV); /* NYI: init array of aggregates. */ for (i = 1, ofs = 0; ofs < sz; ofs += esize) { TRef dp = emitir(IRT(IR_ADD, IRT_PTR), trcd, lj_ir_kintp(J, ofs + sizeof(GCcdata))); if (J->base[i]) { sp = J->base[i]; sval = &rd->argv[i]; i++; } else if (i != 2) { sp = ctype_isnum(dc->info) ? lj_ir_kint(J, 0) : TREF_NIL; } crec_ct_tv(J, dc, dp, sp, sval); } } else if (ctype_isstruct(d->info)) { CTypeID fid = d->sib; MSize i = 1; while (fid) { CType *df = ctype_get(cts, fid); fid = df->sib; if (ctype_isfield(df->info)) { CType *dc; TRef sp, dp; TValue tv; TValue *sval = &tv; setintV(&tv, 0); if (!gcref(df->name)) continue; /* Ignore unnamed fields. */ dc = ctype_rawchild(cts, df); /* Field type. */ if (!(ctype_isnum(dc->info) || ctype_isptr(dc->info) || ctype_isenum(dc->info))) lj_trace_err(J, LJ_TRERR_NYICONV); /* NYI: init aggregates. */ if (J->base[i]) { sp = J->base[i]; sval = &rd->argv[i]; i++; } else { sp = ctype_isptr(dc->info) ? TREF_NIL : lj_ir_kint(J, 0); } dp = emitir(IRT(IR_ADD, IRT_PTR), trcd, lj_ir_kintp(J, df->size + sizeof(GCcdata))); crec_ct_tv(J, dc, dp, sp, sval); } else if (!ctype_isconstval(df->info)) { /* NYI: init bitfields and sub-structures. */ lj_trace_err(J, LJ_TRERR_NYICONV); } } } else { TRef dp; single_init: dp = emitir(IRT(IR_ADD, IRT_PTR), trcd, lj_ir_kintp(J, sizeof(GCcdata))); if (J->base[1]) { crec_ct_tv(J, d, dp, J->base[1], &rd->argv[1]); } else { TValue tv; tv.u64 = 0; crec_ct_tv(J, d, dp, lj_ir_kint(J, 0), &tv); } } /* Handle __gc metamethod. */ fin = lj_ctype_meta(cts, id, MM_gc); if (fin) crec_finalizer(J, trcd, fin); } } /* Record argument conversions. */ static TRef crec_call_args(jit_State *J, RecordFFData *rd, CTState *cts, CType *ct) { TRef args[CCI_NARGS_MAX]; CTypeID fid; MSize i, n; TRef tr, *base; cTValue *o; #if LJ_TARGET_X86 #if LJ_ABI_WIN TRef *arg0 = NULL, *arg1 = NULL; #endif int ngpr = 0; if (ctype_cconv(ct->info) == CTCC_THISCALL) ngpr = 1; else if (ctype_cconv(ct->info) == CTCC_FASTCALL) ngpr = 2; #endif /* Skip initial attributes. */ fid = ct->sib; while (fid) { CType *ctf = ctype_get(cts, fid); if (!ctype_isattrib(ctf->info)) break; fid = ctf->sib; } args[0] = TREF_NIL; for (n = 0, base = J->base+1, o = rd->argv+1; *base; n++, base++, o++) { CTypeID did; CType *d; if (n >= CCI_NARGS_MAX) lj_trace_err(J, LJ_TRERR_NYICALL); if (fid) { /* Get argument type from field. */ CType *ctf = ctype_get(cts, fid); fid = ctf->sib; lua_assert(ctype_isfield(ctf->info)); did = ctype_cid(ctf->info); } else { if (!(ct->info & CTF_VARARG)) lj_trace_err(J, LJ_TRERR_NYICALL); /* Too many arguments. */ did = lj_ccall_ctid_vararg(cts, o); /* Infer vararg type. */ } d = ctype_raw(cts, did); if (!(ctype_isnum(d->info) || ctype_isptr(d->info) || ctype_isenum(d->info))) lj_trace_err(J, LJ_TRERR_NYICALL); tr = crec_ct_tv(J, d, 0, *base, o); if (ctype_isinteger_or_bool(d->info)) { if (d->size < 4) { if ((d->info & CTF_UNSIGNED)) tr = emitconv(tr, IRT_INT, d->size==1 ? IRT_U8 : IRT_U16, 0); else tr = emitconv(tr, IRT_INT, d->size==1 ? IRT_I8 : IRT_I16,IRCONV_SEXT); } } else if (LJ_SOFTFP && ctype_isfp(d->info) && d->size > 4) { lj_needsplit(J); } #if LJ_TARGET_X86 /* 64 bit args must not end up in registers for fastcall/thiscall. */ #if LJ_ABI_WIN if (!ctype_isfp(d->info)) { /* Sigh, the Windows/x86 ABI allows reordering across 64 bit args. */ if (tref_typerange(tr, IRT_I64, IRT_U64)) { if (ngpr) { arg0 = &args[n]; args[n++] = TREF_NIL; ngpr--; if (ngpr) { arg1 = &args[n]; args[n++] = TREF_NIL; ngpr--; } } } else { if (arg0) { *arg0 = tr; arg0 = NULL; n--; continue; } if (arg1) { *arg1 = tr; arg1 = NULL; n--; continue; } if (ngpr) ngpr--; } } #else if (!ctype_isfp(d->info) && ngpr) { if (tref_typerange(tr, IRT_I64, IRT_U64)) { /* No reordering for other x86 ABIs. Simply add alignment args. */ do { args[n++] = TREF_NIL; } while (--ngpr); } else { ngpr--; } } #endif #endif args[n] = tr; } tr = args[0]; for (i = 1; i < n; i++) tr = emitir(IRT(IR_CARG, IRT_NIL), tr, args[i]); return tr; } /* Create a snapshot for the caller, simulating a 'false' return value. */ static void crec_snap_caller(jit_State *J) { lua_State *L = J->L; TValue *base = L->base, *top = L->top; const BCIns *pc = J->pc; TRef ftr = J->base[-1]; ptrdiff_t delta; if (!frame_islua(base-1) || J->framedepth <= 0) lj_trace_err(J, LJ_TRERR_NYICALL); J->pc = frame_pc(base-1); delta = 1+bc_a(J->pc[-1]); L->top = base; L->base = base - delta; J->base[-1] = TREF_FALSE; J->base -= delta; J->baseslot -= (BCReg)delta; J->maxslot = (BCReg)delta; J->framedepth--; lj_snap_add(J); L->base = base; L->top = top; J->framedepth++; J->maxslot = 1; J->base += delta; J->baseslot += (BCReg)delta; J->base[-1] = ftr; J->pc = pc; } /* Record function call. */ static int crec_call(jit_State *J, RecordFFData *rd, GCcdata *cd) { CTState *cts = ctype_ctsG(J2G(J)); CType *ct = ctype_raw(cts, cd->ctypeid); IRType tp = IRT_PTR; if (ctype_isptr(ct->info)) { tp = (LJ_64 && ct->size == 8) ? IRT_P64 : IRT_P32; ct = ctype_rawchild(cts, ct); } if (ctype_isfunc(ct->info)) { TRef func = emitir(IRT(IR_FLOAD, tp), J->base[0], IRFL_CDATA_PTR); CType *ctr = ctype_rawchild(cts, ct); IRType t = crec_ct2irt(cts, ctr); TRef tr; TValue tv; /* Check for blacklisted C functions that might call a callback. */ setlightudV(&tv, cdata_getptr(cdataptr(cd), (LJ_64 && tp == IRT_P64) ? 8 : 4)); if (tvistrue(lj_tab_get(J->L, cts->miscmap, &tv))) lj_trace_err(J, LJ_TRERR_BLACKL); if (ctype_isvoid(ctr->info)) { t = IRT_NIL; rd->nres = 0; } else if (!(ctype_isnum(ctr->info) || ctype_isptr(ctr->info) || ctype_isenum(ctr->info)) || t == IRT_CDATA) { lj_trace_err(J, LJ_TRERR_NYICALL); } if ((ct->info & CTF_VARARG) #if LJ_TARGET_X86 || ctype_cconv(ct->info) != CTCC_CDECL #endif ) func = emitir(IRT(IR_CARG, IRT_NIL), func, lj_ir_kint(J, ctype_typeid(cts, ct))); tr = emitir(IRT(IR_CALLXS, t), crec_call_args(J, rd, cts, ct), func); if (ctype_isbool(ctr->info)) { if (frame_islua(J->L->base-1) && bc_b(frame_pc(J->L->base-1)[-1]) == 1) { /* Don't check result if ignored. */ tr = TREF_NIL; } else { crec_snap_caller(J); #if LJ_TARGET_X86ORX64 /* Note: only the x86/x64 backend supports U8 and only for EQ(tr, 0). */ lj_ir_set(J, IRTG(IR_NE, IRT_U8), tr, lj_ir_kint(J, 0)); #else lj_ir_set(J, IRTGI(IR_NE), tr, lj_ir_kint(J, 0)); #endif J->postproc = LJ_POST_FIXGUARDSNAP; tr = TREF_TRUE; } } else if (t == IRT_PTR || (LJ_64 && t == IRT_P32) || t == IRT_I64 || t == IRT_U64 || ctype_isenum(ctr->info)) { TRef trid = lj_ir_kint(J, ctype_cid(ct->info)); tr = emitir(IRTG(IR_CNEWI, IRT_CDATA), trid, tr); if (t == IRT_I64 || t == IRT_U64) lj_needsplit(J); } else if (t == IRT_FLOAT || t == IRT_U32) { tr = emitconv(tr, IRT_NUM, t, 0); } else if (t == IRT_I8 || t == IRT_I16) { tr = emitconv(tr, IRT_INT, t, IRCONV_SEXT); } else if (t == IRT_U8 || t == IRT_U16) { tr = emitconv(tr, IRT_INT, t, 0); } J->base[0] = tr; J->needsnap = 1; return 1; } return 0; } void LJ_FASTCALL recff_cdata_call(jit_State *J, RecordFFData *rd) { CTState *cts = ctype_ctsG(J2G(J)); GCcdata *cd = argv2cdata(J, J->base[0], &rd->argv[0]); CTypeID id = cd->ctypeid; CType *ct; cTValue *tv; MMS mm = MM_call; if (id == CTID_CTYPEID) { id = crec_constructor(J, cd, J->base[0]); mm = MM_new; } else if (crec_call(J, rd, cd)) { return; } /* Record ctype __call/__new metamethod. */ ct = ctype_raw(cts, id); tv = lj_ctype_meta(cts, ctype_isptr(ct->info) ? ctype_cid(ct->info) : id, mm); if (tv) { if (tvisfunc(tv)) { J->base[-1] = lj_ir_kfunc(J, funcV(tv)) | TREF_FRAME; rd->nres = -1; /* Pending tailcall. */ return; } } else if (mm == MM_new) { crec_alloc(J, rd, id); return; } /* No metamethod or NYI: non-function metamethods. */ lj_trace_err(J, LJ_TRERR_BADTYPE); } static TRef crec_arith_int64(jit_State *J, TRef *sp, CType **s, MMS mm) { if (sp[0] && sp[1] && ctype_isnum(s[0]->info) && ctype_isnum(s[1]->info)) { IRType dt; CTypeID id; TRef tr; MSize i; IROp op; lj_needsplit(J); if (((s[0]->info & CTF_UNSIGNED) && s[0]->size == 8) || ((s[1]->info & CTF_UNSIGNED) && s[1]->size == 8)) { dt = IRT_U64; id = CTID_UINT64; } else { dt = IRT_I64; id = CTID_INT64; if (mm < MM_add && !((s[0]->info | s[1]->info) & CTF_FP) && s[0]->size == 4 && s[1]->size == 4) { /* Try to narrow comparison. */ if (!((s[0]->info ^ s[1]->info) & CTF_UNSIGNED) || (tref_isk(sp[1]) && IR(tref_ref(sp[1]))->i >= 0)) { dt = (s[0]->info & CTF_UNSIGNED) ? IRT_U32 : IRT_INT; goto comp; } else if (tref_isk(sp[0]) && IR(tref_ref(sp[0]))->i >= 0) { dt = (s[1]->info & CTF_UNSIGNED) ? IRT_U32 : IRT_INT; goto comp; } } } for (i = 0; i < 2; i++) { IRType st = tref_type(sp[i]); if (st == IRT_NUM || st == IRT_FLOAT) sp[i] = emitconv(sp[i], dt, st, IRCONV_TRUNC|IRCONV_ANY); else if (!(st == IRT_I64 || st == IRT_U64)) sp[i] = emitconv(sp[i], dt, IRT_INT, (s[i]->info & CTF_UNSIGNED) ? 0 : IRCONV_SEXT); } if (mm < MM_add) { comp: /* Assume true comparison. Fixup and emit pending guard later. */ if (mm == MM_eq) { op = IR_EQ; } else { op = mm == MM_lt ? IR_LT : IR_LE; if (dt == IRT_U32 || dt == IRT_U64) op += (IR_ULT-IR_LT); } lj_ir_set(J, IRTG(op, dt), sp[0], sp[1]); J->postproc = LJ_POST_FIXGUARD; return TREF_TRUE; } else { tr = emitir(IRT(mm+(int)IR_ADD-(int)MM_add, dt), sp[0], sp[1]); } return emitir(IRTG(IR_CNEWI, IRT_CDATA), lj_ir_kint(J, id), tr); } return 0; } static TRef crec_arith_ptr(jit_State *J, TRef *sp, CType **s, MMS mm) { CTState *cts = ctype_ctsG(J2G(J)); CType *ctp = s[0]; if (!(sp[0] && sp[1])) return 0; if (ctype_isptr(ctp->info) || ctype_isrefarray(ctp->info)) { if ((mm == MM_sub || mm == MM_eq || mm == MM_lt || mm == MM_le) && (ctype_isptr(s[1]->info) || ctype_isrefarray(s[1]->info))) { if (mm == MM_sub) { /* Pointer difference. */ TRef tr; CTSize sz = lj_ctype_size(cts, ctype_cid(ctp->info)); if (sz == 0 || (sz & (sz-1)) != 0) return 0; /* NYI: integer division. */ tr = emitir(IRT(IR_SUB, IRT_INTP), sp[0], sp[1]); tr = emitir(IRT(IR_BSAR, IRT_INTP), tr, lj_ir_kint(J, lj_fls(sz))); #if LJ_64 tr = emitconv(tr, IRT_NUM, IRT_INTP, 0); #endif return tr; } else { /* Pointer comparison (unsigned). */ /* Assume true comparison. Fixup and emit pending guard later. */ IROp op = mm == MM_eq ? IR_EQ : mm == MM_lt ? IR_ULT : IR_ULE; lj_ir_set(J, IRTG(op, IRT_PTR), sp[0], sp[1]); J->postproc = LJ_POST_FIXGUARD; return TREF_TRUE; } } if (!((mm == MM_add || mm == MM_sub) && ctype_isnum(s[1]->info))) return 0; } else if (mm == MM_add && ctype_isnum(ctp->info) && (ctype_isptr(s[1]->info) || ctype_isrefarray(s[1]->info))) { TRef tr = sp[0]; sp[0] = sp[1]; sp[1] = tr; /* Swap pointer and index. */ ctp = s[1]; } else { return 0; } { TRef tr = sp[1]; IRType t = tref_type(tr); CTSize sz = lj_ctype_size(cts, ctype_cid(ctp->info)); CTypeID id; #if LJ_64 if (t == IRT_NUM || t == IRT_FLOAT) tr = emitconv(tr, IRT_INTP, t, IRCONV_TRUNC|IRCONV_ANY); else if (!(t == IRT_I64 || t == IRT_U64)) tr = emitconv(tr, IRT_INTP, IRT_INT, ((t - IRT_I8) & 1) ? 0 : IRCONV_SEXT); #else if (!tref_typerange(sp[1], IRT_I8, IRT_U32)) { tr = emitconv(tr, IRT_INTP, t, (t == IRT_NUM || t == IRT_FLOAT) ? IRCONV_TRUNC|IRCONV_ANY : 0); } #endif tr = emitir(IRT(IR_MUL, IRT_INTP), tr, lj_ir_kintp(J, sz)); tr = emitir(IRT(mm+(int)IR_ADD-(int)MM_add, IRT_PTR), sp[0], tr); id = lj_ctype_intern(cts, CTINFO(CT_PTR, CTALIGN_PTR|ctype_cid(ctp->info)), CTSIZE_PTR); return emitir(IRTG(IR_CNEWI, IRT_CDATA), lj_ir_kint(J, id), tr); } } /* Record ctype arithmetic metamethods. */ static TRef crec_arith_meta(jit_State *J, TRef *sp, CType **s, CTState *cts, RecordFFData *rd) { cTValue *tv = NULL; if (J->base[0]) { if (tviscdata(&rd->argv[0])) { CTypeID id = argv2cdata(J, J->base[0], &rd->argv[0])->ctypeid; CType *ct = ctype_raw(cts, id); if (ctype_isptr(ct->info)) id = ctype_cid(ct->info); tv = lj_ctype_meta(cts, id, (MMS)rd->data); } if (!tv && J->base[1] && tviscdata(&rd->argv[1])) { CTypeID id = argv2cdata(J, J->base[1], &rd->argv[1])->ctypeid; CType *ct = ctype_raw(cts, id); if (ctype_isptr(ct->info)) id = ctype_cid(ct->info); tv = lj_ctype_meta(cts, id, (MMS)rd->data); } } if (tv) { if (tvisfunc(tv)) { J->base[-1] = lj_ir_kfunc(J, funcV(tv)) | TREF_FRAME; rd->nres = -1; /* Pending tailcall. */ return 0; } /* NYI: non-function metamethods. */ } else if ((MMS)rd->data == MM_eq) { /* Fallback cdata pointer comparison. */ if (sp[0] && sp[1] && ctype_isnum(s[0]->info) == ctype_isnum(s[1]->info)) { /* Assume true comparison. Fixup and emit pending guard later. */ lj_ir_set(J, IRTG(IR_EQ, IRT_PTR), sp[0], sp[1]); J->postproc = LJ_POST_FIXGUARD; return TREF_TRUE; } else { return TREF_FALSE; } } lj_trace_err(J, LJ_TRERR_BADTYPE); return 0; } void LJ_FASTCALL recff_cdata_arith(jit_State *J, RecordFFData *rd) { CTState *cts = ctype_ctsG(J2G(J)); TRef sp[2]; CType *s[2]; MSize i; for (i = 0; i < 2; i++) { TRef tr = J->base[i]; CType *ct = ctype_get(cts, CTID_DOUBLE); if (!tr) { lj_trace_err(J, LJ_TRERR_BADTYPE); } else if (tref_iscdata(tr)) { CTypeID id = argv2cdata(J, tr, &rd->argv[i])->ctypeid; IRType t; ct = ctype_raw(cts, id); t = crec_ct2irt(cts, ct); if (ctype_isptr(ct->info)) { /* Resolve pointer or reference. */ tr = emitir(IRT(IR_FLOAD, t), tr, IRFL_CDATA_PTR); if (ctype_isref(ct->info)) { ct = ctype_rawchild(cts, ct); t = crec_ct2irt(cts, ct); } } else if (t == IRT_I64 || t == IRT_U64) { tr = emitir(IRT(IR_FLOAD, t), tr, IRFL_CDATA_INT64); lj_needsplit(J); goto ok; } else if (t == IRT_INT || t == IRT_U32) { tr = emitir(IRT(IR_FLOAD, t), tr, IRFL_CDATA_INT); if (ctype_isenum(ct->info)) ct = ctype_child(cts, ct); goto ok; } else if (ctype_isfunc(ct->info)) { tr = emitir(IRT(IR_FLOAD, IRT_PTR), tr, IRFL_CDATA_PTR); ct = ctype_get(cts, lj_ctype_intern(cts, CTINFO(CT_PTR, CTALIGN_PTR|id), CTSIZE_PTR)); goto ok; } else { tr = emitir(IRT(IR_ADD, IRT_PTR), tr, lj_ir_kintp(J, sizeof(GCcdata))); } if (ctype_isenum(ct->info)) ct = ctype_child(cts, ct); if (ctype_isnum(ct->info)) { if (t == IRT_CDATA) { tr = 0; } else { if (t == IRT_I64 || t == IRT_U64) lj_needsplit(J); tr = emitir(IRT(IR_XLOAD, t), tr, 0); } } } else if (tref_isnil(tr)) { tr = lj_ir_kptr(J, NULL); ct = ctype_get(cts, CTID_P_VOID); } else if (tref_isinteger(tr)) { ct = ctype_get(cts, CTID_INT32); } else if (tref_isstr(tr)) { TRef tr2 = J->base[1-i]; CTypeID id = argv2cdata(J, tr2, &rd->argv[1-i])->ctypeid; ct = ctype_raw(cts, id); if (ctype_isenum(ct->info)) { /* Match string against enum constant. */ GCstr *str = strV(&rd->argv[i]); CTSize ofs; CType *cct = lj_ctype_getfield(cts, ct, str, &ofs); if (cct && ctype_isconstval(cct->info)) { /* Specialize to the name of the enum constant. */ emitir(IRTG(IR_EQ, IRT_STR), tr, lj_ir_kstr(J, str)); ct = ctype_child(cts, cct); tr = lj_ir_kint(J, (int32_t)ofs); } else { /* Interpreter will throw or return false. */ ct = ctype_get(cts, CTID_P_VOID); } } else if (ctype_isptr(ct->info)) { tr = emitir(IRT(IR_ADD, IRT_PTR), tr, lj_ir_kintp(J, sizeof(GCstr))); } else { ct = ctype_get(cts, CTID_P_VOID); } } else if (!tref_isnum(tr)) { tr = 0; ct = ctype_get(cts, CTID_P_VOID); } ok: s[i] = ct; sp[i] = tr; } { TRef tr; if (!(tr = crec_arith_int64(J, sp, s, (MMS)rd->data)) && !(tr = crec_arith_ptr(J, sp, s, (MMS)rd->data)) && !(tr = crec_arith_meta(J, sp, s, cts, rd))) return; J->base[0] = tr; /* Fixup cdata comparisons, too. Avoids some cdata escapes. */ if (J->postproc == LJ_POST_FIXGUARD && frame_iscont(J->L->base-1) && !irt_isguard(J->guardemit)) { const BCIns *pc = frame_contpc(J->L->base-1) - 1; if (bc_op(*pc) <= BC_ISNEP) { setframe_pc(&J2G(J)->tmptv, pc); J2G(J)->tmptv.u32.lo = ((tref_istrue(tr) ^ bc_op(*pc)) & 1); J->postproc = LJ_POST_FIXCOMP; } } } } /* -- C library namespace metamethods ------------------------------------- */ void LJ_FASTCALL recff_clib_index(jit_State *J, RecordFFData *rd) { CTState *cts = ctype_ctsG(J2G(J)); if (tref_isudata(J->base[0]) && tref_isstr(J->base[1]) && udataV(&rd->argv[0])->udtype == UDTYPE_FFI_CLIB) { CLibrary *cl = (CLibrary *)uddata(udataV(&rd->argv[0])); GCstr *name = strV(&rd->argv[1]); CType *ct; CTypeID id = lj_ctype_getname(cts, &ct, name, CLNS_INDEX); cTValue *tv = lj_tab_getstr(cl->cache, name); rd->nres = rd->data; if (id && tv && !tvisnil(tv)) { /* Specialize to the symbol name and make the result a constant. */ emitir(IRTG(IR_EQ, IRT_STR), J->base[1], lj_ir_kstr(J, name)); if (ctype_isconstval(ct->info)) { if (ct->size >= 0x80000000u && (ctype_child(cts, ct)->info & CTF_UNSIGNED)) J->base[0] = lj_ir_knum(J, (lua_Number)(uint32_t)ct->size); else J->base[0] = lj_ir_kint(J, (int32_t)ct->size); } else if (ctype_isextern(ct->info)) { CTypeID sid = ctype_cid(ct->info); void *sp = *(void **)cdataptr(cdataV(tv)); TRef ptr; ct = ctype_raw(cts, sid); if (LJ_64 && !checkptr32(sp)) ptr = lj_ir_kintp(J, (uintptr_t)sp); else ptr = lj_ir_kptr(J, sp); if (rd->data) { J->base[0] = crec_tv_ct(J, ct, sid, ptr); } else { J->needsnap = 1; crec_ct_tv(J, ct, ptr, J->base[2], &rd->argv[2]); } } else { J->base[0] = lj_ir_kgc(J, obj2gco(cdataV(tv)), IRT_CDATA); } } else { lj_trace_err(J, LJ_TRERR_NOCACHE); } } /* else: interpreter will throw. */ } /* -- FFI library functions ----------------------------------------------- */ static TRef crec_toint(jit_State *J, CTState *cts, TRef sp, TValue *sval) { return crec_ct_tv(J, ctype_get(cts, CTID_INT32), 0, sp, sval); } void LJ_FASTCALL recff_ffi_new(jit_State *J, RecordFFData *rd) { crec_alloc(J, rd, argv2ctype(J, J->base[0], &rd->argv[0])); } void LJ_FASTCALL recff_ffi_errno(jit_State *J, RecordFFData *rd) { UNUSED(rd); if (J->base[0]) lj_trace_err(J, LJ_TRERR_NYICALL); J->base[0] = lj_ir_call(J, IRCALL_lj_vm_errno); } void LJ_FASTCALL recff_ffi_string(jit_State *J, RecordFFData *rd) { CTState *cts = ctype_ctsG(J2G(J)); TRef tr = J->base[0]; if (tr) { TRef trlen = J->base[1]; if (!tref_isnil(trlen)) { trlen = crec_toint(J, cts, trlen, &rd->argv[1]); tr = crec_ct_tv(J, ctype_get(cts, CTID_P_CVOID), 0, tr, &rd->argv[0]); } else { tr = crec_ct_tv(J, ctype_get(cts, CTID_P_CCHAR), 0, tr, &rd->argv[0]); trlen = lj_ir_call(J, IRCALL_strlen, tr); } J->base[0] = emitir(IRT(IR_XSNEW, IRT_STR), tr, trlen); } /* else: interpreter will throw. */ } void LJ_FASTCALL recff_ffi_copy(jit_State *J, RecordFFData *rd) { CTState *cts = ctype_ctsG(J2G(J)); TRef trdst = J->base[0], trsrc = J->base[1], trlen = J->base[2]; if (trdst && trsrc && (trlen || tref_isstr(trsrc))) { trdst = crec_ct_tv(J, ctype_get(cts, CTID_P_VOID), 0, trdst, &rd->argv[0]); trsrc = crec_ct_tv(J, ctype_get(cts, CTID_P_CVOID), 0, trsrc, &rd->argv[1]); if (trlen) { trlen = crec_toint(J, cts, trlen, &rd->argv[2]); } else { trlen = emitir(IRTI(IR_FLOAD), J->base[1], IRFL_STR_LEN); trlen = emitir(IRTI(IR_ADD), trlen, lj_ir_kint(J, 1)); } rd->nres = 0; crec_copy(J, trdst, trsrc, trlen, NULL); } /* else: interpreter will throw. */ } void LJ_FASTCALL recff_ffi_fill(jit_State *J, RecordFFData *rd) { CTState *cts = ctype_ctsG(J2G(J)); TRef trdst = J->base[0], trlen = J->base[1], trfill = J->base[2]; if (trdst && trlen) { CTSize step = 1; if (tviscdata(&rd->argv[0])) { /* Get alignment of original destination. */ CTSize sz; CType *ct = ctype_raw(cts, cdataV(&rd->argv[0])->ctypeid); if (ctype_isptr(ct->info)) ct = ctype_rawchild(cts, ct); step = (1u<argv[0]); trlen = crec_toint(J, cts, trlen, &rd->argv[1]); if (trfill) trfill = crec_toint(J, cts, trfill, &rd->argv[2]); else trfill = lj_ir_kint(J, 0); rd->nres = 0; crec_fill(J, trdst, trlen, trfill, step); } /* else: interpreter will throw. */ } void LJ_FASTCALL recff_ffi_typeof(jit_State *J, RecordFFData *rd) { if (tref_iscdata(J->base[0])) { TRef trid = lj_ir_kint(J, argv2ctype(J, J->base[0], &rd->argv[0])); J->base[0] = emitir(IRTG(IR_CNEWI, IRT_CDATA), lj_ir_kint(J, CTID_CTYPEID), trid); } else { setfuncV(J->L, &J->errinfo, J->fn); lj_trace_err_info(J, LJ_TRERR_NYIFFU); } } void LJ_FASTCALL recff_ffi_istype(jit_State *J, RecordFFData *rd) { argv2ctype(J, J->base[0], &rd->argv[0]); if (tref_iscdata(J->base[1])) { argv2ctype(J, J->base[1], &rd->argv[1]); J->postproc = LJ_POST_FIXBOOL; J->base[0] = TREF_TRUE; } else { J->base[0] = TREF_FALSE; } } void LJ_FASTCALL recff_ffi_abi(jit_State *J, RecordFFData *rd) { if (tref_isstr(J->base[0])) { /* Specialize to the ABI string to make the boolean result a constant. */ emitir(IRTG(IR_EQ, IRT_STR), J->base[0], lj_ir_kstr(J, strV(&rd->argv[0]))); J->postproc = LJ_POST_FIXBOOL; J->base[0] = TREF_TRUE; } else { lj_trace_err(J, LJ_TRERR_BADTYPE); } } /* Record ffi.sizeof(), ffi.alignof(), ffi.offsetof(). */ void LJ_FASTCALL recff_ffi_xof(jit_State *J, RecordFFData *rd) { CTypeID id = argv2ctype(J, J->base[0], &rd->argv[0]); if (rd->data == FF_ffi_sizeof) { CType *ct = lj_ctype_rawref(ctype_ctsG(J2G(J)), id); if (ctype_isvltype(ct->info)) lj_trace_err(J, LJ_TRERR_BADTYPE); } else if (rd->data == FF_ffi_offsetof) { /* Specialize to the field name. */ if (!tref_isstr(J->base[1])) lj_trace_err(J, LJ_TRERR_BADTYPE); emitir(IRTG(IR_EQ, IRT_STR), J->base[1], lj_ir_kstr(J, strV(&rd->argv[1]))); rd->nres = 3; /* Just in case. */ } J->postproc = LJ_POST_FIXCONST; J->base[0] = J->base[1] = J->base[2] = TREF_NIL; } void LJ_FASTCALL recff_ffi_gc(jit_State *J, RecordFFData *rd) { argv2cdata(J, J->base[0], &rd->argv[0]); crec_finalizer(J, J->base[0], &rd->argv[1]); } /* -- Miscellaneous library functions ------------------------------------- */ void LJ_FASTCALL lj_crecord_tonumber(jit_State *J, RecordFFData *rd) { CTState *cts = ctype_ctsG(J2G(J)); CType *d, *ct = lj_ctype_rawref(cts, cdataV(&rd->argv[0])->ctypeid); if (ctype_isenum(ct->info)) ct = ctype_child(cts, ct); if (ctype_isnum(ct->info) || ctype_iscomplex(ct->info)) { if (ctype_isinteger_or_bool(ct->info) && ct->size <= 4 && !(ct->size == 4 && (ct->info & CTF_UNSIGNED))) d = ctype_get(cts, CTID_INT32); else d = ctype_get(cts, CTID_DOUBLE); J->base[0] = crec_ct_tv(J, d, 0, J->base[0], &rd->argv[0]); } else { J->base[0] = TREF_NIL; } } #undef IR #undef emitir #undef emitconv #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lib_base.c0000644000175000017500000004121713122010155016602 0ustar philphil/* ** Base and coroutine library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2011 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #include #define lib_base_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_meta.h" #include "lj_state.h" #if LJ_HASFFI #include "lj_ctype.h" #include "lj_cconv.h" #endif #include "lj_bc.h" #include "lj_ff.h" #include "lj_dispatch.h" #include "lj_char.h" #include "lj_strscan.h" #include "lj_lib.h" /* -- Base library: checks ------------------------------------------------ */ #define LJLIB_MODULE_base LJLIB_ASM(assert) LJLIB_REC(.) { GCstr *s; lj_lib_checkany(L, 1); s = lj_lib_optstr(L, 2); if (s) lj_err_callermsg(L, strdata(s)); else lj_err_caller(L, LJ_ERR_ASSERT); return FFH_UNREACHABLE; } /* ORDER LJ_T */ LJLIB_PUSH("nil") LJLIB_PUSH("boolean") LJLIB_PUSH(top-1) /* boolean */ LJLIB_PUSH("userdata") LJLIB_PUSH("string") LJLIB_PUSH("upval") LJLIB_PUSH("thread") LJLIB_PUSH("proto") LJLIB_PUSH("function") LJLIB_PUSH("trace") LJLIB_PUSH("cdata") LJLIB_PUSH("table") LJLIB_PUSH(top-9) /* userdata */ LJLIB_PUSH("number") LJLIB_ASM_(type) LJLIB_REC(.) /* Recycle the lj_lib_checkany(L, 1) from assert. */ /* -- Base library: iterators --------------------------------------------- */ /* This solves a circular dependency problem -- change FF_next_N as needed. */ LJ_STATIC_ASSERT((int)FF_next == FF_next_N); LJLIB_ASM(next) { lj_lib_checktab(L, 1); return FFH_UNREACHABLE; } #if LJ_52 || LJ_HASFFI static int ffh_pairs(lua_State *L, MMS mm) { TValue *o = lj_lib_checkany(L, 1); cTValue *mo = lj_meta_lookup(L, o, mm); if ((LJ_52 || tviscdata(o)) && !tvisnil(mo)) { L->top = o+1; /* Only keep one argument. */ copyTV(L, L->base-1, mo); /* Replace callable. */ return FFH_TAILCALL; } else { if (!tvistab(o)) lj_err_argt(L, 1, LUA_TTABLE); setfuncV(L, o-1, funcV(lj_lib_upvalue(L, 1))); if (mm == MM_pairs) setnilV(o+1); else setintV(o+1, 0); return FFH_RES(3); } } #else #define ffh_pairs(L, mm) (lj_lib_checktab(L, 1), FFH_UNREACHABLE) #endif LJLIB_PUSH(lastcl) LJLIB_ASM(pairs) { return ffh_pairs(L, MM_pairs); } LJLIB_NOREGUV LJLIB_ASM(ipairs_aux) LJLIB_REC(.) { lj_lib_checktab(L, 1); lj_lib_checkint(L, 2); return FFH_UNREACHABLE; } LJLIB_PUSH(lastcl) LJLIB_ASM(ipairs) LJLIB_REC(.) { return ffh_pairs(L, MM_ipairs); } /* -- Base library: getters and setters ----------------------------------- */ LJLIB_ASM_(getmetatable) LJLIB_REC(.) /* Recycle the lj_lib_checkany(L, 1) from assert. */ LJLIB_ASM(setmetatable) LJLIB_REC(.) { GCtab *t = lj_lib_checktab(L, 1); GCtab *mt = lj_lib_checktabornil(L, 2); if (!tvisnil(lj_meta_lookup(L, L->base, MM_metatable))) lj_err_caller(L, LJ_ERR_PROTMT); setgcref(t->metatable, obj2gco(mt)); if (mt) { lj_gc_objbarriert(L, t, mt); } settabV(L, L->base-1, t); return FFH_RES(1); } LJLIB_CF(getfenv) { GCfunc *fn; cTValue *o = L->base; if (!(o < L->top && tvisfunc(o))) { int level = lj_lib_optint(L, 1, 1); o = lj_debug_frame(L, level, &level); if (o == NULL) lj_err_arg(L, 1, LJ_ERR_INVLVL); } fn = &gcval(o)->fn; settabV(L, L->top++, isluafunc(fn) ? tabref(fn->l.env) : tabref(L->env)); return 1; } LJLIB_CF(setfenv) { GCfunc *fn; GCtab *t = lj_lib_checktab(L, 2); cTValue *o = L->base; if (!(o < L->top && tvisfunc(o))) { int level = lj_lib_checkint(L, 1); if (level == 0) { /* NOBARRIER: A thread (i.e. L) is never black. */ setgcref(L->env, obj2gco(t)); return 0; } o = lj_debug_frame(L, level, &level); if (o == NULL) lj_err_arg(L, 1, LJ_ERR_INVLVL); } fn = &gcval(o)->fn; if (!isluafunc(fn)) lj_err_caller(L, LJ_ERR_SETFENV); setgcref(fn->l.env, obj2gco(t)); lj_gc_objbarrier(L, obj2gco(fn), t); setfuncV(L, L->top++, fn); return 1; } LJLIB_ASM(rawget) LJLIB_REC(.) { lj_lib_checktab(L, 1); lj_lib_checkany(L, 2); return FFH_UNREACHABLE; } LJLIB_CF(rawset) LJLIB_REC(.) { lj_lib_checktab(L, 1); lj_lib_checkany(L, 2); L->top = 1+lj_lib_checkany(L, 3); lua_rawset(L, 1); return 1; } LJLIB_CF(rawequal) LJLIB_REC(.) { cTValue *o1 = lj_lib_checkany(L, 1); cTValue *o2 = lj_lib_checkany(L, 2); setboolV(L->top-1, lj_obj_equal(o1, o2)); return 1; } #if LJ_52 LJLIB_CF(rawlen) LJLIB_REC(.) { cTValue *o = L->base; int32_t len; if (L->top > o && tvisstr(o)) len = (int32_t)strV(o)->len; else len = (int32_t)lj_tab_len(lj_lib_checktab(L, 1)); setintV(L->top-1, len); return 1; } #endif LJLIB_CF(unpack) { GCtab *t = lj_lib_checktab(L, 1); int32_t n, i = lj_lib_optint(L, 2, 1); int32_t e = (L->base+3-1 < L->top && !tvisnil(L->base+3-1)) ? lj_lib_checkint(L, 3) : (int32_t)lj_tab_len(t); if (i > e) return 0; n = e - i + 1; if (n <= 0 || !lua_checkstack(L, n)) lj_err_caller(L, LJ_ERR_UNPACK); do { cTValue *tv = lj_tab_getint(t, i); if (tv) { copyTV(L, L->top++, tv); } else { setnilV(L->top++); } } while (i++ < e); return n; } LJLIB_CF(select) LJLIB_REC(.) { int32_t n = (int32_t)(L->top - L->base); if (n >= 1 && tvisstr(L->base) && *strVdata(L->base) == '#') { setintV(L->top-1, n-1); return 1; } else { int32_t i = lj_lib_checkint(L, 1); if (i < 0) i = n + i; else if (i > n) i = n; if (i < 1) lj_err_arg(L, 1, LJ_ERR_IDXRNG); return n - i; } } /* -- Base library: conversions ------------------------------------------- */ LJLIB_ASM(tonumber) LJLIB_REC(.) { int32_t base = lj_lib_optint(L, 2, 10); if (base == 10) { TValue *o = lj_lib_checkany(L, 1); if (lj_strscan_numberobj(o)) { copyTV(L, L->base-1, o); return FFH_RES(1); } #if LJ_HASFFI if (tviscdata(o)) { CTState *cts = ctype_cts(L); CType *ct = lj_ctype_rawref(cts, cdataV(o)->ctypeid); if (ctype_isenum(ct->info)) ct = ctype_child(cts, ct); if (ctype_isnum(ct->info) || ctype_iscomplex(ct->info)) { if (LJ_DUALNUM && ctype_isinteger_or_bool(ct->info) && ct->size <= 4 && !(ct->size == 4 && (ct->info & CTF_UNSIGNED))) { int32_t i; lj_cconv_ct_tv(cts, ctype_get(cts, CTID_INT32), (uint8_t *)&i, o, 0); setintV(L->base-1, i); return FFH_RES(1); } lj_cconv_ct_tv(cts, ctype_get(cts, CTID_DOUBLE), (uint8_t *)&(L->base-1)->n, o, 0); return FFH_RES(1); } } #endif } else { const char *p = strdata(lj_lib_checkstr(L, 1)); char *ep; unsigned long ul; if (base < 2 || base > 36) lj_err_arg(L, 2, LJ_ERR_BASERNG); ul = strtoul(p, &ep, base); if (p != ep) { while (lj_char_isspace((unsigned char)(*ep))) ep++; if (*ep == '\0') { if (LJ_DUALNUM && LJ_LIKELY(ul < 0x80000000u)) setintV(L->base-1, (int32_t)ul); else setnumV(L->base-1, (lua_Number)ul); return FFH_RES(1); } } } setnilV(L->base-1); return FFH_RES(1); } LJLIB_PUSH("nil") LJLIB_PUSH("false") LJLIB_PUSH("true") LJLIB_ASM(tostring) LJLIB_REC(.) { TValue *o = lj_lib_checkany(L, 1); cTValue *mo; L->top = o+1; /* Only keep one argument. */ if (!tvisnil(mo = lj_meta_lookup(L, o, MM_tostring))) { copyTV(L, L->base-1, mo); /* Replace callable. */ return FFH_TAILCALL; } else { GCstr *s; if (tvisnumber(o)) { s = lj_str_fromnumber(L, o); } else if (tvispri(o)) { s = strV(lj_lib_upvalue(L, -(int32_t)itype(o))); } else { if (tvisfunc(o) && isffunc(funcV(o))) lua_pushfstring(L, "function: builtin#%d", funcV(o)->c.ffid); else lua_pushfstring(L, "%s: %p", lj_typename(o), lua_topointer(L, 1)); /* Note: lua_pushfstring calls the GC which may invalidate o. */ s = strV(L->top-1); } setstrV(L, L->base-1, s); return FFH_RES(1); } } /* -- Base library: throw and catch errors -------------------------------- */ LJLIB_CF(error) { int32_t level = lj_lib_optint(L, 2, 1); lua_settop(L, 1); if (lua_isstring(L, 1) && level > 0) { luaL_where(L, level); lua_pushvalue(L, 1); lua_concat(L, 2); } return lua_error(L); } LJLIB_ASM(pcall) LJLIB_REC(.) { lj_lib_checkany(L, 1); lj_lib_checkfunc(L, 2); /* For xpcall only. */ return FFH_UNREACHABLE; } LJLIB_ASM_(xpcall) LJLIB_REC(.) /* -- Base library: load Lua code ----------------------------------------- */ static int load_aux(lua_State *L, int status, int envarg) { if (status == 0) { if (tvistab(L->base+envarg-1)) { GCfunc *fn = funcV(L->top-1); GCtab *t = tabV(L->base+envarg-1); setgcref(fn->c.env, obj2gco(t)); lj_gc_objbarrier(L, fn, t); } return 1; } else { setnilV(L->top-2); return 2; } } LJLIB_CF(loadfile) { GCstr *fname = lj_lib_optstr(L, 1); GCstr *mode = lj_lib_optstr(L, 2); int status; lua_settop(L, 3); /* Ensure env arg exists. */ status = luaL_loadfilex(L, fname ? strdata(fname) : NULL, mode ? strdata(mode) : NULL); return load_aux(L, status, 3); } static const char *reader_func(lua_State *L, void *ud, size_t *size) { UNUSED(ud); luaL_checkstack(L, 2, "too many nested functions"); copyTV(L, L->top++, L->base); lua_call(L, 0, 1); /* Call user-supplied function. */ L->top--; if (tvisnil(L->top)) { *size = 0; return NULL; } else if (tvisstr(L->top) || tvisnumber(L->top)) { copyTV(L, L->base+4, L->top); /* Anchor string in reserved stack slot. */ return lua_tolstring(L, 5, size); } else { lj_err_caller(L, LJ_ERR_RDRSTR); return NULL; } } LJLIB_CF(load) { GCstr *name = lj_lib_optstr(L, 2); GCstr *mode = lj_lib_optstr(L, 3); int status; if (L->base < L->top && (tvisstr(L->base) || tvisnumber(L->base))) { GCstr *s = lj_lib_checkstr(L, 1); lua_settop(L, 4); /* Ensure env arg exists. */ status = luaL_loadbufferx(L, strdata(s), s->len, strdata(name ? name : s), mode ? strdata(mode) : NULL); } else { lj_lib_checkfunc(L, 1); lua_settop(L, 5); /* Reserve a slot for the string from the reader. */ status = lua_loadx(L, reader_func, NULL, name ? strdata(name) : "=(load)", mode ? strdata(mode) : NULL); } return load_aux(L, status, 4); } LJLIB_CF(loadstring) { return lj_cf_load(L); } LJLIB_CF(dofile) { GCstr *fname = lj_lib_optstr(L, 1); setnilV(L->top); L->top = L->base+1; if (luaL_loadfile(L, fname ? strdata(fname) : NULL) != 0) lua_error(L); lua_call(L, 0, LUA_MULTRET); return (int)(L->top - L->base) - 1; } /* -- Base library: GC control -------------------------------------------- */ LJLIB_CF(gcinfo) { setintV(L->top++, (G(L)->gc.total >> 10)); return 1; } LJLIB_CF(collectgarbage) { int opt = lj_lib_checkopt(L, 1, LUA_GCCOLLECT, /* ORDER LUA_GC* */ "\4stop\7restart\7collect\5count\1\377\4step\10setpause\12setstepmul"); int32_t data = lj_lib_optint(L, 2, 0); if (opt == LUA_GCCOUNT) { setnumV(L->top, (lua_Number)G(L)->gc.total/1024.0); } else { int res = lua_gc(L, opt, data); if (opt == LUA_GCSTEP) setboolV(L->top, res); else setintV(L->top, res); } L->top++; return 1; } /* -- Base library: miscellaneous functions ------------------------------- */ LJLIB_PUSH(top-2) /* Upvalue holds weak table. */ LJLIB_CF(newproxy) { lua_settop(L, 1); lua_newuserdata(L, 0); if (lua_toboolean(L, 1) == 0) { /* newproxy(): without metatable. */ return 1; } else if (lua_isboolean(L, 1)) { /* newproxy(true): with metatable. */ lua_newtable(L); lua_pushvalue(L, -1); lua_pushboolean(L, 1); lua_rawset(L, lua_upvalueindex(1)); /* Remember mt in weak table. */ } else { /* newproxy(proxy): inherit metatable. */ int validproxy = 0; if (lua_getmetatable(L, 1)) { lua_rawget(L, lua_upvalueindex(1)); validproxy = lua_toboolean(L, -1); lua_pop(L, 1); } if (!validproxy) lj_err_arg(L, 1, LJ_ERR_NOPROXY); lua_getmetatable(L, 1); } lua_setmetatable(L, 2); return 1; } LJLIB_PUSH("tostring") LJLIB_CF(print) { ptrdiff_t i, nargs = L->top - L->base; cTValue *tv = lj_tab_getstr(tabref(L->env), strV(lj_lib_upvalue(L, 1))); int shortcut; if (tv && !tvisnil(tv)) { copyTV(L, L->top++, tv); } else { setstrV(L, L->top++, strV(lj_lib_upvalue(L, 1))); lua_gettable(L, LUA_GLOBALSINDEX); tv = L->top-1; } shortcut = (tvisfunc(tv) && funcV(tv)->c.ffid == FF_tostring); for (i = 0; i < nargs; i++) { const char *str; size_t size; cTValue *o = &L->base[i]; if (shortcut && tvisstr(o)) { str = strVdata(o); size = strV(o)->len; } else if (shortcut && tvisint(o)) { char buf[LJ_STR_INTBUF]; char *p = lj_str_bufint(buf, intV(o)); size = (size_t)(buf+LJ_STR_INTBUF-p); str = p; } else if (shortcut && tvisnum(o)) { char buf[LJ_STR_NUMBUF]; size = lj_str_bufnum(buf, o); str = buf; } else { copyTV(L, L->top+1, o); copyTV(L, L->top, L->top-1); L->top += 2; lua_call(L, 1, 1); str = lua_tolstring(L, -1, &size); if (!str) lj_err_caller(L, LJ_ERR_PRTOSTR); L->top--; } if (i) putchar('\t'); fwrite(str, 1, size, stdout); } putchar('\n'); return 0; } LJLIB_PUSH(top-3) LJLIB_SET(_VERSION) #include "lj_libdef.h" /* -- Coroutine library --------------------------------------------------- */ #define LJLIB_MODULE_coroutine LJLIB_CF(coroutine_status) { const char *s; lua_State *co; if (!(L->top > L->base && tvisthread(L->base))) lj_err_arg(L, 1, LJ_ERR_NOCORO); co = threadV(L->base); if (co == L) s = "running"; else if (co->status == LUA_YIELD) s = "suspended"; else if (co->status != 0) s = "dead"; else if (co->base > tvref(co->stack)+1) s = "normal"; else if (co->top == co->base) s = "dead"; else s = "suspended"; lua_pushstring(L, s); return 1; } LJLIB_CF(coroutine_running) { #if LJ_52 int ismain = lua_pushthread(L); setboolV(L->top++, ismain); return 2; #else if (lua_pushthread(L)) setnilV(L->top++); return 1; #endif } LJLIB_CF(coroutine_create) { lua_State *L1; if (!(L->base < L->top && tvisfunc(L->base))) lj_err_argt(L, 1, LUA_TFUNCTION); L1 = lua_newthread(L); setfuncV(L, L1->top++, funcV(L->base)); return 1; } LJLIB_ASM(coroutine_yield) { lj_err_caller(L, LJ_ERR_CYIELD); return FFH_UNREACHABLE; } static int ffh_resume(lua_State *L, lua_State *co, int wrap) { if (co->cframe != NULL || co->status > LUA_YIELD || (co->status == 0 && co->top == co->base)) { ErrMsg em = co->cframe ? LJ_ERR_CORUN : LJ_ERR_CODEAD; if (wrap) lj_err_caller(L, em); setboolV(L->base-1, 0); setstrV(L, L->base, lj_err_str(L, em)); return FFH_RES(2); } lj_state_growstack(co, (MSize)(L->top - L->base)); return FFH_RETRY; } LJLIB_ASM(coroutine_resume) { if (!(L->top > L->base && tvisthread(L->base))) lj_err_arg(L, 1, LJ_ERR_NOCORO); return ffh_resume(L, threadV(L->base), 0); } LJLIB_NOREG LJLIB_ASM(coroutine_wrap_aux) { return ffh_resume(L, threadV(lj_lib_upvalue(L, 1)), 1); } /* Inline declarations. */ LJ_ASMF void lj_ff_coroutine_wrap_aux(void); #if !(LJ_TARGET_MIPS && defined(ljamalg_c)) LJ_FUNCA_NORET void LJ_FASTCALL lj_ffh_coroutine_wrap_err(lua_State *L, lua_State *co); #endif /* Error handler, called from assembler VM. */ void LJ_FASTCALL lj_ffh_coroutine_wrap_err(lua_State *L, lua_State *co) { co->top--; copyTV(L, L->top, co->top); L->top++; if (tvisstr(L->top-1)) lj_err_callermsg(L, strVdata(L->top-1)); else lj_err_run(L); } /* Forward declaration. */ static void setpc_wrap_aux(lua_State *L, GCfunc *fn); LJLIB_CF(coroutine_wrap) { lj_cf_coroutine_create(L); lj_lib_pushcc(L, lj_ffh_coroutine_wrap_aux, FF_coroutine_wrap_aux, 1); setpc_wrap_aux(L, funcV(L->top-1)); return 1; } #include "lj_libdef.h" /* Fix the PC of wrap_aux. Really ugly workaround. */ static void setpc_wrap_aux(lua_State *L, GCfunc *fn) { setmref(fn->c.pc, &L2GG(L)->bcff[lj_lib_init_coroutine[1]+2]); } /* ------------------------------------------------------------------------ */ static void newproxy_weaktable(lua_State *L) { /* NOBARRIER: The table is new (marked white). */ GCtab *t = lj_tab_new(L, 0, 1); settabV(L, L->top++, t); setgcref(t->metatable, obj2gco(t)); setstrV(L, lj_tab_setstr(L, t, lj_str_newlit(L, "__mode")), lj_str_newlit(L, "kv")); t->nomm = (uint8_t)(~(1u<env); settabV(L, lj_tab_setstr(L, env, lj_str_newlit(L, "_G")), env); lua_pushliteral(L, LUA_VERSION); /* top-3. */ newproxy_weaktable(L); /* top-2. */ LJ_LIB_REG(L, "_G", base); LJ_LIB_REG(L, LUA_COLIBNAME, coroutine); return 2; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_errmsg.h0000644000175000017500000001742113122010155017033 0ustar philphil/* ** VM error messages. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* This file may be included multiple times with different ERRDEF macros. */ /* Basic error handling. */ ERRDEF(ERRMEM, "not enough memory") ERRDEF(ERRERR, "error in error handling") ERRDEF(ERRCPP, "C++ exception") /* Allocations. */ ERRDEF(STROV, "string length overflow") ERRDEF(UDATAOV, "userdata length overflow") ERRDEF(STKOV, "stack overflow") ERRDEF(STKOVM, "stack overflow (%s)") ERRDEF(TABOV, "table overflow") /* Table indexing. */ ERRDEF(NANIDX, "table index is NaN") ERRDEF(NILIDX, "table index is nil") ERRDEF(NEXTIDX, "invalid key to " LUA_QL("next")) /* Metamethod resolving. */ ERRDEF(BADCALL, "attempt to call a %s value") ERRDEF(BADOPRT, "attempt to %s %s " LUA_QS " (a %s value)") ERRDEF(BADOPRV, "attempt to %s a %s value") ERRDEF(BADCMPT, "attempt to compare %s with %s") ERRDEF(BADCMPV, "attempt to compare two %s values") ERRDEF(GETLOOP, "loop in gettable") ERRDEF(SETLOOP, "loop in settable") ERRDEF(OPCALL, "call") ERRDEF(OPINDEX, "index") ERRDEF(OPARITH, "perform arithmetic on") ERRDEF(OPCAT, "concatenate") ERRDEF(OPLEN, "get length of") /* Type checks. */ ERRDEF(BADSELF, "calling " LUA_QS " on bad self (%s)") ERRDEF(BADARG, "bad argument #%d to " LUA_QS " (%s)") ERRDEF(BADTYPE, "%s expected, got %s") ERRDEF(BADVAL, "invalid value") ERRDEF(NOVAL, "value expected") ERRDEF(NOCORO, "coroutine expected") ERRDEF(NOTABN, "nil or table expected") ERRDEF(NOLFUNC, "Lua function expected") ERRDEF(NOFUNCL, "function or level expected") ERRDEF(NOSFT, "string/function/table expected") ERRDEF(NOPROXY, "boolean or proxy expected") ERRDEF(FORINIT, LUA_QL("for") " initial value must be a number") ERRDEF(FORLIM, LUA_QL("for") " limit must be a number") ERRDEF(FORSTEP, LUA_QL("for") " step must be a number") /* C API checks. */ ERRDEF(NOENV, "no calling environment") ERRDEF(CYIELD, "attempt to yield across C-call boundary") ERRDEF(BADLU, "bad light userdata pointer") ERRDEF(NOGCMM, "bad action while in __gc metamethod") #if LJ_TARGET_WINDOWS ERRDEF(BADFPU, "bad FPU precision (use D3DCREATE_FPU_PRESERVE with DirectX)") #endif /* Standard library function errors. */ ERRDEF(ASSERT, "assertion failed!") ERRDEF(PROTMT, "cannot change a protected metatable") ERRDEF(UNPACK, "too many results to unpack") ERRDEF(RDRSTR, "reader function must return a string") ERRDEF(PRTOSTR, LUA_QL("tostring") " must return a string to " LUA_QL("print")) ERRDEF(IDXRNG, "index out of range") ERRDEF(BASERNG, "base out of range") ERRDEF(LVLRNG, "level out of range") ERRDEF(INVLVL, "invalid level") ERRDEF(INVOPT, "invalid option") ERRDEF(INVOPTM, "invalid option " LUA_QS) ERRDEF(INVFMT, "invalid format") ERRDEF(SETFENV, LUA_QL("setfenv") " cannot change environment of given object") ERRDEF(CORUN, "cannot resume running coroutine") ERRDEF(CODEAD, "cannot resume dead coroutine") ERRDEF(COSUSP, "cannot resume non-suspended coroutine") ERRDEF(TABINS, "wrong number of arguments to " LUA_QL("insert")) ERRDEF(TABCAT, "invalid value (%s) at index %d in table for " LUA_QL("concat")) ERRDEF(TABSORT, "invalid order function for sorting") ERRDEF(IOCLFL, "attempt to use a closed file") ERRDEF(IOSTDCL, "standard file is closed") ERRDEF(OSUNIQF, "unable to generate a unique filename") ERRDEF(OSDATEF, "field " LUA_QS " missing in date table") ERRDEF(STRDUMP, "unable to dump given function") ERRDEF(STRSLC, "string slice too long") ERRDEF(STRPATB, "missing " LUA_QL("[") " after " LUA_QL("%f") " in pattern") ERRDEF(STRPATC, "invalid pattern capture") ERRDEF(STRPATE, "malformed pattern (ends with " LUA_QL("%") ")") ERRDEF(STRPATM, "malformed pattern (missing " LUA_QL("]") ")") ERRDEF(STRPATU, "unbalanced pattern") ERRDEF(STRPATX, "pattern too complex") ERRDEF(STRCAPI, "invalid capture index") ERRDEF(STRCAPN, "too many captures") ERRDEF(STRCAPU, "unfinished capture") ERRDEF(STRFMTO, "invalid option " LUA_QL("%%%c") " to " LUA_QL("format")) ERRDEF(STRFMTR, "invalid format (repeated flags)") ERRDEF(STRFMTW, "invalid format (width or precision too long)") ERRDEF(STRGSRV, "invalid replacement value (a %s)") ERRDEF(BADMODN, "name conflict for module " LUA_QS) #if LJ_HASJIT ERRDEF(JITPROT, "runtime code generation failed, restricted kernel?") #if LJ_TARGET_X86ORX64 ERRDEF(NOJIT, "JIT compiler disabled, CPU does not support SSE2") #else ERRDEF(NOJIT, "JIT compiler disabled") #endif #elif defined(LJ_ARCH_NOJIT) ERRDEF(NOJIT, "no JIT compiler for this architecture (yet)") #else ERRDEF(NOJIT, "JIT compiler permanently disabled by build option") #endif ERRDEF(JITOPT, "unknown or malformed optimization flag " LUA_QS) /* Lexer/parser errors. */ ERRDEF(XMODE, "attempt to load chunk with wrong mode") ERRDEF(XNEAR, "%s near " LUA_QS) ERRDEF(XELEM, "lexical element too long") ERRDEF(XLINES, "chunk has too many lines") ERRDEF(XLEVELS, "chunk has too many syntax levels") ERRDEF(XNUMBER, "malformed number") ERRDEF(XLSTR, "unfinished long string") ERRDEF(XLCOM, "unfinished long comment") ERRDEF(XSTR, "unfinished string") ERRDEF(XESC, "invalid escape sequence") ERRDEF(XLDELIM, "invalid long string delimiter") ERRDEF(XTOKEN, LUA_QS " expected") ERRDEF(XJUMP, "control structure too long") ERRDEF(XSLOTS, "function or expression too complex") ERRDEF(XLIMC, "chunk has more than %d local variables") ERRDEF(XLIMM, "main function has more than %d %s") ERRDEF(XLIMF, "function at line %d has more than %d %s") ERRDEF(XMATCH, LUA_QS " expected (to close " LUA_QS " at line %d)") ERRDEF(XFIXUP, "function too long for return fixup") ERRDEF(XPARAM, " or " LUA_QL("...") " expected") #if !LJ_52 ERRDEF(XAMBIG, "ambiguous syntax (function call x new statement)") #endif ERRDEF(XFUNARG, "function arguments expected") ERRDEF(XSYMBOL, "unexpected symbol") ERRDEF(XDOTS, "cannot use " LUA_QL("...") " outside a vararg function") ERRDEF(XSYNTAX, "syntax error") ERRDEF(XFOR, LUA_QL("=") " or " LUA_QL("in") " expected") ERRDEF(XBREAK, "no loop to break") ERRDEF(XLUNDEF, "undefined label " LUA_QS) ERRDEF(XLDUP, "duplicate label " LUA_QS) ERRDEF(XGSCOPE, " jumps into the scope of local " LUA_QS) /* Bytecode reader errors. */ ERRDEF(BCFMT, "cannot load incompatible bytecode") ERRDEF(BCBAD, "cannot load malformed bytecode") #if LJ_HASFFI /* FFI errors. */ ERRDEF(FFI_INVTYPE, "invalid C type") ERRDEF(FFI_INVSIZE, "size of C type is unknown or too large") ERRDEF(FFI_BADSCL, "bad storage class") ERRDEF(FFI_DECLSPEC, "declaration specifier expected") ERRDEF(FFI_BADTAG, "undeclared or implicit tag " LUA_QS) ERRDEF(FFI_REDEF, "attempt to redefine " LUA_QS) ERRDEF(FFI_NUMPARAM, "wrong number of type parameters") ERRDEF(FFI_INITOV, "too many initializers for " LUA_QS) ERRDEF(FFI_BADCONV, "cannot convert " LUA_QS " to " LUA_QS) ERRDEF(FFI_BADLEN, "attempt to get length of " LUA_QS) ERRDEF(FFI_BADCONCAT, "attempt to concatenate " LUA_QS " and " LUA_QS) ERRDEF(FFI_BADARITH, "attempt to perform arithmetic on " LUA_QS " and " LUA_QS) ERRDEF(FFI_BADCOMP, "attempt to compare " LUA_QS " with " LUA_QS) ERRDEF(FFI_BADCALL, LUA_QS " is not callable") ERRDEF(FFI_NUMARG, "wrong number of arguments for function call") ERRDEF(FFI_BADMEMBER, LUA_QS " has no member named " LUA_QS) ERRDEF(FFI_BADIDX, LUA_QS " cannot be indexed") ERRDEF(FFI_BADIDXW, LUA_QS " cannot be indexed with " LUA_QS) ERRDEF(FFI_BADMM, LUA_QS " has no " LUA_QS " metamethod") ERRDEF(FFI_WRCONST, "attempt to write to constant location") ERRDEF(FFI_NODECL, "missing declaration for symbol " LUA_QS) ERRDEF(FFI_BADCBACK, "bad callback") #if LJ_OS_NOJIT ERRDEF(FFI_CBACKOV, "no support for callbacks on this OS") #else ERRDEF(FFI_CBACKOV, "too many callbacks") #endif ERRDEF(FFI_NYIPACKBIT, "NYI: packed bit fields") ERRDEF(FFI_NYICALL, "NYI: cannot call this C function (yet)") #endif #undef ERRDEF /* Detecting unused error messages: awk -F, '/^ERRDEF/ { gsub(/ERRDEF./, ""); printf "grep -q LJ_ERR_%s *.[ch] || echo %s\n", $1, $1}' lj_errmsg.h | sh */ wcc-0.0.2/src/wsh/luajit-2.0/src/lib_init.c0000644000175000017500000000251313122010155016627 0ustar philphil/* ** Library initialization. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major parts taken verbatim from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lib_init_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_arch.h" static const luaL_Reg lj_lib_load[] = { { "", luaopen_base }, { LUA_LOADLIBNAME, luaopen_package }, { LUA_TABLIBNAME, luaopen_table }, { LUA_IOLIBNAME, luaopen_io }, { LUA_OSLIBNAME, luaopen_os }, { LUA_STRLIBNAME, luaopen_string }, { LUA_MATHLIBNAME, luaopen_math }, { LUA_DBLIBNAME, luaopen_debug }, { LUA_BITLIBNAME, luaopen_bit }, { LUA_JITLIBNAME, luaopen_jit }, { NULL, NULL } }; static const luaL_Reg lj_lib_preload[] = { #if LJ_HASFFI { LUA_FFILIBNAME, luaopen_ffi }, #endif { NULL, NULL } }; LUALIB_API void luaL_openlibs(lua_State *L) { const luaL_Reg *lib; for (lib = lj_lib_load; lib->func; lib++) { lua_pushcfunction(L, lib->func); lua_pushstring(L, lib->name); lua_call(L, 1, 0); } luaL_findtable(L, LUA_REGISTRYINDEX, "_PRELOAD", sizeof(lj_lib_preload)/sizeof(lj_lib_preload[0])-1); for (lib = lj_lib_preload; lib->func; lib++) { lua_pushcfunction(L, lib->func); lua_setfield(L, -2, lib->name); } lua_pop(L, 1); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_trace.c0000644000175000017500000005634113122010155016631 0ustar philphil/* ** Trace management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_trace_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_gc.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_str.h" #include "lj_frame.h" #include "lj_state.h" #include "lj_bc.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" #include "lj_mcode.h" #include "lj_trace.h" #include "lj_snap.h" #include "lj_gdbjit.h" #include "lj_record.h" #include "lj_asm.h" #include "lj_dispatch.h" #include "lj_vm.h" #include "lj_vmevent.h" #include "lj_target.h" /* -- Error handling ------------------------------------------------------ */ /* Synchronous abort with error message. */ void lj_trace_err(jit_State *J, TraceError e) { setnilV(&J->errinfo); /* No error info. */ setintV(J->L->top++, (int32_t)e); lj_err_throw(J->L, LUA_ERRRUN); } /* Synchronous abort with error message and error info. */ void lj_trace_err_info(jit_State *J, TraceError e) { setintV(J->L->top++, (int32_t)e); lj_err_throw(J->L, LUA_ERRRUN); } /* -- Trace management ---------------------------------------------------- */ /* The current trace is first assembled in J->cur. The variable length ** arrays point to shared, growable buffers (J->irbuf etc.). When trace ** recording ends successfully, the current trace and its data structures ** are copied to a new (compact) GCtrace object. */ /* Find a free trace number. */ static TraceNo trace_findfree(jit_State *J) { MSize osz, lim; if (J->freetrace == 0) J->freetrace = 1; for (; J->freetrace < J->sizetrace; J->freetrace++) if (traceref(J, J->freetrace) == NULL) return J->freetrace++; /* Need to grow trace array. */ lim = (MSize)J->param[JIT_P_maxtrace] + 1; if (lim < 2) lim = 2; else if (lim > 65535) lim = 65535; osz = J->sizetrace; if (osz >= lim) return 0; /* Too many traces. */ lj_mem_growvec(J->L, J->trace, J->sizetrace, lim, GCRef); for (; osz < J->sizetrace; osz++) setgcrefnull(J->trace[osz]); return J->freetrace; } #define TRACE_APPENDVEC(field, szfield, tp) \ T->field = (tp *)p; \ memcpy(p, J->cur.field, J->cur.szfield*sizeof(tp)); \ p += J->cur.szfield*sizeof(tp); #ifdef LUAJIT_USE_PERFTOOLS /* ** Create symbol table of JIT-compiled code. For use with Linux perf tools. ** Example usage: ** perf record -f -e cycles luajit test.lua ** perf report -s symbol ** rm perf.data /tmp/perf-*.map */ #include #include static void perftools_addtrace(GCtrace *T) { static FILE *fp; GCproto *pt = &gcref(T->startpt)->pt; const BCIns *startpc = mref(T->startpc, const BCIns); const char *name = proto_chunknamestr(pt); BCLine lineno; if (name[0] == '@' || name[0] == '=') name++; else name = "(string)"; lua_assert(startpc >= proto_bc(pt) && startpc < proto_bc(pt) + pt->sizebc); lineno = lj_debug_line(pt, proto_bcpos(pt, startpc)); if (!fp) { char fname[40]; sprintf(fname, "/tmp/perf-%d.map", getpid()); if (!(fp = fopen(fname, "w"))) return; setlinebuf(fp); } fprintf(fp, "%lx %x TRACE_%d::%s:%u\n", (long)T->mcode, T->szmcode, T->traceno, name, lineno); } #endif /* Allocate space for copy of trace. */ static GCtrace *trace_save_alloc(jit_State *J) { size_t sztr = ((sizeof(GCtrace)+7)&~7); size_t szins = (J->cur.nins-J->cur.nk)*sizeof(IRIns); size_t sz = sztr + szins + J->cur.nsnap*sizeof(SnapShot) + J->cur.nsnapmap*sizeof(SnapEntry); return lj_mem_newt(J->L, (MSize)sz, GCtrace); } /* Save current trace by copying and compacting it. */ static void trace_save(jit_State *J, GCtrace *T) { size_t sztr = ((sizeof(GCtrace)+7)&~7); size_t szins = (J->cur.nins-J->cur.nk)*sizeof(IRIns); char *p = (char *)T + sztr; memcpy(T, &J->cur, sizeof(GCtrace)); setgcrefr(T->nextgc, J2G(J)->gc.root); setgcrefp(J2G(J)->gc.root, T); newwhite(J2G(J), T); T->gct = ~LJ_TTRACE; T->ir = (IRIns *)p - J->cur.nk; memcpy(p, J->cur.ir+J->cur.nk, szins); p += szins; TRACE_APPENDVEC(snap, nsnap, SnapShot) TRACE_APPENDVEC(snapmap, nsnapmap, SnapEntry) J->cur.traceno = 0; setgcrefp(J->trace[T->traceno], T); lj_gc_barriertrace(J2G(J), T->traceno); lj_gdbjit_addtrace(J, T); #ifdef LUAJIT_USE_PERFTOOLS perftools_addtrace(T); #endif } void LJ_FASTCALL lj_trace_free(global_State *g, GCtrace *T) { jit_State *J = G2J(g); if (T->traceno) { lj_gdbjit_deltrace(J, T); if (T->traceno < J->freetrace) J->freetrace = T->traceno; setgcrefnull(J->trace[T->traceno]); } lj_mem_free(g, T, ((sizeof(GCtrace)+7)&~7) + (T->nins-T->nk)*sizeof(IRIns) + T->nsnap*sizeof(SnapShot) + T->nsnapmap*sizeof(SnapEntry)); } /* Re-enable compiling a prototype by unpatching any modified bytecode. */ void lj_trace_reenableproto(GCproto *pt) { if ((pt->flags & PROTO_ILOOP)) { BCIns *bc = proto_bc(pt); BCPos i, sizebc = pt->sizebc;; pt->flags &= ~PROTO_ILOOP; if (bc_op(bc[0]) == BC_IFUNCF) setbc_op(&bc[0], BC_FUNCF); for (i = 1; i < sizebc; i++) { BCOp op = bc_op(bc[i]); if (op == BC_IFORL || op == BC_IITERL || op == BC_ILOOP) setbc_op(&bc[i], (int)op+(int)BC_LOOP-(int)BC_ILOOP); } } } /* Unpatch the bytecode modified by a root trace. */ static void trace_unpatch(jit_State *J, GCtrace *T) { BCOp op = bc_op(T->startins); BCIns *pc = mref(T->startpc, BCIns); UNUSED(J); if (op == BC_JMP) return; /* No need to unpatch branches in parent traces (yet). */ switch (bc_op(*pc)) { case BC_JFORL: lua_assert(traceref(J, bc_d(*pc)) == T); *pc = T->startins; pc += bc_j(T->startins); lua_assert(bc_op(*pc) == BC_JFORI); setbc_op(pc, BC_FORI); break; case BC_JITERL: case BC_JLOOP: lua_assert(op == BC_ITERL || op == BC_LOOP || bc_isret(op)); *pc = T->startins; break; case BC_JMP: lua_assert(op == BC_ITERL); pc += bc_j(*pc)+2; if (bc_op(*pc) == BC_JITERL) { lua_assert(traceref(J, bc_d(*pc)) == T); *pc = T->startins; } break; case BC_JFUNCF: lua_assert(op == BC_FUNCF); *pc = T->startins; break; default: /* Already unpatched. */ break; } } /* Flush a root trace. */ static void trace_flushroot(jit_State *J, GCtrace *T) { GCproto *pt = &gcref(T->startpt)->pt; lua_assert(T->root == 0 && pt != NULL); /* First unpatch any modified bytecode. */ trace_unpatch(J, T); /* Unlink root trace from chain anchored in prototype. */ if (pt->trace == T->traceno) { /* Trace is first in chain. Easy. */ pt->trace = T->nextroot; } else if (pt->trace) { /* Otherwise search in chain of root traces. */ GCtrace *T2 = traceref(J, pt->trace); if (T2) { for (; T2->nextroot; T2 = traceref(J, T2->nextroot)) if (T2->nextroot == T->traceno) { T2->nextroot = T->nextroot; /* Unlink from chain. */ break; } } } } /* Flush a trace. Only root traces are considered. */ void lj_trace_flush(jit_State *J, TraceNo traceno) { if (traceno > 0 && traceno < J->sizetrace) { GCtrace *T = traceref(J, traceno); if (T && T->root == 0) trace_flushroot(J, T); } } /* Flush all traces associated with a prototype. */ void lj_trace_flushproto(global_State *g, GCproto *pt) { while (pt->trace != 0) trace_flushroot(G2J(g), traceref(G2J(g), pt->trace)); } /* Flush all traces. */ int lj_trace_flushall(lua_State *L) { jit_State *J = L2J(L); ptrdiff_t i; if ((J2G(J)->hookmask & HOOK_GC)) return 1; for (i = (ptrdiff_t)J->sizetrace-1; i > 0; i--) { GCtrace *T = traceref(J, i); if (T) { if (T->root == 0) trace_flushroot(J, T); lj_gdbjit_deltrace(J, T); T->traceno = 0; setgcrefnull(J->trace[i]); } } J->cur.traceno = 0; J->freetrace = 0; /* Clear penalty cache. */ memset(J->penalty, 0, sizeof(J->penalty)); /* Free the whole machine code and invalidate all exit stub groups. */ lj_mcode_free(J); memset(J->exitstubgroup, 0, sizeof(J->exitstubgroup)); lj_vmevent_send(L, TRACE, setstrV(L, L->top++, lj_str_newlit(L, "flush")); ); return 0; } /* Initialize JIT compiler state. */ void lj_trace_initstate(global_State *g) { jit_State *J = G2J(g); TValue *tv; /* Initialize SIMD constants. */ tv = LJ_KSIMD(J, LJ_KSIMD_ABS); tv[0].u64 = U64x(7fffffff,ffffffff); tv[1].u64 = U64x(7fffffff,ffffffff); tv = LJ_KSIMD(J, LJ_KSIMD_NEG); tv[0].u64 = U64x(80000000,00000000); tv[1].u64 = U64x(80000000,00000000); } /* Free everything associated with the JIT compiler state. */ void lj_trace_freestate(global_State *g) { jit_State *J = G2J(g); #ifdef LUA_USE_ASSERT { /* This assumes all traces have already been freed. */ ptrdiff_t i; for (i = 1; i < (ptrdiff_t)J->sizetrace; i++) lua_assert(i == (ptrdiff_t)J->cur.traceno || traceref(J, i) == NULL); } #endif lj_mcode_free(J); lj_ir_k64_freeall(J); lj_mem_freevec(g, J->snapmapbuf, J->sizesnapmap, SnapEntry); lj_mem_freevec(g, J->snapbuf, J->sizesnap, SnapShot); lj_mem_freevec(g, J->irbuf + J->irbotlim, J->irtoplim - J->irbotlim, IRIns); lj_mem_freevec(g, J->trace, J->sizetrace, GCRef); } /* -- Penalties and blacklisting ------------------------------------------ */ /* Blacklist a bytecode instruction. */ static void blacklist_pc(GCproto *pt, BCIns *pc) { setbc_op(pc, (int)bc_op(*pc)+(int)BC_ILOOP-(int)BC_LOOP); pt->flags |= PROTO_ILOOP; } /* Penalize a bytecode instruction. */ static void penalty_pc(jit_State *J, GCproto *pt, BCIns *pc, TraceError e) { uint32_t i, val = PENALTY_MIN; for (i = 0; i < PENALTY_SLOTS; i++) if (mref(J->penalty[i].pc, const BCIns) == pc) { /* Cache slot found? */ /* First try to bump its hotcount several times. */ val = ((uint32_t)J->penalty[i].val << 1) + LJ_PRNG_BITS(J, PENALTY_RNDBITS); if (val > PENALTY_MAX) { blacklist_pc(pt, pc); /* Blacklist it, if that didn't help. */ return; } goto setpenalty; } /* Assign a new penalty cache slot. */ i = J->penaltyslot; J->penaltyslot = (J->penaltyslot + 1) & (PENALTY_SLOTS-1); setmref(J->penalty[i].pc, pc); setpenalty: J->penalty[i].val = (uint16_t)val; J->penalty[i].reason = e; hotcount_set(J2GG(J), pc+1, val); } /* -- Trace compiler state machine ---------------------------------------- */ /* Start tracing. */ static void trace_start(jit_State *J) { lua_State *L; TraceNo traceno; if ((J->pt->flags & PROTO_NOJIT)) { /* JIT disabled for this proto? */ if (J->parent == 0) { /* Lazy bytecode patching to disable hotcount events. */ lua_assert(bc_op(*J->pc) == BC_FORL || bc_op(*J->pc) == BC_ITERL || bc_op(*J->pc) == BC_LOOP || bc_op(*J->pc) == BC_FUNCF); setbc_op(J->pc, (int)bc_op(*J->pc)+(int)BC_ILOOP-(int)BC_LOOP); J->pt->flags |= PROTO_ILOOP; } J->state = LJ_TRACE_IDLE; /* Silently ignored. */ return; } /* Get a new trace number. */ traceno = trace_findfree(J); if (LJ_UNLIKELY(traceno == 0)) { /* No free trace? */ lua_assert((J2G(J)->hookmask & HOOK_GC) == 0); lj_trace_flushall(J->L); J->state = LJ_TRACE_IDLE; /* Silently ignored. */ return; } setgcrefp(J->trace[traceno], &J->cur); /* Setup enough of the current trace to be able to send the vmevent. */ memset(&J->cur, 0, sizeof(GCtrace)); J->cur.traceno = traceno; J->cur.nins = J->cur.nk = REF_BASE; J->cur.ir = J->irbuf; J->cur.snap = J->snapbuf; J->cur.snapmap = J->snapmapbuf; J->mergesnap = 0; J->needsnap = 0; J->bcskip = 0; J->guardemit.irt = 0; J->postproc = LJ_POST_NONE; lj_resetsplit(J); setgcref(J->cur.startpt, obj2gco(J->pt)); L = J->L; lj_vmevent_send(L, TRACE, setstrV(L, L->top++, lj_str_newlit(L, "start")); setintV(L->top++, traceno); setfuncV(L, L->top++, J->fn); setintV(L->top++, proto_bcpos(J->pt, J->pc)); if (J->parent) { setintV(L->top++, J->parent); setintV(L->top++, J->exitno); } ); lj_record_setup(J); } /* Stop tracing. */ static void trace_stop(jit_State *J) { BCIns *pc = mref(J->cur.startpc, BCIns); BCOp op = bc_op(J->cur.startins); GCproto *pt = &gcref(J->cur.startpt)->pt; TraceNo traceno = J->cur.traceno; GCtrace *T = trace_save_alloc(J); /* Do this first. May throw OOM. */ lua_State *L; switch (op) { case BC_FORL: setbc_op(pc+bc_j(J->cur.startins), BC_JFORI); /* Patch FORI, too. */ /* fallthrough */ case BC_LOOP: case BC_ITERL: case BC_FUNCF: /* Patch bytecode of starting instruction in root trace. */ setbc_op(pc, (int)op+(int)BC_JLOOP-(int)BC_LOOP); setbc_d(pc, traceno); addroot: /* Add to root trace chain in prototype. */ J->cur.nextroot = pt->trace; pt->trace = (TraceNo1)traceno; break; case BC_RET: case BC_RET0: case BC_RET1: *pc = BCINS_AD(BC_JLOOP, J->cur.snap[0].nslots, traceno); goto addroot; case BC_JMP: /* Patch exit branch in parent to side trace entry. */ lua_assert(J->parent != 0 && J->cur.root != 0); lj_asm_patchexit(J, traceref(J, J->parent), J->exitno, J->cur.mcode); /* Avoid compiling a side trace twice (stack resizing uses parent exit). */ traceref(J, J->parent)->snap[J->exitno].count = SNAPCOUNT_DONE; /* Add to side trace chain in root trace. */ { GCtrace *root = traceref(J, J->cur.root); root->nchild++; J->cur.nextside = root->nextside; root->nextside = (TraceNo1)traceno; } break; default: lua_assert(0); break; } /* Commit new mcode only after all patching is done. */ lj_mcode_commit(J, J->cur.mcode); J->postproc = LJ_POST_NONE; trace_save(J, T); L = J->L; lj_vmevent_send(L, TRACE, setstrV(L, L->top++, lj_str_newlit(L, "stop")); setintV(L->top++, traceno); ); } /* Start a new root trace for down-recursion. */ static int trace_downrec(jit_State *J) { /* Restart recording at the return instruction. */ lua_assert(J->pt != NULL); lua_assert(bc_isret(bc_op(*J->pc))); if (bc_op(*J->pc) == BC_RETM) return 0; /* NYI: down-recursion with RETM. */ J->parent = 0; J->exitno = 0; J->state = LJ_TRACE_RECORD; trace_start(J); return 1; } /* Abort tracing. */ static int trace_abort(jit_State *J) { lua_State *L = J->L; TraceError e = LJ_TRERR_RECERR; TraceNo traceno; J->postproc = LJ_POST_NONE; lj_mcode_abort(J); if (tvisnumber(L->top-1)) e = (TraceError)numberVint(L->top-1); if (e == LJ_TRERR_MCODELM) { L->top--; /* Remove error object */ J->state = LJ_TRACE_ASM; return 1; /* Retry ASM with new MCode area. */ } /* Penalize or blacklist starting bytecode instruction. */ if (J->parent == 0 && !bc_isret(bc_op(J->cur.startins))) penalty_pc(J, &gcref(J->cur.startpt)->pt, mref(J->cur.startpc, BCIns), e); /* Is there anything to abort? */ traceno = J->cur.traceno; if (traceno) { ptrdiff_t errobj = savestack(L, L->top-1); /* Stack may be resized. */ J->cur.link = 0; J->cur.linktype = LJ_TRLINK_NONE; lj_vmevent_send(L, TRACE, TValue *frame; const BCIns *pc; GCfunc *fn; setstrV(L, L->top++, lj_str_newlit(L, "abort")); setintV(L->top++, traceno); /* Find original Lua function call to generate a better error message. */ frame = J->L->base-1; pc = J->pc; while (!isluafunc(frame_func(frame))) { pc = (frame_iscont(frame) ? frame_contpc(frame) : frame_pc(frame)) - 1; frame = frame_prev(frame); } fn = frame_func(frame); setfuncV(L, L->top++, fn); setintV(L->top++, proto_bcpos(funcproto(fn), pc)); copyTV(L, L->top++, restorestack(L, errobj)); copyTV(L, L->top++, &J->errinfo); ); /* Drop aborted trace after the vmevent (which may still access it). */ setgcrefnull(J->trace[traceno]); if (traceno < J->freetrace) J->freetrace = traceno; J->cur.traceno = 0; } L->top--; /* Remove error object */ if (e == LJ_TRERR_DOWNREC) return trace_downrec(J); else if (e == LJ_TRERR_MCODEAL) lj_trace_flushall(L); return 0; } /* Perform pending re-patch of a bytecode instruction. */ static LJ_AINLINE void trace_pendpatch(jit_State *J, int force) { if (LJ_UNLIKELY(J->patchpc)) { if (force || J->bcskip == 0) { *J->patchpc = J->patchins; J->patchpc = NULL; } else { J->bcskip = 0; } } } /* State machine for the trace compiler. Protected callback. */ static TValue *trace_state(lua_State *L, lua_CFunction dummy, void *ud) { jit_State *J = (jit_State *)ud; UNUSED(dummy); do { retry: switch (J->state) { case LJ_TRACE_START: J->state = LJ_TRACE_RECORD; /* trace_start() may change state. */ trace_start(J); lj_dispatch_update(J2G(J)); break; case LJ_TRACE_RECORD: trace_pendpatch(J, 0); setvmstate(J2G(J), RECORD); lj_vmevent_send_(L, RECORD, /* Save/restore tmptv state for trace recorder. */ TValue savetv = J2G(J)->tmptv; TValue savetv2 = J2G(J)->tmptv2; setintV(L->top++, J->cur.traceno); setfuncV(L, L->top++, J->fn); setintV(L->top++, J->pt ? (int32_t)proto_bcpos(J->pt, J->pc) : -1); setintV(L->top++, J->framedepth); , J2G(J)->tmptv = savetv; J2G(J)->tmptv2 = savetv2; ); lj_record_ins(J); break; case LJ_TRACE_END: trace_pendpatch(J, 1); J->loopref = 0; if ((J->flags & JIT_F_OPT_LOOP) && J->cur.link == J->cur.traceno && J->framedepth + J->retdepth == 0) { setvmstate(J2G(J), OPT); lj_opt_dce(J); if (lj_opt_loop(J)) { /* Loop optimization failed? */ J->cur.link = 0; J->cur.linktype = LJ_TRLINK_NONE; J->loopref = J->cur.nins; J->state = LJ_TRACE_RECORD; /* Try to continue recording. */ break; } J->loopref = J->chain[IR_LOOP]; /* Needed by assembler. */ } lj_opt_split(J); lj_opt_sink(J); if (!J->loopref) J->cur.snap[J->cur.nsnap-1].count = SNAPCOUNT_DONE; J->state = LJ_TRACE_ASM; break; case LJ_TRACE_ASM: setvmstate(J2G(J), ASM); lj_asm_trace(J, &J->cur); trace_stop(J); setvmstate(J2G(J), INTERP); J->state = LJ_TRACE_IDLE; lj_dispatch_update(J2G(J)); return NULL; default: /* Trace aborted asynchronously. */ setintV(L->top++, (int32_t)LJ_TRERR_RECERR); /* fallthrough */ case LJ_TRACE_ERR: trace_pendpatch(J, 1); if (trace_abort(J)) goto retry; setvmstate(J2G(J), INTERP); J->state = LJ_TRACE_IDLE; lj_dispatch_update(J2G(J)); return NULL; } } while (J->state > LJ_TRACE_RECORD); return NULL; } /* -- Event handling ------------------------------------------------------ */ /* A bytecode instruction is about to be executed. Record it. */ void lj_trace_ins(jit_State *J, const BCIns *pc) { /* Note: J->L must already be set. pc is the true bytecode PC here. */ J->pc = pc; J->fn = curr_func(J->L); J->pt = isluafunc(J->fn) ? funcproto(J->fn) : NULL; while (lj_vm_cpcall(J->L, NULL, (void *)J, trace_state) != 0) J->state = LJ_TRACE_ERR; } /* A hotcount triggered. Start recording a root trace. */ void LJ_FASTCALL lj_trace_hot(jit_State *J, const BCIns *pc) { /* Note: pc is the interpreter bytecode PC here. It's offset by 1. */ ERRNO_SAVE /* Reset hotcount. */ hotcount_set(J2GG(J), pc, J->param[JIT_P_hotloop]*HOTCOUNT_LOOP); /* Only start a new trace if not recording or inside __gc call or vmevent. */ if (J->state == LJ_TRACE_IDLE && !(J2G(J)->hookmask & (HOOK_GC|HOOK_VMEVENT))) { J->parent = 0; /* Root trace. */ J->exitno = 0; J->state = LJ_TRACE_START; lj_trace_ins(J, pc-1); } ERRNO_RESTORE } /* Check for a hot side exit. If yes, start recording a side trace. */ static void trace_hotside(jit_State *J, const BCIns *pc) { SnapShot *snap = &traceref(J, J->parent)->snap[J->exitno]; if (!(J2G(J)->hookmask & (HOOK_GC|HOOK_VMEVENT)) && snap->count != SNAPCOUNT_DONE && ++snap->count >= J->param[JIT_P_hotexit]) { lua_assert(J->state == LJ_TRACE_IDLE); /* J->parent is non-zero for a side trace. */ J->state = LJ_TRACE_START; lj_trace_ins(J, pc); } } /* Tiny struct to pass data to protected call. */ typedef struct ExitDataCP { jit_State *J; void *exptr; /* Pointer to exit state. */ const BCIns *pc; /* Restart interpreter at this PC. */ } ExitDataCP; /* Need to protect lj_snap_restore because it may throw. */ static TValue *trace_exit_cp(lua_State *L, lua_CFunction dummy, void *ud) { ExitDataCP *exd = (ExitDataCP *)ud; cframe_errfunc(L->cframe) = -1; /* Inherit error function. */ exd->pc = lj_snap_restore(exd->J, exd->exptr); UNUSED(dummy); return NULL; } #ifndef LUAJIT_DISABLE_VMEVENT /* Push all registers from exit state. */ static void trace_exit_regs(lua_State *L, ExitState *ex) { int32_t i; setintV(L->top++, RID_NUM_GPR); setintV(L->top++, RID_NUM_FPR); for (i = 0; i < RID_NUM_GPR; i++) { if (sizeof(ex->gpr[i]) == sizeof(int32_t)) setintV(L->top++, (int32_t)ex->gpr[i]); else setnumV(L->top++, (lua_Number)ex->gpr[i]); } #if !LJ_SOFTFP for (i = 0; i < RID_NUM_FPR; i++) { setnumV(L->top, ex->fpr[i]); if (LJ_UNLIKELY(tvisnan(L->top))) setnanV(L->top); L->top++; } #endif } #endif #ifdef EXITSTATE_PCREG /* Determine trace number from pc of exit instruction. */ static TraceNo trace_exit_find(jit_State *J, MCode *pc) { TraceNo traceno; for (traceno = 1; traceno < J->sizetrace; traceno++) { GCtrace *T = traceref(J, traceno); if (T && pc >= T->mcode && pc < (MCode *)((char *)T->mcode + T->szmcode)) return traceno; } lua_assert(0); return 0; } #endif /* A trace exited. Restore interpreter state. */ int LJ_FASTCALL lj_trace_exit(jit_State *J, void *exptr) { ERRNO_SAVE lua_State *L = J->L; ExitState *ex = (ExitState *)exptr; ExitDataCP exd; int errcode; const BCIns *pc; void *cf; GCtrace *T; #ifdef EXITSTATE_PCREG J->parent = trace_exit_find(J, (MCode *)(intptr_t)ex->gpr[EXITSTATE_PCREG]); #endif T = traceref(J, J->parent); UNUSED(T); #ifdef EXITSTATE_CHECKEXIT if (J->exitno == T->nsnap) { /* Treat stack check like a parent exit. */ lua_assert(T->root != 0); J->exitno = T->ir[REF_BASE].op2; J->parent = T->ir[REF_BASE].op1; T = traceref(J, J->parent); } #endif lua_assert(T != NULL && J->exitno < T->nsnap); exd.J = J; exd.exptr = exptr; errcode = lj_vm_cpcall(L, NULL, &exd, trace_exit_cp); if (errcode) return -errcode; /* Return negated error code. */ lj_vmevent_send(L, TEXIT, lj_state_checkstack(L, 4+RID_NUM_GPR+RID_NUM_FPR+LUA_MINSTACK); setintV(L->top++, J->parent); setintV(L->top++, J->exitno); trace_exit_regs(L, ex); ); pc = exd.pc; cf = cframe_raw(L->cframe); setcframe_pc(cf, pc); if (G(L)->gc.state == GCSatomic || G(L)->gc.state == GCSfinalize) { if (!(G(L)->hookmask & HOOK_GC)) lj_gc_step(L); /* Exited because of GC: drive GC forward. */ } else { trace_hotside(J, pc); } if (bc_op(*pc) == BC_JLOOP) { BCIns *retpc = &traceref(J, bc_d(*pc))->startins; if (bc_isret(bc_op(*retpc))) { if (J->state == LJ_TRACE_RECORD) { J->patchins = *pc; J->patchpc = (BCIns *)pc; *J->patchpc = *retpc; J->bcskip = 1; } else { pc = retpc; setcframe_pc(cf, pc); } } } /* Return MULTRES or 0. */ ERRNO_RESTORE switch (bc_op(*pc)) { case BC_CALLM: case BC_CALLMT: return (int)((BCReg)(L->top - L->base) - bc_a(*pc) - bc_c(*pc)); case BC_RETM: return (int)((BCReg)(L->top - L->base) + 1 - bc_a(*pc) - bc_d(*pc)); case BC_TSETM: return (int)((BCReg)(L->top - L->base) + 1 - bc_a(*pc)); default: if (bc_op(*pc) >= BC_FUNCF) return (int)((BCReg)(L->top - L->base) + 1); return 0; } } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_bcread.c0000644000175000017500000003214413122010155016746 0ustar philphil/* ** Bytecode reader. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_bcread_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_bc.h" #if LJ_HASFFI #include "lj_ctype.h" #include "lj_cdata.h" #include "lualib.h" #endif #include "lj_lex.h" #include "lj_bcdump.h" #include "lj_state.h" /* Reuse some lexer fields for our own purposes. */ #define bcread_flags(ls) ls->level #define bcread_swap(ls) \ ((bcread_flags(ls) & BCDUMP_F_BE) != LJ_BE*BCDUMP_F_BE) #define bcread_oldtop(L, ls) restorestack(L, ls->lastline) #define bcread_savetop(L, ls, top) \ ls->lastline = (BCLine)savestack(L, (top)) /* -- Input buffer handling ----------------------------------------------- */ /* Throw reader error. */ static LJ_NOINLINE void bcread_error(LexState *ls, ErrMsg em) { lua_State *L = ls->L; const char *name = ls->chunkarg; if (*name == BCDUMP_HEAD1) name = "(binary)"; else if (*name == '@' || *name == '=') name++; lj_str_pushf(L, "%s: %s", name, err2msg(em)); lj_err_throw(L, LUA_ERRSYNTAX); } /* Resize input buffer. */ static void bcread_resize(LexState *ls, MSize len) { if (ls->sb.sz < len) { MSize sz = ls->sb.sz * 2; while (len > sz) sz = sz * 2; lj_str_resizebuf(ls->L, &ls->sb, sz); /* Caveat: this may change ls->sb.buf which may affect ls->p. */ } } /* Refill buffer if needed. */ static LJ_NOINLINE void bcread_fill(LexState *ls, MSize len, int need) { lua_assert(len != 0); if (len > LJ_MAX_MEM || ls->current < 0) bcread_error(ls, LJ_ERR_BCBAD); do { const char *buf; size_t size; if (ls->n) { /* Copy remainder to buffer. */ if (ls->sb.n) { /* Move down in buffer. */ lua_assert(ls->p + ls->n == ls->sb.buf + ls->sb.n); if (ls->n != ls->sb.n) memmove(ls->sb.buf, ls->p, ls->n); } else { /* Copy from buffer provided by reader. */ bcread_resize(ls, len); memcpy(ls->sb.buf, ls->p, ls->n); } ls->p = ls->sb.buf; } ls->sb.n = ls->n; buf = ls->rfunc(ls->L, ls->rdata, &size); /* Get more data from reader. */ if (buf == NULL || size == 0) { /* EOF? */ if (need) bcread_error(ls, LJ_ERR_BCBAD); ls->current = -1; /* Only bad if we get called again. */ break; } if (ls->sb.n) { /* Append to buffer. */ MSize n = ls->sb.n + (MSize)size; bcread_resize(ls, n < len ? len : n); memcpy(ls->sb.buf + ls->sb.n, buf, size); ls->n = ls->sb.n = n; ls->p = ls->sb.buf; } else { /* Return buffer provided by reader. */ ls->n = (MSize)size; ls->p = buf; } } while (ls->n < len); } /* Need a certain number of bytes. */ static LJ_AINLINE void bcread_need(LexState *ls, MSize len) { if (LJ_UNLIKELY(ls->n < len)) bcread_fill(ls, len, 1); } /* Want to read up to a certain number of bytes, but may need less. */ static LJ_AINLINE void bcread_want(LexState *ls, MSize len) { if (LJ_UNLIKELY(ls->n < len)) bcread_fill(ls, len, 0); } #define bcread_dec(ls) check_exp(ls->n > 0, ls->n--) #define bcread_consume(ls, len) check_exp(ls->n >= (len), ls->n -= (len)) /* Return memory block from buffer. */ static uint8_t *bcread_mem(LexState *ls, MSize len) { uint8_t *p = (uint8_t *)ls->p; bcread_consume(ls, len); ls->p = (char *)p + len; return p; } /* Copy memory block from buffer. */ static void bcread_block(LexState *ls, void *q, MSize len) { memcpy(q, bcread_mem(ls, len), len); } /* Read byte from buffer. */ static LJ_AINLINE uint32_t bcread_byte(LexState *ls) { bcread_dec(ls); return (uint32_t)(uint8_t)*ls->p++; } /* Read ULEB128 value from buffer. */ static uint32_t bcread_uleb128(LexState *ls) { const uint8_t *p = (const uint8_t *)ls->p; uint32_t v = *p++; if (LJ_UNLIKELY(v >= 0x80)) { int sh = 0; v &= 0x7f; do { v |= ((*p & 0x7f) << (sh += 7)); bcread_dec(ls); } while (*p++ >= 0x80); } bcread_dec(ls); ls->p = (char *)p; return v; } /* Read top 32 bits of 33 bit ULEB128 value from buffer. */ static uint32_t bcread_uleb128_33(LexState *ls) { const uint8_t *p = (const uint8_t *)ls->p; uint32_t v = (*p++ >> 1); if (LJ_UNLIKELY(v >= 0x40)) { int sh = -1; v &= 0x3f; do { v |= ((*p & 0x7f) << (sh += 7)); bcread_dec(ls); } while (*p++ >= 0x80); } bcread_dec(ls); ls->p = (char *)p; return v; } /* -- Bytecode reader ----------------------------------------------------- */ /* Read debug info of a prototype. */ static void bcread_dbg(LexState *ls, GCproto *pt, MSize sizedbg) { void *lineinfo = (void *)proto_lineinfo(pt); bcread_block(ls, lineinfo, sizedbg); /* Swap lineinfo if the endianess differs. */ if (bcread_swap(ls) && pt->numline >= 256) { MSize i, n = pt->sizebc-1; if (pt->numline < 65536) { uint16_t *p = (uint16_t *)lineinfo; for (i = 0; i < n; i++) p[i] = (uint16_t)((p[i] >> 8)|(p[i] << 8)); } else { uint32_t *p = (uint32_t *)lineinfo; for (i = 0; i < n; i++) p[i] = lj_bswap(p[i]); } } } /* Find pointer to varinfo. */ static const void *bcread_varinfo(GCproto *pt) { const uint8_t *p = proto_uvinfo(pt); MSize n = pt->sizeuv; if (n) while (*p++ || --n) ; return p; } /* Read a single constant key/value of a template table. */ static void bcread_ktabk(LexState *ls, TValue *o) { MSize tp = bcread_uleb128(ls); if (tp >= BCDUMP_KTAB_STR) { MSize len = tp - BCDUMP_KTAB_STR; const char *p = (const char *)bcread_mem(ls, len); setstrV(ls->L, o, lj_str_new(ls->L, p, len)); } else if (tp == BCDUMP_KTAB_INT) { setintV(o, (int32_t)bcread_uleb128(ls)); } else if (tp == BCDUMP_KTAB_NUM) { o->u32.lo = bcread_uleb128(ls); o->u32.hi = bcread_uleb128(ls); } else { lua_assert(tp <= BCDUMP_KTAB_TRUE); setitype(o, ~tp); } } /* Read a template table. */ static GCtab *bcread_ktab(LexState *ls) { MSize narray = bcread_uleb128(ls); MSize nhash = bcread_uleb128(ls); GCtab *t = lj_tab_new(ls->L, narray, hsize2hbits(nhash)); if (narray) { /* Read array entries. */ MSize i; TValue *o = tvref(t->array); for (i = 0; i < narray; i++, o++) bcread_ktabk(ls, o); } if (nhash) { /* Read hash entries. */ MSize i; for (i = 0; i < nhash; i++) { TValue key; bcread_ktabk(ls, &key); lua_assert(!tvisnil(&key)); bcread_ktabk(ls, lj_tab_set(ls->L, t, &key)); } } return t; } /* Read GC constants of a prototype. */ static void bcread_kgc(LexState *ls, GCproto *pt, MSize sizekgc) { MSize i; GCRef *kr = mref(pt->k, GCRef) - (ptrdiff_t)sizekgc; for (i = 0; i < sizekgc; i++, kr++) { MSize tp = bcread_uleb128(ls); if (tp >= BCDUMP_KGC_STR) { MSize len = tp - BCDUMP_KGC_STR; const char *p = (const char *)bcread_mem(ls, len); setgcref(*kr, obj2gco(lj_str_new(ls->L, p, len))); } else if (tp == BCDUMP_KGC_TAB) { setgcref(*kr, obj2gco(bcread_ktab(ls))); #if LJ_HASFFI } else if (tp != BCDUMP_KGC_CHILD) { CTypeID id = tp == BCDUMP_KGC_COMPLEX ? CTID_COMPLEX_DOUBLE : tp == BCDUMP_KGC_I64 ? CTID_INT64 : CTID_UINT64; CTSize sz = tp == BCDUMP_KGC_COMPLEX ? 16 : 8; GCcdata *cd = lj_cdata_new_(ls->L, id, sz); TValue *p = (TValue *)cdataptr(cd); setgcref(*kr, obj2gco(cd)); p[0].u32.lo = bcread_uleb128(ls); p[0].u32.hi = bcread_uleb128(ls); if (tp == BCDUMP_KGC_COMPLEX) { p[1].u32.lo = bcread_uleb128(ls); p[1].u32.hi = bcread_uleb128(ls); } #endif } else { lua_State *L = ls->L; lua_assert(tp == BCDUMP_KGC_CHILD); if (L->top <= bcread_oldtop(L, ls)) /* Stack underflow? */ bcread_error(ls, LJ_ERR_BCBAD); L->top--; setgcref(*kr, obj2gco(protoV(L->top))); } } } /* Read number constants of a prototype. */ static void bcread_knum(LexState *ls, GCproto *pt, MSize sizekn) { MSize i; TValue *o = mref(pt->k, TValue); for (i = 0; i < sizekn; i++, o++) { int isnum = (ls->p[0] & 1); uint32_t lo = bcread_uleb128_33(ls); if (isnum) { o->u32.lo = lo; o->u32.hi = bcread_uleb128(ls); } else { setintV(o, lo); } } } /* Read bytecode instructions. */ static void bcread_bytecode(LexState *ls, GCproto *pt, MSize sizebc) { BCIns *bc = proto_bc(pt); bc[0] = BCINS_AD((pt->flags & PROTO_VARARG) ? BC_FUNCV : BC_FUNCF, pt->framesize, 0); bcread_block(ls, bc+1, (sizebc-1)*(MSize)sizeof(BCIns)); /* Swap bytecode instructions if the endianess differs. */ if (bcread_swap(ls)) { MSize i; for (i = 1; i < sizebc; i++) bc[i] = lj_bswap(bc[i]); } } /* Read upvalue refs. */ static void bcread_uv(LexState *ls, GCproto *pt, MSize sizeuv) { if (sizeuv) { uint16_t *uv = proto_uv(pt); bcread_block(ls, uv, sizeuv*2); /* Swap upvalue refs if the endianess differs. */ if (bcread_swap(ls)) { MSize i; for (i = 0; i < sizeuv; i++) uv[i] = (uint16_t)((uv[i] >> 8)|(uv[i] << 8)); } } } /* Read a prototype. */ static GCproto *bcread_proto(LexState *ls) { GCproto *pt; MSize framesize, numparams, flags, sizeuv, sizekgc, sizekn, sizebc, sizept; MSize ofsk, ofsuv, ofsdbg; MSize sizedbg = 0; BCLine firstline = 0, numline = 0; MSize len, startn; /* Read length. */ if (ls->n > 0 && ls->p[0] == 0) { /* Shortcut EOF. */ ls->n--; ls->p++; return NULL; } bcread_want(ls, 5); len = bcread_uleb128(ls); if (!len) return NULL; /* EOF */ bcread_need(ls, len); startn = ls->n; /* Read prototype header. */ flags = bcread_byte(ls); numparams = bcread_byte(ls); framesize = bcread_byte(ls); sizeuv = bcread_byte(ls); sizekgc = bcread_uleb128(ls); sizekn = bcread_uleb128(ls); sizebc = bcread_uleb128(ls) + 1; if (!(bcread_flags(ls) & BCDUMP_F_STRIP)) { sizedbg = bcread_uleb128(ls); if (sizedbg) { firstline = bcread_uleb128(ls); numline = bcread_uleb128(ls); } } /* Calculate total size of prototype including all colocated arrays. */ sizept = (MSize)sizeof(GCproto) + sizebc*(MSize)sizeof(BCIns) + sizekgc*(MSize)sizeof(GCRef); sizept = (sizept + (MSize)sizeof(TValue)-1) & ~((MSize)sizeof(TValue)-1); ofsk = sizept; sizept += sizekn*(MSize)sizeof(TValue); ofsuv = sizept; sizept += ((sizeuv+1)&~1)*2; ofsdbg = sizept; sizept += sizedbg; /* Allocate prototype object and initialize its fields. */ pt = (GCproto *)lj_mem_newgco(ls->L, (MSize)sizept); pt->gct = ~LJ_TPROTO; pt->numparams = (uint8_t)numparams; pt->framesize = (uint8_t)framesize; pt->sizebc = sizebc; setmref(pt->k, (char *)pt + ofsk); setmref(pt->uv, (char *)pt + ofsuv); pt->sizekgc = 0; /* Set to zero until fully initialized. */ pt->sizekn = sizekn; pt->sizept = sizept; pt->sizeuv = (uint8_t)sizeuv; pt->flags = (uint8_t)flags; pt->trace = 0; setgcref(pt->chunkname, obj2gco(ls->chunkname)); /* Close potentially uninitialized gap between bc and kgc. */ *(uint32_t *)((char *)pt + ofsk - sizeof(GCRef)*(sizekgc+1)) = 0; /* Read bytecode instructions and upvalue refs. */ bcread_bytecode(ls, pt, sizebc); bcread_uv(ls, pt, sizeuv); /* Read constants. */ bcread_kgc(ls, pt, sizekgc); pt->sizekgc = sizekgc; bcread_knum(ls, pt, sizekn); /* Read and initialize debug info. */ pt->firstline = firstline; pt->numline = numline; if (sizedbg) { MSize sizeli = (sizebc-1) << (numline < 256 ? 0 : numline < 65536 ? 1 : 2); setmref(pt->lineinfo, (char *)pt + ofsdbg); setmref(pt->uvinfo, (char *)pt + ofsdbg + sizeli); bcread_dbg(ls, pt, sizedbg); setmref(pt->varinfo, bcread_varinfo(pt)); } else { setmref(pt->lineinfo, NULL); setmref(pt->uvinfo, NULL); setmref(pt->varinfo, NULL); } if (len != startn - ls->n) bcread_error(ls, LJ_ERR_BCBAD); return pt; } /* Read and check header of bytecode dump. */ static int bcread_header(LexState *ls) { uint32_t flags; bcread_want(ls, 3+5+5); if (bcread_byte(ls) != BCDUMP_HEAD2 || bcread_byte(ls) != BCDUMP_HEAD3 || bcread_byte(ls) != BCDUMP_VERSION) return 0; bcread_flags(ls) = flags = bcread_uleb128(ls); if ((flags & ~(BCDUMP_F_KNOWN)) != 0) return 0; if ((flags & BCDUMP_F_FFI)) { #if LJ_HASFFI lua_State *L = ls->L; if (!ctype_ctsG(G(L))) { ptrdiff_t oldtop = savestack(L, L->top); luaopen_ffi(L); /* Load FFI library on-demand. */ L->top = restorestack(L, oldtop); } #else return 0; #endif } if ((flags & BCDUMP_F_STRIP)) { ls->chunkname = lj_str_newz(ls->L, ls->chunkarg); } else { MSize len = bcread_uleb128(ls); bcread_need(ls, len); ls->chunkname = lj_str_new(ls->L, (const char *)bcread_mem(ls, len), len); } return 1; /* Ok. */ } /* Read a bytecode dump. */ GCproto *lj_bcread(LexState *ls) { lua_State *L = ls->L; lua_assert(ls->current == BCDUMP_HEAD1); bcread_savetop(L, ls, L->top); lj_str_resetbuf(&ls->sb); /* Check for a valid bytecode dump header. */ if (!bcread_header(ls)) bcread_error(ls, LJ_ERR_BCFMT); for (;;) { /* Process all prototypes in the bytecode dump. */ GCproto *pt = bcread_proto(ls); if (!pt) break; setprotoV(L, L->top, pt); incr_top(L); } if ((int32_t)ls->n > 0 || L->top-1 != bcread_oldtop(L, ls)) bcread_error(ls, LJ_ERR_BCBAD); /* Pop off last prototype. */ L->top--; return protoV(L->top); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ffrecord.h0000644000175000017500000000117513122010155017325 0ustar philphil/* ** Fast function call recorder. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_FFRECORD_H #define _LJ_FFRECORD_H #include "lj_obj.h" #include "lj_jit.h" #if LJ_HASJIT /* Data used by handlers to record a fast function. */ typedef struct RecordFFData { TValue *argv; /* Runtime argument values. */ ptrdiff_t nres; /* Number of returned results (defaults to 1). */ uint32_t data; /* Per-ffid auxiliary data (opcode, literal etc.). */ } RecordFFData; LJ_FUNC int32_t lj_ffrecord_select_mode(jit_State *J, TRef tr, TValue *tv); LJ_FUNC void lj_ffrecord_func(jit_State *J); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_asm_arm.h0000644000175000017500000022341313122010155017153 0ustar philphil/* ** ARM IR assembler (SSA IR -> machine code). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Register allocator extensions --------------------------------------- */ /* Allocate a register with a hint. */ static Reg ra_hintalloc(ASMState *as, IRRef ref, Reg hint, RegSet allow) { Reg r = IR(ref)->r; if (ra_noreg(r)) { if (!ra_hashint(r) && !iscrossref(as, ref)) ra_sethint(IR(ref)->r, hint); /* Propagate register hint. */ r = ra_allocref(as, ref, allow); } ra_noweak(as, r); return r; } /* Allocate a scratch register pair. */ static Reg ra_scratchpair(ASMState *as, RegSet allow) { RegSet pick1 = as->freeset & allow; RegSet pick2 = pick1 & (pick1 >> 1) & RSET_GPREVEN; Reg r; if (pick2) { r = rset_picktop(pick2); } else { RegSet pick = pick1 & (allow >> 1) & RSET_GPREVEN; if (pick) { r = rset_picktop(pick); ra_restore(as, regcost_ref(as->cost[r+1])); } else { pick = pick1 & (allow << 1) & RSET_GPRODD; if (pick) { r = ra_restore(as, regcost_ref(as->cost[rset_picktop(pick)-1])); } else { r = ra_evict(as, allow & (allow >> 1) & RSET_GPREVEN); ra_restore(as, regcost_ref(as->cost[r+1])); } } } lua_assert(rset_test(RSET_GPREVEN, r)); ra_modified(as, r); ra_modified(as, r+1); RA_DBGX((as, "scratchpair $r $r", r, r+1)); return r; } #if !LJ_SOFTFP /* Allocate two source registers for three-operand instructions. */ static Reg ra_alloc2(ASMState *as, IRIns *ir, RegSet allow) { IRIns *irl = IR(ir->op1), *irr = IR(ir->op2); Reg left = irl->r, right = irr->r; if (ra_hasreg(left)) { ra_noweak(as, left); if (ra_noreg(right)) right = ra_allocref(as, ir->op2, rset_exclude(allow, left)); else ra_noweak(as, right); } else if (ra_hasreg(right)) { ra_noweak(as, right); left = ra_allocref(as, ir->op1, rset_exclude(allow, right)); } else if (ra_hashint(right)) { right = ra_allocref(as, ir->op2, allow); left = ra_alloc1(as, ir->op1, rset_exclude(allow, right)); } else { left = ra_allocref(as, ir->op1, allow); right = ra_alloc1(as, ir->op2, rset_exclude(allow, left)); } return left | (right << 8); } #endif /* -- Guard handling ------------------------------------------------------ */ /* Generate an exit stub group at the bottom of the reserved MCode memory. */ static MCode *asm_exitstub_gen(ASMState *as, ExitNo group) { MCode *mxp = as->mcbot; int i; if (mxp + 4*4+4*EXITSTUBS_PER_GROUP >= as->mctop) asm_mclimit(as); /* str lr, [sp]; bl ->vm_exit_handler; .long DISPATCH_address, group. */ *mxp++ = ARMI_STR|ARMI_LS_P|ARMI_LS_U|ARMF_D(RID_LR)|ARMF_N(RID_SP); *mxp = ARMI_BL|((((MCode *)(void *)lj_vm_exit_handler-mxp)-2)&0x00ffffffu); mxp++; *mxp++ = (MCode)i32ptr(J2GG(as->J)->dispatch); /* DISPATCH address */ *mxp++ = group*EXITSTUBS_PER_GROUP; for (i = 0; i < EXITSTUBS_PER_GROUP; i++) *mxp++ = ARMI_B|((-6-i)&0x00ffffffu); lj_mcode_sync(as->mcbot, mxp); lj_mcode_commitbot(as->J, mxp); as->mcbot = mxp; as->mclim = as->mcbot + MCLIM_REDZONE; return mxp - EXITSTUBS_PER_GROUP; } /* Setup all needed exit stubs. */ static void asm_exitstub_setup(ASMState *as, ExitNo nexits) { ExitNo i; if (nexits >= EXITSTUBS_PER_GROUP*LJ_MAX_EXITSTUBGR) lj_trace_err(as->J, LJ_TRERR_SNAPOV); for (i = 0; i < (nexits+EXITSTUBS_PER_GROUP-1)/EXITSTUBS_PER_GROUP; i++) if (as->J->exitstubgroup[i] == NULL) as->J->exitstubgroup[i] = asm_exitstub_gen(as, i); } /* Emit conditional branch to exit for guard. */ static void asm_guardcc(ASMState *as, ARMCC cc) { MCode *target = exitstub_addr(as->J, as->snapno); MCode *p = as->mcp; if (LJ_UNLIKELY(p == as->invmcp)) { as->loopinv = 1; *p = ARMI_BL | ((target-p-2) & 0x00ffffffu); emit_branch(as, ARMF_CC(ARMI_B, cc^1), p+1); return; } emit_branch(as, ARMF_CC(ARMI_BL, cc), target); } /* -- Operand fusion ------------------------------------------------------ */ /* Limit linear search to this distance. Avoids O(n^2) behavior. */ #define CONFLICT_SEARCH_LIM 31 /* Check if there's no conflicting instruction between curins and ref. */ static int noconflict(ASMState *as, IRRef ref, IROp conflict) { IRIns *ir = as->ir; IRRef i = as->curins; if (i > ref + CONFLICT_SEARCH_LIM) return 0; /* Give up, ref is too far away. */ while (--i > ref) if (ir[i].o == conflict) return 0; /* Conflict found. */ return 1; /* Ok, no conflict. */ } /* Fuse the array base of colocated arrays. */ static int32_t asm_fuseabase(ASMState *as, IRRef ref) { IRIns *ir = IR(ref); if (ir->o == IR_TNEW && ir->op1 <= LJ_MAX_COLOSIZE && !neverfuse(as) && noconflict(as, ref, IR_NEWREF)) return (int32_t)sizeof(GCtab); return 0; } /* Fuse array/hash/upvalue reference into register+offset operand. */ static Reg asm_fuseahuref(ASMState *as, IRRef ref, int32_t *ofsp, RegSet allow, int lim) { IRIns *ir = IR(ref); if (ra_noreg(ir->r)) { if (ir->o == IR_AREF) { if (mayfuse(as, ref)) { if (irref_isk(ir->op2)) { IRRef tab = IR(ir->op1)->op1; int32_t ofs = asm_fuseabase(as, tab); IRRef refa = ofs ? tab : ir->op1; ofs += 8*IR(ir->op2)->i; if (ofs > -lim && ofs < lim) { *ofsp = ofs; return ra_alloc1(as, refa, allow); } } } } else if (ir->o == IR_HREFK) { if (mayfuse(as, ref)) { int32_t ofs = (int32_t)(IR(ir->op2)->op2 * sizeof(Node)); if (ofs < lim) { *ofsp = ofs; return ra_alloc1(as, ir->op1, allow); } } } else if (ir->o == IR_UREFC) { if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); int32_t ofs = i32ptr(&gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv.tv); *ofsp = (ofs & 255); /* Mask out less bits to allow LDRD. */ return ra_allock(as, (ofs & ~255), allow); } } } *ofsp = 0; return ra_alloc1(as, ref, allow); } /* Fuse m operand into arithmetic/logic instructions. */ static uint32_t asm_fuseopm(ASMState *as, ARMIns ai, IRRef ref, RegSet allow) { IRIns *ir = IR(ref); if (ra_hasreg(ir->r)) { ra_noweak(as, ir->r); return ARMF_M(ir->r); } else if (irref_isk(ref)) { uint32_t k = emit_isk12(ai, ir->i); if (k) return k; } else if (mayfuse(as, ref)) { if (ir->o >= IR_BSHL && ir->o <= IR_BROR) { Reg m = ra_alloc1(as, ir->op1, allow); ARMShift sh = ir->o == IR_BSHL ? ARMSH_LSL : ir->o == IR_BSHR ? ARMSH_LSR : ir->o == IR_BSAR ? ARMSH_ASR : ARMSH_ROR; if (irref_isk(ir->op2)) { return m | ARMF_SH(sh, (IR(ir->op2)->i & 31)); } else { Reg s = ra_alloc1(as, ir->op2, rset_exclude(allow, m)); return m | ARMF_RSH(sh, s); } } else if (ir->o == IR_ADD && ir->op1 == ir->op2) { Reg m = ra_alloc1(as, ir->op1, allow); return m | ARMF_SH(ARMSH_LSL, 1); } } return ra_allocref(as, ref, allow); } /* Fuse shifts into loads/stores. Only bother with BSHL 2 => lsl #2. */ static IRRef asm_fuselsl2(ASMState *as, IRRef ref) { IRIns *ir = IR(ref); if (ra_noreg(ir->r) && mayfuse(as, ref) && ir->o == IR_BSHL && irref_isk(ir->op2) && IR(ir->op2)->i == 2) return ir->op1; return 0; /* No fusion. */ } /* Fuse XLOAD/XSTORE reference into load/store operand. */ static void asm_fusexref(ASMState *as, ARMIns ai, Reg rd, IRRef ref, RegSet allow, int32_t ofs) { IRIns *ir = IR(ref); Reg base; if (ra_noreg(ir->r) && canfuse(as, ir)) { int32_t lim = (!LJ_SOFTFP && (ai & 0x08000000)) ? 1024 : (ai & 0x04000000) ? 4096 : 256; if (ir->o == IR_ADD) { int32_t ofs2; if (irref_isk(ir->op2) && (ofs2 = ofs + IR(ir->op2)->i) > -lim && ofs2 < lim && (!(!LJ_SOFTFP && (ai & 0x08000000)) || !(ofs2 & 3))) { ofs = ofs2; ref = ir->op1; } else if (ofs == 0 && !(!LJ_SOFTFP && (ai & 0x08000000))) { IRRef lref = ir->op1, rref = ir->op2; Reg rn, rm; if ((ai & 0x04000000)) { IRRef sref = asm_fuselsl2(as, rref); if (sref) { rref = sref; ai |= ARMF_SH(ARMSH_LSL, 2); } else if ((sref = asm_fuselsl2(as, lref)) != 0) { lref = rref; rref = sref; ai |= ARMF_SH(ARMSH_LSL, 2); } } rn = ra_alloc1(as, lref, allow); rm = ra_alloc1(as, rref, rset_exclude(allow, rn)); if ((ai & 0x04000000)) ai |= ARMI_LS_R; emit_dnm(as, ai|ARMI_LS_P|ARMI_LS_U, rd, rn, rm); return; } } else if (ir->o == IR_STRREF && !(!LJ_SOFTFP && (ai & 0x08000000))) { lua_assert(ofs == 0); ofs = (int32_t)sizeof(GCstr); if (irref_isk(ir->op2)) { ofs += IR(ir->op2)->i; ref = ir->op1; } else if (irref_isk(ir->op1)) { ofs += IR(ir->op1)->i; ref = ir->op2; } else { /* NYI: Fuse ADD with constant. */ Reg rn = ra_alloc1(as, ir->op1, allow); uint32_t m = asm_fuseopm(as, 0, ir->op2, rset_exclude(allow, rn)); if ((ai & 0x04000000)) emit_lso(as, ai, rd, rd, ofs); else emit_lsox(as, ai, rd, rd, ofs); emit_dn(as, ARMI_ADD^m, rd, rn); return; } if (ofs <= -lim || ofs >= lim) { Reg rn = ra_alloc1(as, ref, allow); Reg rm = ra_allock(as, ofs, rset_exclude(allow, rn)); if ((ai & 0x04000000)) ai |= ARMI_LS_R; emit_dnm(as, ai|ARMI_LS_P|ARMI_LS_U, rd, rn, rm); return; } } } base = ra_alloc1(as, ref, allow); #if !LJ_SOFTFP if ((ai & 0x08000000)) emit_vlso(as, ai, rd, base, ofs); else #endif if ((ai & 0x04000000)) emit_lso(as, ai, rd, base, ofs); else emit_lsox(as, ai, rd, base, ofs); } #if !LJ_SOFTFP /* Fuse to multiply-add/sub instruction. */ static int asm_fusemadd(ASMState *as, IRIns *ir, ARMIns ai, ARMIns air) { IRRef lref = ir->op1, rref = ir->op2; IRIns *irm; if (lref != rref && ((mayfuse(as, lref) && (irm = IR(lref), irm->o == IR_MUL) && ra_noreg(irm->r)) || (mayfuse(as, rref) && (irm = IR(rref), irm->o == IR_MUL) && (rref = lref, ai = air, ra_noreg(irm->r))))) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg add = ra_hintalloc(as, rref, dest, RSET_FPR); Reg right, left = ra_alloc2(as, irm, rset_exclude(rset_exclude(RSET_FPR, dest), add)); right = (left >> 8); left &= 255; emit_dnm(as, ai, (dest & 15), (left & 15), (right & 15)); if (dest != add) emit_dm(as, ARMI_VMOV_D, (dest & 15), (add & 15)); return 1; } return 0; } #endif /* -- Calls --------------------------------------------------------------- */ /* Generate a call to a C function. */ static void asm_gencall(ASMState *as, const CCallInfo *ci, IRRef *args) { uint32_t n, nargs = CCI_NARGS(ci); int32_t ofs = 0; #if LJ_SOFTFP Reg gpr = REGARG_FIRSTGPR; #else Reg gpr, fpr = REGARG_FIRSTFPR, fprodd = 0; #endif if ((void *)ci->func) emit_call(as, (void *)ci->func); #if !LJ_SOFTFP for (gpr = REGARG_FIRSTGPR; gpr <= REGARG_LASTGPR; gpr++) as->cost[gpr] = REGCOST(~0u, ASMREF_L); gpr = REGARG_FIRSTGPR; #endif for (n = 0; n < nargs; n++) { /* Setup args. */ IRRef ref = args[n]; IRIns *ir = IR(ref); #if !LJ_SOFTFP if (ref && irt_isfp(ir->t)) { RegSet of = as->freeset; Reg src; if (!LJ_ABI_SOFTFP && !(ci->flags & CCI_VARARG)) { if (irt_isnum(ir->t)) { if (fpr <= REGARG_LASTFPR) { ra_leftov(as, fpr, ref); fpr++; continue; } } else if (fprodd) { /* Ick. */ src = ra_alloc1(as, ref, RSET_FPR); emit_dm(as, ARMI_VMOV_S, (fprodd & 15), (src & 15) | 0x00400000); fprodd = 0; continue; } else if (fpr <= REGARG_LASTFPR) { ra_leftov(as, fpr, ref); fprodd = fpr++; continue; } /* Workaround to protect argument GPRs from being used for remat. */ as->freeset &= ~RSET_RANGE(REGARG_FIRSTGPR, REGARG_LASTGPR+1); src = ra_alloc1(as, ref, RSET_FPR); /* May alloc GPR to remat FPR. */ as->freeset |= (of & RSET_RANGE(REGARG_FIRSTGPR, REGARG_LASTGPR+1)); fprodd = 0; goto stackfp; } /* Workaround to protect argument GPRs from being used for remat. */ as->freeset &= ~RSET_RANGE(REGARG_FIRSTGPR, REGARG_LASTGPR+1); src = ra_alloc1(as, ref, RSET_FPR); /* May alloc GPR to remat FPR. */ as->freeset |= (of & RSET_RANGE(REGARG_FIRSTGPR, REGARG_LASTGPR+1)); if (irt_isnum(ir->t)) gpr = (gpr+1) & ~1u; if (gpr <= REGARG_LASTGPR) { lua_assert(rset_test(as->freeset, gpr)); /* Must have been evicted. */ if (irt_isnum(ir->t)) { lua_assert(rset_test(as->freeset, gpr+1)); /* Ditto. */ emit_dnm(as, ARMI_VMOV_RR_D, gpr, gpr+1, (src & 15)); gpr += 2; } else { emit_dn(as, ARMI_VMOV_R_S, gpr, (src & 15)); gpr++; } } else { stackfp: if (irt_isnum(ir->t)) ofs = (ofs + 4) & ~4; emit_spstore(as, ir, src, ofs); ofs += irt_isnum(ir->t) ? 8 : 4; } } else #endif { if (gpr <= REGARG_LASTGPR) { lua_assert(rset_test(as->freeset, gpr)); /* Must have been evicted. */ if (ref) ra_leftov(as, gpr, ref); gpr++; } else { if (ref) { Reg r = ra_alloc1(as, ref, RSET_GPR); emit_spstore(as, ir, r, ofs); } ofs += 4; } } } } /* Setup result reg/sp for call. Evict scratch regs. */ static void asm_setupresult(ASMState *as, IRIns *ir, const CCallInfo *ci) { RegSet drop = RSET_SCRATCH; int hiop = ((ir+1)->o == IR_HIOP && !irt_isnil((ir+1)->t)); if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ if (hiop && ra_hasreg((ir+1)->r)) rset_clear(drop, (ir+1)->r); /* Dest reg handled below. */ ra_evictset(as, drop); /* Evictions must be performed first. */ if (ra_used(ir)) { lua_assert(!irt_ispri(ir->t)); if (!LJ_SOFTFP && irt_isfp(ir->t)) { if (LJ_ABI_SOFTFP || (ci->flags & (CCI_CASTU64|CCI_VARARG))) { Reg dest = (ra_dest(as, ir, RSET_FPR) & 15); if (irt_isnum(ir->t)) emit_dnm(as, ARMI_VMOV_D_RR, RID_RETLO, RID_RETHI, dest); else emit_dn(as, ARMI_VMOV_S_R, RID_RET, dest); } else { ra_destreg(as, ir, RID_FPRET); } } else if (hiop) { ra_destpair(as, ir); } else { ra_destreg(as, ir, RID_RET); } } UNUSED(ci); } static void asm_call(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX]; const CCallInfo *ci = &lj_ir_callinfo[ir->op2]; asm_collectargs(as, ir, ci, args); asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } static void asm_callx(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX*2]; CCallInfo ci; IRRef func; IRIns *irf; ci.flags = asm_callx_flags(as, ir); asm_collectargs(as, ir, &ci, args); asm_setupresult(as, ir, &ci); func = ir->op2; irf = IR(func); if (irf->o == IR_CARG) { func = irf->op1; irf = IR(func); } if (irref_isk(func)) { /* Call to constant address. */ ci.func = (ASMFunction)(void *)(irf->i); } else { /* Need a non-argument register for indirect calls. */ Reg freg = ra_alloc1(as, func, RSET_RANGE(RID_R4, RID_R12+1)); emit_m(as, ARMI_BLXr, freg); ci.func = (ASMFunction)(void *)0; } asm_gencall(as, &ci, args); } /* -- Returns ------------------------------------------------------------- */ /* Return to lower frame. Guard that it goes to the right spot. */ static void asm_retf(ASMState *as, IRIns *ir) { Reg base = ra_alloc1(as, REF_BASE, RSET_GPR); void *pc = ir_kptr(IR(ir->op2)); int32_t delta = 1+bc_a(*((const BCIns *)pc - 1)); as->topslot -= (BCReg)delta; if ((int32_t)as->topslot < 0) as->topslot = 0; irt_setmark(IR(REF_BASE)->t); /* Children must not coalesce with BASE reg. */ /* Need to force a spill on REF_BASE now to update the stack slot. */ emit_lso(as, ARMI_STR, base, RID_SP, ra_spill(as, IR(REF_BASE))); emit_setgl(as, base, jit_base); emit_addptr(as, base, -8*delta); asm_guardcc(as, CC_NE); emit_nm(as, ARMI_CMP, RID_TMP, ra_allock(as, i32ptr(pc), rset_exclude(RSET_GPR, base))); emit_lso(as, ARMI_LDR, RID_TMP, base, -4); } /* -- Type conversions ---------------------------------------------------- */ #if !LJ_SOFTFP static void asm_tointg(ASMState *as, IRIns *ir, Reg left) { Reg tmp = ra_scratch(as, rset_exclude(RSET_FPR, left)); Reg dest = ra_dest(as, ir, RSET_GPR); asm_guardcc(as, CC_NE); emit_d(as, ARMI_VMRS, 0); emit_dm(as, ARMI_VCMP_D, (tmp & 15), (left & 15)); emit_dm(as, ARMI_VCVT_F64_S32, (tmp & 15), (tmp & 15)); emit_dn(as, ARMI_VMOV_R_S, dest, (tmp & 15)); emit_dm(as, ARMI_VCVT_S32_F64, (tmp & 15), (left & 15)); } static void asm_tobit(ASMState *as, IRIns *ir) { RegSet allow = RSET_FPR; Reg left = ra_alloc1(as, ir->op1, allow); Reg right = ra_alloc1(as, ir->op2, rset_clear(allow, left)); Reg tmp = ra_scratch(as, rset_clear(allow, right)); Reg dest = ra_dest(as, ir, RSET_GPR); emit_dn(as, ARMI_VMOV_R_S, dest, (tmp & 15)); emit_dnm(as, ARMI_VADD_D, (tmp & 15), (left & 15), (right & 15)); } #endif static void asm_conv(ASMState *as, IRIns *ir) { IRType st = (IRType)(ir->op2 & IRCONV_SRCMASK); #if !LJ_SOFTFP int stfp = (st == IRT_NUM || st == IRT_FLOAT); #endif IRRef lref = ir->op1; /* 64 bit integer conversions are handled by SPLIT. */ lua_assert(!irt_isint64(ir->t) && !(st == IRT_I64 || st == IRT_U64)); #if LJ_SOFTFP /* FP conversions are handled by SPLIT. */ lua_assert(!irt_isfp(ir->t) && !(st == IRT_NUM || st == IRT_FLOAT)); /* Can't check for same types: SPLIT uses CONV int.int + BXOR for sfp NEG. */ #else lua_assert(irt_type(ir->t) != st); if (irt_isfp(ir->t)) { Reg dest = ra_dest(as, ir, RSET_FPR); if (stfp) { /* FP to FP conversion. */ emit_dm(as, st == IRT_NUM ? ARMI_VCVT_F32_F64 : ARMI_VCVT_F64_F32, (dest & 15), (ra_alloc1(as, lref, RSET_FPR) & 15)); } else { /* Integer to FP conversion. */ Reg left = ra_alloc1(as, lref, RSET_GPR); ARMIns ai = irt_isfloat(ir->t) ? (st == IRT_INT ? ARMI_VCVT_F32_S32 : ARMI_VCVT_F32_U32) : (st == IRT_INT ? ARMI_VCVT_F64_S32 : ARMI_VCVT_F64_U32); emit_dm(as, ai, (dest & 15), (dest & 15)); emit_dn(as, ARMI_VMOV_S_R, left, (dest & 15)); } } else if (stfp) { /* FP to integer conversion. */ if (irt_isguard(ir->t)) { /* Checked conversions are only supported from number to int. */ lua_assert(irt_isint(ir->t) && st == IRT_NUM); asm_tointg(as, ir, ra_alloc1(as, lref, RSET_FPR)); } else { Reg left = ra_alloc1(as, lref, RSET_FPR); Reg tmp = ra_scratch(as, rset_exclude(RSET_FPR, left)); Reg dest = ra_dest(as, ir, RSET_GPR); ARMIns ai; emit_dn(as, ARMI_VMOV_R_S, dest, (tmp & 15)); ai = irt_isint(ir->t) ? (st == IRT_NUM ? ARMI_VCVT_S32_F64 : ARMI_VCVT_S32_F32) : (st == IRT_NUM ? ARMI_VCVT_U32_F64 : ARMI_VCVT_U32_F32); emit_dm(as, ai, (tmp & 15), (left & 15)); } } else #endif { Reg dest = ra_dest(as, ir, RSET_GPR); if (st >= IRT_I8 && st <= IRT_U16) { /* Extend to 32 bit integer. */ Reg left = ra_alloc1(as, lref, RSET_GPR); lua_assert(irt_isint(ir->t) || irt_isu32(ir->t)); if ((as->flags & JIT_F_ARMV6)) { ARMIns ai = st == IRT_I8 ? ARMI_SXTB : st == IRT_U8 ? ARMI_UXTB : st == IRT_I16 ? ARMI_SXTH : ARMI_UXTH; emit_dm(as, ai, dest, left); } else if (st == IRT_U8) { emit_dn(as, ARMI_AND|ARMI_K12|255, dest, left); } else { uint32_t shift = st == IRT_I8 ? 24 : 16; ARMShift sh = st == IRT_U16 ? ARMSH_LSR : ARMSH_ASR; emit_dm(as, ARMI_MOV|ARMF_SH(sh, shift), dest, RID_TMP); emit_dm(as, ARMI_MOV|ARMF_SH(ARMSH_LSL, shift), RID_TMP, left); } } else { /* Handle 32/32 bit no-op (cast). */ ra_leftov(as, dest, lref); /* Do nothing, but may need to move regs. */ } } } #if !LJ_SOFTFP && LJ_HASFFI static void asm_conv64(ASMState *as, IRIns *ir) { IRType st = (IRType)((ir-1)->op2 & IRCONV_SRCMASK); IRType dt = (((ir-1)->op2 & IRCONV_DSTMASK) >> IRCONV_DSH); IRCallID id; CCallInfo ci; IRRef args[2]; args[0] = (ir-1)->op1; args[1] = ir->op1; if (st == IRT_NUM || st == IRT_FLOAT) { id = IRCALL_fp64_d2l + ((st == IRT_FLOAT) ? 2 : 0) + (dt - IRT_I64); ir--; } else { id = IRCALL_fp64_l2d + ((dt == IRT_FLOAT) ? 2 : 0) + (st - IRT_I64); } ci = lj_ir_callinfo[id]; #if !LJ_ABI_SOFTFP ci.flags |= CCI_VARARG; /* These calls don't use the hard-float ABI! */ #endif asm_setupresult(as, ir, &ci); asm_gencall(as, &ci, args); } #endif static void asm_strto(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_strscan_num]; IRRef args[2]; Reg rlo = 0, rhi = 0, tmp; int destused = ra_used(ir); int32_t ofs = 0; ra_evictset(as, RSET_SCRATCH); #if LJ_SOFTFP if (destused) { if (ra_hasspill(ir->s) && ra_hasspill((ir+1)->s) && (ir->s & 1) == 0 && ir->s + 1 == (ir+1)->s) { int i; for (i = 0; i < 2; i++) { Reg r = (ir+i)->r; if (ra_hasreg(r)) { ra_free(as, r); ra_modified(as, r); emit_spload(as, ir+i, r, sps_scale((ir+i)->s)); } } ofs = sps_scale(ir->s); destused = 0; } else { rhi = ra_dest(as, ir+1, RSET_GPR); rlo = ra_dest(as, ir, rset_exclude(RSET_GPR, rhi)); } } asm_guardcc(as, CC_EQ); if (destused) { emit_lso(as, ARMI_LDR, rhi, RID_SP, 4); emit_lso(as, ARMI_LDR, rlo, RID_SP, 0); } #else UNUSED(rhi); if (destused) { if (ra_hasspill(ir->s)) { ofs = sps_scale(ir->s); destused = 0; if (ra_hasreg(ir->r)) { ra_free(as, ir->r); ra_modified(as, ir->r); emit_spload(as, ir, ir->r, ofs); } } else { rlo = ra_dest(as, ir, RSET_FPR); } } asm_guardcc(as, CC_EQ); if (destused) emit_vlso(as, ARMI_VLDR_D, rlo, RID_SP, 0); #endif emit_n(as, ARMI_CMP|ARMI_K12|0, RID_RET); /* Test return status. */ args[0] = ir->op1; /* GCstr *str */ args[1] = ASMREF_TMP1; /* TValue *n */ asm_gencall(as, ci, args); tmp = ra_releasetmp(as, ASMREF_TMP1); if (ofs == 0) emit_dm(as, ARMI_MOV, tmp, RID_SP); else emit_opk(as, ARMI_ADD, tmp, RID_SP, ofs, RSET_GPR); } /* Get pointer to TValue. */ static void asm_tvptr(ASMState *as, Reg dest, IRRef ref) { IRIns *ir = IR(ref); if (irt_isnum(ir->t)) { if (irref_isk(ref)) { /* Use the number constant itself as a TValue. */ ra_allockreg(as, i32ptr(ir_knum(ir)), dest); } else { #if LJ_SOFTFP lua_assert(0); #else /* Otherwise force a spill and use the spill slot. */ emit_opk(as, ARMI_ADD, dest, RID_SP, ra_spill(as, ir), RSET_GPR); #endif } } else { /* Otherwise use [sp] and [sp+4] to hold the TValue. */ RegSet allow = rset_exclude(RSET_GPR, dest); Reg type; emit_dm(as, ARMI_MOV, dest, RID_SP); if (!irt_ispri(ir->t)) { Reg src = ra_alloc1(as, ref, allow); emit_lso(as, ARMI_STR, src, RID_SP, 0); } if ((ir+1)->o == IR_HIOP) type = ra_alloc1(as, ref+1, allow); else type = ra_allock(as, irt_toitype(ir->t), allow); emit_lso(as, ARMI_STR, type, RID_SP, 4); } } static void asm_tostr(ASMState *as, IRIns *ir) { IRRef args[2]; args[0] = ASMREF_L; as->gcsteps++; if (irt_isnum(IR(ir->op1)->t) || (ir+1)->o == IR_HIOP) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromnum]; args[1] = ASMREF_TMP1; /* const lua_Number * */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); asm_tvptr(as, ra_releasetmp(as, ASMREF_TMP1), ir->op1); } else { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromint]; args[1] = ir->op1; /* int32_t k */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); } } /* -- Memory references --------------------------------------------------- */ static void asm_aref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg idx, base; if (irref_isk(ir->op2)) { IRRef tab = IR(ir->op1)->op1; int32_t ofs = asm_fuseabase(as, tab); IRRef refa = ofs ? tab : ir->op1; uint32_t k = emit_isk12(ARMI_ADD, ofs + 8*IR(ir->op2)->i); if (k) { base = ra_alloc1(as, refa, RSET_GPR); emit_dn(as, ARMI_ADD^k, dest, base); return; } } base = ra_alloc1(as, ir->op1, RSET_GPR); idx = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, base)); emit_dnm(as, ARMI_ADD|ARMF_SH(ARMSH_LSL, 3), dest, base, idx); } /* Inlined hash lookup. Specialized for key type and for const keys. ** The equivalent C code is: ** Node *n = hashkey(t, key); ** do { ** if (lj_obj_equal(&n->key, key)) return &n->val; ** } while ((n = nextnode(n))); ** return niltv(L); */ static void asm_href(ASMState *as, IRIns *ir, IROp merge) { RegSet allow = RSET_GPR; int destused = ra_used(ir); Reg dest = ra_dest(as, ir, allow); Reg tab = ra_alloc1(as, ir->op1, rset_clear(allow, dest)); Reg key = 0, keyhi = 0, keynumhi = RID_NONE, tmp = RID_TMP; IRRef refkey = ir->op2; IRIns *irkey = IR(refkey); IRType1 kt = irkey->t; int32_t k = 0, khi = emit_isk12(ARMI_CMP, irt_toitype(kt)); uint32_t khash; MCLabel l_end, l_loop; rset_clear(allow, tab); if (!irref_isk(refkey) || irt_isstr(kt)) { #if LJ_SOFTFP key = ra_alloc1(as, refkey, allow); rset_clear(allow, key); if (irkey[1].o == IR_HIOP) { if (ra_hasreg((irkey+1)->r)) { keynumhi = (irkey+1)->r; keyhi = RID_TMP; ra_noweak(as, keynumhi); } else { keyhi = keynumhi = ra_allocref(as, refkey+1, allow); } rset_clear(allow, keynumhi); khi = 0; } #else if (irt_isnum(kt)) { key = ra_scratch(as, allow); rset_clear(allow, key); keyhi = keynumhi = ra_scratch(as, allow); rset_clear(allow, keyhi); khi = 0; } else { key = ra_alloc1(as, refkey, allow); rset_clear(allow, key); } #endif } else if (irt_isnum(kt)) { int32_t val = (int32_t)ir_knum(irkey)->u32.lo; k = emit_isk12(ARMI_CMP, val); if (!k) { key = ra_allock(as, val, allow); rset_clear(allow, key); } val = (int32_t)ir_knum(irkey)->u32.hi; khi = emit_isk12(ARMI_CMP, val); if (!khi) { keyhi = ra_allock(as, val, allow); rset_clear(allow, keyhi); } } else if (!irt_ispri(kt)) { k = emit_isk12(ARMI_CMP, irkey->i); if (!k) { key = ra_alloc1(as, refkey, allow); rset_clear(allow, key); } } if (!irt_ispri(kt)) tmp = ra_scratchpair(as, allow); /* Key not found in chain: jump to exit (if merged) or load niltv. */ l_end = emit_label(as); as->invmcp = NULL; if (merge == IR_NE) asm_guardcc(as, CC_AL); else if (destused) emit_loada(as, dest, niltvg(J2G(as->J))); /* Follow hash chain until the end. */ l_loop = --as->mcp; emit_n(as, ARMI_CMP|ARMI_K12|0, dest); emit_lso(as, ARMI_LDR, dest, dest, (int32_t)offsetof(Node, next)); /* Type and value comparison. */ if (merge == IR_EQ) asm_guardcc(as, CC_EQ); else emit_branch(as, ARMF_CC(ARMI_B, CC_EQ), l_end); if (!irt_ispri(kt)) { emit_nm(as, ARMF_CC(ARMI_CMP, CC_EQ)^k, tmp, key); emit_nm(as, ARMI_CMP^khi, tmp+1, keyhi); emit_lsox(as, ARMI_LDRD, tmp, dest, (int32_t)offsetof(Node, key)); } else { emit_n(as, ARMI_CMP^khi, tmp); emit_lso(as, ARMI_LDR, tmp, dest, (int32_t)offsetof(Node, key.it)); } *l_loop = ARMF_CC(ARMI_B, CC_NE) | ((as->mcp-l_loop-2) & 0x00ffffffu); /* Load main position relative to tab->node into dest. */ khash = irref_isk(refkey) ? ir_khash(irkey) : 1; if (khash == 0) { emit_lso(as, ARMI_LDR, dest, tab, (int32_t)offsetof(GCtab, node)); } else { emit_dnm(as, ARMI_ADD|ARMF_SH(ARMSH_LSL, 3), dest, dest, tmp); emit_dnm(as, ARMI_ADD|ARMF_SH(ARMSH_LSL, 1), tmp, tmp, tmp); if (irt_isstr(kt)) { /* Fetch of str->hash is cheaper than ra_allock. */ emit_dnm(as, ARMI_AND, tmp, tmp+1, RID_TMP); emit_lso(as, ARMI_LDR, dest, tab, (int32_t)offsetof(GCtab, node)); emit_lso(as, ARMI_LDR, tmp+1, key, (int32_t)offsetof(GCstr, hash)); emit_lso(as, ARMI_LDR, RID_TMP, tab, (int32_t)offsetof(GCtab, hmask)); } else if (irref_isk(refkey)) { emit_opk(as, ARMI_AND, tmp, RID_TMP, (int32_t)khash, rset_exclude(rset_exclude(RSET_GPR, tab), dest)); emit_lso(as, ARMI_LDR, dest, tab, (int32_t)offsetof(GCtab, node)); emit_lso(as, ARMI_LDR, RID_TMP, tab, (int32_t)offsetof(GCtab, hmask)); } else { /* Must match with hash*() in lj_tab.c. */ if (ra_hasreg(keynumhi)) { /* Canonicalize +-0.0 to 0.0. */ if (keyhi == RID_TMP) emit_dm(as, ARMF_CC(ARMI_MOV, CC_NE), keyhi, keynumhi); emit_d(as, ARMF_CC(ARMI_MOV, CC_EQ)|ARMI_K12|0, keyhi); } emit_dnm(as, ARMI_AND, tmp, tmp, RID_TMP); emit_dnm(as, ARMI_SUB|ARMF_SH(ARMSH_ROR, 32-HASH_ROT3), tmp, tmp, tmp+1); emit_lso(as, ARMI_LDR, dest, tab, (int32_t)offsetof(GCtab, node)); emit_dnm(as, ARMI_EOR|ARMF_SH(ARMSH_ROR, 32-((HASH_ROT2+HASH_ROT1)&31)), tmp, tmp+1, tmp); emit_lso(as, ARMI_LDR, RID_TMP, tab, (int32_t)offsetof(GCtab, hmask)); emit_dnm(as, ARMI_SUB|ARMF_SH(ARMSH_ROR, 32-HASH_ROT1), tmp+1, tmp+1, tmp); if (ra_hasreg(keynumhi)) { emit_dnm(as, ARMI_EOR, tmp+1, tmp, key); emit_dnm(as, ARMI_ORR|ARMI_S, RID_TMP, tmp, key); /* Test for +-0.0. */ emit_dnm(as, ARMI_ADD, tmp, keynumhi, keynumhi); #if !LJ_SOFTFP emit_dnm(as, ARMI_VMOV_RR_D, key, keynumhi, (ra_alloc1(as, refkey, RSET_FPR) & 15)); #endif } else { emit_dnm(as, ARMI_EOR, tmp+1, tmp, key); emit_opk(as, ARMI_ADD, tmp, key, (int32_t)HASH_BIAS, rset_exclude(rset_exclude(RSET_GPR, tab), key)); } } } } static void asm_hrefk(ASMState *as, IRIns *ir) { IRIns *kslot = IR(ir->op2); IRIns *irkey = IR(kslot->op1); int32_t ofs = (int32_t)(kslot->op2 * sizeof(Node)); int32_t kofs = ofs + (int32_t)offsetof(Node, key); Reg dest = (ra_used(ir) || ofs > 4095) ? ra_dest(as, ir, RSET_GPR) : RID_NONE; Reg node = ra_alloc1(as, ir->op1, RSET_GPR); Reg key = RID_NONE, type = RID_TMP, idx = node; RegSet allow = rset_exclude(RSET_GPR, node); lua_assert(ofs % sizeof(Node) == 0); if (ofs > 4095) { idx = dest; rset_clear(allow, dest); kofs = (int32_t)offsetof(Node, key); } else if (ra_hasreg(dest)) { emit_opk(as, ARMI_ADD, dest, node, ofs, allow); } asm_guardcc(as, CC_NE); if (!irt_ispri(irkey->t)) { RegSet even = (as->freeset & allow); even = even & (even >> 1) & RSET_GPREVEN; if (even) { key = ra_scratch(as, even); if (rset_test(as->freeset, key+1)) { type = key+1; ra_modified(as, type); } } else { key = ra_scratch(as, allow); } rset_clear(allow, key); } rset_clear(allow, type); if (irt_isnum(irkey->t)) { emit_opk(as, ARMF_CC(ARMI_CMP, CC_EQ), 0, type, (int32_t)ir_knum(irkey)->u32.hi, allow); emit_opk(as, ARMI_CMP, 0, key, (int32_t)ir_knum(irkey)->u32.lo, allow); } else { if (ra_hasreg(key)) emit_opk(as, ARMF_CC(ARMI_CMP, CC_EQ), 0, key, irkey->i, allow); emit_n(as, ARMI_CMN|ARMI_K12|-irt_toitype(irkey->t), type); } emit_lso(as, ARMI_LDR, type, idx, kofs+4); if (ra_hasreg(key)) emit_lso(as, ARMI_LDR, key, idx, kofs); if (ofs > 4095) emit_opk(as, ARMI_ADD, dest, node, ofs, RSET_GPR); } static void asm_newref(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_tab_newkey]; IRRef args[3]; if (ir->r == RID_SINK) return; args[0] = ASMREF_L; /* lua_State *L */ args[1] = ir->op1; /* GCtab *t */ args[2] = ASMREF_TMP1; /* cTValue *key */ asm_setupresult(as, ir, ci); /* TValue * */ asm_gencall(as, ci, args); asm_tvptr(as, ra_releasetmp(as, ASMREF_TMP1), ir->op2); } static void asm_uref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); MRef *v = &gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv.v; emit_lsptr(as, ARMI_LDR, dest, v); } else { Reg uv = ra_scratch(as, RSET_GPR); Reg func = ra_alloc1(as, ir->op1, RSET_GPR); if (ir->o == IR_UREFC) { asm_guardcc(as, CC_NE); emit_n(as, ARMI_CMP|ARMI_K12|1, RID_TMP); emit_opk(as, ARMI_ADD, dest, uv, (int32_t)offsetof(GCupval, tv), RSET_GPR); emit_lso(as, ARMI_LDRB, RID_TMP, uv, (int32_t)offsetof(GCupval, closed)); } else { emit_lso(as, ARMI_LDR, dest, uv, (int32_t)offsetof(GCupval, v)); } emit_lso(as, ARMI_LDR, uv, func, (int32_t)offsetof(GCfuncL, uvptr) + 4*(int32_t)(ir->op2 >> 8)); } } static void asm_fref(ASMState *as, IRIns *ir) { UNUSED(as); UNUSED(ir); lua_assert(!ra_used(ir)); } static void asm_strref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); IRRef ref = ir->op2, refk = ir->op1; Reg r; if (irref_isk(ref)) { IRRef tmp = refk; refk = ref; ref = tmp; } else if (!irref_isk(refk)) { uint32_t k, m = ARMI_K12|sizeof(GCstr); Reg right, left = ra_alloc1(as, ir->op1, RSET_GPR); IRIns *irr = IR(ir->op2); if (ra_hasreg(irr->r)) { ra_noweak(as, irr->r); right = irr->r; } else if (mayfuse(as, irr->op2) && irr->o == IR_ADD && irref_isk(irr->op2) && (k = emit_isk12(ARMI_ADD, (int32_t)sizeof(GCstr) + IR(irr->op2)->i))) { m = k; right = ra_alloc1(as, irr->op1, rset_exclude(RSET_GPR, left)); } else { right = ra_allocref(as, ir->op2, rset_exclude(RSET_GPR, left)); } emit_dn(as, ARMI_ADD^m, dest, dest); emit_dnm(as, ARMI_ADD, dest, left, right); return; } r = ra_alloc1(as, ref, RSET_GPR); emit_opk(as, ARMI_ADD, dest, r, sizeof(GCstr) + IR(refk)->i, rset_exclude(RSET_GPR, r)); } /* -- Loads and stores ---------------------------------------------------- */ static ARMIns asm_fxloadins(IRIns *ir) { switch (irt_type(ir->t)) { case IRT_I8: return ARMI_LDRSB; case IRT_U8: return ARMI_LDRB; case IRT_I16: return ARMI_LDRSH; case IRT_U16: return ARMI_LDRH; case IRT_NUM: lua_assert(!LJ_SOFTFP); return ARMI_VLDR_D; case IRT_FLOAT: if (!LJ_SOFTFP) return ARMI_VLDR_S; default: return ARMI_LDR; } } static ARMIns asm_fxstoreins(IRIns *ir) { switch (irt_type(ir->t)) { case IRT_I8: case IRT_U8: return ARMI_STRB; case IRT_I16: case IRT_U16: return ARMI_STRH; case IRT_NUM: lua_assert(!LJ_SOFTFP); return ARMI_VSTR_D; case IRT_FLOAT: if (!LJ_SOFTFP) return ARMI_VSTR_S; default: return ARMI_STR; } } static void asm_fload(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg idx = ra_alloc1(as, ir->op1, RSET_GPR); ARMIns ai = asm_fxloadins(ir); int32_t ofs; if (ir->op2 == IRFL_TAB_ARRAY) { ofs = asm_fuseabase(as, ir->op1); if (ofs) { /* Turn the t->array load into an add for colocated arrays. */ emit_dn(as, ARMI_ADD|ARMI_K12|ofs, dest, idx); return; } } ofs = field_ofs[ir->op2]; if ((ai & 0x04000000)) emit_lso(as, ai, dest, idx, ofs); else emit_lsox(as, ai, dest, idx, ofs); } static void asm_fstore(ASMState *as, IRIns *ir) { if (ir->r != RID_SINK) { Reg src = ra_alloc1(as, ir->op2, RSET_GPR); IRIns *irf = IR(ir->op1); Reg idx = ra_alloc1(as, irf->op1, rset_exclude(RSET_GPR, src)); int32_t ofs = field_ofs[irf->op2]; ARMIns ai = asm_fxstoreins(ir); if ((ai & 0x04000000)) emit_lso(as, ai, src, idx, ofs); else emit_lsox(as, ai, src, idx, ofs); } } static void asm_xload(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, (!LJ_SOFTFP && irt_isfp(ir->t)) ? RSET_FPR : RSET_GPR); lua_assert(!(ir->op2 & IRXLOAD_UNALIGNED)); asm_fusexref(as, asm_fxloadins(ir), dest, ir->op1, RSET_GPR, 0); } static void asm_xstore(ASMState *as, IRIns *ir, int32_t ofs) { if (ir->r != RID_SINK) { Reg src = ra_alloc1(as, ir->op2, (!LJ_SOFTFP && irt_isfp(ir->t)) ? RSET_FPR : RSET_GPR); asm_fusexref(as, asm_fxstoreins(ir), src, ir->op1, rset_exclude(RSET_GPR, src), ofs); } } static void asm_ahuvload(ASMState *as, IRIns *ir) { int hiop = (LJ_SOFTFP && (ir+1)->o == IR_HIOP); IRType t = hiop ? IRT_NUM : irt_type(ir->t); Reg dest = RID_NONE, type = RID_NONE, idx; RegSet allow = RSET_GPR; int32_t ofs = 0; if (hiop && ra_used(ir+1)) { type = ra_dest(as, ir+1, allow); rset_clear(allow, type); } if (ra_used(ir)) { lua_assert((LJ_SOFTFP ? 0 : irt_isnum(ir->t)) || irt_isint(ir->t) || irt_isaddr(ir->t)); dest = ra_dest(as, ir, (!LJ_SOFTFP && t == IRT_NUM) ? RSET_FPR : allow); rset_clear(allow, dest); } idx = asm_fuseahuref(as, ir->op1, &ofs, allow, (!LJ_SOFTFP && t == IRT_NUM) ? 1024 : 4096); if (!hiop || type == RID_NONE) { rset_clear(allow, idx); if (ofs < 256 && ra_hasreg(dest) && (dest & 1) == 0 && rset_test((as->freeset & allow), dest+1)) { type = dest+1; ra_modified(as, type); } else { type = RID_TMP; } } asm_guardcc(as, t == IRT_NUM ? CC_HS : CC_NE); emit_n(as, ARMI_CMN|ARMI_K12|-irt_toitype_(t), type); if (ra_hasreg(dest)) { #if !LJ_SOFTFP if (t == IRT_NUM) emit_vlso(as, ARMI_VLDR_D, dest, idx, ofs); else #endif emit_lso(as, ARMI_LDR, dest, idx, ofs); } emit_lso(as, ARMI_LDR, type, idx, ofs+4); } static void asm_ahustore(ASMState *as, IRIns *ir) { if (ir->r != RID_SINK) { RegSet allow = RSET_GPR; Reg idx, src = RID_NONE, type = RID_NONE; int32_t ofs = 0; #if !LJ_SOFTFP if (irt_isnum(ir->t)) { src = ra_alloc1(as, ir->op2, RSET_FPR); idx = asm_fuseahuref(as, ir->op1, &ofs, allow, 1024); emit_vlso(as, ARMI_VSTR_D, src, idx, ofs); } else #endif { int hiop = (LJ_SOFTFP && (ir+1)->o == IR_HIOP); if (!irt_ispri(ir->t)) { src = ra_alloc1(as, ir->op2, allow); rset_clear(allow, src); } if (hiop) type = ra_alloc1(as, (ir+1)->op2, allow); else type = ra_allock(as, (int32_t)irt_toitype(ir->t), allow); idx = asm_fuseahuref(as, ir->op1, &ofs, rset_exclude(allow, type), 4096); if (ra_hasreg(src)) emit_lso(as, ARMI_STR, src, idx, ofs); emit_lso(as, ARMI_STR, type, idx, ofs+4); } } } static void asm_sload(ASMState *as, IRIns *ir) { int32_t ofs = 8*((int32_t)ir->op1-1) + ((ir->op2 & IRSLOAD_FRAME) ? 4 : 0); int hiop = (LJ_SOFTFP && (ir+1)->o == IR_HIOP); IRType t = hiop ? IRT_NUM : irt_type(ir->t); Reg dest = RID_NONE, type = RID_NONE, base; RegSet allow = RSET_GPR; lua_assert(!(ir->op2 & IRSLOAD_PARENT)); /* Handled by asm_head_side(). */ lua_assert(irt_isguard(ir->t) || !(ir->op2 & IRSLOAD_TYPECHECK)); #if LJ_SOFTFP lua_assert(!(ir->op2 & IRSLOAD_CONVERT)); /* Handled by LJ_SOFTFP SPLIT. */ if (hiop && ra_used(ir+1)) { type = ra_dest(as, ir+1, allow); rset_clear(allow, type); } #else if ((ir->op2 & IRSLOAD_CONVERT) && irt_isguard(ir->t) && t == IRT_INT) { dest = ra_scratch(as, RSET_FPR); asm_tointg(as, ir, dest); t = IRT_NUM; /* Continue with a regular number type check. */ } else #endif if (ra_used(ir)) { Reg tmp = RID_NONE; if ((ir->op2 & IRSLOAD_CONVERT)) tmp = ra_scratch(as, t == IRT_INT ? RSET_FPR : RSET_GPR); lua_assert((LJ_SOFTFP ? 0 : irt_isnum(ir->t)) || irt_isint(ir->t) || irt_isaddr(ir->t)); dest = ra_dest(as, ir, (!LJ_SOFTFP && t == IRT_NUM) ? RSET_FPR : allow); rset_clear(allow, dest); base = ra_alloc1(as, REF_BASE, allow); if ((ir->op2 & IRSLOAD_CONVERT)) { if (t == IRT_INT) { emit_dn(as, ARMI_VMOV_R_S, dest, (tmp & 15)); emit_dm(as, ARMI_VCVT_S32_F64, (tmp & 15), (tmp & 15)); t = IRT_NUM; /* Check for original type. */ } else { emit_dm(as, ARMI_VCVT_F64_S32, (dest & 15), (dest & 15)); emit_dn(as, ARMI_VMOV_S_R, tmp, (dest & 15)); t = IRT_INT; /* Check for original type. */ } dest = tmp; } goto dotypecheck; } base = ra_alloc1(as, REF_BASE, allow); dotypecheck: rset_clear(allow, base); if ((ir->op2 & IRSLOAD_TYPECHECK)) { if (ra_noreg(type)) { if (ofs < 256 && ra_hasreg(dest) && (dest & 1) == 0 && rset_test((as->freeset & allow), dest+1)) { type = dest+1; ra_modified(as, type); } else { type = RID_TMP; } } asm_guardcc(as, t == IRT_NUM ? CC_HS : CC_NE); emit_n(as, ARMI_CMN|ARMI_K12|-irt_toitype_(t), type); } if (ra_hasreg(dest)) { #if !LJ_SOFTFP if (t == IRT_NUM) { if (ofs < 1024) { emit_vlso(as, ARMI_VLDR_D, dest, base, ofs); } else { if (ra_hasreg(type)) emit_lso(as, ARMI_LDR, type, base, ofs+4); emit_vlso(as, ARMI_VLDR_D, dest, RID_TMP, 0); emit_opk(as, ARMI_ADD, RID_TMP, base, ofs, allow); return; } } else #endif emit_lso(as, ARMI_LDR, dest, base, ofs); } if (ra_hasreg(type)) emit_lso(as, ARMI_LDR, type, base, ofs+4); } /* -- Allocations --------------------------------------------------------- */ #if LJ_HASFFI static void asm_cnew(ASMState *as, IRIns *ir) { CTState *cts = ctype_ctsG(J2G(as->J)); CTypeID ctypeid = (CTypeID)IR(ir->op1)->i; CTSize sz = (ir->o == IR_CNEWI || ir->op2 == REF_NIL) ? lj_ctype_size(cts, ctypeid) : (CTSize)IR(ir->op2)->i; const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_mem_newgco]; IRRef args[2]; RegSet allow = (RSET_GPR & ~RSET_SCRATCH); RegSet drop = RSET_SCRATCH; lua_assert(sz != CTSIZE_INVALID); args[0] = ASMREF_L; /* lua_State *L */ args[1] = ASMREF_TMP1; /* MSize size */ as->gcsteps++; if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ ra_evictset(as, drop); if (ra_used(ir)) ra_destreg(as, ir, RID_RET); /* GCcdata * */ /* Initialize immutable cdata object. */ if (ir->o == IR_CNEWI) { int32_t ofs = sizeof(GCcdata); lua_assert(sz == 4 || sz == 8); if (sz == 8) { ofs += 4; ir++; lua_assert(ir->o == IR_HIOP); } for (;;) { Reg r = ra_alloc1(as, ir->op2, allow); emit_lso(as, ARMI_STR, r, RID_RET, ofs); rset_clear(allow, r); if (ofs == sizeof(GCcdata)) break; ofs -= 4; ir--; } } /* Initialize gct and ctypeid. lj_mem_newgco() already sets marked. */ { uint32_t k = emit_isk12(ARMI_MOV, ctypeid); Reg r = k ? RID_R1 : ra_allock(as, ctypeid, allow); emit_lso(as, ARMI_STRB, RID_TMP, RID_RET, offsetof(GCcdata, gct)); emit_lsox(as, ARMI_STRH, r, RID_RET, offsetof(GCcdata, ctypeid)); emit_d(as, ARMI_MOV|ARMI_K12|~LJ_TCDATA, RID_TMP); if (k) emit_d(as, ARMI_MOV^k, RID_R1); } asm_gencall(as, ci, args); ra_allockreg(as, (int32_t)(sz+sizeof(GCcdata)), ra_releasetmp(as, ASMREF_TMP1)); } #else #define asm_cnew(as, ir) ((void)0) #endif /* -- Write barriers ------------------------------------------------------ */ static void asm_tbar(ASMState *as, IRIns *ir) { Reg tab = ra_alloc1(as, ir->op1, RSET_GPR); Reg link = ra_scratch(as, rset_exclude(RSET_GPR, tab)); Reg gr = ra_allock(as, i32ptr(J2G(as->J)), rset_exclude(rset_exclude(RSET_GPR, tab), link)); Reg mark = RID_TMP; MCLabel l_end = emit_label(as); emit_lso(as, ARMI_STR, link, tab, (int32_t)offsetof(GCtab, gclist)); emit_lso(as, ARMI_STRB, mark, tab, (int32_t)offsetof(GCtab, marked)); emit_lso(as, ARMI_STR, tab, gr, (int32_t)offsetof(global_State, gc.grayagain)); emit_dn(as, ARMI_BIC|ARMI_K12|LJ_GC_BLACK, mark, mark); emit_lso(as, ARMI_LDR, link, gr, (int32_t)offsetof(global_State, gc.grayagain)); emit_branch(as, ARMF_CC(ARMI_B, CC_EQ), l_end); emit_n(as, ARMI_TST|ARMI_K12|LJ_GC_BLACK, mark); emit_lso(as, ARMI_LDRB, mark, tab, (int32_t)offsetof(GCtab, marked)); } static void asm_obar(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_barrieruv]; IRRef args[2]; MCLabel l_end; Reg obj, val, tmp; /* No need for other object barriers (yet). */ lua_assert(IR(ir->op1)->o == IR_UREFC); ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ir->op1; /* TValue *tv */ asm_gencall(as, ci, args); if ((l_end[-1] >> 28) == CC_AL) l_end[-1] = ARMF_CC(l_end[-1], CC_NE); else emit_branch(as, ARMF_CC(ARMI_B, CC_EQ), l_end); ra_allockreg(as, i32ptr(J2G(as->J)), ra_releasetmp(as, ASMREF_TMP1)); obj = IR(ir->op1)->r; tmp = ra_scratch(as, rset_exclude(RSET_GPR, obj)); emit_n(as, ARMF_CC(ARMI_TST, CC_NE)|ARMI_K12|LJ_GC_BLACK, tmp); emit_n(as, ARMI_TST|ARMI_K12|LJ_GC_WHITES, RID_TMP); val = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, obj)); emit_lso(as, ARMI_LDRB, tmp, obj, (int32_t)offsetof(GCupval, marked)-(int32_t)offsetof(GCupval, tv)); emit_lso(as, ARMI_LDRB, RID_TMP, val, (int32_t)offsetof(GChead, marked)); } /* -- Arithmetic and logic operations ------------------------------------- */ #if !LJ_SOFTFP static void asm_fparith(ASMState *as, IRIns *ir, ARMIns ai) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = (left >> 8); left &= 255; emit_dnm(as, ai, (dest & 15), (left & 15), (right & 15)); } static void asm_fpunary(ASMState *as, IRIns *ir, ARMIns ai) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg left = ra_hintalloc(as, ir->op1, dest, RSET_FPR); emit_dm(as, ai, (dest & 15), (left & 15)); } static int asm_fpjoin_pow(ASMState *as, IRIns *ir) { IRIns *irp = IR(ir->op1); if (irp == ir-1 && irp->o == IR_MUL && !ra_used(irp)) { IRIns *irpp = IR(irp->op1); if (irpp == ir-2 && irpp->o == IR_FPMATH && irpp->op2 == IRFPM_LOG2 && !ra_used(irpp)) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_pow]; IRRef args[2]; args[0] = irpp->op1; args[1] = irp->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); return 1; } } return 0; } #endif static int asm_swapops(ASMState *as, IRRef lref, IRRef rref) { IRIns *ir; if (irref_isk(rref)) return 0; /* Don't swap constants to the left. */ if (irref_isk(lref)) return 1; /* But swap constants to the right. */ ir = IR(rref); if ((ir->o >= IR_BSHL && ir->o <= IR_BROR) || (ir->o == IR_ADD && ir->op1 == ir->op2)) return 0; /* Don't swap fusable operands to the left. */ ir = IR(lref); if ((ir->o >= IR_BSHL && ir->o <= IR_BROR) || (ir->o == IR_ADD && ir->op1 == ir->op2)) return 1; /* But swap fusable operands to the right. */ return 0; /* Otherwise don't swap. */ } static void asm_intop(ASMState *as, IRIns *ir, ARMIns ai) { IRRef lref = ir->op1, rref = ir->op2; Reg left, dest = ra_dest(as, ir, RSET_GPR); uint32_t m; if (asm_swapops(as, lref, rref)) { IRRef tmp = lref; lref = rref; rref = tmp; if ((ai & ~ARMI_S) == ARMI_SUB || (ai & ~ARMI_S) == ARMI_SBC) ai ^= (ARMI_SUB^ARMI_RSB); } left = ra_hintalloc(as, lref, dest, RSET_GPR); m = asm_fuseopm(as, ai, rref, rset_exclude(RSET_GPR, left)); if (irt_isguard(ir->t)) { /* For IR_ADDOV etc. */ asm_guardcc(as, CC_VS); ai |= ARMI_S; } emit_dn(as, ai^m, dest, left); } static void asm_intop_s(ASMState *as, IRIns *ir, ARMIns ai) { if (as->flagmcp == as->mcp) { /* Drop cmp r, #0. */ as->flagmcp = NULL; as->mcp++; ai |= ARMI_S; } asm_intop(as, ir, ai); } static void asm_bitop(ASMState *as, IRIns *ir, ARMIns ai) { if (as->flagmcp == as->mcp) { /* Try to drop cmp r, #0. */ uint32_t cc = (as->mcp[1] >> 28); as->flagmcp = NULL; if (cc <= CC_NE) { as->mcp++; ai |= ARMI_S; } else if (cc == CC_GE) { *++as->mcp ^= ((CC_GE^CC_PL) << 28); ai |= ARMI_S; } else if (cc == CC_LT) { *++as->mcp ^= ((CC_LT^CC_MI) << 28); ai |= ARMI_S; } /* else: other conds don't work with bit ops. */ } if (ir->op2 == 0) { Reg dest = ra_dest(as, ir, RSET_GPR); uint32_t m = asm_fuseopm(as, ai, ir->op1, RSET_GPR); emit_d(as, ai^m, dest); } else { /* NYI: Turn BAND !k12 into uxtb, uxth or bfc or shl+shr. */ asm_intop(as, ir, ai); } } static void asm_intneg(ASMState *as, IRIns *ir, ARMIns ai) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); emit_dn(as, ai|ARMI_K12|0, dest, left); } /* NYI: use add/shift for MUL(OV) with constants. FOLD only does 2^k. */ static void asm_intmul(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, rset_exclude(RSET_GPR, dest)); Reg right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); Reg tmp = RID_NONE; /* ARMv5 restriction: dest != left and dest_hi != left. */ if (dest == left && left != right) { left = right; right = dest; } if (irt_isguard(ir->t)) { /* IR_MULOV */ if (!(as->flags & JIT_F_ARMV6) && dest == left) tmp = left = ra_scratch(as, rset_exclude(RSET_GPR, left)); asm_guardcc(as, CC_NE); emit_nm(as, ARMI_TEQ|ARMF_SH(ARMSH_ASR, 31), RID_TMP, dest); emit_dnm(as, ARMI_SMULL|ARMF_S(right), dest, RID_TMP, left); } else { if (!(as->flags & JIT_F_ARMV6) && dest == left) tmp = left = RID_TMP; emit_nm(as, ARMI_MUL|ARMF_S(right), dest, left); } /* Only need this for the dest == left == right case. */ if (ra_hasreg(tmp)) emit_dm(as, ARMI_MOV, tmp, right); } static void asm_add(ASMState *as, IRIns *ir) { #if !LJ_SOFTFP if (irt_isnum(ir->t)) { if (!asm_fusemadd(as, ir, ARMI_VMLA_D, ARMI_VMLA_D)) asm_fparith(as, ir, ARMI_VADD_D); return; } #endif asm_intop_s(as, ir, ARMI_ADD); } static void asm_sub(ASMState *as, IRIns *ir) { #if !LJ_SOFTFP if (irt_isnum(ir->t)) { if (!asm_fusemadd(as, ir, ARMI_VNMLS_D, ARMI_VMLS_D)) asm_fparith(as, ir, ARMI_VSUB_D); return; } #endif asm_intop_s(as, ir, ARMI_SUB); } static void asm_mul(ASMState *as, IRIns *ir) { #if !LJ_SOFTFP if (irt_isnum(ir->t)) { asm_fparith(as, ir, ARMI_VMUL_D); return; } #endif asm_intmul(as, ir); } static void asm_neg(ASMState *as, IRIns *ir) { #if !LJ_SOFTFP if (irt_isnum(ir->t)) { asm_fpunary(as, ir, ARMI_VNEG_D); return; } #endif asm_intneg(as, ir, ARMI_RSB); } static void asm_callid(ASMState *as, IRIns *ir, IRCallID id) { const CCallInfo *ci = &lj_ir_callinfo[id]; IRRef args[2]; args[0] = ir->op1; args[1] = ir->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } #if !LJ_SOFTFP static void asm_callround(ASMState *as, IRIns *ir, int id) { /* The modified regs must match with the *.dasc implementation. */ RegSet drop = RID2RSET(RID_R0)|RID2RSET(RID_R1)|RID2RSET(RID_R2)| RID2RSET(RID_R3)|RID2RSET(RID_R12); RegSet of; Reg dest, src; ra_evictset(as, drop); dest = ra_dest(as, ir, RSET_FPR); emit_dnm(as, ARMI_VMOV_D_RR, RID_RETLO, RID_RETHI, (dest & 15)); emit_call(as, id == IRFPM_FLOOR ? (void *)lj_vm_floor_sf : id == IRFPM_CEIL ? (void *)lj_vm_ceil_sf : (void *)lj_vm_trunc_sf); /* Workaround to protect argument GPRs from being used for remat. */ of = as->freeset; as->freeset &= ~RSET_RANGE(RID_R0, RID_R1+1); as->cost[RID_R0] = as->cost[RID_R1] = REGCOST(~0u, ASMREF_L); src = ra_alloc1(as, ir->op1, RSET_FPR); /* May alloc GPR to remat FPR. */ as->freeset |= (of & RSET_RANGE(RID_R0, RID_R1+1)); emit_dnm(as, ARMI_VMOV_RR_D, RID_R0, RID_R1, (src & 15)); } #endif static void asm_bitswap(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, RSET_GPR); if ((as->flags & JIT_F_ARMV6)) { emit_dm(as, ARMI_REV, dest, left); } else { Reg tmp2 = dest; if (tmp2 == left) tmp2 = ra_scratch(as, rset_exclude(rset_exclude(RSET_GPR, dest), left)); emit_dnm(as, ARMI_EOR|ARMF_SH(ARMSH_LSR, 8), dest, tmp2, RID_TMP); emit_dm(as, ARMI_MOV|ARMF_SH(ARMSH_ROR, 8), tmp2, left); emit_dn(as, ARMI_BIC|ARMI_K12|256*8|255, RID_TMP, RID_TMP); emit_dnm(as, ARMI_EOR|ARMF_SH(ARMSH_ROR, 16), RID_TMP, left, left); } } static void asm_bitshift(ASMState *as, IRIns *ir, ARMShift sh) { if (irref_isk(ir->op2)) { /* Constant shifts. */ /* NYI: Turn SHL+SHR or BAND+SHR into uxtb, uxth or ubfx. */ /* NYI: Turn SHL+ASR into sxtb, sxth or sbfx. */ Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, RSET_GPR); int32_t shift = (IR(ir->op2)->i & 31); emit_dm(as, ARMI_MOV|ARMF_SH(sh, shift), dest, left); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, RSET_GPR); Reg right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_dm(as, ARMI_MOV|ARMF_RSH(sh, right), dest, left); } } static void asm_intmin_max(ASMState *as, IRIns *ir, int cc) { uint32_t kcmp = 0, kmov = 0; Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); Reg right = 0; if (irref_isk(ir->op2)) { kcmp = emit_isk12(ARMI_CMP, IR(ir->op2)->i); if (kcmp) kmov = emit_isk12(ARMI_MOV, IR(ir->op2)->i); } if (!kmov) { kcmp = 0; right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); } if (kmov || dest != right) { emit_dm(as, ARMF_CC(ARMI_MOV, cc)^kmov, dest, right); cc ^= 1; /* Must use opposite conditions for paired moves. */ } else { cc ^= (CC_LT^CC_GT); /* Otherwise may swap CC_LT <-> CC_GT. */ } if (dest != left) emit_dm(as, ARMF_CC(ARMI_MOV, cc), dest, left); emit_nm(as, ARMI_CMP^kcmp, left, right); } #if LJ_SOFTFP static void asm_sfpmin_max(ASMState *as, IRIns *ir, int cc) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_softfp_cmp]; RegSet drop = RSET_SCRATCH; Reg r; IRRef args[4]; args[0] = ir->op1; args[1] = (ir+1)->op1; args[2] = ir->op2; args[3] = (ir+1)->op2; /* __aeabi_cdcmple preserves r0-r3. */ if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); if (ra_hasreg((ir+1)->r)) rset_clear(drop, (ir+1)->r); if (!rset_test(as->freeset, RID_R2) && regcost_ref(as->cost[RID_R2]) == args[2]) rset_clear(drop, RID_R2); if (!rset_test(as->freeset, RID_R3) && regcost_ref(as->cost[RID_R3]) == args[3]) rset_clear(drop, RID_R3); ra_evictset(as, drop); ra_destpair(as, ir); emit_dm(as, ARMF_CC(ARMI_MOV, cc), RID_RETHI, RID_R3); emit_dm(as, ARMF_CC(ARMI_MOV, cc), RID_RETLO, RID_R2); emit_call(as, (void *)ci->func); for (r = RID_R0; r <= RID_R3; r++) ra_leftov(as, r, args[r-RID_R0]); } #else static void asm_fpmin_max(ASMState *as, IRIns *ir, int cc) { Reg dest = (ra_dest(as, ir, RSET_FPR) & 15); Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = ((left >> 8) & 15); left &= 15; if (dest != left) emit_dm(as, ARMF_CC(ARMI_VMOV_D, cc^1), dest, left); if (dest != right) emit_dm(as, ARMF_CC(ARMI_VMOV_D, cc), dest, right); emit_d(as, ARMI_VMRS, 0); emit_dm(as, ARMI_VCMP_D, left, right); } #endif static void asm_min_max(ASMState *as, IRIns *ir, int cc, int fcc) { #if LJ_SOFTFP UNUSED(fcc); #else if (irt_isnum(ir->t)) asm_fpmin_max(as, ir, fcc); else #endif asm_intmin_max(as, ir, cc); } /* -- Comparisons --------------------------------------------------------- */ /* Map of comparisons to flags. ORDER IR. */ static const uint8_t asm_compmap[IR_ABC+1] = { /* op FP swp int cc FP cc */ /* LT */ CC_GE + (CC_HS << 4), /* GE x */ CC_LT + (CC_HI << 4), /* LE */ CC_GT + (CC_HI << 4), /* GT x */ CC_LE + (CC_HS << 4), /* ULT x */ CC_HS + (CC_LS << 4), /* UGE */ CC_LO + (CC_LO << 4), /* ULE x */ CC_HI + (CC_LO << 4), /* UGT */ CC_LS + (CC_LS << 4), /* EQ */ CC_NE + (CC_NE << 4), /* NE */ CC_EQ + (CC_EQ << 4), /* ABC */ CC_LS + (CC_LS << 4) /* Same as UGT. */ }; #if LJ_SOFTFP /* FP comparisons. */ static void asm_sfpcomp(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_softfp_cmp]; RegSet drop = RSET_SCRATCH; Reg r; IRRef args[4]; int swp = (((ir->o ^ (ir->o >> 2)) & ~(ir->o >> 3) & 1) << 1); args[swp^0] = ir->op1; args[swp^1] = (ir+1)->op1; args[swp^2] = ir->op2; args[swp^3] = (ir+1)->op2; /* __aeabi_cdcmple preserves r0-r3. This helps to reduce spills. */ for (r = RID_R0; r <= RID_R3; r++) if (!rset_test(as->freeset, r) && regcost_ref(as->cost[r]) == args[r-RID_R0]) rset_clear(drop, r); ra_evictset(as, drop); asm_guardcc(as, (asm_compmap[ir->o] >> 4)); emit_call(as, (void *)ci->func); for (r = RID_R0; r <= RID_R3; r++) ra_leftov(as, r, args[r-RID_R0]); } #else /* FP comparisons. */ static void asm_fpcomp(ASMState *as, IRIns *ir) { Reg left, right; ARMIns ai; int swp = ((ir->o ^ (ir->o >> 2)) & ~(ir->o >> 3) & 1); if (!swp && irref_isk(ir->op2) && ir_knum(IR(ir->op2))->u64 == 0) { left = (ra_alloc1(as, ir->op1, RSET_FPR) & 15); right = 0; ai = ARMI_VCMPZ_D; } else { left = ra_alloc2(as, ir, RSET_FPR); if (swp) { right = (left & 15); left = ((left >> 8) & 15); } else { right = ((left >> 8) & 15); left &= 15; } ai = ARMI_VCMP_D; } asm_guardcc(as, (asm_compmap[ir->o] >> 4)); emit_d(as, ARMI_VMRS, 0); emit_dm(as, ai, left, right); } #endif /* Integer comparisons. */ static void asm_intcomp(ASMState *as, IRIns *ir) { ARMCC cc = (asm_compmap[ir->o] & 15); IRRef lref = ir->op1, rref = ir->op2; Reg left; uint32_t m; int cmpprev0 = 0; lua_assert(irt_isint(ir->t) || irt_isu32(ir->t) || irt_isaddr(ir->t)); if (asm_swapops(as, lref, rref)) { Reg tmp = lref; lref = rref; rref = tmp; if (cc >= CC_GE) cc ^= 7; /* LT <-> GT, LE <-> GE */ else if (cc > CC_NE) cc ^= 11; /* LO <-> HI, LS <-> HS */ } if (irref_isk(rref) && IR(rref)->i == 0) { IRIns *irl = IR(lref); cmpprev0 = (irl+1 == ir); /* Combine comp(BAND(left, right), 0) into tst left, right. */ if (cmpprev0 && irl->o == IR_BAND && !ra_used(irl)) { IRRef blref = irl->op1, brref = irl->op2; uint32_t m2 = 0; Reg bleft; if (asm_swapops(as, blref, brref)) { Reg tmp = blref; blref = brref; brref = tmp; } if (irref_isk(brref)) { m2 = emit_isk12(ARMI_AND, IR(brref)->i); if ((m2 & (ARMI_AND^ARMI_BIC))) goto notst; /* Not beneficial if we miss a constant operand. */ } if (cc == CC_GE) cc = CC_PL; else if (cc == CC_LT) cc = CC_MI; else if (cc > CC_NE) goto notst; /* Other conds don't work with tst. */ bleft = ra_alloc1(as, blref, RSET_GPR); if (!m2) m2 = asm_fuseopm(as, 0, brref, rset_exclude(RSET_GPR, bleft)); asm_guardcc(as, cc); emit_n(as, ARMI_TST^m2, bleft); return; } } notst: left = ra_alloc1(as, lref, RSET_GPR); m = asm_fuseopm(as, ARMI_CMP, rref, rset_exclude(RSET_GPR, left)); asm_guardcc(as, cc); emit_n(as, ARMI_CMP^m, left); /* Signed comparison with zero and referencing previous ins? */ if (cmpprev0 && (cc <= CC_NE || cc >= CC_GE)) as->flagmcp = as->mcp; /* Allow elimination of the compare. */ } #if LJ_HASFFI /* 64 bit integer comparisons. */ static void asm_int64comp(ASMState *as, IRIns *ir) { int signedcomp = (ir->o <= IR_GT); ARMCC cclo, cchi; Reg leftlo, lefthi; uint32_t mlo, mhi; RegSet allow = RSET_GPR, oldfree; /* Always use unsigned comparison for loword. */ cclo = asm_compmap[ir->o + (signedcomp ? 4 : 0)] & 15; leftlo = ra_alloc1(as, ir->op1, allow); oldfree = as->freeset; mlo = asm_fuseopm(as, ARMI_CMP, ir->op2, rset_clear(allow, leftlo)); allow &= ~(oldfree & ~as->freeset); /* Update for allocs of asm_fuseopm. */ /* Use signed or unsigned comparison for hiword. */ cchi = asm_compmap[ir->o] & 15; lefthi = ra_alloc1(as, (ir+1)->op1, allow); mhi = asm_fuseopm(as, ARMI_CMP, (ir+1)->op2, rset_clear(allow, lefthi)); /* All register allocations must be performed _before_ this point. */ if (signedcomp) { MCLabel l_around = emit_label(as); asm_guardcc(as, cclo); emit_n(as, ARMI_CMP^mlo, leftlo); emit_branch(as, ARMF_CC(ARMI_B, CC_NE), l_around); if (cchi == CC_GE || cchi == CC_LE) cchi ^= 6; /* GE -> GT, LE -> LT */ asm_guardcc(as, cchi); } else { asm_guardcc(as, cclo); emit_n(as, ARMF_CC(ARMI_CMP, CC_EQ)^mlo, leftlo); } emit_n(as, ARMI_CMP^mhi, lefthi); } #endif /* -- Support for 64 bit ops in 32 bit mode ------------------------------- */ /* Hiword op of a split 64 bit op. Previous op must be the loword op. */ static void asm_hiop(ASMState *as, IRIns *ir) { #if LJ_HASFFI || LJ_SOFTFP /* HIOP is marked as a store because it needs its own DCE logic. */ int uselo = ra_used(ir-1), usehi = ra_used(ir); /* Loword/hiword used? */ if (LJ_UNLIKELY(!(as->flags & JIT_F_OPT_DCE))) uselo = usehi = 1; if ((ir-1)->o <= IR_NE) { /* 64 bit integer or FP comparisons. ORDER IR. */ as->curins--; /* Always skip the loword comparison. */ #if LJ_SOFTFP if (!irt_isint(ir->t)) { asm_sfpcomp(as, ir-1); return; } #endif #if LJ_HASFFI asm_int64comp(as, ir-1); #endif return; #if LJ_SOFTFP } else if ((ir-1)->o == IR_MIN || (ir-1)->o == IR_MAX) { as->curins--; /* Always skip the loword min/max. */ if (uselo || usehi) asm_sfpmin_max(as, ir-1, (ir-1)->o == IR_MIN ? CC_HI : CC_LO); return; #elif LJ_HASFFI } else if ((ir-1)->o == IR_CONV) { as->curins--; /* Always skip the CONV. */ if (usehi || uselo) asm_conv64(as, ir); return; #endif } else if ((ir-1)->o == IR_XSTORE) { if ((ir-1)->r != RID_SINK) asm_xstore(as, ir, 4); return; } if (!usehi) return; /* Skip unused hiword op for all remaining ops. */ switch ((ir-1)->o) { #if LJ_HASFFI case IR_ADD: as->curins--; asm_intop(as, ir, ARMI_ADC); asm_intop(as, ir-1, ARMI_ADD|ARMI_S); break; case IR_SUB: as->curins--; asm_intop(as, ir, ARMI_SBC); asm_intop(as, ir-1, ARMI_SUB|ARMI_S); break; case IR_NEG: as->curins--; asm_intneg(as, ir, ARMI_RSC); asm_intneg(as, ir-1, ARMI_RSB|ARMI_S); break; #endif #if LJ_SOFTFP case IR_SLOAD: case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: case IR_STRTO: if (!uselo) ra_allocref(as, ir->op1, RSET_GPR); /* Mark lo op as used. */ break; #endif case IR_CALLN: case IR_CALLS: case IR_CALLXS: if (!uselo) ra_allocref(as, ir->op1, RID2RSET(RID_RETLO)); /* Mark lo op as used. */ break; #if LJ_SOFTFP case IR_ASTORE: case IR_HSTORE: case IR_USTORE: case IR_TOSTR: #endif case IR_CNEWI: /* Nothing to do here. Handled by lo op itself. */ break; default: lua_assert(0); break; } #else UNUSED(as); UNUSED(ir); lua_assert(0); #endif } /* -- Stack handling ------------------------------------------------------ */ /* Check Lua stack size for overflow. Use exit handler as fallback. */ static void asm_stack_check(ASMState *as, BCReg topslot, IRIns *irp, RegSet allow, ExitNo exitno) { Reg pbase; uint32_t k; if (irp) { if (!ra_hasspill(irp->s)) { pbase = irp->r; lua_assert(ra_hasreg(pbase)); } else if (allow) { pbase = rset_pickbot(allow); } else { pbase = RID_RET; emit_lso(as, ARMI_LDR, RID_RET, RID_SP, 0); /* Restore temp. register. */ } } else { pbase = RID_BASE; } emit_branch(as, ARMF_CC(ARMI_BL, CC_LS), exitstub_addr(as->J, exitno)); k = emit_isk12(0, (int32_t)(8*topslot)); lua_assert(k); emit_n(as, ARMI_CMP^k, RID_TMP); emit_dnm(as, ARMI_SUB, RID_TMP, RID_TMP, pbase); emit_lso(as, ARMI_LDR, RID_TMP, RID_TMP, (int32_t)offsetof(lua_State, maxstack)); if (irp) { /* Must not spill arbitrary registers in head of side trace. */ int32_t i = i32ptr(&J2G(as->J)->jit_L); if (ra_hasspill(irp->s)) emit_lso(as, ARMI_LDR, pbase, RID_SP, sps_scale(irp->s)); emit_lso(as, ARMI_LDR, RID_TMP, RID_TMP, (i & 4095)); if (ra_hasspill(irp->s) && !allow) emit_lso(as, ARMI_STR, RID_RET, RID_SP, 0); /* Save temp. register. */ emit_loadi(as, RID_TMP, (i & ~4095)); } else { emit_getgl(as, RID_TMP, jit_L); } } /* Restore Lua stack from on-trace state. */ static void asm_stack_restore(ASMState *as, SnapShot *snap) { SnapEntry *map = &as->T->snapmap[snap->mapofs]; SnapEntry *flinks = &as->T->snapmap[snap_nextofs(as->T, snap)-1]; MSize n, nent = snap->nent; /* Store the value of all modified slots to the Lua stack. */ for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; BCReg s = snap_slot(sn); int32_t ofs = 8*((int32_t)s-1); IRRef ref = snap_ref(sn); IRIns *ir = IR(ref); if ((sn & SNAP_NORESTORE)) continue; if (irt_isnum(ir->t)) { #if LJ_SOFTFP RegSet odd = rset_exclude(RSET_GPRODD, RID_BASE); Reg tmp; lua_assert(irref_isk(ref)); /* LJ_SOFTFP: must be a number constant. */ tmp = ra_allock(as, (int32_t)ir_knum(ir)->u32.lo, rset_exclude(RSET_GPREVEN, RID_BASE)); emit_lso(as, ARMI_STR, tmp, RID_BASE, ofs); if (rset_test(as->freeset, tmp+1)) odd = RID2RSET(tmp+1); tmp = ra_allock(as, (int32_t)ir_knum(ir)->u32.hi, odd); emit_lso(as, ARMI_STR, tmp, RID_BASE, ofs+4); #else Reg src = ra_alloc1(as, ref, RSET_FPR); emit_vlso(as, ARMI_VSTR_D, src, RID_BASE, ofs); #endif } else { RegSet odd = rset_exclude(RSET_GPRODD, RID_BASE); Reg type; lua_assert(irt_ispri(ir->t) || irt_isaddr(ir->t) || irt_isinteger(ir->t)); if (!irt_ispri(ir->t)) { Reg src = ra_alloc1(as, ref, rset_exclude(RSET_GPREVEN, RID_BASE)); emit_lso(as, ARMI_STR, src, RID_BASE, ofs); if (rset_test(as->freeset, src+1)) odd = RID2RSET(src+1); } if ((sn & (SNAP_CONT|SNAP_FRAME))) { if (s == 0) continue; /* Do not overwrite link to previous frame. */ type = ra_allock(as, (int32_t)(*flinks--), odd); #if LJ_SOFTFP } else if ((sn & SNAP_SOFTFPNUM)) { type = ra_alloc1(as, ref+1, rset_exclude(RSET_GPRODD, RID_BASE)); #endif } else { type = ra_allock(as, (int32_t)irt_toitype(ir->t), odd); } emit_lso(as, ARMI_STR, type, RID_BASE, ofs+4); } checkmclim(as); } lua_assert(map + nent == flinks); } /* -- GC handling --------------------------------------------------------- */ /* Check GC threshold and do one or more GC steps. */ static void asm_gc_check(ASMState *as) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_step_jit]; IRRef args[2]; MCLabel l_end; Reg tmp1, tmp2; ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); /* Exit trace if in GCSatomic or GCSfinalize. Avoids syncing GC objects. */ asm_guardcc(as, CC_NE); /* Assumes asm_snap_prep() already done. */ emit_n(as, ARMI_CMP|ARMI_K12|0, RID_RET); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ASMREF_TMP2; /* MSize steps */ asm_gencall(as, ci, args); tmp1 = ra_releasetmp(as, ASMREF_TMP1); tmp2 = ra_releasetmp(as, ASMREF_TMP2); emit_loadi(as, tmp2, as->gcsteps); /* Jump around GC step if GC total < GC threshold. */ emit_branch(as, ARMF_CC(ARMI_B, CC_LS), l_end); emit_nm(as, ARMI_CMP, RID_TMP, tmp2); emit_lso(as, ARMI_LDR, tmp2, tmp1, (int32_t)offsetof(global_State, gc.threshold)); emit_lso(as, ARMI_LDR, RID_TMP, tmp1, (int32_t)offsetof(global_State, gc.total)); ra_allockreg(as, i32ptr(J2G(as->J)), tmp1); as->gcsteps = 0; checkmclim(as); } /* -- Loop handling ------------------------------------------------------- */ /* Fixup the loop branch. */ static void asm_loop_fixup(ASMState *as) { MCode *p = as->mctop; MCode *target = as->mcp; if (as->loopinv) { /* Inverted loop branch? */ /* asm_guardcc already inverted the bcc and patched the final bl. */ p[-2] |= ((uint32_t)(target-p) & 0x00ffffffu); } else { p[-1] = ARMI_B | ((uint32_t)((target-p)-1) & 0x00ffffffu); } } /* -- Head of trace ------------------------------------------------------- */ /* Reload L register from g->jit_L. */ static void asm_head_lreg(ASMState *as) { IRIns *ir = IR(ASMREF_L); if (ra_used(ir)) { Reg r = ra_dest(as, ir, RSET_GPR); emit_getgl(as, r, jit_L); ra_evictk(as); } } /* Coalesce BASE register for a root trace. */ static void asm_head_root_base(ASMState *as) { IRIns *ir; asm_head_lreg(as); ir = IR(REF_BASE); if (ra_hasreg(ir->r) && (rset_test(as->modset, ir->r) || irt_ismarked(ir->t))) ra_spill(as, ir); ra_destreg(as, ir, RID_BASE); } /* Coalesce BASE register for a side trace. */ static RegSet asm_head_side_base(ASMState *as, IRIns *irp, RegSet allow) { IRIns *ir; asm_head_lreg(as); ir = IR(REF_BASE); if (ra_hasreg(ir->r) && (rset_test(as->modset, ir->r) || irt_ismarked(ir->t))) ra_spill(as, ir); if (ra_hasspill(irp->s)) { rset_clear(allow, ra_dest(as, ir, allow)); } else { Reg r = irp->r; lua_assert(ra_hasreg(r)); rset_clear(allow, r); if (r != ir->r && !rset_test(as->freeset, r)) ra_restore(as, regcost_ref(as->cost[r])); ra_destreg(as, ir, r); } return allow; } /* -- Tail of trace ------------------------------------------------------- */ /* Fixup the tail code. */ static void asm_tail_fixup(ASMState *as, TraceNo lnk) { MCode *p = as->mctop; MCode *target; int32_t spadj = as->T->spadjust; if (spadj == 0) { as->mctop = --p; } else { /* Patch stack adjustment. */ uint32_t k = emit_isk12(ARMI_ADD, spadj); lua_assert(k); p[-2] = (ARMI_ADD^k) | ARMF_D(RID_SP) | ARMF_N(RID_SP); } /* Patch exit branch. */ target = lnk ? traceref(as->J, lnk)->mcode : (MCode *)lj_vm_exit_interp; p[-1] = ARMI_B|(((target-p)-1)&0x00ffffffu); } /* Prepare tail of code. */ static void asm_tail_prep(ASMState *as) { MCode *p = as->mctop - 1; /* Leave room for exit branch. */ if (as->loopref) { as->invmcp = as->mcp = p; } else { as->mcp = p-1; /* Leave room for stack pointer adjustment. */ as->invmcp = NULL; } *p = 0; /* Prevent load/store merging. */ } /* -- Instruction dispatch ------------------------------------------------ */ /* Assemble a single instruction. */ static void asm_ir(ASMState *as, IRIns *ir) { switch ((IROp)ir->o) { /* Miscellaneous ops. */ case IR_LOOP: asm_loop(as); break; case IR_NOP: case IR_XBAR: lua_assert(!ra_used(ir)); break; case IR_USE: ra_alloc1(as, ir->op1, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); break; case IR_PHI: asm_phi(as, ir); break; case IR_HIOP: asm_hiop(as, ir); break; case IR_GCSTEP: asm_gcstep(as, ir); break; /* Guarded assertions. */ case IR_EQ: case IR_NE: if ((ir-1)->o == IR_HREF && ir->op1 == as->curins-1) { as->curins--; asm_href(as, ir-1, (IROp)ir->o); break; } /* fallthrough */ case IR_LT: case IR_GE: case IR_LE: case IR_GT: case IR_ULT: case IR_UGE: case IR_ULE: case IR_UGT: case IR_ABC: #if !LJ_SOFTFP if (irt_isnum(ir->t)) { asm_fpcomp(as, ir); break; } #endif asm_intcomp(as, ir); break; case IR_RETF: asm_retf(as, ir); break; /* Bit ops. */ case IR_BNOT: asm_bitop(as, ir, ARMI_MVN); break; case IR_BSWAP: asm_bitswap(as, ir); break; case IR_BAND: asm_bitop(as, ir, ARMI_AND); break; case IR_BOR: asm_bitop(as, ir, ARMI_ORR); break; case IR_BXOR: asm_bitop(as, ir, ARMI_EOR); break; case IR_BSHL: asm_bitshift(as, ir, ARMSH_LSL); break; case IR_BSHR: asm_bitshift(as, ir, ARMSH_LSR); break; case IR_BSAR: asm_bitshift(as, ir, ARMSH_ASR); break; case IR_BROR: asm_bitshift(as, ir, ARMSH_ROR); break; case IR_BROL: lua_assert(0); break; /* Arithmetic ops. */ case IR_ADD: case IR_ADDOV: asm_add(as, ir); break; case IR_SUB: case IR_SUBOV: asm_sub(as, ir); break; case IR_MUL: case IR_MULOV: asm_mul(as, ir); break; case IR_MOD: asm_callid(as, ir, IRCALL_lj_vm_modi); break; case IR_NEG: asm_neg(as, ir); break; #if LJ_SOFTFP case IR_DIV: case IR_POW: case IR_ABS: case IR_ATAN2: case IR_LDEXP: case IR_FPMATH: case IR_TOBIT: lua_assert(0); /* Unused for LJ_SOFTFP. */ break; #else case IR_DIV: asm_fparith(as, ir, ARMI_VDIV_D); break; case IR_POW: asm_callid(as, ir, IRCALL_lj_vm_powi); break; case IR_ABS: asm_fpunary(as, ir, ARMI_VABS_D); break; case IR_ATAN2: asm_callid(as, ir, IRCALL_atan2); break; case IR_LDEXP: asm_callid(as, ir, IRCALL_ldexp); break; case IR_FPMATH: if (ir->op2 == IRFPM_EXP2 && asm_fpjoin_pow(as, ir)) break; if (ir->op2 <= IRFPM_TRUNC) asm_callround(as, ir, ir->op2); else if (ir->op2 == IRFPM_SQRT) asm_fpunary(as, ir, ARMI_VSQRT_D); else asm_callid(as, ir, IRCALL_lj_vm_floor + ir->op2); break; case IR_TOBIT: asm_tobit(as, ir); break; #endif case IR_MIN: asm_min_max(as, ir, CC_GT, CC_HI); break; case IR_MAX: asm_min_max(as, ir, CC_LT, CC_LO); break; /* Memory references. */ case IR_AREF: asm_aref(as, ir); break; case IR_HREF: asm_href(as, ir, 0); break; case IR_HREFK: asm_hrefk(as, ir); break; case IR_NEWREF: asm_newref(as, ir); break; case IR_UREFO: case IR_UREFC: asm_uref(as, ir); break; case IR_FREF: asm_fref(as, ir); break; case IR_STRREF: asm_strref(as, ir); break; /* Loads and stores. */ case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: asm_ahuvload(as, ir); break; case IR_FLOAD: asm_fload(as, ir); break; case IR_XLOAD: asm_xload(as, ir); break; case IR_SLOAD: asm_sload(as, ir); break; case IR_ASTORE: case IR_HSTORE: case IR_USTORE: asm_ahustore(as, ir); break; case IR_FSTORE: asm_fstore(as, ir); break; case IR_XSTORE: asm_xstore(as, ir, 0); break; /* Allocations. */ case IR_SNEW: case IR_XSNEW: asm_snew(as, ir); break; case IR_TNEW: asm_tnew(as, ir); break; case IR_TDUP: asm_tdup(as, ir); break; case IR_CNEW: case IR_CNEWI: asm_cnew(as, ir); break; /* Write barriers. */ case IR_TBAR: asm_tbar(as, ir); break; case IR_OBAR: asm_obar(as, ir); break; /* Type conversions. */ case IR_CONV: asm_conv(as, ir); break; case IR_TOSTR: asm_tostr(as, ir); break; case IR_STRTO: asm_strto(as, ir); break; /* Calls. */ case IR_CALLN: case IR_CALLL: case IR_CALLS: asm_call(as, ir); break; case IR_CALLXS: asm_callx(as, ir); break; case IR_CARG: break; default: setintV(&as->J->errinfo, ir->o); lj_trace_err_info(as->J, LJ_TRERR_NYIIR); break; } } /* -- Trace setup --------------------------------------------------------- */ /* Ensure there are enough stack slots for call arguments. */ static Reg asm_setup_call_slots(ASMState *as, IRIns *ir, const CCallInfo *ci) { IRRef args[CCI_NARGS_MAX*2]; uint32_t i, nargs = (int)CCI_NARGS(ci); int nslots = 0, ngpr = REGARG_NUMGPR, nfpr = REGARG_NUMFPR, fprodd = 0; asm_collectargs(as, ir, ci, args); for (i = 0; i < nargs; i++) { if (!LJ_SOFTFP && args[i] && irt_isfp(IR(args[i])->t)) { if (!LJ_ABI_SOFTFP && !(ci->flags & CCI_VARARG)) { if (irt_isnum(IR(args[i])->t)) { if (nfpr > 0) nfpr--; else fprodd = 0, nslots = (nslots + 3) & ~1; } else { if (fprodd) fprodd--; else if (nfpr > 0) fprodd = 1, nfpr--; else nslots++; } } else if (irt_isnum(IR(args[i])->t)) { ngpr &= ~1; if (ngpr > 0) ngpr -= 2; else nslots += 2; } else { if (ngpr > 0) ngpr--; else nslots++; } } else { if (ngpr > 0) ngpr--; else nslots++; } } if (nslots > as->evenspill) /* Leave room for args in stack slots. */ as->evenspill = nslots; return REGSP_HINT(RID_RET); } static void asm_setup_target(ASMState *as) { /* May need extra exit for asm_stack_check on side traces. */ asm_exitstub_setup(as, as->T->nsnap + (as->parent ? 1 : 0)); } /* -- Trace patching ------------------------------------------------------ */ /* Patch exit jumps of existing machine code to a new target. */ void lj_asm_patchexit(jit_State *J, GCtrace *T, ExitNo exitno, MCode *target) { MCode *p = T->mcode; MCode *pe = (MCode *)((char *)p + T->szmcode); MCode *cstart = NULL, *cend = p; MCode *mcarea = lj_mcode_patch(J, p, 0); MCode *px = exitstub_addr(J, exitno) - 2; for (; p < pe; p++) { /* Look for bl_cc exitstub, replace with b_cc target. */ uint32_t ins = *p; if ((ins & 0x0f000000u) == 0x0b000000u && ins < 0xf0000000u && ((ins ^ (px-p)) & 0x00ffffffu) == 0) { *p = (ins & 0xfe000000u) | (((target-p)-2) & 0x00ffffffu); cend = p+1; if (!cstart) cstart = p; } } lua_assert(cstart != NULL); lj_mcode_sync(cstart, cend); lj_mcode_patch(J, mcarea, 1); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_lex.h0000644000175000017500000000601213122010155016316 0ustar philphil/* ** Lexical analyzer. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_LEX_H #define _LJ_LEX_H #include #include "lj_obj.h" #include "lj_err.h" /* Lua lexer tokens. */ #define TKDEF(_, __) \ _(and) _(break) _(do) _(else) _(elseif) _(end) _(false) \ _(for) _(function) _(goto) _(if) _(in) _(local) _(nil) _(not) _(or) \ _(repeat) _(return) _(then) _(true) _(until) _(while) \ __(concat, ..) __(dots, ...) __(eq, ==) __(ge, >=) __(le, <=) __(ne, ~=) \ __(label, ::) __(number, ) __(name, ) __(string, ) \ __(eof, ) enum { TK_OFS = 256, #define TKENUM1(name) TK_##name, #define TKENUM2(name, sym) TK_##name, TKDEF(TKENUM1, TKENUM2) #undef TKENUM1 #undef TKENUM2 TK_RESERVED = TK_while - TK_OFS }; typedef int LexToken; /* Combined bytecode ins/line. Only used during bytecode generation. */ typedef struct BCInsLine { BCIns ins; /* Bytecode instruction. */ BCLine line; /* Line number for this bytecode. */ } BCInsLine; /* Info for local variables. Only used during bytecode generation. */ typedef struct VarInfo { GCRef name; /* Local variable name or goto/label name. */ BCPos startpc; /* First point where the local variable is active. */ BCPos endpc; /* First point where the local variable is dead. */ uint8_t slot; /* Variable slot. */ uint8_t info; /* Variable/goto/label info. */ } VarInfo; /* Lua lexer state. */ typedef struct LexState { struct FuncState *fs; /* Current FuncState. Defined in lj_parse.c. */ struct lua_State *L; /* Lua state. */ TValue tokenval; /* Current token value. */ TValue lookaheadval; /* Lookahead token value. */ int current; /* Current character (charint). */ LexToken token; /* Current token. */ LexToken lookahead; /* Lookahead token. */ MSize n; /* Bytes left in input buffer. */ const char *p; /* Current position in input buffer. */ SBuf sb; /* String buffer for tokens. */ lua_Reader rfunc; /* Reader callback. */ void *rdata; /* Reader callback data. */ BCLine linenumber; /* Input line counter. */ BCLine lastline; /* Line of last token. */ GCstr *chunkname; /* Current chunk name (interned string). */ const char *chunkarg; /* Chunk name argument. */ const char *mode; /* Allow loading bytecode (b) and/or source text (t). */ VarInfo *vstack; /* Stack for names and extents of local variables. */ MSize sizevstack; /* Size of variable stack. */ MSize vtop; /* Top of variable stack. */ BCInsLine *bcstack; /* Stack for bytecode instructions/line numbers. */ MSize sizebcstack; /* Size of bytecode stack. */ uint32_t level; /* Syntactical nesting level. */ } LexState; LJ_FUNC int lj_lex_setup(lua_State *L, LexState *ls); LJ_FUNC void lj_lex_cleanup(lua_State *L, LexState *ls); LJ_FUNC void lj_lex_next(LexState *ls); LJ_FUNC LexToken lj_lex_lookahead(LexState *ls); LJ_FUNC const char *lj_lex_token2str(LexState *ls, LexToken token); LJ_FUNC_NORET void lj_lex_error(LexState *ls, LexToken token, ErrMsg em, ...); LJ_FUNC void lj_lex_init(lua_State *L); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_def.h0000644000175000017500000002421513122010155016271 0ustar philphil/* ** LuaJIT common internal definitions. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_DEF_H #define _LJ_DEF_H #include "lua.h" #if defined(_MSC_VER) /* MSVC is stuck in the last century and doesn't have C99's stdint.h. */ typedef __int8 int8_t; typedef __int16 int16_t; typedef __int32 int32_t; typedef __int64 int64_t; typedef unsigned __int8 uint8_t; typedef unsigned __int16 uint16_t; typedef unsigned __int32 uint32_t; typedef unsigned __int64 uint64_t; #ifdef _WIN64 typedef __int64 intptr_t; typedef unsigned __int64 uintptr_t; #else typedef __int32 intptr_t; typedef unsigned __int32 uintptr_t; #endif #elif defined(__symbian__) /* Cough. */ typedef signed char int8_t; typedef short int int16_t; typedef int int32_t; typedef long long int64_t; typedef unsigned char uint8_t; typedef unsigned short int uint16_t; typedef unsigned int uint32_t; typedef unsigned long long uint64_t; typedef int intptr_t; typedef unsigned int uintptr_t; #else #include #endif /* Needed everywhere. */ #include #include /* Various VM limits. */ #define LJ_MAX_MEM 0x7fffff00 /* Max. total memory allocation. */ #define LJ_MAX_ALLOC LJ_MAX_MEM /* Max. individual allocation length. */ #define LJ_MAX_STR LJ_MAX_MEM /* Max. string length. */ #define LJ_MAX_UDATA LJ_MAX_MEM /* Max. userdata length. */ #define LJ_MAX_STRTAB (1<<26) /* Max. string table size. */ #define LJ_MAX_HBITS 26 /* Max. hash bits. */ #define LJ_MAX_ABITS 28 /* Max. bits of array key. */ #define LJ_MAX_ASIZE ((1<<(LJ_MAX_ABITS-1))+1) /* Max. array part size. */ #define LJ_MAX_COLOSIZE 16 /* Max. elems for colocated array. */ #define LJ_MAX_LINE LJ_MAX_MEM /* Max. source code line number. */ #define LJ_MAX_XLEVEL 200 /* Max. syntactic nesting level. */ #define LJ_MAX_BCINS (1<<26) /* Max. # of bytecode instructions. */ #define LJ_MAX_SLOTS 250 /* Max. # of slots in a Lua func. */ #define LJ_MAX_LOCVAR 200 /* Max. # of local variables. */ #define LJ_MAX_UPVAL 60 /* Max. # of upvalues. */ #define LJ_MAX_IDXCHAIN 100 /* __index/__newindex chain limit. */ #define LJ_STACK_EXTRA 5 /* Extra stack space (metamethods). */ #define LJ_NUM_CBPAGE 1 /* Number of FFI callback pages. */ /* Minimum table/buffer sizes. */ #define LJ_MIN_GLOBAL 6 /* Min. global table size (hbits). */ #define LJ_MIN_REGISTRY 2 /* Min. registry size (hbits). */ #define LJ_MIN_STRTAB 256 /* Min. string table size (pow2). */ #define LJ_MIN_SBUF 32 /* Min. string buffer length. */ #define LJ_MIN_VECSZ 8 /* Min. size for growable vectors. */ #define LJ_MIN_IRSZ 32 /* Min. size for growable IR. */ #define LJ_MIN_K64SZ 16 /* Min. size for chained K64Array. */ /* JIT compiler limits. */ #define LJ_MAX_JSLOTS 250 /* Max. # of stack slots for a trace. */ #define LJ_MAX_PHI 64 /* Max. # of PHIs for a loop. */ #define LJ_MAX_EXITSTUBGR 16 /* Max. # of exit stub groups. */ /* Various macros. */ #ifndef UNUSED #define UNUSED(x) ((void)(x)) /* to avoid warnings */ #endif #define U64x(hi, lo) (((uint64_t)0x##hi << 32) + (uint64_t)0x##lo) #define i32ptr(p) ((int32_t)(intptr_t)(void *)(p)) #define u32ptr(p) ((uint32_t)(intptr_t)(void *)(p)) #define checki8(x) ((x) == (int32_t)(int8_t)(x)) #define checku8(x) ((x) == (int32_t)(uint8_t)(x)) #define checki16(x) ((x) == (int32_t)(int16_t)(x)) #define checku16(x) ((x) == (int32_t)(uint16_t)(x)) #define checki32(x) ((x) == (int32_t)(x)) #define checku32(x) ((x) == (uint32_t)(x)) #define checkptr32(x) ((uintptr_t)(x) == (uint32_t)(uintptr_t)(x)) /* Every half-decent C compiler transforms this into a rotate instruction. */ #define lj_rol(x, n) (((x)<<(n)) | ((x)>>(-(int)(n)&(8*sizeof(x)-1)))) #define lj_ror(x, n) (((x)<<(-(int)(n)&(8*sizeof(x)-1))) | ((x)>>(n))) /* A really naive Bloom filter. But sufficient for our needs. */ typedef uintptr_t BloomFilter; #define BLOOM_MASK (8*sizeof(BloomFilter) - 1) #define bloombit(x) ((uintptr_t)1 << ((x) & BLOOM_MASK)) #define bloomset(b, x) ((b) |= bloombit((x))) #define bloomtest(b, x) ((b) & bloombit((x))) #if defined(__GNUC__) || defined(__psp2__) #define LJ_NORET __attribute__((noreturn)) #define LJ_ALIGN(n) __attribute__((aligned(n))) #define LJ_INLINE inline #define LJ_AINLINE inline __attribute__((always_inline)) #define LJ_NOINLINE __attribute__((noinline)) #if defined(__ELF__) || defined(__MACH__) || defined(__psp2__) #if !((defined(__sun__) && defined(__svr4__)) || defined(__CELLOS_LV2__)) #define LJ_NOAPI extern __attribute__((visibility("hidden"))) #endif #endif /* Note: it's only beneficial to use fastcall on x86 and then only for up to ** two non-FP args. The amalgamated compile covers all LJ_FUNC cases. Only ** indirect calls and related tail-called C functions are marked as fastcall. */ #if defined(__i386__) #define LJ_FASTCALL __attribute__((fastcall)) #endif #define LJ_LIKELY(x) __builtin_expect(!!(x), 1) #define LJ_UNLIKELY(x) __builtin_expect(!!(x), 0) #define lj_ffs(x) ((uint32_t)__builtin_ctz(x)) /* Don't ask ... */ #if defined(__INTEL_COMPILER) && (defined(__i386__) || defined(__x86_64__)) static LJ_AINLINE uint32_t lj_fls(uint32_t x) { uint32_t r; __asm__("bsrl %1, %0" : "=r" (r) : "rm" (x) : "cc"); return r; } #else #define lj_fls(x) ((uint32_t)(__builtin_clz(x)^31)) #endif #if defined(__arm__) static LJ_AINLINE uint32_t lj_bswap(uint32_t x) { #if defined(__psp2__) return __builtin_rev(x); #else uint32_t r; #if __ARM_ARCH_6__ || __ARM_ARCH_6J__ || __ARM_ARCH_6T2__ || __ARM_ARCH_6Z__ ||\ __ARM_ARCH_6ZK__ || __ARM_ARCH_7__ || __ARM_ARCH_7A__ || __ARM_ARCH_7R__ __asm__("rev %0, %1" : "=r" (r) : "r" (x)); return r; #else #ifdef __thumb__ r = x ^ lj_ror(x, 16); #else __asm__("eor %0, %1, %1, ror #16" : "=r" (r) : "r" (x)); #endif return ((r & 0xff00ffffu) >> 8) ^ lj_ror(x, 8); #endif #endif } static LJ_AINLINE uint64_t lj_bswap64(uint64_t x) { return ((uint64_t)lj_bswap((uint32_t)x)<<32) | lj_bswap((uint32_t)(x>>32)); } #elif (__GNUC__ > 4) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3) static LJ_AINLINE uint32_t lj_bswap(uint32_t x) { return (uint32_t)__builtin_bswap32((int32_t)x); } static LJ_AINLINE uint64_t lj_bswap64(uint64_t x) { return (uint64_t)__builtin_bswap64((int64_t)x); } #elif defined(__i386__) || defined(__x86_64__) static LJ_AINLINE uint32_t lj_bswap(uint32_t x) { uint32_t r; __asm__("bswap %0" : "=r" (r) : "0" (x)); return r; } #if defined(__i386__) static LJ_AINLINE uint64_t lj_bswap64(uint64_t x) { return ((uint64_t)lj_bswap((uint32_t)x)<<32) | lj_bswap((uint32_t)(x>>32)); } #else static LJ_AINLINE uint64_t lj_bswap64(uint64_t x) { uint64_t r; __asm__("bswap %0" : "=r" (r) : "0" (x)); return r; } #endif #else static LJ_AINLINE uint32_t lj_bswap(uint32_t x) { return (x << 24) | ((x & 0xff00) << 8) | ((x >> 8) & 0xff00) | (x >> 24); } static LJ_AINLINE uint64_t lj_bswap64(uint64_t x) { return (uint64_t)lj_bswap((uint32_t)(x >> 32)) | ((uint64_t)lj_bswap((uint32_t)x) << 32); } #endif typedef union __attribute__((packed)) Unaligned16 { uint16_t u; uint8_t b[2]; } Unaligned16; typedef union __attribute__((packed)) Unaligned32 { uint32_t u; uint8_t b[4]; } Unaligned32; /* Unaligned load of uint16_t. */ static LJ_AINLINE uint16_t lj_getu16(const void *p) { return ((const Unaligned16 *)p)->u; } /* Unaligned load of uint32_t. */ static LJ_AINLINE uint32_t lj_getu32(const void *p) { return ((const Unaligned32 *)p)->u; } #elif defined(_MSC_VER) #define LJ_NORET __declspec(noreturn) #define LJ_ALIGN(n) __declspec(align(n)) #define LJ_INLINE __inline #define LJ_AINLINE __forceinline #define LJ_NOINLINE __declspec(noinline) #if defined(_M_IX86) #define LJ_FASTCALL __fastcall #endif #ifdef _M_PPC unsigned int _CountLeadingZeros(long); #pragma intrinsic(_CountLeadingZeros) static LJ_AINLINE uint32_t lj_fls(uint32_t x) { return _CountLeadingZeros(x) ^ 31; } #else unsigned char _BitScanForward(uint32_t *, unsigned long); unsigned char _BitScanReverse(uint32_t *, unsigned long); #pragma intrinsic(_BitScanForward) #pragma intrinsic(_BitScanReverse) static LJ_AINLINE uint32_t lj_ffs(uint32_t x) { uint32_t r; _BitScanForward(&r, x); return r; } static LJ_AINLINE uint32_t lj_fls(uint32_t x) { uint32_t r; _BitScanReverse(&r, x); return r; } #endif unsigned long _byteswap_ulong(unsigned long); uint64_t _byteswap_uint64(uint64_t); #define lj_bswap(x) (_byteswap_ulong((x))) #define lj_bswap64(x) (_byteswap_uint64((x))) #if defined(_M_PPC) && defined(LUAJIT_NO_UNALIGNED) /* ** Replacement for unaligned loads on Xbox 360. Disabled by default since it's ** usually more costly than the occasional stall when crossing a cache-line. */ static LJ_AINLINE uint16_t lj_getu16(const void *v) { const uint8_t *p = (const uint8_t *)v; return (uint16_t)((p[0]<<8) | p[1]); } static LJ_AINLINE uint32_t lj_getu32(const void *v) { const uint8_t *p = (const uint8_t *)v; return (uint32_t)((p[0]<<24) | (p[1]<<16) | (p[2]<<8) | p[3]); } #else /* Unaligned loads are generally ok on x86/x64. */ #define lj_getu16(p) (*(uint16_t *)(p)) #define lj_getu32(p) (*(uint32_t *)(p)) #endif #else #error "missing defines for your compiler" #endif /* Optional defines. */ #ifndef LJ_FASTCALL #define LJ_FASTCALL #endif #ifndef LJ_NORET #define LJ_NORET #endif #ifndef LJ_NOAPI #define LJ_NOAPI extern #endif #ifndef LJ_LIKELY #define LJ_LIKELY(x) (x) #define LJ_UNLIKELY(x) (x) #endif /* Attributes for internal functions. */ #define LJ_DATA LJ_NOAPI #define LJ_DATADEF #define LJ_ASMF LJ_NOAPI #define LJ_FUNCA LJ_NOAPI #if defined(ljamalg_c) #define LJ_FUNC static #else #define LJ_FUNC LJ_NOAPI #endif #define LJ_FUNC_NORET LJ_FUNC LJ_NORET #define LJ_FUNCA_NORET LJ_FUNCA LJ_NORET #define LJ_ASMF_NORET LJ_ASMF LJ_NORET /* Runtime assertions. */ #ifdef lua_assert #define check_exp(c, e) (lua_assert(c), (e)) #define api_check(l, e) lua_assert(e) #else #define lua_assert(c) ((void)0) #define check_exp(c, e) (e) #define api_check luai_apicheck #endif /* Static assertions. */ #define LJ_ASSERT_NAME2(name, line) name ## line #define LJ_ASSERT_NAME(line) LJ_ASSERT_NAME2(lj_assert_, line) #ifdef __COUNTER__ #define LJ_STATIC_ASSERT(cond) \ extern void LJ_ASSERT_NAME(__COUNTER__)(int STATIC_ASSERTION_FAILED[(cond)?1:-1]) #else #define LJ_STATIC_ASSERT(cond) \ extern void LJ_ASSERT_NAME(__LINE__)(int STATIC_ASSERTION_FAILED[(cond)?1:-1]) #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_frame.h0000644000175000017500000001335513122010155016630 0ustar philphil/* ** Stack frames. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_FRAME_H #define _LJ_FRAME_H #include "lj_obj.h" #include "lj_bc.h" /* -- Lua stack frame ----------------------------------------------------- */ /* Frame type markers in callee function slot (callee base-1). */ enum { FRAME_LUA, FRAME_C, FRAME_CONT, FRAME_VARG, FRAME_LUAP, FRAME_CP, FRAME_PCALL, FRAME_PCALLH }; #define FRAME_TYPE 3 #define FRAME_P 4 #define FRAME_TYPEP (FRAME_TYPE|FRAME_P) /* Macros to access and modify Lua frames. */ #define frame_gc(f) (gcref((f)->fr.func)) #define frame_func(f) (&frame_gc(f)->fn) #define frame_ftsz(f) ((f)->fr.tp.ftsz) #define frame_type(f) (frame_ftsz(f) & FRAME_TYPE) #define frame_typep(f) (frame_ftsz(f) & FRAME_TYPEP) #define frame_islua(f) (frame_type(f) == FRAME_LUA) #define frame_isc(f) (frame_type(f) == FRAME_C) #define frame_iscont(f) (frame_typep(f) == FRAME_CONT) #define frame_isvarg(f) (frame_typep(f) == FRAME_VARG) #define frame_ispcall(f) ((frame_ftsz(f) & 6) == FRAME_PCALL) #define frame_pc(f) (mref((f)->fr.tp.pcr, const BCIns)) #define frame_contpc(f) (frame_pc((f)-1)) #if LJ_64 #define frame_contf(f) \ ((ASMFunction)(void *)((intptr_t)lj_vm_asm_begin + \ (intptr_t)(int32_t)((f)-1)->u32.lo)) #else #define frame_contf(f) ((ASMFunction)gcrefp(((f)-1)->gcr, void)) #endif #define frame_delta(f) (frame_ftsz(f) >> 3) #define frame_sized(f) (frame_ftsz(f) & ~FRAME_TYPEP) #define frame_prevl(f) ((f) - (1+bc_a(frame_pc(f)[-1]))) #define frame_prevd(f) ((TValue *)((char *)(f) - frame_sized(f))) #define frame_prev(f) (frame_islua(f)?frame_prevl(f):frame_prevd(f)) /* Note: this macro does not skip over FRAME_VARG. */ #define setframe_pc(f, pc) (setmref((f)->fr.tp.pcr, (pc))) #define setframe_ftsz(f, sz) ((f)->fr.tp.ftsz = (sz)) #define setframe_gc(f, p) (setgcref((f)->fr.func, (p))) /* -- C stack frame ------------------------------------------------------- */ /* Macros to access and modify the C stack frame chain. */ /* These definitions must match with the arch-specific *.dasc files. */ #if LJ_TARGET_X86 #define CFRAME_OFS_ERRF (15*4) #define CFRAME_OFS_NRES (14*4) #define CFRAME_OFS_PREV (13*4) #define CFRAME_OFS_L (12*4) #define CFRAME_OFS_PC (6*4) #define CFRAME_OFS_MULTRES (5*4) #define CFRAME_SIZE (12*4) #define CFRAME_SHIFT_MULTRES 0 #elif LJ_TARGET_X64 #if LJ_ABI_WIN #define CFRAME_OFS_PREV (13*8) #define CFRAME_OFS_PC (25*4) #define CFRAME_OFS_L (24*4) #define CFRAME_OFS_ERRF (23*4) #define CFRAME_OFS_NRES (22*4) #define CFRAME_OFS_MULTRES (21*4) #define CFRAME_SIZE (10*8) #define CFRAME_SIZE_JIT (CFRAME_SIZE + 9*16 + 4*8) #define CFRAME_SHIFT_MULTRES 0 #else #define CFRAME_OFS_PREV (4*8) #define CFRAME_OFS_PC (7*4) #define CFRAME_OFS_L (6*4) #define CFRAME_OFS_ERRF (5*4) #define CFRAME_OFS_NRES (4*4) #define CFRAME_OFS_MULTRES (1*4) #if LJ_NO_UNWIND #define CFRAME_SIZE (12*8) #else #define CFRAME_SIZE (10*8) #endif #define CFRAME_SIZE_JIT (CFRAME_SIZE + 16) #define CFRAME_SHIFT_MULTRES 0 #endif #elif LJ_TARGET_ARM #define CFRAME_OFS_ERRF 24 #define CFRAME_OFS_NRES 20 #define CFRAME_OFS_PREV 16 #define CFRAME_OFS_L 12 #define CFRAME_OFS_PC 8 #define CFRAME_OFS_MULTRES 4 #if LJ_ARCH_HASFPU #define CFRAME_SIZE 128 #else #define CFRAME_SIZE 64 #endif #define CFRAME_SHIFT_MULTRES 3 #elif LJ_TARGET_PPC #if LJ_TARGET_XBOX360 #define CFRAME_OFS_ERRF 424 #define CFRAME_OFS_NRES 420 #define CFRAME_OFS_PREV 400 #define CFRAME_OFS_L 416 #define CFRAME_OFS_PC 412 #define CFRAME_OFS_MULTRES 408 #define CFRAME_SIZE 384 #define CFRAME_SHIFT_MULTRES 3 #elif LJ_ARCH_PPC64 #define CFRAME_OFS_ERRF 472 #define CFRAME_OFS_NRES 468 #define CFRAME_OFS_PREV 448 #define CFRAME_OFS_L 464 #define CFRAME_OFS_PC 460 #define CFRAME_OFS_MULTRES 456 #define CFRAME_SIZE 400 #define CFRAME_SHIFT_MULTRES 3 #else #define CFRAME_OFS_ERRF 48 #define CFRAME_OFS_NRES 44 #define CFRAME_OFS_PREV 40 #define CFRAME_OFS_L 36 #define CFRAME_OFS_PC 32 #define CFRAME_OFS_MULTRES 28 #define CFRAME_SIZE 272 #define CFRAME_SHIFT_MULTRES 3 #endif #elif LJ_TARGET_PPCSPE #define CFRAME_OFS_ERRF 28 #define CFRAME_OFS_NRES 24 #define CFRAME_OFS_PREV 20 #define CFRAME_OFS_L 16 #define CFRAME_OFS_PC 12 #define CFRAME_OFS_MULTRES 8 #define CFRAME_SIZE 184 #define CFRAME_SHIFT_MULTRES 3 #elif LJ_TARGET_MIPS #define CFRAME_OFS_ERRF 124 #define CFRAME_OFS_NRES 120 #define CFRAME_OFS_PREV 116 #define CFRAME_OFS_L 112 #define CFRAME_OFS_PC 20 #define CFRAME_OFS_MULTRES 16 #define CFRAME_SIZE 112 #define CFRAME_SHIFT_MULTRES 3 #else #error "Missing CFRAME_* definitions for this architecture" #endif #ifndef CFRAME_SIZE_JIT #define CFRAME_SIZE_JIT CFRAME_SIZE #endif #define CFRAME_RESUME 1 #define CFRAME_UNWIND_FF 2 /* Only used in unwinder. */ #define CFRAME_RAWMASK (~(intptr_t)(CFRAME_RESUME|CFRAME_UNWIND_FF)) #define cframe_errfunc(cf) (*(int32_t *)(((char *)(cf))+CFRAME_OFS_ERRF)) #define cframe_nres(cf) (*(int32_t *)(((char *)(cf))+CFRAME_OFS_NRES)) #define cframe_prev(cf) (*(void **)(((char *)(cf))+CFRAME_OFS_PREV)) #define cframe_multres(cf) (*(uint32_t *)(((char *)(cf))+CFRAME_OFS_MULTRES)) #define cframe_multres_n(cf) (cframe_multres((cf)) >> CFRAME_SHIFT_MULTRES) #define cframe_L(cf) \ (&gcref(*(GCRef *)(((char *)(cf))+CFRAME_OFS_L))->th) #define cframe_pc(cf) \ (mref(*(MRef *)(((char *)(cf))+CFRAME_OFS_PC), const BCIns)) #define setcframe_L(cf, L) \ (setmref(*(MRef *)(((char *)(cf))+CFRAME_OFS_L), (L))) #define setcframe_pc(cf, pc) \ (setmref(*(MRef *)(((char *)(cf))+CFRAME_OFS_PC), (pc))) #define cframe_canyield(cf) ((intptr_t)(cf) & CFRAME_RESUME) #define cframe_unwind_ff(cf) ((intptr_t)(cf) & CFRAME_UNWIND_FF) #define cframe_raw(cf) ((void *)((intptr_t)(cf) & CFRAME_RAWMASK)) #define cframe_Lpc(L) cframe_pc(cframe_raw(L->cframe)) #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_asm_ppc.h0000644000175000017500000021231613122010155017156 0ustar philphil/* ** PPC IR assembler (SSA IR -> machine code). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Register allocator extensions --------------------------------------- */ /* Allocate a register with a hint. */ static Reg ra_hintalloc(ASMState *as, IRRef ref, Reg hint, RegSet allow) { Reg r = IR(ref)->r; if (ra_noreg(r)) { if (!ra_hashint(r) && !iscrossref(as, ref)) ra_sethint(IR(ref)->r, hint); /* Propagate register hint. */ r = ra_allocref(as, ref, allow); } ra_noweak(as, r); return r; } /* Allocate two source registers for three-operand instructions. */ static Reg ra_alloc2(ASMState *as, IRIns *ir, RegSet allow) { IRIns *irl = IR(ir->op1), *irr = IR(ir->op2); Reg left = irl->r, right = irr->r; if (ra_hasreg(left)) { ra_noweak(as, left); if (ra_noreg(right)) right = ra_allocref(as, ir->op2, rset_exclude(allow, left)); else ra_noweak(as, right); } else if (ra_hasreg(right)) { ra_noweak(as, right); left = ra_allocref(as, ir->op1, rset_exclude(allow, right)); } else if (ra_hashint(right)) { right = ra_allocref(as, ir->op2, allow); left = ra_alloc1(as, ir->op1, rset_exclude(allow, right)); } else { left = ra_allocref(as, ir->op1, allow); right = ra_alloc1(as, ir->op2, rset_exclude(allow, left)); } return left | (right << 8); } /* -- Guard handling ------------------------------------------------------ */ /* Setup exit stubs after the end of each trace. */ static void asm_exitstub_setup(ASMState *as, ExitNo nexits) { ExitNo i; MCode *mxp = as->mctop; if (mxp - (nexits + 3 + MCLIM_REDZONE) < as->mclim) asm_mclimit(as); /* 1: mflr r0; bl ->vm_exit_handler; li r0, traceno; bl <1; bl <1; ... */ for (i = nexits-1; (int32_t)i >= 0; i--) *--mxp = PPCI_BL|(((-3-i)&0x00ffffffu)<<2); *--mxp = PPCI_LI|PPCF_T(RID_TMP)|as->T->traceno; /* Read by exit handler. */ mxp--; *mxp = PPCI_BL|((((MCode *)(void *)lj_vm_exit_handler-mxp)&0x00ffffffu)<<2); *--mxp = PPCI_MFLR|PPCF_T(RID_TMP); as->mctop = mxp; } static MCode *asm_exitstub_addr(ASMState *as, ExitNo exitno) { /* Keep this in-sync with exitstub_trace_addr(). */ return as->mctop + exitno + 3; } /* Emit conditional branch to exit for guard. */ static void asm_guardcc(ASMState *as, PPCCC cc) { MCode *target = asm_exitstub_addr(as, as->snapno); MCode *p = as->mcp; if (LJ_UNLIKELY(p == as->invmcp)) { as->loopinv = 1; *p = PPCI_B | (((target-p) & 0x00ffffffu) << 2); emit_condbranch(as, PPCI_BC, cc^4, p); return; } emit_condbranch(as, PPCI_BC, cc, target); } /* -- Operand fusion ------------------------------------------------------ */ /* Limit linear search to this distance. Avoids O(n^2) behavior. */ #define CONFLICT_SEARCH_LIM 31 /* Check if there's no conflicting instruction between curins and ref. */ static int noconflict(ASMState *as, IRRef ref, IROp conflict) { IRIns *ir = as->ir; IRRef i = as->curins; if (i > ref + CONFLICT_SEARCH_LIM) return 0; /* Give up, ref is too far away. */ while (--i > ref) if (ir[i].o == conflict) return 0; /* Conflict found. */ return 1; /* Ok, no conflict. */ } /* Fuse the array base of colocated arrays. */ static int32_t asm_fuseabase(ASMState *as, IRRef ref) { IRIns *ir = IR(ref); if (ir->o == IR_TNEW && ir->op1 <= LJ_MAX_COLOSIZE && !neverfuse(as) && noconflict(as, ref, IR_NEWREF)) return (int32_t)sizeof(GCtab); return 0; } /* Indicates load/store indexed is ok. */ #define AHUREF_LSX ((int32_t)0x80000000) /* Fuse array/hash/upvalue reference into register+offset operand. */ static Reg asm_fuseahuref(ASMState *as, IRRef ref, int32_t *ofsp, RegSet allow) { IRIns *ir = IR(ref); if (ra_noreg(ir->r)) { if (ir->o == IR_AREF) { if (mayfuse(as, ref)) { if (irref_isk(ir->op2)) { IRRef tab = IR(ir->op1)->op1; int32_t ofs = asm_fuseabase(as, tab); IRRef refa = ofs ? tab : ir->op1; ofs += 8*IR(ir->op2)->i; if (checki16(ofs)) { *ofsp = ofs; return ra_alloc1(as, refa, allow); } } if (*ofsp == AHUREF_LSX) { Reg base = ra_alloc1(as, ir->op1, allow); Reg idx = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, base)); return base | (idx << 8); } } } else if (ir->o == IR_HREFK) { if (mayfuse(as, ref)) { int32_t ofs = (int32_t)(IR(ir->op2)->op2 * sizeof(Node)); if (checki16(ofs)) { *ofsp = ofs; return ra_alloc1(as, ir->op1, allow); } } } else if (ir->o == IR_UREFC) { if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); int32_t ofs = i32ptr(&gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv.tv); int32_t jgl = (intptr_t)J2G(as->J); if ((uint32_t)(ofs-jgl) < 65536) { *ofsp = ofs-jgl-32768; return RID_JGL; } else { *ofsp = (int16_t)ofs; return ra_allock(as, ofs-(int16_t)ofs, allow); } } } } *ofsp = 0; return ra_alloc1(as, ref, allow); } /* Fuse XLOAD/XSTORE reference into load/store operand. */ static void asm_fusexref(ASMState *as, PPCIns pi, Reg rt, IRRef ref, RegSet allow, int32_t ofs) { IRIns *ir = IR(ref); Reg base; if (ra_noreg(ir->r) && canfuse(as, ir)) { if (ir->o == IR_ADD) { int32_t ofs2; if (irref_isk(ir->op2) && (ofs2 = ofs + IR(ir->op2)->i, checki16(ofs2))) { ofs = ofs2; ref = ir->op1; } else if (ofs == 0) { Reg right, left = ra_alloc2(as, ir, allow); right = (left >> 8); left &= 255; emit_fab(as, PPCI_LWZX | ((pi >> 20) & 0x780), rt, left, right); return; } } else if (ir->o == IR_STRREF) { lua_assert(ofs == 0); ofs = (int32_t)sizeof(GCstr); if (irref_isk(ir->op2)) { ofs += IR(ir->op2)->i; ref = ir->op1; } else if (irref_isk(ir->op1)) { ofs += IR(ir->op1)->i; ref = ir->op2; } else { /* NYI: Fuse ADD with constant. */ Reg tmp, right, left = ra_alloc2(as, ir, allow); right = (left >> 8); left &= 255; tmp = ra_scratch(as, rset_exclude(rset_exclude(allow, left), right)); emit_fai(as, pi, rt, tmp, ofs); emit_tab(as, PPCI_ADD, tmp, left, right); return; } if (!checki16(ofs)) { Reg left = ra_alloc1(as, ref, allow); Reg right = ra_allock(as, ofs, rset_exclude(allow, left)); emit_fab(as, PPCI_LWZX | ((pi >> 20) & 0x780), rt, left, right); return; } } } base = ra_alloc1(as, ref, allow); emit_fai(as, pi, rt, base, ofs); } /* Fuse XLOAD/XSTORE reference into indexed-only load/store operand. */ static void asm_fusexrefx(ASMState *as, PPCIns pi, Reg rt, IRRef ref, RegSet allow) { IRIns *ira = IR(ref); Reg right, left; if (canfuse(as, ira) && ira->o == IR_ADD && ra_noreg(ira->r)) { left = ra_alloc2(as, ira, allow); right = (left >> 8); left &= 255; } else { right = ra_alloc1(as, ref, allow); left = RID_R0; } emit_tab(as, pi, rt, left, right); } /* Fuse to multiply-add/sub instruction. */ static int asm_fusemadd(ASMState *as, IRIns *ir, PPCIns pi, PPCIns pir) { IRRef lref = ir->op1, rref = ir->op2; IRIns *irm; if (lref != rref && ((mayfuse(as, lref) && (irm = IR(lref), irm->o == IR_MUL) && ra_noreg(irm->r)) || (mayfuse(as, rref) && (irm = IR(rref), irm->o == IR_MUL) && (rref = lref, pi = pir, ra_noreg(irm->r))))) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg add = ra_alloc1(as, rref, RSET_FPR); Reg right, left = ra_alloc2(as, irm, rset_exclude(RSET_FPR, add)); right = (left >> 8); left &= 255; emit_facb(as, pi, dest, left, right, add); return 1; } return 0; } /* -- Calls --------------------------------------------------------------- */ /* Generate a call to a C function. */ static void asm_gencall(ASMState *as, const CCallInfo *ci, IRRef *args) { uint32_t n, nargs = CCI_NARGS(ci); int32_t ofs = 8; Reg gpr = REGARG_FIRSTGPR, fpr = REGARG_FIRSTFPR; if ((void *)ci->func) emit_call(as, (void *)ci->func); for (n = 0; n < nargs; n++) { /* Setup args. */ IRRef ref = args[n]; if (ref) { IRIns *ir = IR(ref); if (irt_isfp(ir->t)) { if (fpr <= REGARG_LASTFPR) { lua_assert(rset_test(as->freeset, fpr)); /* Already evicted. */ ra_leftov(as, fpr, ref); fpr++; } else { Reg r = ra_alloc1(as, ref, RSET_FPR); if (irt_isnum(ir->t)) ofs = (ofs + 4) & ~4; emit_spstore(as, ir, r, ofs); ofs += irt_isnum(ir->t) ? 8 : 4; } } else { if (gpr <= REGARG_LASTGPR) { lua_assert(rset_test(as->freeset, gpr)); /* Already evicted. */ ra_leftov(as, gpr, ref); gpr++; } else { Reg r = ra_alloc1(as, ref, RSET_GPR); emit_spstore(as, ir, r, ofs); ofs += 4; } } } else { if (gpr <= REGARG_LASTGPR) gpr++; else ofs += 4; } checkmclim(as); } if ((ci->flags & CCI_VARARG)) /* Vararg calls need to know about FPR use. */ emit_tab(as, fpr == REGARG_FIRSTFPR ? PPCI_CRXOR : PPCI_CREQV, 6, 6, 6); } /* Setup result reg/sp for call. Evict scratch regs. */ static void asm_setupresult(ASMState *as, IRIns *ir, const CCallInfo *ci) { RegSet drop = RSET_SCRATCH; int hiop = ((ir+1)->o == IR_HIOP && !irt_isnil((ir+1)->t)); if ((ci->flags & CCI_NOFPRCLOBBER)) drop &= ~RSET_FPR; if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ if (hiop && ra_hasreg((ir+1)->r)) rset_clear(drop, (ir+1)->r); /* Dest reg handled below. */ ra_evictset(as, drop); /* Evictions must be performed first. */ if (ra_used(ir)) { lua_assert(!irt_ispri(ir->t)); if (irt_isfp(ir->t)) { if ((ci->flags & CCI_CASTU64)) { /* Use spill slot or temp slots. */ int32_t ofs = ir->s ? sps_scale(ir->s) : SPOFS_TMP; Reg dest = ir->r; if (ra_hasreg(dest)) { ra_free(as, dest); ra_modified(as, dest); emit_fai(as, PPCI_LFD, dest, RID_SP, ofs); } emit_tai(as, PPCI_STW, RID_RETHI, RID_SP, ofs); emit_tai(as, PPCI_STW, RID_RETLO, RID_SP, ofs+4); } else { ra_destreg(as, ir, RID_FPRET); } } else if (hiop) { ra_destpair(as, ir); } else { ra_destreg(as, ir, RID_RET); } } } static void asm_call(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX]; const CCallInfo *ci = &lj_ir_callinfo[ir->op2]; asm_collectargs(as, ir, ci, args); asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } static void asm_callx(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX*2]; CCallInfo ci; IRRef func; IRIns *irf; ci.flags = asm_callx_flags(as, ir); asm_collectargs(as, ir, &ci, args); asm_setupresult(as, ir, &ci); func = ir->op2; irf = IR(func); if (irf->o == IR_CARG) { func = irf->op1; irf = IR(func); } if (irref_isk(func)) { /* Call to constant address. */ ci.func = (ASMFunction)(void *)(irf->i); } else { /* Need a non-argument register for indirect calls. */ RegSet allow = RSET_GPR & ~RSET_RANGE(RID_R0, REGARG_LASTGPR+1); Reg freg = ra_alloc1(as, func, allow); *--as->mcp = PPCI_BCTRL; *--as->mcp = PPCI_MTCTR | PPCF_T(freg); ci.func = (ASMFunction)(void *)0; } asm_gencall(as, &ci, args); } static void asm_callid(ASMState *as, IRIns *ir, IRCallID id) { const CCallInfo *ci = &lj_ir_callinfo[id]; IRRef args[2]; args[0] = ir->op1; args[1] = ir->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } /* -- Returns ------------------------------------------------------------- */ /* Return to lower frame. Guard that it goes to the right spot. */ static void asm_retf(ASMState *as, IRIns *ir) { Reg base = ra_alloc1(as, REF_BASE, RSET_GPR); void *pc = ir_kptr(IR(ir->op2)); int32_t delta = 1+bc_a(*((const BCIns *)pc - 1)); as->topslot -= (BCReg)delta; if ((int32_t)as->topslot < 0) as->topslot = 0; irt_setmark(IR(REF_BASE)->t); /* Children must not coalesce with BASE reg. */ emit_setgl(as, base, jit_base); emit_addptr(as, base, -8*delta); asm_guardcc(as, CC_NE); emit_ab(as, PPCI_CMPW, RID_TMP, ra_allock(as, i32ptr(pc), rset_exclude(RSET_GPR, base))); emit_tai(as, PPCI_LWZ, RID_TMP, base, -8); } /* -- Type conversions ---------------------------------------------------- */ static void asm_tointg(ASMState *as, IRIns *ir, Reg left) { RegSet allow = RSET_FPR; Reg tmp = ra_scratch(as, rset_clear(allow, left)); Reg fbias = ra_scratch(as, rset_clear(allow, tmp)); Reg dest = ra_dest(as, ir, RSET_GPR); Reg hibias = ra_allock(as, 0x43300000, rset_exclude(RSET_GPR, dest)); asm_guardcc(as, CC_NE); emit_fab(as, PPCI_FCMPU, 0, tmp, left); emit_fab(as, PPCI_FSUB, tmp, tmp, fbias); emit_fai(as, PPCI_LFD, tmp, RID_SP, SPOFS_TMP); emit_tai(as, PPCI_STW, RID_TMP, RID_SP, SPOFS_TMPLO); emit_tai(as, PPCI_STW, hibias, RID_SP, SPOFS_TMPHI); emit_asi(as, PPCI_XORIS, RID_TMP, dest, 0x8000); emit_tai(as, PPCI_LWZ, dest, RID_SP, SPOFS_TMPLO); emit_lsptr(as, PPCI_LFS, (fbias & 31), (void *)lj_ir_k64_find(as->J, U64x(59800004,59800000)), RSET_GPR); emit_fai(as, PPCI_STFD, tmp, RID_SP, SPOFS_TMP); emit_fb(as, PPCI_FCTIWZ, tmp, left); } static void asm_tobit(ASMState *as, IRIns *ir) { RegSet allow = RSET_FPR; Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, allow); Reg right = ra_alloc1(as, ir->op2, rset_clear(allow, left)); Reg tmp = ra_scratch(as, rset_clear(allow, right)); emit_tai(as, PPCI_LWZ, dest, RID_SP, SPOFS_TMPLO); emit_fai(as, PPCI_STFD, tmp, RID_SP, SPOFS_TMP); emit_fab(as, PPCI_FADD, tmp, left, right); } static void asm_conv(ASMState *as, IRIns *ir) { IRType st = (IRType)(ir->op2 & IRCONV_SRCMASK); int stfp = (st == IRT_NUM || st == IRT_FLOAT); IRRef lref = ir->op1; lua_assert(irt_type(ir->t) != st); lua_assert(!(irt_isint64(ir->t) || (st == IRT_I64 || st == IRT_U64))); /* Handled by SPLIT. */ if (irt_isfp(ir->t)) { Reg dest = ra_dest(as, ir, RSET_FPR); if (stfp) { /* FP to FP conversion. */ if (st == IRT_NUM) /* double -> float conversion. */ emit_fb(as, PPCI_FRSP, dest, ra_alloc1(as, lref, RSET_FPR)); else /* float -> double conversion is a no-op on PPC. */ ra_leftov(as, dest, lref); /* Do nothing, but may need to move regs. */ } else { /* Integer to FP conversion. */ /* IRT_INT: Flip hibit, bias with 2^52, subtract 2^52+2^31. */ /* IRT_U32: Bias with 2^52, subtract 2^52. */ RegSet allow = RSET_GPR; Reg left = ra_alloc1(as, lref, allow); Reg hibias = ra_allock(as, 0x43300000, rset_clear(allow, left)); Reg fbias = ra_scratch(as, rset_exclude(RSET_FPR, dest)); const float *kbias; if (irt_isfloat(ir->t)) emit_fb(as, PPCI_FRSP, dest, dest); emit_fab(as, PPCI_FSUB, dest, dest, fbias); emit_fai(as, PPCI_LFD, dest, RID_SP, SPOFS_TMP); kbias = (const float *)lj_ir_k64_find(as->J, U64x(59800004,59800000)); if (st == IRT_U32) kbias++; emit_lsptr(as, PPCI_LFS, (fbias & 31), (void *)kbias, rset_clear(allow, hibias)); emit_tai(as, PPCI_STW, st == IRT_U32 ? left : RID_TMP, RID_SP, SPOFS_TMPLO); emit_tai(as, PPCI_STW, hibias, RID_SP, SPOFS_TMPHI); if (st != IRT_U32) emit_asi(as, PPCI_XORIS, RID_TMP, left, 0x8000); } } else if (stfp) { /* FP to integer conversion. */ if (irt_isguard(ir->t)) { /* Checked conversions are only supported from number to int. */ lua_assert(irt_isint(ir->t) && st == IRT_NUM); asm_tointg(as, ir, ra_alloc1(as, lref, RSET_FPR)); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, lref, RSET_FPR); Reg tmp = ra_scratch(as, rset_exclude(RSET_FPR, left)); if (irt_isu32(ir->t)) { /* Convert both x and x-2^31 to int and merge results. */ Reg tmpi = ra_scratch(as, rset_exclude(RSET_GPR, dest)); emit_asb(as, PPCI_OR, dest, dest, tmpi); /* Select with mask idiom. */ emit_asb(as, PPCI_AND, tmpi, tmpi, RID_TMP); emit_asb(as, PPCI_ANDC, dest, dest, RID_TMP); emit_tai(as, PPCI_LWZ, tmpi, RID_SP, SPOFS_TMPLO); /* tmp = (int)(x) */ emit_tai(as, PPCI_ADDIS, dest, dest, 0x8000); /* dest += 2^31 */ emit_asb(as, PPCI_SRAWI, RID_TMP, dest, 31); /* mask = -(dest < 0) */ emit_fai(as, PPCI_STFD, tmp, RID_SP, SPOFS_TMP); emit_tai(as, PPCI_LWZ, dest, RID_SP, SPOFS_TMPLO); /* dest = (int)(x-2^31) */ emit_fb(as, PPCI_FCTIWZ, tmp, left); emit_fai(as, PPCI_STFD, tmp, RID_SP, SPOFS_TMP); emit_fb(as, PPCI_FCTIWZ, tmp, tmp); emit_fab(as, PPCI_FSUB, tmp, left, tmp); emit_lsptr(as, PPCI_LFS, (tmp & 31), (void *)lj_ir_k64_find(as->J, U64x(4f000000,00000000)), RSET_GPR); } else { emit_tai(as, PPCI_LWZ, dest, RID_SP, SPOFS_TMPLO); emit_fai(as, PPCI_STFD, tmp, RID_SP, SPOFS_TMP); emit_fb(as, PPCI_FCTIWZ, tmp, left); } } } else { Reg dest = ra_dest(as, ir, RSET_GPR); if (st >= IRT_I8 && st <= IRT_U16) { /* Extend to 32 bit integer. */ Reg left = ra_alloc1(as, ir->op1, RSET_GPR); lua_assert(irt_isint(ir->t) || irt_isu32(ir->t)); if ((ir->op2 & IRCONV_SEXT)) emit_as(as, st == IRT_I8 ? PPCI_EXTSB : PPCI_EXTSH, dest, left); else emit_rot(as, PPCI_RLWINM, dest, left, 0, st == IRT_U8 ? 24 : 16, 31); } else { /* 32/64 bit integer conversions. */ /* Only need to handle 32/32 bit no-op (cast) on 32 bit archs. */ ra_leftov(as, dest, lref); /* Do nothing, but may need to move regs. */ } } } #if LJ_HASFFI static void asm_conv64(ASMState *as, IRIns *ir) { IRType st = (IRType)((ir-1)->op2 & IRCONV_SRCMASK); IRType dt = (((ir-1)->op2 & IRCONV_DSTMASK) >> IRCONV_DSH); IRCallID id; const CCallInfo *ci; IRRef args[2]; args[0] = ir->op1; args[1] = (ir-1)->op1; if (st == IRT_NUM || st == IRT_FLOAT) { id = IRCALL_fp64_d2l + ((st == IRT_FLOAT) ? 2 : 0) + (dt - IRT_I64); ir--; } else { id = IRCALL_fp64_l2d + ((dt == IRT_FLOAT) ? 2 : 0) + (st - IRT_I64); } ci = &lj_ir_callinfo[id]; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } #endif static void asm_strto(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_strscan_num]; IRRef args[2]; int32_t ofs; RegSet drop = RSET_SCRATCH; if (ra_hasreg(ir->r)) rset_set(drop, ir->r); /* Spill dest reg (if any). */ ra_evictset(as, drop); asm_guardcc(as, CC_EQ); emit_ai(as, PPCI_CMPWI, RID_RET, 0); /* Test return status. */ args[0] = ir->op1; /* GCstr *str */ args[1] = ASMREF_TMP1; /* TValue *n */ asm_gencall(as, ci, args); /* Store the result to the spill slot or temp slots. */ ofs = ir->s ? sps_scale(ir->s) : SPOFS_TMP; emit_tai(as, PPCI_ADDI, ra_releasetmp(as, ASMREF_TMP1), RID_SP, ofs); } /* Get pointer to TValue. */ static void asm_tvptr(ASMState *as, Reg dest, IRRef ref) { IRIns *ir = IR(ref); if (irt_isnum(ir->t)) { if (irref_isk(ref)) /* Use the number constant itself as a TValue. */ ra_allockreg(as, i32ptr(ir_knum(ir)), dest); else /* Otherwise force a spill and use the spill slot. */ emit_tai(as, PPCI_ADDI, dest, RID_SP, ra_spill(as, ir)); } else { /* Otherwise use g->tmptv to hold the TValue. */ RegSet allow = rset_exclude(RSET_GPR, dest); Reg type; emit_tai(as, PPCI_ADDI, dest, RID_JGL, offsetof(global_State, tmptv)-32768); if (!irt_ispri(ir->t)) { Reg src = ra_alloc1(as, ref, allow); emit_setgl(as, src, tmptv.gcr); } type = ra_allock(as, irt_toitype(ir->t), allow); emit_setgl(as, type, tmptv.it); } } static void asm_tostr(ASMState *as, IRIns *ir) { IRRef args[2]; args[0] = ASMREF_L; as->gcsteps++; if (irt_isnum(IR(ir->op1)->t) || (ir+1)->o == IR_HIOP) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromnum]; args[1] = ASMREF_TMP1; /* const lua_Number * */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); asm_tvptr(as, ra_releasetmp(as, ASMREF_TMP1), ir->op1); } else { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromint]; args[1] = ir->op1; /* int32_t k */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); } } /* -- Memory references --------------------------------------------------- */ static void asm_aref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg idx, base; if (irref_isk(ir->op2)) { IRRef tab = IR(ir->op1)->op1; int32_t ofs = asm_fuseabase(as, tab); IRRef refa = ofs ? tab : ir->op1; ofs += 8*IR(ir->op2)->i; if (checki16(ofs)) { base = ra_alloc1(as, refa, RSET_GPR); emit_tai(as, PPCI_ADDI, dest, base, ofs); return; } } base = ra_alloc1(as, ir->op1, RSET_GPR); idx = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, base)); emit_tab(as, PPCI_ADD, dest, RID_TMP, base); emit_slwi(as, RID_TMP, idx, 3); } /* Inlined hash lookup. Specialized for key type and for const keys. ** The equivalent C code is: ** Node *n = hashkey(t, key); ** do { ** if (lj_obj_equal(&n->key, key)) return &n->val; ** } while ((n = nextnode(n))); ** return niltv(L); */ static void asm_href(ASMState *as, IRIns *ir, IROp merge) { RegSet allow = RSET_GPR; int destused = ra_used(ir); Reg dest = ra_dest(as, ir, allow); Reg tab = ra_alloc1(as, ir->op1, rset_clear(allow, dest)); Reg key = RID_NONE, tmp1 = RID_TMP, tmp2; Reg tisnum = RID_NONE, tmpnum = RID_NONE; IRRef refkey = ir->op2; IRIns *irkey = IR(refkey); IRType1 kt = irkey->t; uint32_t khash; MCLabel l_end, l_loop, l_next; rset_clear(allow, tab); if (irt_isnum(kt)) { key = ra_alloc1(as, refkey, RSET_FPR); tmpnum = ra_scratch(as, rset_exclude(RSET_FPR, key)); tisnum = ra_allock(as, (int32_t)LJ_TISNUM, allow); rset_clear(allow, tisnum); } else if (!irt_ispri(kt)) { key = ra_alloc1(as, refkey, allow); rset_clear(allow, key); } tmp2 = ra_scratch(as, allow); rset_clear(allow, tmp2); /* Key not found in chain: jump to exit (if merged) or load niltv. */ l_end = emit_label(as); as->invmcp = NULL; if (merge == IR_NE) asm_guardcc(as, CC_EQ); else if (destused) emit_loada(as, dest, niltvg(J2G(as->J))); /* Follow hash chain until the end. */ l_loop = --as->mcp; emit_ai(as, PPCI_CMPWI, dest, 0); emit_tai(as, PPCI_LWZ, dest, dest, (int32_t)offsetof(Node, next)); l_next = emit_label(as); /* Type and value comparison. */ if (merge == IR_EQ) asm_guardcc(as, CC_EQ); else emit_condbranch(as, PPCI_BC|PPCF_Y, CC_EQ, l_end); if (irt_isnum(kt)) { emit_fab(as, PPCI_FCMPU, 0, tmpnum, key); emit_condbranch(as, PPCI_BC, CC_GE, l_next); emit_ab(as, PPCI_CMPLW, tmp1, tisnum); emit_fai(as, PPCI_LFD, tmpnum, dest, (int32_t)offsetof(Node, key.n)); } else { if (!irt_ispri(kt)) { emit_ab(as, PPCI_CMPW, tmp2, key); emit_condbranch(as, PPCI_BC, CC_NE, l_next); } emit_ai(as, PPCI_CMPWI, tmp1, irt_toitype(irkey->t)); if (!irt_ispri(kt)) emit_tai(as, PPCI_LWZ, tmp2, dest, (int32_t)offsetof(Node, key.gcr)); } emit_tai(as, PPCI_LWZ, tmp1, dest, (int32_t)offsetof(Node, key.it)); *l_loop = PPCI_BC | PPCF_Y | PPCF_CC(CC_NE) | (((char *)as->mcp-(char *)l_loop) & 0xffffu); /* Load main position relative to tab->node into dest. */ khash = irref_isk(refkey) ? ir_khash(irkey) : 1; if (khash == 0) { emit_tai(as, PPCI_LWZ, dest, tab, (int32_t)offsetof(GCtab, node)); } else { Reg tmphash = tmp1; if (irref_isk(refkey)) tmphash = ra_allock(as, khash, allow); emit_tab(as, PPCI_ADD, dest, dest, tmp1); emit_tai(as, PPCI_MULLI, tmp1, tmp1, sizeof(Node)); emit_asb(as, PPCI_AND, tmp1, tmp2, tmphash); emit_tai(as, PPCI_LWZ, dest, tab, (int32_t)offsetof(GCtab, node)); emit_tai(as, PPCI_LWZ, tmp2, tab, (int32_t)offsetof(GCtab, hmask)); if (irref_isk(refkey)) { /* Nothing to do. */ } else if (irt_isstr(kt)) { emit_tai(as, PPCI_LWZ, tmp1, key, (int32_t)offsetof(GCstr, hash)); } else { /* Must match with hash*() in lj_tab.c. */ emit_tab(as, PPCI_SUBF, tmp1, tmp2, tmp1); emit_rotlwi(as, tmp2, tmp2, HASH_ROT3); emit_asb(as, PPCI_XOR, tmp1, tmp1, tmp2); emit_rotlwi(as, tmp1, tmp1, (HASH_ROT2+HASH_ROT1)&31); emit_tab(as, PPCI_SUBF, tmp2, dest, tmp2); if (irt_isnum(kt)) { int32_t ofs = ra_spill(as, irkey); emit_asb(as, PPCI_XOR, tmp2, tmp2, tmp1); emit_rotlwi(as, dest, tmp1, HASH_ROT1); emit_tab(as, PPCI_ADD, tmp1, tmp1, tmp1); emit_tai(as, PPCI_LWZ, tmp2, RID_SP, ofs+4); emit_tai(as, PPCI_LWZ, tmp1, RID_SP, ofs); } else { emit_asb(as, PPCI_XOR, tmp2, key, tmp1); emit_rotlwi(as, dest, tmp1, HASH_ROT1); emit_tai(as, PPCI_ADDI, tmp1, tmp2, HASH_BIAS); emit_tai(as, PPCI_ADDIS, tmp2, key, (HASH_BIAS + 32768)>>16); } } } } static void asm_hrefk(ASMState *as, IRIns *ir) { IRIns *kslot = IR(ir->op2); IRIns *irkey = IR(kslot->op1); int32_t ofs = (int32_t)(kslot->op2 * sizeof(Node)); int32_t kofs = ofs + (int32_t)offsetof(Node, key); Reg dest = (ra_used(ir)||ofs > 32736) ? ra_dest(as, ir, RSET_GPR) : RID_NONE; Reg node = ra_alloc1(as, ir->op1, RSET_GPR); Reg key = RID_NONE, type = RID_TMP, idx = node; RegSet allow = rset_exclude(RSET_GPR, node); lua_assert(ofs % sizeof(Node) == 0); if (ofs > 32736) { idx = dest; rset_clear(allow, dest); kofs = (int32_t)offsetof(Node, key); } else if (ra_hasreg(dest)) { emit_tai(as, PPCI_ADDI, dest, node, ofs); } asm_guardcc(as, CC_NE); if (!irt_ispri(irkey->t)) { key = ra_scratch(as, allow); rset_clear(allow, key); } rset_clear(allow, type); if (irt_isnum(irkey->t)) { emit_cmpi(as, key, (int32_t)ir_knum(irkey)->u32.lo); asm_guardcc(as, CC_NE); emit_cmpi(as, type, (int32_t)ir_knum(irkey)->u32.hi); } else { if (ra_hasreg(key)) { emit_cmpi(as, key, irkey->i); /* May use RID_TMP, i.e. type. */ asm_guardcc(as, CC_NE); } emit_ai(as, PPCI_CMPWI, type, irt_toitype(irkey->t)); } if (ra_hasreg(key)) emit_tai(as, PPCI_LWZ, key, idx, kofs+4); emit_tai(as, PPCI_LWZ, type, idx, kofs); if (ofs > 32736) { emit_tai(as, PPCI_ADDIS, dest, dest, (ofs + 32768) >> 16); emit_tai(as, PPCI_ADDI, dest, node, ofs); } } static void asm_newref(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_tab_newkey]; IRRef args[3]; if (ir->r == RID_SINK) return; args[0] = ASMREF_L; /* lua_State *L */ args[1] = ir->op1; /* GCtab *t */ args[2] = ASMREF_TMP1; /* cTValue *key */ asm_setupresult(as, ir, ci); /* TValue * */ asm_gencall(as, ci, args); asm_tvptr(as, ra_releasetmp(as, ASMREF_TMP1), ir->op2); } static void asm_uref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); MRef *v = &gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv.v; emit_lsptr(as, PPCI_LWZ, dest, v, RSET_GPR); } else { Reg uv = ra_scratch(as, RSET_GPR); Reg func = ra_alloc1(as, ir->op1, RSET_GPR); if (ir->o == IR_UREFC) { asm_guardcc(as, CC_NE); emit_ai(as, PPCI_CMPWI, RID_TMP, 1); emit_tai(as, PPCI_ADDI, dest, uv, (int32_t)offsetof(GCupval, tv)); emit_tai(as, PPCI_LBZ, RID_TMP, uv, (int32_t)offsetof(GCupval, closed)); } else { emit_tai(as, PPCI_LWZ, dest, uv, (int32_t)offsetof(GCupval, v)); } emit_tai(as, PPCI_LWZ, uv, func, (int32_t)offsetof(GCfuncL, uvptr) + 4*(int32_t)(ir->op2 >> 8)); } } static void asm_fref(ASMState *as, IRIns *ir) { UNUSED(as); UNUSED(ir); lua_assert(!ra_used(ir)); } static void asm_strref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); IRRef ref = ir->op2, refk = ir->op1; int32_t ofs = (int32_t)sizeof(GCstr); Reg r; if (irref_isk(ref)) { IRRef tmp = refk; refk = ref; ref = tmp; } else if (!irref_isk(refk)) { Reg right, left = ra_alloc1(as, ir->op1, RSET_GPR); IRIns *irr = IR(ir->op2); if (ra_hasreg(irr->r)) { ra_noweak(as, irr->r); right = irr->r; } else if (mayfuse(as, irr->op2) && irr->o == IR_ADD && irref_isk(irr->op2) && checki16(ofs + IR(irr->op2)->i)) { ofs += IR(irr->op2)->i; right = ra_alloc1(as, irr->op1, rset_exclude(RSET_GPR, left)); } else { right = ra_allocref(as, ir->op2, rset_exclude(RSET_GPR, left)); } emit_tai(as, PPCI_ADDI, dest, dest, ofs); emit_tab(as, PPCI_ADD, dest, left, right); return; } r = ra_alloc1(as, ref, RSET_GPR); ofs += IR(refk)->i; if (checki16(ofs)) emit_tai(as, PPCI_ADDI, dest, r, ofs); else emit_tab(as, PPCI_ADD, dest, r, ra_allock(as, ofs, rset_exclude(RSET_GPR, r))); } /* -- Loads and stores ---------------------------------------------------- */ static PPCIns asm_fxloadins(IRIns *ir) { switch (irt_type(ir->t)) { case IRT_I8: return PPCI_LBZ; /* Needs sign-extension. */ case IRT_U8: return PPCI_LBZ; case IRT_I16: return PPCI_LHA; case IRT_U16: return PPCI_LHZ; case IRT_NUM: return PPCI_LFD; case IRT_FLOAT: return PPCI_LFS; default: return PPCI_LWZ; } } static PPCIns asm_fxstoreins(IRIns *ir) { switch (irt_type(ir->t)) { case IRT_I8: case IRT_U8: return PPCI_STB; case IRT_I16: case IRT_U16: return PPCI_STH; case IRT_NUM: return PPCI_STFD; case IRT_FLOAT: return PPCI_STFS; default: return PPCI_STW; } } static void asm_fload(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg idx = ra_alloc1(as, ir->op1, RSET_GPR); PPCIns pi = asm_fxloadins(ir); int32_t ofs; if (ir->op2 == IRFL_TAB_ARRAY) { ofs = asm_fuseabase(as, ir->op1); if (ofs) { /* Turn the t->array load into an add for colocated arrays. */ emit_tai(as, PPCI_ADDI, dest, idx, ofs); return; } } ofs = field_ofs[ir->op2]; lua_assert(!irt_isi8(ir->t)); emit_tai(as, pi, dest, idx, ofs); } static void asm_fstore(ASMState *as, IRIns *ir) { if (ir->r != RID_SINK) { Reg src = ra_alloc1(as, ir->op2, RSET_GPR); IRIns *irf = IR(ir->op1); Reg idx = ra_alloc1(as, irf->op1, rset_exclude(RSET_GPR, src)); int32_t ofs = field_ofs[irf->op2]; PPCIns pi = asm_fxstoreins(ir); emit_tai(as, pi, src, idx, ofs); } } static void asm_xload(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); lua_assert(!(ir->op2 & IRXLOAD_UNALIGNED)); if (irt_isi8(ir->t)) emit_as(as, PPCI_EXTSB, dest, dest); asm_fusexref(as, asm_fxloadins(ir), dest, ir->op1, RSET_GPR, 0); } static void asm_xstore(ASMState *as, IRIns *ir, int32_t ofs) { IRIns *irb; if (ir->r == RID_SINK) return; if (ofs == 0 && mayfuse(as, ir->op2) && (irb = IR(ir->op2))->o == IR_BSWAP && ra_noreg(irb->r) && (irt_isint(ir->t) || irt_isu32(ir->t))) { /* Fuse BSWAP with XSTORE to stwbrx. */ Reg src = ra_alloc1(as, irb->op1, RSET_GPR); asm_fusexrefx(as, PPCI_STWBRX, src, ir->op1, rset_exclude(RSET_GPR, src)); } else { Reg src = ra_alloc1(as, ir->op2, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); asm_fusexref(as, asm_fxstoreins(ir), src, ir->op1, rset_exclude(RSET_GPR, src), ofs); } } static void asm_ahuvload(ASMState *as, IRIns *ir) { IRType1 t = ir->t; Reg dest = RID_NONE, type = RID_TMP, tmp = RID_TMP, idx; RegSet allow = RSET_GPR; int32_t ofs = AHUREF_LSX; if (ra_used(ir)) { lua_assert(irt_isnum(t) || irt_isint(t) || irt_isaddr(t)); if (!irt_isnum(t)) ofs = 0; dest = ra_dest(as, ir, irt_isnum(t) ? RSET_FPR : RSET_GPR); rset_clear(allow, dest); } idx = asm_fuseahuref(as, ir->op1, &ofs, allow); if (irt_isnum(t)) { Reg tisnum = ra_allock(as, (int32_t)LJ_TISNUM, rset_exclude(allow, idx)); asm_guardcc(as, CC_GE); emit_ab(as, PPCI_CMPLW, type, tisnum); if (ra_hasreg(dest)) { if (ofs == AHUREF_LSX) { tmp = ra_scratch(as, rset_exclude(rset_exclude(RSET_GPR, (idx&255)), (idx>>8))); emit_fab(as, PPCI_LFDX, dest, (idx&255), tmp); } else { emit_fai(as, PPCI_LFD, dest, idx, ofs); } } } else { asm_guardcc(as, CC_NE); emit_ai(as, PPCI_CMPWI, type, irt_toitype(t)); if (ra_hasreg(dest)) emit_tai(as, PPCI_LWZ, dest, idx, ofs+4); } if (ofs == AHUREF_LSX) { emit_tab(as, PPCI_LWZX, type, (idx&255), tmp); emit_slwi(as, tmp, (idx>>8), 3); } else { emit_tai(as, PPCI_LWZ, type, idx, ofs); } } static void asm_ahustore(ASMState *as, IRIns *ir) { RegSet allow = RSET_GPR; Reg idx, src = RID_NONE, type = RID_NONE; int32_t ofs = AHUREF_LSX; if (ir->r == RID_SINK) return; if (irt_isnum(ir->t)) { src = ra_alloc1(as, ir->op2, RSET_FPR); } else { if (!irt_ispri(ir->t)) { src = ra_alloc1(as, ir->op2, allow); rset_clear(allow, src); ofs = 0; } type = ra_allock(as, (int32_t)irt_toitype(ir->t), allow); rset_clear(allow, type); } idx = asm_fuseahuref(as, ir->op1, &ofs, allow); if (irt_isnum(ir->t)) { if (ofs == AHUREF_LSX) { emit_fab(as, PPCI_STFDX, src, (idx&255), RID_TMP); emit_slwi(as, RID_TMP, (idx>>8), 3); } else { emit_fai(as, PPCI_STFD, src, idx, ofs); } } else { if (ra_hasreg(src)) emit_tai(as, PPCI_STW, src, idx, ofs+4); if (ofs == AHUREF_LSX) { emit_tab(as, PPCI_STWX, type, (idx&255), RID_TMP); emit_slwi(as, RID_TMP, (idx>>8), 3); } else { emit_tai(as, PPCI_STW, type, idx, ofs); } } } static void asm_sload(ASMState *as, IRIns *ir) { int32_t ofs = 8*((int32_t)ir->op1-1) + ((ir->op2 & IRSLOAD_FRAME) ? 0 : 4); IRType1 t = ir->t; Reg dest = RID_NONE, type = RID_NONE, base; RegSet allow = RSET_GPR; lua_assert(!(ir->op2 & IRSLOAD_PARENT)); /* Handled by asm_head_side(). */ lua_assert(irt_isguard(t) || !(ir->op2 & IRSLOAD_TYPECHECK)); lua_assert(LJ_DUALNUM || !irt_isint(t) || (ir->op2 & (IRSLOAD_CONVERT|IRSLOAD_FRAME))); if ((ir->op2 & IRSLOAD_CONVERT) && irt_isguard(t) && irt_isint(t)) { dest = ra_scratch(as, RSET_FPR); asm_tointg(as, ir, dest); t.irt = IRT_NUM; /* Continue with a regular number type check. */ } else if (ra_used(ir)) { lua_assert(irt_isnum(t) || irt_isint(t) || irt_isaddr(t)); dest = ra_dest(as, ir, irt_isnum(t) ? RSET_FPR : RSET_GPR); rset_clear(allow, dest); base = ra_alloc1(as, REF_BASE, allow); rset_clear(allow, base); if ((ir->op2 & IRSLOAD_CONVERT)) { if (irt_isint(t)) { emit_tai(as, PPCI_LWZ, dest, RID_SP, SPOFS_TMPLO); dest = ra_scratch(as, RSET_FPR); emit_fai(as, PPCI_STFD, dest, RID_SP, SPOFS_TMP); emit_fb(as, PPCI_FCTIWZ, dest, dest); t.irt = IRT_NUM; /* Check for original type. */ } else { Reg tmp = ra_scratch(as, allow); Reg hibias = ra_allock(as, 0x43300000, rset_clear(allow, tmp)); Reg fbias = ra_scratch(as, rset_exclude(RSET_FPR, dest)); emit_fab(as, PPCI_FSUB, dest, dest, fbias); emit_fai(as, PPCI_LFD, dest, RID_SP, SPOFS_TMP); emit_lsptr(as, PPCI_LFS, (fbias & 31), (void *)lj_ir_k64_find(as->J, U64x(59800004,59800000)), rset_clear(allow, hibias)); emit_tai(as, PPCI_STW, tmp, RID_SP, SPOFS_TMPLO); emit_tai(as, PPCI_STW, hibias, RID_SP, SPOFS_TMPHI); emit_asi(as, PPCI_XORIS, tmp, tmp, 0x8000); dest = tmp; t.irt = IRT_INT; /* Check for original type. */ } } goto dotypecheck; } base = ra_alloc1(as, REF_BASE, allow); rset_clear(allow, base); dotypecheck: if (irt_isnum(t)) { if ((ir->op2 & IRSLOAD_TYPECHECK)) { Reg tisnum = ra_allock(as, (int32_t)LJ_TISNUM, allow); asm_guardcc(as, CC_GE); emit_ab(as, PPCI_CMPLW, RID_TMP, tisnum); type = RID_TMP; } if (ra_hasreg(dest)) emit_fai(as, PPCI_LFD, dest, base, ofs-4); } else { if ((ir->op2 & IRSLOAD_TYPECHECK)) { asm_guardcc(as, CC_NE); emit_ai(as, PPCI_CMPWI, RID_TMP, irt_toitype(t)); type = RID_TMP; } if (ra_hasreg(dest)) emit_tai(as, PPCI_LWZ, dest, base, ofs); } if (ra_hasreg(type)) emit_tai(as, PPCI_LWZ, type, base, ofs-4); } /* -- Allocations --------------------------------------------------------- */ #if LJ_HASFFI static void asm_cnew(ASMState *as, IRIns *ir) { CTState *cts = ctype_ctsG(J2G(as->J)); CTypeID ctypeid = (CTypeID)IR(ir->op1)->i; CTSize sz = (ir->o == IR_CNEWI || ir->op2 == REF_NIL) ? lj_ctype_size(cts, ctypeid) : (CTSize)IR(ir->op2)->i; const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_mem_newgco]; IRRef args[2]; RegSet allow = (RSET_GPR & ~RSET_SCRATCH); RegSet drop = RSET_SCRATCH; lua_assert(sz != CTSIZE_INVALID); args[0] = ASMREF_L; /* lua_State *L */ args[1] = ASMREF_TMP1; /* MSize size */ as->gcsteps++; if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ ra_evictset(as, drop); if (ra_used(ir)) ra_destreg(as, ir, RID_RET); /* GCcdata * */ /* Initialize immutable cdata object. */ if (ir->o == IR_CNEWI) { int32_t ofs = sizeof(GCcdata); lua_assert(sz == 4 || sz == 8); if (sz == 8) { ofs += 4; lua_assert((ir+1)->o == IR_HIOP); } for (;;) { Reg r = ra_alloc1(as, ir->op2, allow); emit_tai(as, PPCI_STW, r, RID_RET, ofs); rset_clear(allow, r); if (ofs == sizeof(GCcdata)) break; ofs -= 4; ir++; } } /* Initialize gct and ctypeid. lj_mem_newgco() already sets marked. */ emit_tai(as, PPCI_STB, RID_RET+1, RID_RET, offsetof(GCcdata, gct)); emit_tai(as, PPCI_STH, RID_TMP, RID_RET, offsetof(GCcdata, ctypeid)); emit_ti(as, PPCI_LI, RID_RET+1, ~LJ_TCDATA); emit_ti(as, PPCI_LI, RID_TMP, ctypeid); /* Lower 16 bit used. Sign-ext ok. */ asm_gencall(as, ci, args); ra_allockreg(as, (int32_t)(sz+sizeof(GCcdata)), ra_releasetmp(as, ASMREF_TMP1)); } #else #define asm_cnew(as, ir) ((void)0) #endif /* -- Write barriers ------------------------------------------------------ */ static void asm_tbar(ASMState *as, IRIns *ir) { Reg tab = ra_alloc1(as, ir->op1, RSET_GPR); Reg mark = ra_scratch(as, rset_exclude(RSET_GPR, tab)); Reg link = RID_TMP; MCLabel l_end = emit_label(as); emit_tai(as, PPCI_STW, link, tab, (int32_t)offsetof(GCtab, gclist)); emit_tai(as, PPCI_STB, mark, tab, (int32_t)offsetof(GCtab, marked)); emit_setgl(as, tab, gc.grayagain); lua_assert(LJ_GC_BLACK == 0x04); emit_rot(as, PPCI_RLWINM, mark, mark, 0, 30, 28); /* Clear black bit. */ emit_getgl(as, link, gc.grayagain); emit_condbranch(as, PPCI_BC|PPCF_Y, CC_EQ, l_end); emit_asi(as, PPCI_ANDIDOT, RID_TMP, mark, LJ_GC_BLACK); emit_tai(as, PPCI_LBZ, mark, tab, (int32_t)offsetof(GCtab, marked)); } static void asm_obar(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_barrieruv]; IRRef args[2]; MCLabel l_end; Reg obj, val, tmp; /* No need for other object barriers (yet). */ lua_assert(IR(ir->op1)->o == IR_UREFC); ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ir->op1; /* TValue *tv */ asm_gencall(as, ci, args); emit_tai(as, PPCI_ADDI, ra_releasetmp(as, ASMREF_TMP1), RID_JGL, -32768); obj = IR(ir->op1)->r; tmp = ra_scratch(as, rset_exclude(RSET_GPR, obj)); emit_condbranch(as, PPCI_BC|PPCF_Y, CC_EQ, l_end); emit_asi(as, PPCI_ANDIDOT, tmp, tmp, LJ_GC_BLACK); emit_condbranch(as, PPCI_BC, CC_EQ, l_end); emit_asi(as, PPCI_ANDIDOT, RID_TMP, RID_TMP, LJ_GC_WHITES); val = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, obj)); emit_tai(as, PPCI_LBZ, tmp, obj, (int32_t)offsetof(GCupval, marked)-(int32_t)offsetof(GCupval, tv)); emit_tai(as, PPCI_LBZ, RID_TMP, val, (int32_t)offsetof(GChead, marked)); } /* -- Arithmetic and logic operations ------------------------------------- */ static void asm_fparith(ASMState *as, IRIns *ir, PPCIns pi) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = (left >> 8); left &= 255; if (pi == PPCI_FMUL) emit_fac(as, pi, dest, left, right); else emit_fab(as, pi, dest, left, right); } static void asm_fpunary(ASMState *as, IRIns *ir, PPCIns pi) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg left = ra_hintalloc(as, ir->op1, dest, RSET_FPR); emit_fb(as, pi, dest, left); } static int asm_fpjoin_pow(ASMState *as, IRIns *ir) { IRIns *irp = IR(ir->op1); if (irp == ir-1 && irp->o == IR_MUL && !ra_used(irp)) { IRIns *irpp = IR(irp->op1); if (irpp == ir-2 && irpp->o == IR_FPMATH && irpp->op2 == IRFPM_LOG2 && !ra_used(irpp)) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_pow]; IRRef args[2]; args[0] = irpp->op1; args[1] = irp->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); return 1; } } return 0; } static void asm_add(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { if (!asm_fusemadd(as, ir, PPCI_FMADD, PPCI_FMADD)) asm_fparith(as, ir, PPCI_FADD); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); PPCIns pi; if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (checki16(k)) { pi = PPCI_ADDI; /* May fail due to spills/restores above, but simplifies the logic. */ if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; pi = PPCI_ADDICDOT; } emit_tai(as, pi, dest, left, k); return; } else if ((k & 0xffff) == 0) { emit_tai(as, PPCI_ADDIS, dest, left, (k >> 16)); return; } else if (!as->sectref) { emit_tai(as, PPCI_ADDIS, dest, dest, (k + 32768) >> 16); emit_tai(as, PPCI_ADDI, dest, left, k); return; } } pi = PPCI_ADD; /* May fail due to spills/restores above, but simplifies the logic. */ if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; pi |= PPCF_DOT; } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_tab(as, pi, dest, left, right); } } static void asm_sub(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { if (!asm_fusemadd(as, ir, PPCI_FMSUB, PPCI_FNMSUB)) asm_fparith(as, ir, PPCI_FSUB); } else { PPCIns pi = PPCI_SUBF; Reg dest = ra_dest(as, ir, RSET_GPR); Reg left, right; if (irref_isk(ir->op1)) { int32_t k = IR(ir->op1)->i; if (checki16(k)) { right = ra_alloc1(as, ir->op2, RSET_GPR); emit_tai(as, PPCI_SUBFIC, dest, right, k); return; } } /* May fail due to spills/restores above, but simplifies the logic. */ if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; pi |= PPCF_DOT; } left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_tab(as, pi, dest, right, left); /* Subtract right _from_ left. */ } } static void asm_mul(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { asm_fparith(as, ir, PPCI_FMUL); } else { PPCIns pi = PPCI_MULLW; Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (checki16(k)) { emit_tai(as, PPCI_MULLI, dest, left, k); return; } } /* May fail due to spills/restores above, but simplifies the logic. */ if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; pi |= PPCF_DOT; } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_tab(as, pi, dest, left, right); } } static void asm_neg(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { asm_fpunary(as, ir, PPCI_FNEG); } else { Reg dest, left; PPCIns pi = PPCI_NEG; if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; pi |= PPCF_DOT; } dest = ra_dest(as, ir, RSET_GPR); left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); emit_tab(as, pi, dest, left, 0); } } static void asm_arithov(ASMState *as, IRIns *ir, PPCIns pi) { Reg dest, left, right; if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; } asm_guardcc(as, CC_SO); dest = ra_dest(as, ir, RSET_GPR); left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; if (pi == PPCI_SUBFO) { Reg tmp = left; left = right; right = tmp; } emit_tab(as, pi|PPCF_DOT, dest, left, right); } #if LJ_HASFFI static void asm_add64(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_alloc1(as, ir->op1, RSET_GPR); PPCIns pi = PPCI_ADDE; if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (k == 0) pi = PPCI_ADDZE; else if (k == -1) pi = PPCI_ADDME; else goto needright; right = 0; } else { needright: right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); } emit_tab(as, pi, dest, left, right); ir--; dest = ra_dest(as, ir, RSET_GPR); left = ra_alloc1(as, ir->op1, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (checki16(k)) { emit_tai(as, PPCI_ADDIC, dest, left, k); return; } } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_tab(as, PPCI_ADDC, dest, left, right); } static void asm_sub64(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left, right = ra_alloc1(as, ir->op2, RSET_GPR); PPCIns pi = PPCI_SUBFE; if (irref_isk(ir->op1)) { int32_t k = IR(ir->op1)->i; if (k == 0) pi = PPCI_SUBFZE; else if (k == -1) pi = PPCI_SUBFME; else goto needleft; left = 0; } else { needleft: left = ra_alloc1(as, ir->op1, rset_exclude(RSET_GPR, right)); } emit_tab(as, pi, dest, right, left); /* Subtract right _from_ left. */ ir--; dest = ra_dest(as, ir, RSET_GPR); right = ra_alloc1(as, ir->op2, RSET_GPR); if (irref_isk(ir->op1)) { int32_t k = IR(ir->op1)->i; if (checki16(k)) { emit_tai(as, PPCI_SUBFIC, dest, right, k); return; } } left = ra_alloc1(as, ir->op1, rset_exclude(RSET_GPR, right)); emit_tab(as, PPCI_SUBFC, dest, right, left); } static void asm_neg64(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, RSET_GPR); emit_tab(as, PPCI_SUBFZE, dest, left, 0); ir--; dest = ra_dest(as, ir, RSET_GPR); left = ra_alloc1(as, ir->op1, RSET_GPR); emit_tai(as, PPCI_SUBFIC, dest, left, 0); } #endif static void asm_bitnot(ASMState *as, IRIns *ir) { Reg dest, left, right; PPCIns pi = PPCI_NOR; if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; pi |= PPCF_DOT; } dest = ra_dest(as, ir, RSET_GPR); if (mayfuse(as, ir->op1)) { IRIns *irl = IR(ir->op1); if (irl->o == IR_BAND) pi ^= (PPCI_NOR ^ PPCI_NAND); else if (irl->o == IR_BXOR) pi ^= (PPCI_NOR ^ PPCI_EQV); else if (irl->o != IR_BOR) goto nofuse; left = ra_hintalloc(as, irl->op1, dest, RSET_GPR); right = ra_alloc1(as, irl->op2, rset_exclude(RSET_GPR, left)); } else { nofuse: left = right = ra_hintalloc(as, ir->op1, dest, RSET_GPR); } emit_asb(as, pi, dest, left, right); } static void asm_bitswap(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); IRIns *irx; if (mayfuse(as, ir->op1) && (irx = IR(ir->op1))->o == IR_XLOAD && ra_noreg(irx->r) && (irt_isint(irx->t) || irt_isu32(irx->t))) { /* Fuse BSWAP with XLOAD to lwbrx. */ asm_fusexrefx(as, PPCI_LWBRX, dest, irx->op1, RSET_GPR); } else { Reg left = ra_alloc1(as, ir->op1, RSET_GPR); Reg tmp = dest; if (tmp == left) { tmp = RID_TMP; emit_mr(as, dest, RID_TMP); } emit_rot(as, PPCI_RLWIMI, tmp, left, 24, 16, 23); emit_rot(as, PPCI_RLWIMI, tmp, left, 24, 0, 7); emit_rotlwi(as, tmp, left, 8); } } static void asm_bitop(ASMState *as, IRIns *ir, PPCIns pi, PPCIns pik) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; Reg tmp = left; if ((checku16(k) || (k & 0xffff) == 0) || (tmp = dest, !as->sectref)) { if (!checku16(k)) { emit_asi(as, pik ^ (PPCI_ORI ^ PPCI_ORIS), dest, tmp, (k >> 16)); if ((k & 0xffff) == 0) return; } emit_asi(as, pik, dest, left, k); return; } } /* May fail due to spills/restores above, but simplifies the logic. */ if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; pi |= PPCF_DOT; } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_asb(as, pi, dest, left, right); } /* Fuse BAND with contiguous bitmask and a shift to rlwinm. */ static void asm_fuseandsh(ASMState *as, PPCIns pi, int32_t mask, IRRef ref) { IRIns *ir; Reg left; if (mayfuse(as, ref) && (ir = IR(ref), ra_noreg(ir->r)) && irref_isk(ir->op2) && ir->o >= IR_BSHL && ir->o <= IR_BROR) { int32_t sh = (IR(ir->op2)->i & 31); switch (ir->o) { case IR_BSHL: if ((mask & ((1u<>sh))) goto nofuse; sh = ((32-sh)&31); break; case IR_BROL: break; default: goto nofuse; } left = ra_alloc1(as, ir->op1, RSET_GPR); *--as->mcp = pi | PPCF_T(left) | PPCF_B(sh); return; } nofuse: left = ra_alloc1(as, ref, RSET_GPR); *--as->mcp = pi | PPCF_T(left); } static void asm_bitand(ASMState *as, IRIns *ir) { Reg dest, left, right; IRRef lref = ir->op1; PPCIns dot = 0; IRRef op2; if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; dot = PPCF_DOT; } dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (k) { /* First check for a contiguous bitmask as used by rlwinm. */ uint32_t s1 = lj_ffs((uint32_t)k); uint32_t k1 = ((uint32_t)k >> s1); if ((k1 & (k1+1)) == 0) { asm_fuseandsh(as, PPCI_RLWINM|dot | PPCF_A(dest) | PPCF_MB(31-lj_fls((uint32_t)k)) | PPCF_ME(31-s1), k, lref); return; } if (~(uint32_t)k) { uint32_t s2 = lj_ffs(~(uint32_t)k); uint32_t k2 = (~(uint32_t)k >> s2); if ((k2 & (k2+1)) == 0) { asm_fuseandsh(as, PPCI_RLWINM|dot | PPCF_A(dest) | PPCF_MB(32-s2) | PPCF_ME(30-lj_fls(~(uint32_t)k)), k, lref); return; } } } if (checku16(k)) { left = ra_alloc1(as, lref, RSET_GPR); emit_asi(as, PPCI_ANDIDOT, dest, left, k); return; } else if ((k & 0xffff) == 0) { left = ra_alloc1(as, lref, RSET_GPR); emit_asi(as, PPCI_ANDISDOT, dest, left, (k >> 16)); return; } } op2 = ir->op2; if (mayfuse(as, op2) && IR(op2)->o == IR_BNOT && ra_noreg(IR(op2)->r)) { dot ^= (PPCI_AND ^ PPCI_ANDC); op2 = IR(op2)->op1; } left = ra_hintalloc(as, lref, dest, RSET_GPR); right = ra_alloc1(as, op2, rset_exclude(RSET_GPR, left)); emit_asb(as, PPCI_AND ^ dot, dest, left, right); } static void asm_bitshift(ASMState *as, IRIns *ir, PPCIns pi, PPCIns pik) { Reg dest, left; Reg dot = 0; if (as->flagmcp == as->mcp) { as->flagmcp = NULL; as->mcp++; dot = PPCF_DOT; } dest = ra_dest(as, ir, RSET_GPR); left = ra_alloc1(as, ir->op1, RSET_GPR); if (irref_isk(ir->op2)) { /* Constant shifts. */ int32_t shift = (IR(ir->op2)->i & 31); if (pik == 0) /* SLWI */ emit_rot(as, PPCI_RLWINM|dot, dest, left, shift, 0, 31-shift); else if (pik == 1) /* SRWI */ emit_rot(as, PPCI_RLWINM|dot, dest, left, (32-shift)&31, shift, 31); else emit_asb(as, pik|dot, dest, left, shift); } else { Reg right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_asb(as, pi|dot, dest, left, right); } } static void asm_min_max(ASMState *as, IRIns *ir, int ismax) { if (irt_isnum(ir->t)) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg tmp = dest; Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = (left >> 8); left &= 255; if (tmp == left || tmp == right) tmp = ra_scratch(as, rset_exclude(rset_exclude(rset_exclude(RSET_FPR, dest), left), right)); emit_facb(as, PPCI_FSEL, dest, tmp, ismax ? left : right, ismax ? right : left); emit_fab(as, PPCI_FSUB, tmp, left, right); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg tmp1 = RID_TMP, tmp2 = dest; Reg right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; if (tmp2 == left || tmp2 == right) tmp2 = ra_scratch(as, rset_exclude(rset_exclude(rset_exclude(RSET_GPR, dest), left), right)); emit_tab(as, PPCI_ADD, dest, tmp2, right); emit_asb(as, ismax ? PPCI_ANDC : PPCI_AND, tmp2, tmp2, tmp1); emit_tab(as, PPCI_SUBFE, tmp1, tmp1, tmp1); emit_tab(as, PPCI_SUBFC, tmp2, tmp2, tmp1); emit_asi(as, PPCI_XORIS, tmp2, right, 0x8000); emit_asi(as, PPCI_XORIS, tmp1, left, 0x8000); } } /* -- Comparisons --------------------------------------------------------- */ #define CC_UNSIGNED 0x08 /* Unsigned integer comparison. */ #define CC_TWO 0x80 /* Check two flags for FP comparison. */ /* Map of comparisons to flags. ORDER IR. */ static const uint8_t asm_compmap[IR_ABC+1] = { /* op int cc FP cc */ /* LT */ CC_GE + (CC_GE<<4), /* GE */ CC_LT + (CC_LE<<4) + CC_TWO, /* LE */ CC_GT + (CC_GE<<4) + CC_TWO, /* GT */ CC_LE + (CC_LE<<4), /* ULT */ CC_GE + CC_UNSIGNED + (CC_GT<<4) + CC_TWO, /* UGE */ CC_LT + CC_UNSIGNED + (CC_LT<<4), /* ULE */ CC_GT + CC_UNSIGNED + (CC_GT<<4), /* UGT */ CC_LE + CC_UNSIGNED + (CC_LT<<4) + CC_TWO, /* EQ */ CC_NE + (CC_NE<<4), /* NE */ CC_EQ + (CC_EQ<<4), /* ABC */ CC_LE + CC_UNSIGNED + (CC_LT<<4) + CC_TWO /* Same as UGT. */ }; static void asm_intcomp_(ASMState *as, IRRef lref, IRRef rref, Reg cr, PPCCC cc) { Reg right, left = ra_alloc1(as, lref, RSET_GPR); if (irref_isk(rref)) { int32_t k = IR(rref)->i; if ((cc & CC_UNSIGNED) == 0) { /* Signed comparison with constant. */ if (checki16(k)) { emit_tai(as, PPCI_CMPWI, cr, left, k); /* Signed comparison with zero and referencing previous ins? */ if (k == 0 && lref == as->curins-1) as->flagmcp = as->mcp; /* Allow elimination of the compare. */ return; } else if ((cc & 3) == (CC_EQ & 3)) { /* Use CMPLWI for EQ or NE. */ if (checku16(k)) { emit_tai(as, PPCI_CMPLWI, cr, left, k); return; } else if (!as->sectref && ra_noreg(IR(rref)->r)) { emit_tai(as, PPCI_CMPLWI, cr, RID_TMP, k); emit_asi(as, PPCI_XORIS, RID_TMP, left, (k >> 16)); return; } } } else { /* Unsigned comparison with constant. */ if (checku16(k)) { emit_tai(as, PPCI_CMPLWI, cr, left, k); return; } } } right = ra_alloc1(as, rref, rset_exclude(RSET_GPR, left)); emit_tab(as, (cc & CC_UNSIGNED) ? PPCI_CMPLW : PPCI_CMPW, cr, left, right); } static void asm_comp(ASMState *as, IRIns *ir) { PPCCC cc = asm_compmap[ir->o]; if (irt_isnum(ir->t)) { Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = (left >> 8); left &= 255; asm_guardcc(as, (cc >> 4)); if ((cc & CC_TWO)) emit_tab(as, PPCI_CROR, ((cc>>4)&3), ((cc>>4)&3), (CC_EQ&3)); emit_fab(as, PPCI_FCMPU, 0, left, right); } else { IRRef lref = ir->op1, rref = ir->op2; if (irref_isk(lref) && !irref_isk(rref)) { /* Swap constants to the right (only for ABC). */ IRRef tmp = lref; lref = rref; rref = tmp; if ((cc & 2) == 0) cc ^= 1; /* LT <-> GT, LE <-> GE */ } asm_guardcc(as, cc); asm_intcomp_(as, lref, rref, 0, cc); } } #if LJ_HASFFI /* 64 bit integer comparisons. */ static void asm_comp64(ASMState *as, IRIns *ir) { PPCCC cc = asm_compmap[(ir-1)->o]; if ((cc&3) == (CC_EQ&3)) { asm_guardcc(as, cc); emit_tab(as, (cc&4) ? PPCI_CRAND : PPCI_CROR, (CC_EQ&3), (CC_EQ&3), 4+(CC_EQ&3)); } else { asm_guardcc(as, CC_EQ); emit_tab(as, PPCI_CROR, (CC_EQ&3), (CC_EQ&3), ((cc^~(cc>>2))&1)); emit_tab(as, (cc&4) ? PPCI_CRAND : PPCI_CRANDC, (CC_EQ&3), (CC_EQ&3), 4+(cc&3)); } /* Loword comparison sets cr1 and is unsigned, except for equality. */ asm_intcomp_(as, (ir-1)->op1, (ir-1)->op2, 4, cc | ((cc&3) == (CC_EQ&3) ? 0 : CC_UNSIGNED)); /* Hiword comparison sets cr0. */ asm_intcomp_(as, ir->op1, ir->op2, 0, cc); as->flagmcp = NULL; /* Doesn't work here. */ } #endif /* -- Support for 64 bit ops in 32 bit mode ------------------------------- */ /* Hiword op of a split 64 bit op. Previous op must be the loword op. */ static void asm_hiop(ASMState *as, IRIns *ir) { #if LJ_HASFFI /* HIOP is marked as a store because it needs its own DCE logic. */ int uselo = ra_used(ir-1), usehi = ra_used(ir); /* Loword/hiword used? */ if (LJ_UNLIKELY(!(as->flags & JIT_F_OPT_DCE))) uselo = usehi = 1; if ((ir-1)->o == IR_CONV) { /* Conversions to/from 64 bit. */ as->curins--; /* Always skip the CONV. */ if (usehi || uselo) asm_conv64(as, ir); return; } else if ((ir-1)->o <= IR_NE) { /* 64 bit integer comparisons. ORDER IR. */ as->curins--; /* Always skip the loword comparison. */ asm_comp64(as, ir); return; } else if ((ir-1)->o == IR_XSTORE) { as->curins--; /* Handle both stores here. */ if ((ir-1)->r != RID_SINK) { asm_xstore(as, ir, 0); asm_xstore(as, ir-1, 4); } return; } if (!usehi) return; /* Skip unused hiword op for all remaining ops. */ switch ((ir-1)->o) { case IR_ADD: as->curins--; asm_add64(as, ir); break; case IR_SUB: as->curins--; asm_sub64(as, ir); break; case IR_NEG: as->curins--; asm_neg64(as, ir); break; case IR_CALLN: case IR_CALLXS: if (!uselo) ra_allocref(as, ir->op1, RID2RSET(RID_RETLO)); /* Mark lo op as used. */ break; case IR_CNEWI: /* Nothing to do here. Handled by lo op itself. */ break; default: lua_assert(0); break; } #else UNUSED(as); UNUSED(ir); lua_assert(0); /* Unused without FFI. */ #endif } /* -- Stack handling ------------------------------------------------------ */ /* Check Lua stack size for overflow. Use exit handler as fallback. */ static void asm_stack_check(ASMState *as, BCReg topslot, IRIns *irp, RegSet allow, ExitNo exitno) { /* Try to get an unused temp. register, otherwise spill/restore RID_RET*. */ Reg tmp, pbase = irp ? (ra_hasreg(irp->r) ? irp->r : RID_TMP) : RID_BASE; rset_clear(allow, pbase); tmp = allow ? rset_pickbot(allow) : (pbase == RID_RETHI ? RID_RETLO : RID_RETHI); emit_condbranch(as, PPCI_BC, CC_LT, asm_exitstub_addr(as, exitno)); if (allow == RSET_EMPTY) /* Restore temp. register. */ emit_tai(as, PPCI_LWZ, tmp, RID_SP, SPOFS_TMPW); else ra_modified(as, tmp); emit_ai(as, PPCI_CMPLWI, RID_TMP, (int32_t)(8*topslot)); emit_tab(as, PPCI_SUBF, RID_TMP, pbase, tmp); emit_tai(as, PPCI_LWZ, tmp, tmp, offsetof(lua_State, maxstack)); if (pbase == RID_TMP) emit_getgl(as, RID_TMP, jit_base); emit_getgl(as, tmp, jit_L); if (allow == RSET_EMPTY) /* Spill temp. register. */ emit_tai(as, PPCI_STW, tmp, RID_SP, SPOFS_TMPW); } /* Restore Lua stack from on-trace state. */ static void asm_stack_restore(ASMState *as, SnapShot *snap) { SnapEntry *map = &as->T->snapmap[snap->mapofs]; SnapEntry *flinks = &as->T->snapmap[snap_nextofs(as->T, snap)-1]; MSize n, nent = snap->nent; /* Store the value of all modified slots to the Lua stack. */ for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; BCReg s = snap_slot(sn); int32_t ofs = 8*((int32_t)s-1); IRRef ref = snap_ref(sn); IRIns *ir = IR(ref); if ((sn & SNAP_NORESTORE)) continue; if (irt_isnum(ir->t)) { Reg src = ra_alloc1(as, ref, RSET_FPR); emit_fai(as, PPCI_STFD, src, RID_BASE, ofs); } else { Reg type; RegSet allow = rset_exclude(RSET_GPR, RID_BASE); lua_assert(irt_ispri(ir->t) || irt_isaddr(ir->t) || irt_isinteger(ir->t)); if (!irt_ispri(ir->t)) { Reg src = ra_alloc1(as, ref, allow); rset_clear(allow, src); emit_tai(as, PPCI_STW, src, RID_BASE, ofs+4); } if ((sn & (SNAP_CONT|SNAP_FRAME))) { if (s == 0) continue; /* Do not overwrite link to previous frame. */ type = ra_allock(as, (int32_t)(*flinks--), allow); } else { type = ra_allock(as, (int32_t)irt_toitype(ir->t), allow); } emit_tai(as, PPCI_STW, type, RID_BASE, ofs); } checkmclim(as); } lua_assert(map + nent == flinks); } /* -- GC handling --------------------------------------------------------- */ /* Check GC threshold and do one or more GC steps. */ static void asm_gc_check(ASMState *as) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_step_jit]; IRRef args[2]; MCLabel l_end; Reg tmp; ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); /* Exit trace if in GCSatomic or GCSfinalize. Avoids syncing GC objects. */ asm_guardcc(as, CC_NE); /* Assumes asm_snap_prep() already done. */ emit_ai(as, PPCI_CMPWI, RID_RET, 0); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ASMREF_TMP2; /* MSize steps */ asm_gencall(as, ci, args); emit_tai(as, PPCI_ADDI, ra_releasetmp(as, ASMREF_TMP1), RID_JGL, -32768); tmp = ra_releasetmp(as, ASMREF_TMP2); emit_loadi(as, tmp, as->gcsteps); /* Jump around GC step if GC total < GC threshold. */ emit_condbranch(as, PPCI_BC|PPCF_Y, CC_LT, l_end); emit_ab(as, PPCI_CMPLW, RID_TMP, tmp); emit_getgl(as, tmp, gc.threshold); emit_getgl(as, RID_TMP, gc.total); as->gcsteps = 0; checkmclim(as); } /* -- Loop handling ------------------------------------------------------- */ /* Fixup the loop branch. */ static void asm_loop_fixup(ASMState *as) { MCode *p = as->mctop; MCode *target = as->mcp; if (as->loopinv) { /* Inverted loop branch? */ /* asm_guardcc already inverted the cond branch and patched the final b. */ p[-2] = (p[-2] & (0xffff0000u & ~PPCF_Y)) | (((target-p+2) & 0x3fffu) << 2); } else { p[-1] = PPCI_B|(((target-p+1)&0x00ffffffu)<<2); } } /* -- Head of trace ------------------------------------------------------- */ /* Coalesce BASE register for a root trace. */ static void asm_head_root_base(ASMState *as) { IRIns *ir = IR(REF_BASE); Reg r = ir->r; if (ra_hasreg(r)) { ra_free(as, r); if (rset_test(as->modset, r) || irt_ismarked(ir->t)) ir->r = RID_INIT; /* No inheritance for modified BASE register. */ if (r != RID_BASE) emit_mr(as, r, RID_BASE); } } /* Coalesce BASE register for a side trace. */ static RegSet asm_head_side_base(ASMState *as, IRIns *irp, RegSet allow) { IRIns *ir = IR(REF_BASE); Reg r = ir->r; if (ra_hasreg(r)) { ra_free(as, r); if (rset_test(as->modset, r) || irt_ismarked(ir->t)) ir->r = RID_INIT; /* No inheritance for modified BASE register. */ if (irp->r == r) { rset_clear(allow, r); /* Mark same BASE register as coalesced. */ } else if (ra_hasreg(irp->r) && rset_test(as->freeset, irp->r)) { rset_clear(allow, irp->r); emit_mr(as, r, irp->r); /* Move from coalesced parent reg. */ } else { emit_getgl(as, r, jit_base); /* Otherwise reload BASE. */ } } return allow; } /* -- Tail of trace ------------------------------------------------------- */ /* Fixup the tail code. */ static void asm_tail_fixup(ASMState *as, TraceNo lnk) { MCode *p = as->mctop; MCode *target; int32_t spadj = as->T->spadjust; if (spadj == 0) { *--p = PPCI_NOP; *--p = PPCI_NOP; as->mctop = p; } else { /* Patch stack adjustment. */ lua_assert(checki16(CFRAME_SIZE+spadj)); p[-3] = PPCI_ADDI | PPCF_T(RID_TMP) | PPCF_A(RID_SP) | (CFRAME_SIZE+spadj); p[-2] = PPCI_STWU | PPCF_T(RID_TMP) | PPCF_A(RID_SP) | spadj; } /* Patch exit branch. */ target = lnk ? traceref(as->J, lnk)->mcode : (MCode *)lj_vm_exit_interp; p[-1] = PPCI_B|(((target-p+1)&0x00ffffffu)<<2); } /* Prepare tail of code. */ static void asm_tail_prep(ASMState *as) { MCode *p = as->mctop - 1; /* Leave room for exit branch. */ if (as->loopref) { as->invmcp = as->mcp = p; } else { as->mcp = p-2; /* Leave room for stack pointer adjustment. */ as->invmcp = NULL; } } /* -- Instruction dispatch ------------------------------------------------ */ /* Assemble a single instruction. */ static void asm_ir(ASMState *as, IRIns *ir) { switch ((IROp)ir->o) { /* Miscellaneous ops. */ case IR_LOOP: asm_loop(as); break; case IR_NOP: case IR_XBAR: lua_assert(!ra_used(ir)); break; case IR_USE: ra_alloc1(as, ir->op1, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); break; case IR_PHI: asm_phi(as, ir); break; case IR_HIOP: asm_hiop(as, ir); break; case IR_GCSTEP: asm_gcstep(as, ir); break; /* Guarded assertions. */ case IR_EQ: case IR_NE: if ((ir-1)->o == IR_HREF && ir->op1 == as->curins-1) { as->curins--; asm_href(as, ir-1, (IROp)ir->o); break; } /* fallthrough */ case IR_LT: case IR_GE: case IR_LE: case IR_GT: case IR_ULT: case IR_UGE: case IR_ULE: case IR_UGT: case IR_ABC: asm_comp(as, ir); break; case IR_RETF: asm_retf(as, ir); break; /* Bit ops. */ case IR_BNOT: asm_bitnot(as, ir); break; case IR_BSWAP: asm_bitswap(as, ir); break; case IR_BAND: asm_bitand(as, ir); break; case IR_BOR: asm_bitop(as, ir, PPCI_OR, PPCI_ORI); break; case IR_BXOR: asm_bitop(as, ir, PPCI_XOR, PPCI_XORI); break; case IR_BSHL: asm_bitshift(as, ir, PPCI_SLW, 0); break; case IR_BSHR: asm_bitshift(as, ir, PPCI_SRW, 1); break; case IR_BSAR: asm_bitshift(as, ir, PPCI_SRAW, PPCI_SRAWI); break; case IR_BROL: asm_bitshift(as, ir, PPCI_RLWNM|PPCF_MB(0)|PPCF_ME(31), PPCI_RLWINM|PPCF_MB(0)|PPCF_ME(31)); break; case IR_BROR: lua_assert(0); break; /* Arithmetic ops. */ case IR_ADD: asm_add(as, ir); break; case IR_SUB: asm_sub(as, ir); break; case IR_MUL: asm_mul(as, ir); break; case IR_DIV: asm_fparith(as, ir, PPCI_FDIV); break; case IR_MOD: asm_callid(as, ir, IRCALL_lj_vm_modi); break; case IR_POW: asm_callid(as, ir, IRCALL_lj_vm_powi); break; case IR_NEG: asm_neg(as, ir); break; case IR_ABS: asm_fpunary(as, ir, PPCI_FABS); break; case IR_ATAN2: asm_callid(as, ir, IRCALL_atan2); break; case IR_LDEXP: asm_callid(as, ir, IRCALL_ldexp); break; case IR_MIN: asm_min_max(as, ir, 0); break; case IR_MAX: asm_min_max(as, ir, 1); break; case IR_FPMATH: if (ir->op2 == IRFPM_EXP2 && asm_fpjoin_pow(as, ir)) break; if (ir->op2 == IRFPM_SQRT && (as->flags & JIT_F_SQRT)) asm_fpunary(as, ir, PPCI_FSQRT); else asm_callid(as, ir, IRCALL_lj_vm_floor + ir->op2); break; /* Overflow-checking arithmetic ops. */ case IR_ADDOV: asm_arithov(as, ir, PPCI_ADDO); break; case IR_SUBOV: asm_arithov(as, ir, PPCI_SUBFO); break; case IR_MULOV: asm_arithov(as, ir, PPCI_MULLWO); break; /* Memory references. */ case IR_AREF: asm_aref(as, ir); break; case IR_HREF: asm_href(as, ir, 0); break; case IR_HREFK: asm_hrefk(as, ir); break; case IR_NEWREF: asm_newref(as, ir); break; case IR_UREFO: case IR_UREFC: asm_uref(as, ir); break; case IR_FREF: asm_fref(as, ir); break; case IR_STRREF: asm_strref(as, ir); break; /* Loads and stores. */ case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: asm_ahuvload(as, ir); break; case IR_FLOAD: asm_fload(as, ir); break; case IR_XLOAD: asm_xload(as, ir); break; case IR_SLOAD: asm_sload(as, ir); break; case IR_ASTORE: case IR_HSTORE: case IR_USTORE: asm_ahustore(as, ir); break; case IR_FSTORE: asm_fstore(as, ir); break; case IR_XSTORE: asm_xstore(as, ir, 0); break; /* Allocations. */ case IR_SNEW: case IR_XSNEW: asm_snew(as, ir); break; case IR_TNEW: asm_tnew(as, ir); break; case IR_TDUP: asm_tdup(as, ir); break; case IR_CNEW: case IR_CNEWI: asm_cnew(as, ir); break; /* Write barriers. */ case IR_TBAR: asm_tbar(as, ir); break; case IR_OBAR: asm_obar(as, ir); break; /* Type conversions. */ case IR_CONV: asm_conv(as, ir); break; case IR_TOBIT: asm_tobit(as, ir); break; case IR_TOSTR: asm_tostr(as, ir); break; case IR_STRTO: asm_strto(as, ir); break; /* Calls. */ case IR_CALLN: case IR_CALLL: case IR_CALLS: asm_call(as, ir); break; case IR_CALLXS: asm_callx(as, ir); break; case IR_CARG: break; default: setintV(&as->J->errinfo, ir->o); lj_trace_err_info(as->J, LJ_TRERR_NYIIR); break; } } /* -- Trace setup --------------------------------------------------------- */ /* Ensure there are enough stack slots for call arguments. */ static Reg asm_setup_call_slots(ASMState *as, IRIns *ir, const CCallInfo *ci) { IRRef args[CCI_NARGS_MAX*2]; uint32_t i, nargs = (int)CCI_NARGS(ci); int nslots = 2, ngpr = REGARG_NUMGPR, nfpr = REGARG_NUMFPR; asm_collectargs(as, ir, ci, args); for (i = 0; i < nargs; i++) if (args[i] && irt_isfp(IR(args[i])->t)) { if (nfpr > 0) nfpr--; else nslots = (nslots+3) & ~1; } else { if (ngpr > 0) ngpr--; else nslots++; } if (nslots > as->evenspill) /* Leave room for args in stack slots. */ as->evenspill = nslots; return irt_isfp(ir->t) ? REGSP_HINT(RID_FPRET) : REGSP_HINT(RID_RET); } static void asm_setup_target(ASMState *as) { asm_exitstub_setup(as, as->T->nsnap + (as->parent ? 1 : 0)); } /* -- Trace patching ------------------------------------------------------ */ /* Patch exit jumps of existing machine code to a new target. */ void lj_asm_patchexit(jit_State *J, GCtrace *T, ExitNo exitno, MCode *target) { MCode *p = T->mcode; MCode *pe = (MCode *)((char *)p + T->szmcode); MCode *px = exitstub_trace_addr(T, exitno); MCode *cstart = NULL; MCode *mcarea = lj_mcode_patch(J, p, 0); int clearso = 0; for (; p < pe; p++) { /* Look for exitstub branch, try to replace with branch to target. */ uint32_t ins = *p; if ((ins & 0xfc000000u) == 0x40000000u && ((ins ^ ((char *)px-(char *)p)) & 0xffffu) == 0) { ptrdiff_t delta = (char *)target - (char *)p; if (((ins >> 16) & 3) == (CC_SO&3)) { clearso = sizeof(MCode); delta -= sizeof(MCode); } /* Many, but not all short-range branches can be patched directly. */ if (((delta + 0x8000) >> 16) == 0) { *p = (ins & 0xffdf0000u) | ((uint32_t)delta & 0xffffu) | ((delta & 0x8000) * (PPCF_Y/0x8000)); if (!cstart) cstart = p; } } else if ((ins & 0xfc000000u) == PPCI_B && ((ins ^ ((char *)px-(char *)p)) & 0x03ffffffu) == 0) { ptrdiff_t delta = (char *)target - (char *)p; lua_assert(((delta + 0x02000000) >> 26) == 0); *p = PPCI_B | ((uint32_t)delta & 0x03ffffffu); if (!cstart) cstart = p; } } { /* Always patch long-range branch in exit stub itself. */ ptrdiff_t delta = (char *)target - (char *)px - clearso; lua_assert(((delta + 0x02000000) >> 26) == 0); *px = PPCI_B | ((uint32_t)delta & 0x03ffffffu); } if (!cstart) cstart = px; lj_mcode_sync(cstart, px+1); if (clearso) { /* Extend the current trace. Ugly workaround. */ MCode *pp = J->cur.mcode; J->cur.szmcode += sizeof(MCode); *--pp = PPCI_MCRXR; /* Clear SO flag. */ J->cur.mcode = pp; lj_mcode_sync(pp, pp+1); } lj_mcode_patch(J, mcarea, 1); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_emit_mips.h0000644000175000017500000001370713122010155017525 0ustar philphil/* ** MIPS instruction emitter. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Emit basic instructions --------------------------------------------- */ static void emit_dst(ASMState *as, MIPSIns mi, Reg rd, Reg rs, Reg rt) { *--as->mcp = mi | MIPSF_D(rd) | MIPSF_S(rs) | MIPSF_T(rt); } static void emit_dta(ASMState *as, MIPSIns mi, Reg rd, Reg rt, uint32_t a) { *--as->mcp = mi | MIPSF_D(rd) | MIPSF_T(rt) | MIPSF_A(a); } #define emit_ds(as, mi, rd, rs) emit_dst(as, (mi), (rd), (rs), 0) #define emit_tg(as, mi, rt, rg) emit_dst(as, (mi), (rg)&31, 0, (rt)) static void emit_tsi(ASMState *as, MIPSIns mi, Reg rt, Reg rs, int32_t i) { *--as->mcp = mi | MIPSF_T(rt) | MIPSF_S(rs) | (i & 0xffff); } #define emit_ti(as, mi, rt, i) emit_tsi(as, (mi), (rt), 0, (i)) #define emit_hsi(as, mi, rh, rs, i) emit_tsi(as, (mi), (rh) & 31, (rs), (i)) static void emit_fgh(ASMState *as, MIPSIns mi, Reg rf, Reg rg, Reg rh) { *--as->mcp = mi | MIPSF_F(rf&31) | MIPSF_G(rg&31) | MIPSF_H(rh&31); } #define emit_fg(as, mi, rf, rg) emit_fgh(as, (mi), (rf), (rg), 0) static void emit_rotr(ASMState *as, Reg dest, Reg src, Reg tmp, uint32_t shift) { if ((as->flags & JIT_F_MIPS32R2)) { emit_dta(as, MIPSI_ROTR, dest, src, shift); } else { emit_dst(as, MIPSI_OR, dest, dest, tmp); emit_dta(as, MIPSI_SLL, dest, src, (-shift)&31); emit_dta(as, MIPSI_SRL, tmp, src, shift); } } /* -- Emit loads/stores --------------------------------------------------- */ /* Prefer rematerialization of BASE/L from global_State over spills. */ #define emit_canremat(ref) ((ref) <= REF_BASE) /* Try to find a one step delta relative to another constant. */ static int emit_kdelta1(ASMState *as, Reg t, int32_t i) { RegSet work = ~as->freeset & RSET_GPR; while (work) { Reg r = rset_picktop(work); IRRef ref = regcost_ref(as->cost[r]); lua_assert(r != t); if (ref < ASMREF_L) { int32_t delta = i - (ra_iskref(ref) ? ra_krefk(as, ref) : IR(ref)->i); if (checki16(delta)) { emit_tsi(as, MIPSI_ADDIU, t, r, delta); return 1; } } rset_clear(work, r); } return 0; /* Failed. */ } /* Load a 32 bit constant into a GPR. */ static void emit_loadi(ASMState *as, Reg r, int32_t i) { if (checki16(i)) { emit_ti(as, MIPSI_LI, r, i); } else { if ((i & 0xffff)) { int32_t jgl = i32ptr(J2G(as->J)); if ((uint32_t)(i-jgl) < 65536) { emit_tsi(as, MIPSI_ADDIU, r, RID_JGL, i-jgl-32768); return; } else if (emit_kdelta1(as, r, i)) { return; } else if ((i >> 16) == 0) { emit_tsi(as, MIPSI_ORI, r, RID_ZERO, i); return; } emit_tsi(as, MIPSI_ORI, r, r, i); } emit_ti(as, MIPSI_LUI, r, (i >> 16)); } } #define emit_loada(as, r, addr) emit_loadi(as, (r), i32ptr((addr))) static Reg ra_allock(ASMState *as, int32_t k, RegSet allow); static void ra_allockreg(ASMState *as, int32_t k, Reg r); /* Get/set from constant pointer. */ static void emit_lsptr(ASMState *as, MIPSIns mi, Reg r, void *p, RegSet allow) { int32_t jgl = i32ptr(J2G(as->J)); int32_t i = i32ptr(p); Reg base; if ((uint32_t)(i-jgl) < 65536) { i = i-jgl-32768; base = RID_JGL; } else { base = ra_allock(as, i-(int16_t)i, allow); } emit_tsi(as, mi, r, base, i); } #define emit_loadn(as, r, tv) \ emit_lsptr(as, MIPSI_LDC1, ((r) & 31), (void *)(tv), RSET_GPR) /* Get/set global_State fields. */ static void emit_lsglptr(ASMState *as, MIPSIns mi, Reg r, int32_t ofs) { emit_tsi(as, mi, r, RID_JGL, ofs-32768); } #define emit_getgl(as, r, field) \ emit_lsglptr(as, MIPSI_LW, (r), (int32_t)offsetof(global_State, field)) #define emit_setgl(as, r, field) \ emit_lsglptr(as, MIPSI_SW, (r), (int32_t)offsetof(global_State, field)) /* Trace number is determined from per-trace exit stubs. */ #define emit_setvmstate(as, i) UNUSED(i) /* -- Emit control-flow instructions -------------------------------------- */ /* Label for internal jumps. */ typedef MCode *MCLabel; /* Return label pointing to current PC. */ #define emit_label(as) ((as)->mcp) static void emit_branch(ASMState *as, MIPSIns mi, Reg rs, Reg rt, MCode *target) { MCode *p = as->mcp; ptrdiff_t delta = target - p; lua_assert(((delta + 0x8000) >> 16) == 0); *--p = mi | MIPSF_S(rs) | MIPSF_T(rt) | ((uint32_t)delta & 0xffffu); as->mcp = p; } static void emit_jmp(ASMState *as, MCode *target) { *--as->mcp = MIPSI_NOP; emit_branch(as, MIPSI_B, RID_ZERO, RID_ZERO, (target)); } static void emit_call(ASMState *as, void *target) { MCode *p = as->mcp; *--p = MIPSI_NOP; if ((((uintptr_t)target ^ (uintptr_t)p) >> 28) == 0) *--p = MIPSI_JAL | (((uintptr_t)target >>2) & 0x03ffffffu); else /* Target out of range: need indirect call. */ *--p = MIPSI_JALR | MIPSF_S(RID_CFUNCADDR); as->mcp = p; ra_allockreg(as, i32ptr(target), RID_CFUNCADDR); } /* -- Emit generic operations --------------------------------------------- */ #define emit_move(as, dst, src) \ emit_ds(as, MIPSI_MOVE, (dst), (src)) /* Generic move between two regs. */ static void emit_movrr(ASMState *as, IRIns *ir, Reg dst, Reg src) { if (dst < RID_MAX_GPR) emit_move(as, dst, src); else emit_fg(as, irt_isnum(ir->t) ? MIPSI_MOV_D : MIPSI_MOV_S, dst, src); } /* Generic load of register from stack slot. */ static void emit_spload(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { if (r < RID_MAX_GPR) emit_tsi(as, MIPSI_LW, r, RID_SP, ofs); else emit_tsi(as, irt_isnum(ir->t) ? MIPSI_LDC1 : MIPSI_LWC1, (r & 31), RID_SP, ofs); } /* Generic store of register to stack slot. */ static void emit_spstore(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { if (r < RID_MAX_GPR) emit_tsi(as, MIPSI_SW, r, RID_SP, ofs); else emit_tsi(as, irt_isnum(ir->t) ? MIPSI_SDC1 : MIPSI_SWC1, (r&31), RID_SP, ofs); } /* Add offset to pointer. */ static void emit_addptr(ASMState *as, Reg r, int32_t ofs) { if (ofs) { lua_assert(checki16(ofs)); emit_tsi(as, MIPSI_ADDIU, r, r, ofs); } } #define emit_spsub(as, ofs) emit_addptr(as, RID_SP, -(ofs)) wcc-0.0.2/src/wsh/luajit-2.0/src/lj_target_arm.h0000644000175000017500000001611313122010155017656 0ustar philphil/* ** Definitions for ARM CPUs. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_TARGET_ARM_H #define _LJ_TARGET_ARM_H /* -- Registers IDs ------------------------------------------------------- */ #define GPRDEF(_) \ _(R0) _(R1) _(R2) _(R3) _(R4) _(R5) _(R6) _(R7) \ _(R8) _(R9) _(R10) _(R11) _(R12) _(SP) _(LR) _(PC) #if LJ_SOFTFP #define FPRDEF(_) #else #define FPRDEF(_) \ _(D0) _(D1) _(D2) _(D3) _(D4) _(D5) _(D6) _(D7) \ _(D8) _(D9) _(D10) _(D11) _(D12) _(D13) _(D14) _(D15) #endif #define VRIDDEF(_) #define RIDENUM(name) RID_##name, enum { GPRDEF(RIDENUM) /* General-purpose registers (GPRs). */ FPRDEF(RIDENUM) /* Floating-point registers (FPRs). */ RID_MAX, RID_TMP = RID_LR, /* Calling conventions. */ RID_RET = RID_R0, RID_RETLO = RID_R0, RID_RETHI = RID_R1, #if LJ_SOFTFP RID_FPRET = RID_R0, #else RID_FPRET = RID_D0, #endif /* These definitions must match with the *.dasc file(s): */ RID_BASE = RID_R9, /* Interpreter BASE. */ RID_LPC = RID_R6, /* Interpreter PC. */ RID_DISPATCH = RID_R7, /* Interpreter DISPATCH table. */ RID_LREG = RID_R8, /* Interpreter L. */ /* Register ranges [min, max) and number of registers. */ RID_MIN_GPR = RID_R0, RID_MAX_GPR = RID_PC+1, RID_MIN_FPR = RID_MAX_GPR, #if LJ_SOFTFP RID_MAX_FPR = RID_MIN_FPR, #else RID_MAX_FPR = RID_D15+1, #endif RID_NUM_GPR = RID_MAX_GPR - RID_MIN_GPR, RID_NUM_FPR = RID_MAX_FPR - RID_MIN_FPR }; #define RID_NUM_KREF RID_NUM_GPR #define RID_MIN_KREF RID_R0 /* -- Register sets ------------------------------------------------------- */ /* Make use of all registers, except sp, lr and pc. */ #define RSET_GPR (RSET_RANGE(RID_MIN_GPR, RID_R12+1)) #define RSET_GPREVEN \ (RID2RSET(RID_R0)|RID2RSET(RID_R2)|RID2RSET(RID_R4)|RID2RSET(RID_R6)| \ RID2RSET(RID_R8)|RID2RSET(RID_R10)) #define RSET_GPRODD \ (RID2RSET(RID_R1)|RID2RSET(RID_R3)|RID2RSET(RID_R5)|RID2RSET(RID_R7)| \ RID2RSET(RID_R9)|RID2RSET(RID_R11)) #if LJ_SOFTFP #define RSET_FPR 0 #else #define RSET_FPR (RSET_RANGE(RID_MIN_FPR, RID_MAX_FPR)) #endif #define RSET_ALL (RSET_GPR|RSET_FPR) #define RSET_INIT RSET_ALL /* ABI-specific register sets. lr is an implicit scratch register. */ #define RSET_SCRATCH_GPR_ (RSET_RANGE(RID_R0, RID_R3+1)|RID2RSET(RID_R12)) #ifdef __APPLE__ #define RSET_SCRATCH_GPR (RSET_SCRATCH_GPR_|RID2RSET(RID_R9)) #else #define RSET_SCRATCH_GPR RSET_SCRATCH_GPR_ #endif #if LJ_SOFTFP #define RSET_SCRATCH_FPR 0 #else #define RSET_SCRATCH_FPR (RSET_RANGE(RID_D0, RID_D7+1)) #endif #define RSET_SCRATCH (RSET_SCRATCH_GPR|RSET_SCRATCH_FPR) #define REGARG_FIRSTGPR RID_R0 #define REGARG_LASTGPR RID_R3 #define REGARG_NUMGPR 4 #if LJ_ABI_SOFTFP #define REGARG_FIRSTFPR 0 #define REGARG_LASTFPR 0 #define REGARG_NUMFPR 0 #else #define REGARG_FIRSTFPR RID_D0 #define REGARG_LASTFPR RID_D7 #define REGARG_NUMFPR 8 #endif /* -- Spill slots --------------------------------------------------------- */ /* Spill slots are 32 bit wide. An even/odd pair is used for FPRs. ** ** SPS_FIXED: Available fixed spill slots in interpreter frame. ** This definition must match with the *.dasc file(s). ** ** SPS_FIRST: First spill slot for general use. Reserve min. two 32 bit slots. */ #define SPS_FIXED 2 #define SPS_FIRST 2 #define SPOFS_TMP 0 #define sps_scale(slot) (4 * (int32_t)(slot)) #define sps_align(slot) (((slot) - SPS_FIXED + 1) & ~1) /* -- Exit state ---------------------------------------------------------- */ /* This definition must match with the *.dasc file(s). */ typedef struct { #if !LJ_SOFTFP lua_Number fpr[RID_NUM_FPR]; /* Floating-point registers. */ #endif int32_t gpr[RID_NUM_GPR]; /* General-purpose registers. */ int32_t spill[256]; /* Spill slots. */ } ExitState; /* PC after instruction that caused an exit. Used to find the trace number. */ #define EXITSTATE_PCREG RID_PC /* Highest exit + 1 indicates stack check. */ #define EXITSTATE_CHECKEXIT 1 #define EXITSTUB_SPACING 4 #define EXITSTUBS_PER_GROUP 32 /* -- Instructions -------------------------------------------------------- */ /* Instruction fields. */ #define ARMF_CC(ai, cc) (((ai) ^ ARMI_CCAL) | ((cc) << 28)) #define ARMF_N(r) ((r) << 16) #define ARMF_D(r) ((r) << 12) #define ARMF_S(r) ((r) << 8) #define ARMF_M(r) (r) #define ARMF_SH(sh, n) (((sh) << 5) | ((n) << 7)) #define ARMF_RSH(sh, r) (0x10 | ((sh) << 5) | ARMF_S(r)) typedef enum ARMIns { ARMI_CCAL = 0xe0000000, ARMI_S = 0x000100000, ARMI_K12 = 0x02000000, ARMI_KNEG = 0x00200000, ARMI_LS_W = 0x00200000, ARMI_LS_U = 0x00800000, ARMI_LS_P = 0x01000000, ARMI_LS_R = 0x02000000, ARMI_LSX_I = 0x00400000, ARMI_AND = 0xe0000000, ARMI_EOR = 0xe0200000, ARMI_SUB = 0xe0400000, ARMI_RSB = 0xe0600000, ARMI_ADD = 0xe0800000, ARMI_ADC = 0xe0a00000, ARMI_SBC = 0xe0c00000, ARMI_RSC = 0xe0e00000, ARMI_TST = 0xe1100000, ARMI_TEQ = 0xe1300000, ARMI_CMP = 0xe1500000, ARMI_CMN = 0xe1700000, ARMI_ORR = 0xe1800000, ARMI_MOV = 0xe1a00000, ARMI_BIC = 0xe1c00000, ARMI_MVN = 0xe1e00000, ARMI_NOP = 0xe1a00000, ARMI_MUL = 0xe0000090, ARMI_SMULL = 0xe0c00090, ARMI_LDR = 0xe4100000, ARMI_LDRB = 0xe4500000, ARMI_LDRH = 0xe01000b0, ARMI_LDRSB = 0xe01000d0, ARMI_LDRSH = 0xe01000f0, ARMI_LDRD = 0xe00000d0, ARMI_STR = 0xe4000000, ARMI_STRB = 0xe4400000, ARMI_STRH = 0xe00000b0, ARMI_STRD = 0xe00000f0, ARMI_PUSH = 0xe92d0000, ARMI_B = 0xea000000, ARMI_BL = 0xeb000000, ARMI_BLX = 0xfa000000, ARMI_BLXr = 0xe12fff30, /* ARMv6 */ ARMI_REV = 0xe6bf0f30, ARMI_SXTB = 0xe6af0070, ARMI_SXTH = 0xe6bf0070, ARMI_UXTB = 0xe6ef0070, ARMI_UXTH = 0xe6ff0070, /* ARMv6T2 */ ARMI_MOVW = 0xe3000000, ARMI_MOVT = 0xe3400000, /* VFP */ ARMI_VMOV_D = 0xeeb00b40, ARMI_VMOV_S = 0xeeb00a40, ARMI_VMOVI_D = 0xeeb00b00, ARMI_VMOV_R_S = 0xee100a10, ARMI_VMOV_S_R = 0xee000a10, ARMI_VMOV_RR_D = 0xec500b10, ARMI_VMOV_D_RR = 0xec400b10, ARMI_VADD_D = 0xee300b00, ARMI_VSUB_D = 0xee300b40, ARMI_VMUL_D = 0xee200b00, ARMI_VMLA_D = 0xee000b00, ARMI_VMLS_D = 0xee000b40, ARMI_VNMLS_D = 0xee100b00, ARMI_VDIV_D = 0xee800b00, ARMI_VABS_D = 0xeeb00bc0, ARMI_VNEG_D = 0xeeb10b40, ARMI_VSQRT_D = 0xeeb10bc0, ARMI_VCMP_D = 0xeeb40b40, ARMI_VCMPZ_D = 0xeeb50b40, ARMI_VMRS = 0xeef1fa10, ARMI_VCVT_S32_F32 = 0xeebd0ac0, ARMI_VCVT_S32_F64 = 0xeebd0bc0, ARMI_VCVT_U32_F32 = 0xeebc0ac0, ARMI_VCVT_U32_F64 = 0xeebc0bc0, ARMI_VCVTR_S32_F32 = 0xeebd0a40, ARMI_VCVTR_S32_F64 = 0xeebd0b40, ARMI_VCVTR_U32_F32 = 0xeebc0a40, ARMI_VCVTR_U32_F64 = 0xeebc0b40, ARMI_VCVT_F32_S32 = 0xeeb80ac0, ARMI_VCVT_F64_S32 = 0xeeb80bc0, ARMI_VCVT_F32_U32 = 0xeeb80a40, ARMI_VCVT_F64_U32 = 0xeeb80b40, ARMI_VCVT_F32_F64 = 0xeeb70bc0, ARMI_VCVT_F64_F32 = 0xeeb70ac0, ARMI_VLDR_S = 0xed100a00, ARMI_VLDR_D = 0xed100b00, ARMI_VSTR_S = 0xed000a00, ARMI_VSTR_D = 0xed000b00, } ARMIns; typedef enum ARMShift { ARMSH_LSL, ARMSH_LSR, ARMSH_ASR, ARMSH_ROR } ARMShift; /* ARM condition codes. */ typedef enum ARMCC { CC_EQ, CC_NE, CC_CS, CC_CC, CC_MI, CC_PL, CC_VS, CC_VC, CC_HI, CC_LS, CC_GE, CC_LT, CC_GT, CC_LE, CC_AL, CC_HS = CC_CS, CC_LO = CC_CC } ARMCC; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_gdbjit.h0000644000175000017500000000072013122010155016771 0ustar philphil/* ** Client for the GDB JIT API. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_GDBJIT_H #define _LJ_GDBJIT_H #include "lj_obj.h" #include "lj_jit.h" #if LJ_HASJIT && defined(LUAJIT_USE_GDBJIT) LJ_FUNC void lj_gdbjit_addtrace(jit_State *J, GCtrace *T); LJ_FUNC void lj_gdbjit_deltrace(jit_State *J, GCtrace *T); #else #define lj_gdbjit_addtrace(J, T) UNUSED(T) #define lj_gdbjit_deltrace(J, T) UNUSED(T) #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_target.h0000644000175000017500000001350113122010155017015 0ustar philphil/* ** Definitions for target CPU. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_TARGET_H #define _LJ_TARGET_H #include "lj_def.h" #include "lj_arch.h" /* -- Registers and spill slots ------------------------------------------- */ /* Register type (uint8_t in ir->r). */ typedef uint32_t Reg; /* The hi-bit is NOT set for an allocated register. This means the value ** can be directly used without masking. The hi-bit is set for a register ** allocation hint or for RID_INIT, RID_SINK or RID_SUNK. */ #define RID_NONE 0x80 #define RID_MASK 0x7f #define RID_INIT (RID_NONE|RID_MASK) #define RID_SINK (RID_INIT-1) #define RID_SUNK (RID_INIT-2) #define ra_noreg(r) ((r) & RID_NONE) #define ra_hasreg(r) (!((r) & RID_NONE)) /* The ra_hashint() macro assumes a previous test for ra_noreg(). */ #define ra_hashint(r) ((r) < RID_SUNK) #define ra_gethint(r) ((Reg)((r) & RID_MASK)) #define ra_sethint(rr, r) rr = (uint8_t)((r)|RID_NONE) #define ra_samehint(r1, r2) (ra_gethint((r1)^(r2)) == 0) /* Spill slot 0 means no spill slot has been allocated. */ #define SPS_NONE 0 #define ra_hasspill(s) ((s) != SPS_NONE) /* Combined register and spill slot (uint16_t in ir->prev). */ typedef uint32_t RegSP; #define REGSP(r, s) ((r) + ((s) << 8)) #define REGSP_HINT(r) ((r)|RID_NONE) #define REGSP_INIT REGSP(RID_INIT, 0) #define regsp_reg(rs) ((rs) & 255) #define regsp_spill(rs) ((rs) >> 8) #define regsp_used(rs) \ (((rs) & ~REGSP(RID_MASK, 0)) != REGSP(RID_NONE, 0)) /* -- Register sets ------------------------------------------------------- */ /* Bitset for registers. 32 registers suffice for most architectures. ** Note that one set holds bits for both GPRs and FPRs. */ #if LJ_TARGET_PPC || LJ_TARGET_MIPS typedef uint64_t RegSet; #else typedef uint32_t RegSet; #endif #define RID2RSET(r) (((RegSet)1) << (r)) #define RSET_EMPTY ((RegSet)0) #define RSET_RANGE(lo, hi) ((RID2RSET((hi)-(lo))-1) << (lo)) #define rset_test(rs, r) ((int)((rs) >> (r)) & 1) #define rset_set(rs, r) (rs |= RID2RSET(r)) #define rset_clear(rs, r) (rs &= ~RID2RSET(r)) #define rset_exclude(rs, r) (rs & ~RID2RSET(r)) #if LJ_TARGET_PPC || LJ_TARGET_MIPS #define rset_picktop(rs) ((Reg)(__builtin_clzll(rs)^63)) #define rset_pickbot(rs) ((Reg)__builtin_ctzll(rs)) #else #define rset_picktop(rs) ((Reg)lj_fls(rs)) #define rset_pickbot(rs) ((Reg)lj_ffs(rs)) #endif /* -- Register allocation cost -------------------------------------------- */ /* The register allocation heuristic keeps track of the cost for allocating ** a specific register: ** ** A free register (obviously) has a cost of 0 and a 1-bit in the free mask. ** ** An already allocated register has the (non-zero) IR reference in the lowest ** bits and the result of a blended cost-model in the higher bits. ** ** The allocator first checks the free mask for a hit. Otherwise an (unrolled) ** linear search for the minimum cost is used. The search doesn't need to ** keep track of the position of the minimum, which makes it very fast. ** The lowest bits of the minimum cost show the desired IR reference whose ** register is the one to evict. ** ** Without the cost-model this degenerates to the standard heuristics for ** (reverse) linear-scan register allocation. Since code generation is done ** in reverse, a live interval extends from the last use to the first def. ** For an SSA IR the IR reference is the first (and only) def and thus ** trivially marks the end of the interval. The LSRA heuristics says to pick ** the register whose live interval has the furthest extent, i.e. the lowest ** IR reference in our case. ** ** A cost-model should take into account other factors, like spill-cost and ** restore- or rematerialization-cost, which depend on the kind of instruction. ** E.g. constants have zero spill costs, variant instructions have higher ** costs than invariants and PHIs should preferably never be spilled. ** ** Here's a first cut at simple, but effective blended cost-model for R-LSRA: ** - Due to careful design of the IR, constants already have lower IR ** references than invariants and invariants have lower IR references ** than variants. ** - The cost in the upper 16 bits is the sum of the IR reference and a ** weighted score. The score currently only takes into account whether ** the IRT_ISPHI bit is set in the instruction type. ** - The PHI weight is the minimum distance (in IR instructions) a PHI ** reference has to be further apart from a non-PHI reference to be spilled. ** - It should be a power of two (for speed) and must be between 2 and 32768. ** Good values for the PHI weight seem to be between 40 and 150. ** - Further study is required. */ #define REGCOST_PHI_WEIGHT 64 /* Cost for allocating a specific register. */ typedef uint32_t RegCost; /* Note: assumes 16 bit IRRef1. */ #define REGCOST(cost, ref) ((RegCost)(ref) + ((RegCost)(cost) << 16)) #define regcost_ref(rc) ((IRRef1)(rc)) #define REGCOST_T(t) \ ((RegCost)((t)&IRT_ISPHI) * (((RegCost)(REGCOST_PHI_WEIGHT)<<16)/IRT_ISPHI)) #define REGCOST_REF_T(ref, t) (REGCOST((ref), (ref)) + REGCOST_T((t))) /* -- Target-specific definitions ----------------------------------------- */ #if LJ_TARGET_X86ORX64 #include "lj_target_x86.h" #elif LJ_TARGET_ARM #include "lj_target_arm.h" #elif LJ_TARGET_PPC #include "lj_target_ppc.h" #elif LJ_TARGET_MIPS #include "lj_target_mips.h" #else #error "Missing include for target CPU" #endif #ifdef EXITSTUBS_PER_GROUP /* Return the address of an exit stub. */ static LJ_AINLINE char *exitstub_addr_(char **group, uint32_t exitno) { lua_assert(group[exitno / EXITSTUBS_PER_GROUP] != NULL); return (char *)group[exitno / EXITSTUBS_PER_GROUP] + EXITSTUB_SPACING*(exitno % EXITSTUBS_PER_GROUP); } /* Avoid dependence on lj_jit.h if only including lj_target.h. */ #define exitstub_addr(J, exitno) \ ((MCode *)exitstub_addr_((char **)((J)->exitstubgroup), (exitno))) #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_arch.h0000644000175000017500000002711013122010155016445 0ustar philphil/* ** Target architecture selection. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_ARCH_H #define _LJ_ARCH_H #include "lua.h" /* Target endianess. */ #define LUAJIT_LE 0 #define LUAJIT_BE 1 /* Target architectures. */ #define LUAJIT_ARCH_X86 1 #define LUAJIT_ARCH_x86 1 #define LUAJIT_ARCH_X64 2 #define LUAJIT_ARCH_x64 2 #define LUAJIT_ARCH_ARM 3 #define LUAJIT_ARCH_arm 3 #define LUAJIT_ARCH_PPC 4 #define LUAJIT_ARCH_ppc 4 #define LUAJIT_ARCH_PPCSPE 5 #define LUAJIT_ARCH_ppcspe 5 #define LUAJIT_ARCH_MIPS 6 #define LUAJIT_ARCH_mips 6 /* Target OS. */ #define LUAJIT_OS_OTHER 0 #define LUAJIT_OS_WINDOWS 1 #define LUAJIT_OS_LINUX 2 #define LUAJIT_OS_OSX 3 #define LUAJIT_OS_BSD 4 #define LUAJIT_OS_POSIX 5 /* Select native target if no target defined. */ #ifndef LUAJIT_TARGET #if defined(__i386) || defined(__i386__) || defined(_M_IX86) #define LUAJIT_TARGET LUAJIT_ARCH_X86 #elif defined(__x86_64__) || defined(__x86_64) || defined(_M_X64) || defined(_M_AMD64) #define LUAJIT_TARGET LUAJIT_ARCH_X64 #elif defined(__arm__) || defined(__arm) || defined(__ARM__) || defined(__ARM) #define LUAJIT_TARGET LUAJIT_ARCH_ARM #elif defined(__ppc__) || defined(__ppc) || defined(__PPC__) || defined(__PPC) || defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) || defined(__POWERPC) || defined(_M_PPC) #ifdef __NO_FPRS__ #define LUAJIT_TARGET LUAJIT_ARCH_PPCSPE #else #define LUAJIT_TARGET LUAJIT_ARCH_PPC #endif #elif defined(__mips__) || defined(__mips) || defined(__MIPS__) || defined(__MIPS) #define LUAJIT_TARGET LUAJIT_ARCH_MIPS #else #error "No support for this architecture (yet)" #endif #endif /* Select native OS if no target OS defined. */ #ifndef LUAJIT_OS #if defined(_WIN32) && !defined(_XBOX_VER) #define LUAJIT_OS LUAJIT_OS_WINDOWS #elif defined(__linux__) #define LUAJIT_OS LUAJIT_OS_LINUX #elif defined(__MACH__) && defined(__APPLE__) #define LUAJIT_OS LUAJIT_OS_OSX #elif (defined(__FreeBSD__) || defined(__FreeBSD_kernel__) || \ defined(__NetBSD__) || defined(__OpenBSD__) || \ defined(__DragonFly__)) && !defined(__ORBIS__) #define LUAJIT_OS LUAJIT_OS_BSD #elif (defined(__sun__) && defined(__svr4__)) #define LUAJIT_OS LUAJIT_OS_POSIX #elif defined(__CYGWIN__) #define LJ_TARGET_CYGWIN 1 #define LUAJIT_OS LUAJIT_OS_POSIX #else #define LUAJIT_OS LUAJIT_OS_OTHER #endif #endif /* Set target OS properties. */ #if LUAJIT_OS == LUAJIT_OS_WINDOWS #define LJ_OS_NAME "Windows" #elif LUAJIT_OS == LUAJIT_OS_LINUX #define LJ_OS_NAME "Linux" #elif LUAJIT_OS == LUAJIT_OS_OSX #define LJ_OS_NAME "OSX" #elif LUAJIT_OS == LUAJIT_OS_BSD #define LJ_OS_NAME "BSD" #elif LUAJIT_OS == LUAJIT_OS_POSIX #define LJ_OS_NAME "POSIX" #else #define LJ_OS_NAME "Other" #endif #define LJ_TARGET_WINDOWS (LUAJIT_OS == LUAJIT_OS_WINDOWS) #define LJ_TARGET_LINUX (LUAJIT_OS == LUAJIT_OS_LINUX) #define LJ_TARGET_OSX (LUAJIT_OS == LUAJIT_OS_OSX) #define LJ_TARGET_IOS (LJ_TARGET_OSX && LUAJIT_TARGET == LUAJIT_ARCH_ARM) #define LJ_TARGET_POSIX (LUAJIT_OS > LUAJIT_OS_WINDOWS) #define LJ_TARGET_DLOPEN LJ_TARGET_POSIX #ifdef __CELLOS_LV2__ #define LJ_TARGET_PS3 1 #define LJ_TARGET_CONSOLE 1 #endif #ifdef __ORBIS__ #define LJ_TARGET_PS4 1 #define LJ_TARGET_CONSOLE 1 #undef NULL #define NULL ((void*)0) #endif #ifdef __psp2__ #define LJ_TARGET_PSVITA 1 #define LJ_TARGET_CONSOLE 1 #endif #if _XBOX_VER >= 200 #define LJ_TARGET_XBOX360 1 #define LJ_TARGET_CONSOLE 1 #endif #define LJ_NUMMODE_SINGLE 0 /* Single-number mode only. */ #define LJ_NUMMODE_SINGLE_DUAL 1 /* Default to single-number mode. */ #define LJ_NUMMODE_DUAL 2 /* Dual-number mode only. */ #define LJ_NUMMODE_DUAL_SINGLE 3 /* Default to dual-number mode. */ /* Set target architecture properties. */ #if LUAJIT_TARGET == LUAJIT_ARCH_X86 #define LJ_ARCH_NAME "x86" #define LJ_ARCH_BITS 32 #define LJ_ARCH_ENDIAN LUAJIT_LE #if LJ_TARGET_WINDOWS || LJ_TARGET_CYGWIN #define LJ_ABI_WIN 1 #else #define LJ_ABI_WIN 0 #endif #define LJ_TARGET_X86 1 #define LJ_TARGET_X86ORX64 1 #define LJ_TARGET_EHRETREG 0 #define LJ_TARGET_MASKSHIFT 1 #define LJ_TARGET_MASKROT 1 #define LJ_TARGET_UNALIGNED 1 #define LJ_ARCH_NUMMODE LJ_NUMMODE_SINGLE_DUAL #elif LUAJIT_TARGET == LUAJIT_ARCH_X64 #define LJ_ARCH_NAME "x64" #define LJ_ARCH_BITS 64 #define LJ_ARCH_ENDIAN LUAJIT_LE #if LJ_TARGET_WINDOWS || LJ_TARGET_CYGWIN #define LJ_ABI_WIN 1 #else #define LJ_ABI_WIN 0 #endif #define LJ_TARGET_X64 1 #define LJ_TARGET_X86ORX64 1 #define LJ_TARGET_EHRETREG 0 #define LJ_TARGET_JUMPRANGE 31 /* +-2^31 = +-2GB */ #define LJ_TARGET_MASKSHIFT 1 #define LJ_TARGET_MASKROT 1 #define LJ_TARGET_UNALIGNED 1 #define LJ_ARCH_NUMMODE LJ_NUMMODE_SINGLE_DUAL #elif LUAJIT_TARGET == LUAJIT_ARCH_ARM #define LJ_ARCH_NAME "arm" #define LJ_ARCH_BITS 32 #define LJ_ARCH_ENDIAN LUAJIT_LE #if !defined(LJ_ARCH_HASFPU) && __SOFTFP__ #define LJ_ARCH_HASFPU 0 #endif #if !defined(LJ_ABI_SOFTFP) && !__ARM_PCS_VFP #define LJ_ABI_SOFTFP 1 #endif #define LJ_ABI_EABI 1 #define LJ_TARGET_ARM 1 #define LJ_TARGET_EHRETREG 0 #define LJ_TARGET_JUMPRANGE 25 /* +-2^25 = +-32MB */ #define LJ_TARGET_MASKSHIFT 0 #define LJ_TARGET_MASKROT 1 #define LJ_TARGET_UNIFYROT 2 /* Want only IR_BROR. */ #define LJ_ARCH_NUMMODE LJ_NUMMODE_DUAL #if __ARM_ARCH____ARM_ARCH_8__ || __ARM_ARCH_8A__ #define LJ_ARCH_VERSION 80 #elif __ARM_ARCH_7__ || __ARM_ARCH_7A__ || __ARM_ARCH_7R__ || __ARM_ARCH_7S__ || __ARM_ARCH_7VE__ #define LJ_ARCH_VERSION 70 #elif __ARM_ARCH_6T2__ #define LJ_ARCH_VERSION 61 #elif __ARM_ARCH_6__ || __ARM_ARCH_6J__ || __ARM_ARCH_6K__ || __ARM_ARCH_6Z__ || __ARM_ARCH_6ZK__ #define LJ_ARCH_VERSION 60 #else #define LJ_ARCH_VERSION 50 #endif #elif LUAJIT_TARGET == LUAJIT_ARCH_PPC #define LJ_ARCH_NAME "ppc" #if _LP64 #define LJ_ARCH_BITS 64 #else #define LJ_ARCH_BITS 32 #endif #define LJ_ARCH_ENDIAN LUAJIT_BE #define LJ_TARGET_PPC 1 #define LJ_TARGET_EHRETREG 3 #define LJ_TARGET_JUMPRANGE 25 /* +-2^25 = +-32MB */ #define LJ_TARGET_MASKSHIFT 0 #define LJ_TARGET_MASKROT 1 #define LJ_TARGET_UNIFYROT 1 /* Want only IR_BROL. */ #define LJ_ARCH_NUMMODE LJ_NUMMODE_DUAL_SINGLE #if _ARCH_PWR7 #define LJ_ARCH_VERSION 70 #elif _ARCH_PWR6 #define LJ_ARCH_VERSION 60 #elif _ARCH_PWR5X #define LJ_ARCH_VERSION 51 #elif _ARCH_PWR5 #define LJ_ARCH_VERSION 50 #elif _ARCH_PWR4 #define LJ_ARCH_VERSION 40 #else #define LJ_ARCH_VERSION 0 #endif #if __PPC64__ || __powerpc64__ || LJ_TARGET_CONSOLE #define LJ_ARCH_PPC64 1 #define LJ_ARCH_NOFFI 1 #endif #if _ARCH_PPCSQ #define LJ_ARCH_SQRT 1 #endif #if _ARCH_PWR5X #define LJ_ARCH_ROUND 1 #endif #if __PPU__ #define LJ_ARCH_CELL 1 #endif #if LJ_TARGET_XBOX360 #define LJ_ARCH_XENON 1 #endif #elif LUAJIT_TARGET == LUAJIT_ARCH_PPCSPE #define LJ_ARCH_NAME "ppcspe" #define LJ_ARCH_BITS 32 #define LJ_ARCH_ENDIAN LUAJIT_BE #ifndef LJ_ABI_SOFTFP #define LJ_ABI_SOFTFP 1 #endif #define LJ_ABI_EABI 1 #define LJ_TARGET_PPCSPE 1 #define LJ_TARGET_EHRETREG 3 #define LJ_TARGET_JUMPRANGE 25 /* +-2^25 = +-32MB */ #define LJ_TARGET_MASKSHIFT 0 #define LJ_TARGET_MASKROT 1 #define LJ_TARGET_UNIFYROT 1 /* Want only IR_BROL. */ #define LJ_ARCH_NUMMODE LJ_NUMMODE_SINGLE #define LJ_ARCH_NOFFI 1 /* NYI: comparisons, calls. */ #define LJ_ARCH_NOJIT 1 #elif LUAJIT_TARGET == LUAJIT_ARCH_MIPS #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) #define LJ_ARCH_NAME "mipsel" #define LJ_ARCH_ENDIAN LUAJIT_LE #else #define LJ_ARCH_NAME "mips" #define LJ_ARCH_ENDIAN LUAJIT_BE #endif #define LJ_ARCH_BITS 32 #define LJ_TARGET_MIPS 1 #define LJ_TARGET_EHRETREG 4 #define LJ_TARGET_JUMPRANGE 27 /* 2*2^27 = 256MB-aligned region */ #define LJ_TARGET_MASKSHIFT 1 #define LJ_TARGET_MASKROT 1 #define LJ_TARGET_UNIFYROT 2 /* Want only IR_BROR. */ #define LJ_ARCH_NUMMODE LJ_NUMMODE_SINGLE #if _MIPS_ARCH_MIPS32R2 #define LJ_ARCH_VERSION 20 #else #define LJ_ARCH_VERSION 10 #endif #else #error "No target architecture defined" #endif #ifndef LJ_PAGESIZE #define LJ_PAGESIZE 4096 #endif /* Check for minimum required compiler versions. */ #if defined(__GNUC__) #if LJ_TARGET_X86 #if (__GNUC__ < 3) || ((__GNUC__ == 3) && __GNUC_MINOR__ < 4) #error "Need at least GCC 3.4 or newer" #endif #elif LJ_TARGET_X64 #if __GNUC__ < 4 #error "Need at least GCC 4.0 or newer" #endif #elif LJ_TARGET_ARM #if (__GNUC__ < 4) || ((__GNUC__ == 4) && __GNUC_MINOR__ < 2) #error "Need at least GCC 4.2 or newer" #endif #elif !LJ_TARGET_PS3 #if (__GNUC__ < 4) || ((__GNUC__ == 4) && __GNUC_MINOR__ < 3) #error "Need at least GCC 4.3 or newer" #endif #endif #endif /* Check target-specific constraints. */ #ifndef _BUILDVM_H #if LJ_TARGET_X64 #if __USING_SJLJ_EXCEPTIONS__ #error "Need a C compiler with native exception handling on x64" #endif #elif LJ_TARGET_ARM #if defined(__ARMEB__) #error "No support for big-endian ARM" #endif #if __ARM_ARCH_6M__ || __ARM_ARCH_7M__ || __ARM_ARCH_7EM__ #error "No support for Cortex-M CPUs" #endif #if !(__ARM_EABI__ || LJ_TARGET_IOS) #error "Only ARM EABI or iOS 3.0+ ABI is supported" #endif #elif LJ_TARGET_PPC || LJ_TARGET_PPCSPE #if defined(_SOFT_FLOAT) || defined(_SOFT_DOUBLE) #error "No support for PowerPC CPUs without double-precision FPU" #endif #if defined(_LITTLE_ENDIAN) #error "No support for little-endian PowerPC" #endif #if defined(_LP64) #error "No support for PowerPC 64 bit mode" #endif #elif LJ_TARGET_MIPS #if defined(__mips_soft_float) #error "No support for MIPS CPUs without FPU" #endif #if defined(_LP64) #error "No support for MIPS64" #endif #endif #endif /* Enable or disable the dual-number mode for the VM. */ #if (LJ_ARCH_NUMMODE == LJ_NUMMODE_SINGLE && LUAJIT_NUMMODE == 2) || \ (LJ_ARCH_NUMMODE == LJ_NUMMODE_DUAL && LUAJIT_NUMMODE == 1) #error "No support for this number mode on this architecture" #endif #if LJ_ARCH_NUMMODE == LJ_NUMMODE_DUAL || \ (LJ_ARCH_NUMMODE == LJ_NUMMODE_DUAL_SINGLE && LUAJIT_NUMMODE != 1) || \ (LJ_ARCH_NUMMODE == LJ_NUMMODE_SINGLE_DUAL && LUAJIT_NUMMODE == 2) #define LJ_DUALNUM 1 #else #define LJ_DUALNUM 0 #endif #if LJ_TARGET_IOS || LJ_TARGET_CONSOLE /* Runtime code generation is restricted on iOS. Complain to Apple, not me. */ /* Ditto for the consoles. Complain to Sony or MS, not me. */ #ifndef LUAJIT_ENABLE_JIT #define LJ_OS_NOJIT 1 #endif #endif /* Disable or enable the JIT compiler. */ #if defined(LUAJIT_DISABLE_JIT) || defined(LJ_ARCH_NOJIT) || defined(LJ_OS_NOJIT) #define LJ_HASJIT 0 #else #define LJ_HASJIT 1 #endif /* Disable or enable the FFI extension. */ #if defined(LUAJIT_DISABLE_FFI) || defined(LJ_ARCH_NOFFI) #define LJ_HASFFI 0 #else #define LJ_HASFFI 1 #endif #ifndef LJ_ARCH_HASFPU #define LJ_ARCH_HASFPU 1 #endif #ifndef LJ_ABI_SOFTFP #define LJ_ABI_SOFTFP 0 #endif #define LJ_SOFTFP (!LJ_ARCH_HASFPU) #if LJ_ARCH_ENDIAN == LUAJIT_BE #define LJ_LE 0 #define LJ_BE 1 #define LJ_ENDIAN_SELECT(le, be) be #define LJ_ENDIAN_LOHI(lo, hi) hi lo #else #define LJ_LE 1 #define LJ_BE 0 #define LJ_ENDIAN_SELECT(le, be) le #define LJ_ENDIAN_LOHI(lo, hi) lo hi #endif #if LJ_ARCH_BITS == 32 #define LJ_32 1 #define LJ_64 0 #else #define LJ_32 0 #define LJ_64 1 #endif #ifndef LJ_TARGET_UNALIGNED #define LJ_TARGET_UNALIGNED 0 #endif /* Various workarounds for embedded operating systems. */ #if (defined(__ANDROID__) && !defined(LJ_TARGET_X86ORX64)) || defined(__symbian__) || LJ_TARGET_XBOX360 #define LUAJIT_NO_LOG2 #endif #if defined(__symbian__) #define LUAJIT_NO_EXP2 #endif #if LJ_TARGET_CONSOLE || (LJ_TARGET_IOS && __IPHONE_OS_VERSION_MIN_REQUIRED >= __IPHONE_8_0) #define LJ_NO_SYSTEM 1 #endif #if defined(LUAJIT_NO_UNWIND) || defined(__symbian__) || LJ_TARGET_IOS || LJ_TARGET_PS3 || LJ_TARGET_PS4 #define LJ_NO_UNWIND 1 #endif /* Compatibility with Lua 5.1 vs. 5.2. */ #ifdef LUAJIT_ENABLE_LUA52COMPAT #define LJ_52 1 #else #define LJ_52 0 #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_asm_mips.h0000644000175000017500000020011013122010155017331 0ustar philphil/* ** MIPS IR assembler (SSA IR -> machine code). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Register allocator extensions --------------------------------------- */ /* Allocate a register with a hint. */ static Reg ra_hintalloc(ASMState *as, IRRef ref, Reg hint, RegSet allow) { Reg r = IR(ref)->r; if (ra_noreg(r)) { if (!ra_hashint(r) && !iscrossref(as, ref)) ra_sethint(IR(ref)->r, hint); /* Propagate register hint. */ r = ra_allocref(as, ref, allow); } ra_noweak(as, r); return r; } /* Allocate a register or RID_ZERO. */ static Reg ra_alloc1z(ASMState *as, IRRef ref, RegSet allow) { Reg r = IR(ref)->r; if (ra_noreg(r)) { if (!(allow & RSET_FPR) && irref_isk(ref) && IR(ref)->i == 0) return RID_ZERO; r = ra_allocref(as, ref, allow); } else { ra_noweak(as, r); } return r; } /* Allocate two source registers for three-operand instructions. */ static Reg ra_alloc2(ASMState *as, IRIns *ir, RegSet allow) { IRIns *irl = IR(ir->op1), *irr = IR(ir->op2); Reg left = irl->r, right = irr->r; if (ra_hasreg(left)) { ra_noweak(as, left); if (ra_noreg(right)) right = ra_alloc1z(as, ir->op2, rset_exclude(allow, left)); else ra_noweak(as, right); } else if (ra_hasreg(right)) { ra_noweak(as, right); left = ra_alloc1z(as, ir->op1, rset_exclude(allow, right)); } else if (ra_hashint(right)) { right = ra_alloc1z(as, ir->op2, allow); left = ra_alloc1z(as, ir->op1, rset_exclude(allow, right)); } else { left = ra_alloc1z(as, ir->op1, allow); right = ra_alloc1z(as, ir->op2, rset_exclude(allow, left)); } return left | (right << 8); } /* -- Guard handling ------------------------------------------------------ */ /* Need some spare long-range jump slots, for out-of-range branches. */ #define MIPS_SPAREJUMP 4 /* Setup spare long-range jump slots per mcarea. */ static void asm_sparejump_setup(ASMState *as) { MCode *mxp = as->mcbot; /* Assumes sizeof(MCLink) == 8. */ if (((uintptr_t)mxp & (LJ_PAGESIZE-1)) == 8) { lua_assert(MIPSI_NOP == 0); memset(mxp+2, 0, MIPS_SPAREJUMP*8); mxp += MIPS_SPAREJUMP*2; lua_assert(mxp < as->mctop); lj_mcode_sync(as->mcbot, mxp); lj_mcode_commitbot(as->J, mxp); as->mcbot = mxp; as->mclim = as->mcbot + MCLIM_REDZONE; } } /* Setup exit stub after the end of each trace. */ static void asm_exitstub_setup(ASMState *as) { MCode *mxp = as->mctop; /* sw TMP, 0(sp); j ->vm_exit_handler; li TMP, traceno */ *--mxp = MIPSI_LI|MIPSF_T(RID_TMP)|as->T->traceno; *--mxp = MIPSI_J|((((uintptr_t)(void *)lj_vm_exit_handler)>>2)&0x03ffffffu); lua_assert(((uintptr_t)mxp ^ (uintptr_t)(void *)lj_vm_exit_handler)>>28 == 0); *--mxp = MIPSI_SW|MIPSF_T(RID_TMP)|MIPSF_S(RID_SP)|0; as->mctop = mxp; } /* Keep this in-sync with exitstub_trace_addr(). */ #define asm_exitstub_addr(as) ((as)->mctop) /* Emit conditional branch to exit for guard. */ static void asm_guard(ASMState *as, MIPSIns mi, Reg rs, Reg rt) { MCode *target = asm_exitstub_addr(as); MCode *p = as->mcp; if (LJ_UNLIKELY(p == as->invmcp)) { as->invmcp = NULL; as->loopinv = 1; as->mcp = p+1; mi = mi ^ ((mi>>28) == 1 ? 0x04000000u : 0x00010000u); /* Invert cond. */ target = p; /* Patch target later in asm_loop_fixup. */ } emit_ti(as, MIPSI_LI, RID_TMP, as->snapno); emit_branch(as, mi, rs, rt, target); } /* -- Operand fusion ------------------------------------------------------ */ /* Limit linear search to this distance. Avoids O(n^2) behavior. */ #define CONFLICT_SEARCH_LIM 31 /* Check if there's no conflicting instruction between curins and ref. */ static int noconflict(ASMState *as, IRRef ref, IROp conflict) { IRIns *ir = as->ir; IRRef i = as->curins; if (i > ref + CONFLICT_SEARCH_LIM) return 0; /* Give up, ref is too far away. */ while (--i > ref) if (ir[i].o == conflict) return 0; /* Conflict found. */ return 1; /* Ok, no conflict. */ } /* Fuse the array base of colocated arrays. */ static int32_t asm_fuseabase(ASMState *as, IRRef ref) { IRIns *ir = IR(ref); if (ir->o == IR_TNEW && ir->op1 <= LJ_MAX_COLOSIZE && !neverfuse(as) && noconflict(as, ref, IR_NEWREF)) return (int32_t)sizeof(GCtab); return 0; } /* Fuse array/hash/upvalue reference into register+offset operand. */ static Reg asm_fuseahuref(ASMState *as, IRRef ref, int32_t *ofsp, RegSet allow) { IRIns *ir = IR(ref); if (ra_noreg(ir->r)) { if (ir->o == IR_AREF) { if (mayfuse(as, ref)) { if (irref_isk(ir->op2)) { IRRef tab = IR(ir->op1)->op1; int32_t ofs = asm_fuseabase(as, tab); IRRef refa = ofs ? tab : ir->op1; ofs += 8*IR(ir->op2)->i; if (checki16(ofs)) { *ofsp = ofs; return ra_alloc1(as, refa, allow); } } } } else if (ir->o == IR_HREFK) { if (mayfuse(as, ref)) { int32_t ofs = (int32_t)(IR(ir->op2)->op2 * sizeof(Node)); if (checki16(ofs)) { *ofsp = ofs; return ra_alloc1(as, ir->op1, allow); } } } else if (ir->o == IR_UREFC) { if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); int32_t ofs = i32ptr(&gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv.tv); int32_t jgl = (intptr_t)J2G(as->J); if ((uint32_t)(ofs-jgl) < 65536) { *ofsp = ofs-jgl-32768; return RID_JGL; } else { *ofsp = (int16_t)ofs; return ra_allock(as, ofs-(int16_t)ofs, allow); } } } } *ofsp = 0; return ra_alloc1(as, ref, allow); } /* Fuse XLOAD/XSTORE reference into load/store operand. */ static void asm_fusexref(ASMState *as, MIPSIns mi, Reg rt, IRRef ref, RegSet allow, int32_t ofs) { IRIns *ir = IR(ref); Reg base; if (ra_noreg(ir->r) && canfuse(as, ir)) { if (ir->o == IR_ADD) { int32_t ofs2; if (irref_isk(ir->op2) && (ofs2 = ofs + IR(ir->op2)->i, checki16(ofs2))) { ref = ir->op1; ofs = ofs2; } } else if (ir->o == IR_STRREF) { int32_t ofs2 = 65536; lua_assert(ofs == 0); ofs = (int32_t)sizeof(GCstr); if (irref_isk(ir->op2)) { ofs2 = ofs + IR(ir->op2)->i; ref = ir->op1; } else if (irref_isk(ir->op1)) { ofs2 = ofs + IR(ir->op1)->i; ref = ir->op2; } if (!checki16(ofs2)) { /* NYI: Fuse ADD with constant. */ Reg right, left = ra_alloc2(as, ir, allow); right = (left >> 8); left &= 255; emit_hsi(as, mi, rt, RID_TMP, ofs); emit_dst(as, MIPSI_ADDU, RID_TMP, left, right); return; } ofs = ofs2; } } base = ra_alloc1(as, ref, allow); emit_hsi(as, mi, rt, base, ofs); } /* -- Calls --------------------------------------------------------------- */ /* Generate a call to a C function. */ static void asm_gencall(ASMState *as, const CCallInfo *ci, IRRef *args) { uint32_t n, nargs = CCI_NARGS(ci); int32_t ofs = 16; Reg gpr, fpr = REGARG_FIRSTFPR; if ((void *)ci->func) emit_call(as, (void *)ci->func); for (gpr = REGARG_FIRSTGPR; gpr <= REGARG_LASTGPR; gpr++) as->cost[gpr] = REGCOST(~0u, ASMREF_L); gpr = REGARG_FIRSTGPR; for (n = 0; n < nargs; n++) { /* Setup args. */ IRRef ref = args[n]; if (ref) { IRIns *ir = IR(ref); if (irt_isfp(ir->t) && fpr <= REGARG_LASTFPR && !(ci->flags & CCI_VARARG)) { lua_assert(rset_test(as->freeset, fpr)); /* Already evicted. */ ra_leftov(as, fpr, ref); fpr += 2; gpr += irt_isnum(ir->t) ? 2 : 1; } else { fpr = REGARG_LASTFPR+1; if (irt_isnum(ir->t)) gpr = (gpr+1) & ~1; if (gpr <= REGARG_LASTGPR) { lua_assert(rset_test(as->freeset, gpr)); /* Already evicted. */ if (irt_isfp(ir->t)) { RegSet of = as->freeset; Reg r; /* Workaround to protect argument GPRs from being used for remat. */ as->freeset &= ~RSET_RANGE(REGARG_FIRSTGPR, REGARG_LASTGPR+1); r = ra_alloc1(as, ref, RSET_FPR); as->freeset |= (of & RSET_RANGE(REGARG_FIRSTGPR, REGARG_LASTGPR+1)); if (irt_isnum(ir->t)) { emit_tg(as, MIPSI_MFC1, gpr+(LJ_BE?0:1), r+1); emit_tg(as, MIPSI_MFC1, gpr+(LJ_BE?1:0), r); lua_assert(rset_test(as->freeset, gpr+1)); /* Already evicted. */ gpr += 2; } else if (irt_isfloat(ir->t)) { emit_tg(as, MIPSI_MFC1, gpr, r); gpr++; } } else { ra_leftov(as, gpr, ref); gpr++; } } else { Reg r = ra_alloc1z(as, ref, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); if (irt_isnum(ir->t)) ofs = (ofs + 4) & ~4; emit_spstore(as, ir, r, ofs); ofs += irt_isnum(ir->t) ? 8 : 4; } } } else { fpr = REGARG_LASTFPR+1; if (gpr <= REGARG_LASTGPR) gpr++; else ofs += 4; } checkmclim(as); } } /* Setup result reg/sp for call. Evict scratch regs. */ static void asm_setupresult(ASMState *as, IRIns *ir, const CCallInfo *ci) { RegSet drop = RSET_SCRATCH; int hiop = ((ir+1)->o == IR_HIOP && !irt_isnil((ir+1)->t)); if ((ci->flags & CCI_NOFPRCLOBBER)) drop &= ~RSET_FPR; if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ if (hiop && ra_hasreg((ir+1)->r)) rset_clear(drop, (ir+1)->r); /* Dest reg handled below. */ ra_evictset(as, drop); /* Evictions must be performed first. */ if (ra_used(ir)) { lua_assert(!irt_ispri(ir->t)); if (irt_isfp(ir->t)) { if ((ci->flags & CCI_CASTU64)) { int32_t ofs = sps_scale(ir->s); Reg dest = ir->r; if (ra_hasreg(dest)) { ra_free(as, dest); ra_modified(as, dest); emit_tg(as, MIPSI_MTC1, RID_RETHI, dest+1); emit_tg(as, MIPSI_MTC1, RID_RETLO, dest); } if (ofs) { emit_tsi(as, MIPSI_SW, RID_RETLO, RID_SP, ofs+(LJ_BE?4:0)); emit_tsi(as, MIPSI_SW, RID_RETHI, RID_SP, ofs+(LJ_BE?0:4)); } } else { ra_destreg(as, ir, RID_FPRET); } } else if (hiop) { ra_destpair(as, ir); } else { ra_destreg(as, ir, RID_RET); } } } static void asm_call(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX]; const CCallInfo *ci = &lj_ir_callinfo[ir->op2]; asm_collectargs(as, ir, ci, args); asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } static void asm_callx(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX*2]; CCallInfo ci; IRRef func; IRIns *irf; ci.flags = asm_callx_flags(as, ir); asm_collectargs(as, ir, &ci, args); asm_setupresult(as, ir, &ci); func = ir->op2; irf = IR(func); if (irf->o == IR_CARG) { func = irf->op1; irf = IR(func); } if (irref_isk(func)) { /* Call to constant address. */ ci.func = (ASMFunction)(void *)(irf->i); } else { /* Need specific register for indirect calls. */ Reg r = ra_alloc1(as, func, RID2RSET(RID_CFUNCADDR)); MCode *p = as->mcp; if (r == RID_CFUNCADDR) *--p = MIPSI_NOP; else *--p = MIPSI_MOVE | MIPSF_D(RID_CFUNCADDR) | MIPSF_S(r); *--p = MIPSI_JALR | MIPSF_S(r); as->mcp = p; ci.func = (ASMFunction)(void *)0; } asm_gencall(as, &ci, args); } static void asm_callid(ASMState *as, IRIns *ir, IRCallID id) { const CCallInfo *ci = &lj_ir_callinfo[id]; IRRef args[2]; args[0] = ir->op1; args[1] = ir->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } static void asm_callround(ASMState *as, IRIns *ir, IRCallID id) { /* The modified regs must match with the *.dasc implementation. */ RegSet drop = RID2RSET(RID_R1)|RID2RSET(RID_R12)|RID2RSET(RID_FPRET)| RID2RSET(RID_F2)|RID2RSET(RID_F4)|RID2RSET(REGARG_FIRSTFPR); if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); ra_evictset(as, drop); ra_destreg(as, ir, RID_FPRET); emit_call(as, (void *)lj_ir_callinfo[id].func); ra_leftov(as, REGARG_FIRSTFPR, ir->op1); } /* -- Returns ------------------------------------------------------------- */ /* Return to lower frame. Guard that it goes to the right spot. */ static void asm_retf(ASMState *as, IRIns *ir) { Reg base = ra_alloc1(as, REF_BASE, RSET_GPR); void *pc = ir_kptr(IR(ir->op2)); int32_t delta = 1+bc_a(*((const BCIns *)pc - 1)); as->topslot -= (BCReg)delta; if ((int32_t)as->topslot < 0) as->topslot = 0; irt_setmark(IR(REF_BASE)->t); /* Children must not coalesce with BASE reg. */ emit_setgl(as, base, jit_base); emit_addptr(as, base, -8*delta); asm_guard(as, MIPSI_BNE, RID_TMP, ra_allock(as, i32ptr(pc), rset_exclude(RSET_GPR, base))); emit_tsi(as, MIPSI_LW, RID_TMP, base, -8); } /* -- Type conversions ---------------------------------------------------- */ static void asm_tointg(ASMState *as, IRIns *ir, Reg left) { Reg tmp = ra_scratch(as, rset_exclude(RSET_FPR, left)); Reg dest = ra_dest(as, ir, RSET_GPR); asm_guard(as, MIPSI_BC1F, 0, 0); emit_fgh(as, MIPSI_C_EQ_D, 0, tmp, left); emit_fg(as, MIPSI_CVT_D_W, tmp, tmp); emit_tg(as, MIPSI_MFC1, dest, tmp); emit_fg(as, MIPSI_CVT_W_D, tmp, left); } static void asm_tobit(ASMState *as, IRIns *ir) { RegSet allow = RSET_FPR; Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, allow); Reg right = ra_alloc1(as, ir->op2, rset_clear(allow, left)); Reg tmp = ra_scratch(as, rset_clear(allow, right)); emit_tg(as, MIPSI_MFC1, dest, tmp); emit_fgh(as, MIPSI_ADD_D, tmp, left, right); } static void asm_conv(ASMState *as, IRIns *ir) { IRType st = (IRType)(ir->op2 & IRCONV_SRCMASK); int stfp = (st == IRT_NUM || st == IRT_FLOAT); IRRef lref = ir->op1; lua_assert(irt_type(ir->t) != st); lua_assert(!(irt_isint64(ir->t) || (st == IRT_I64 || st == IRT_U64))); /* Handled by SPLIT. */ if (irt_isfp(ir->t)) { Reg dest = ra_dest(as, ir, RSET_FPR); if (stfp) { /* FP to FP conversion. */ emit_fg(as, st == IRT_NUM ? MIPSI_CVT_S_D : MIPSI_CVT_D_S, dest, ra_alloc1(as, lref, RSET_FPR)); } else if (st == IRT_U32) { /* U32 to FP conversion. */ /* y = (x ^ 0x8000000) + 2147483648.0 */ Reg left = ra_alloc1(as, lref, RSET_GPR); Reg tmp = ra_scratch(as, rset_exclude(RSET_FPR, dest)); emit_fgh(as, irt_isfloat(ir->t) ? MIPSI_ADD_S : MIPSI_ADD_D, dest, dest, tmp); emit_fg(as, irt_isfloat(ir->t) ? MIPSI_CVT_S_W : MIPSI_CVT_D_W, dest, dest); if (irt_isfloat(ir->t)) emit_lsptr(as, MIPSI_LWC1, (tmp & 31), (void *)lj_ir_k64_find(as->J, U64x(4f000000,4f000000)), RSET_GPR); else emit_lsptr(as, MIPSI_LDC1, (tmp & 31), (void *)lj_ir_k64_find(as->J, U64x(41e00000,00000000)), RSET_GPR); emit_tg(as, MIPSI_MTC1, RID_TMP, dest); emit_dst(as, MIPSI_XOR, RID_TMP, RID_TMP, left); emit_ti(as, MIPSI_LUI, RID_TMP, 0x8000); } else { /* Integer to FP conversion. */ Reg left = ra_alloc1(as, lref, RSET_GPR); emit_fg(as, irt_isfloat(ir->t) ? MIPSI_CVT_S_W : MIPSI_CVT_D_W, dest, dest); emit_tg(as, MIPSI_MTC1, left, dest); } } else if (stfp) { /* FP to integer conversion. */ if (irt_isguard(ir->t)) { /* Checked conversions are only supported from number to int. */ lua_assert(irt_isint(ir->t) && st == IRT_NUM); asm_tointg(as, ir, ra_alloc1(as, lref, RSET_FPR)); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, lref, RSET_FPR); Reg tmp = ra_scratch(as, rset_exclude(RSET_FPR, left)); if (irt_isu32(ir->t)) { /* y = (int)floor(x - 2147483648.0) ^ 0x80000000 */ emit_dst(as, MIPSI_XOR, dest, dest, RID_TMP); emit_ti(as, MIPSI_LUI, RID_TMP, 0x8000); emit_tg(as, MIPSI_MFC1, dest, tmp); emit_fg(as, st == IRT_FLOAT ? MIPSI_FLOOR_W_S : MIPSI_FLOOR_W_D, tmp, tmp); emit_fgh(as, st == IRT_FLOAT ? MIPSI_SUB_S : MIPSI_SUB_D, tmp, left, tmp); if (st == IRT_FLOAT) emit_lsptr(as, MIPSI_LWC1, (tmp & 31), (void *)lj_ir_k64_find(as->J, U64x(4f000000,4f000000)), RSET_GPR); else emit_lsptr(as, MIPSI_LDC1, (tmp & 31), (void *)lj_ir_k64_find(as->J, U64x(41e00000,00000000)), RSET_GPR); } else { emit_tg(as, MIPSI_MFC1, dest, tmp); emit_fg(as, st == IRT_FLOAT ? MIPSI_TRUNC_W_S : MIPSI_TRUNC_W_D, tmp, left); } } } else { Reg dest = ra_dest(as, ir, RSET_GPR); if (st >= IRT_I8 && st <= IRT_U16) { /* Extend to 32 bit integer. */ Reg left = ra_alloc1(as, ir->op1, RSET_GPR); lua_assert(irt_isint(ir->t) || irt_isu32(ir->t)); if ((ir->op2 & IRCONV_SEXT)) { if ((as->flags & JIT_F_MIPS32R2)) { emit_dst(as, st == IRT_I8 ? MIPSI_SEB : MIPSI_SEH, dest, 0, left); } else { uint32_t shift = st == IRT_I8 ? 24 : 16; emit_dta(as, MIPSI_SRA, dest, dest, shift); emit_dta(as, MIPSI_SLL, dest, left, shift); } } else { emit_tsi(as, MIPSI_ANDI, dest, left, (int32_t)(st == IRT_U8 ? 0xff : 0xffff)); } } else { /* 32/64 bit integer conversions. */ /* Only need to handle 32/32 bit no-op (cast) on 32 bit archs. */ ra_leftov(as, dest, lref); /* Do nothing, but may need to move regs. */ } } } #if LJ_HASFFI static void asm_conv64(ASMState *as, IRIns *ir) { IRType st = (IRType)((ir-1)->op2 & IRCONV_SRCMASK); IRType dt = (((ir-1)->op2 & IRCONV_DSTMASK) >> IRCONV_DSH); IRCallID id; const CCallInfo *ci; IRRef args[2]; args[LJ_BE?0:1] = ir->op1; args[LJ_BE?1:0] = (ir-1)->op1; if (st == IRT_NUM || st == IRT_FLOAT) { id = IRCALL_fp64_d2l + ((st == IRT_FLOAT) ? 2 : 0) + (dt - IRT_I64); ir--; } else { id = IRCALL_fp64_l2d + ((dt == IRT_FLOAT) ? 2 : 0) + (st - IRT_I64); } ci = &lj_ir_callinfo[id]; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } #endif static void asm_strto(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_strscan_num]; IRRef args[2]; RegSet drop = RSET_SCRATCH; if (ra_hasreg(ir->r)) rset_set(drop, ir->r); /* Spill dest reg (if any). */ ra_evictset(as, drop); asm_guard(as, MIPSI_BEQ, RID_RET, RID_ZERO); /* Test return status. */ args[0] = ir->op1; /* GCstr *str */ args[1] = ASMREF_TMP1; /* TValue *n */ asm_gencall(as, ci, args); /* Store the result to the spill slot or temp slots. */ emit_tsi(as, MIPSI_ADDIU, ra_releasetmp(as, ASMREF_TMP1), RID_SP, sps_scale(ir->s)); } /* Get pointer to TValue. */ static void asm_tvptr(ASMState *as, Reg dest, IRRef ref) { IRIns *ir = IR(ref); if (irt_isnum(ir->t)) { if (irref_isk(ref)) /* Use the number constant itself as a TValue. */ ra_allockreg(as, i32ptr(ir_knum(ir)), dest); else /* Otherwise force a spill and use the spill slot. */ emit_tsi(as, MIPSI_ADDIU, dest, RID_SP, ra_spill(as, ir)); } else { /* Otherwise use g->tmptv to hold the TValue. */ RegSet allow = rset_exclude(RSET_GPR, dest); Reg type; emit_tsi(as, MIPSI_ADDIU, dest, RID_JGL, offsetof(global_State, tmptv)-32768); if (!irt_ispri(ir->t)) { Reg src = ra_alloc1(as, ref, allow); emit_setgl(as, src, tmptv.gcr); } type = ra_allock(as, irt_toitype(ir->t), allow); emit_setgl(as, type, tmptv.it); } } static void asm_tostr(ASMState *as, IRIns *ir) { IRRef args[2]; args[0] = ASMREF_L; as->gcsteps++; if (irt_isnum(IR(ir->op1)->t) || (ir+1)->o == IR_HIOP) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromnum]; args[1] = ASMREF_TMP1; /* const lua_Number * */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); asm_tvptr(as, ra_releasetmp(as, ASMREF_TMP1), ir->op1); } else { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromint]; args[1] = ir->op1; /* int32_t k */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); } } /* -- Memory references --------------------------------------------------- */ static void asm_aref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg idx, base; if (irref_isk(ir->op2)) { IRRef tab = IR(ir->op1)->op1; int32_t ofs = asm_fuseabase(as, tab); IRRef refa = ofs ? tab : ir->op1; ofs += 8*IR(ir->op2)->i; if (checki16(ofs)) { base = ra_alloc1(as, refa, RSET_GPR); emit_tsi(as, MIPSI_ADDIU, dest, base, ofs); return; } } base = ra_alloc1(as, ir->op1, RSET_GPR); idx = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, base)); emit_dst(as, MIPSI_ADDU, dest, RID_TMP, base); emit_dta(as, MIPSI_SLL, RID_TMP, idx, 3); } /* Inlined hash lookup. Specialized for key type and for const keys. ** The equivalent C code is: ** Node *n = hashkey(t, key); ** do { ** if (lj_obj_equal(&n->key, key)) return &n->val; ** } while ((n = nextnode(n))); ** return niltv(L); */ static void asm_href(ASMState *as, IRIns *ir) { RegSet allow = RSET_GPR; int destused = ra_used(ir); Reg dest = ra_dest(as, ir, allow); Reg tab = ra_alloc1(as, ir->op1, rset_clear(allow, dest)); Reg key = RID_NONE, type = RID_NONE, tmpnum = RID_NONE, tmp1 = RID_TMP, tmp2; IRRef refkey = ir->op2; IRIns *irkey = IR(refkey); IRType1 kt = irkey->t; uint32_t khash; MCLabel l_end, l_loop, l_next; rset_clear(allow, tab); if (irt_isnum(kt)) { key = ra_alloc1(as, refkey, RSET_FPR); tmpnum = ra_scratch(as, rset_exclude(RSET_FPR, key)); } else if (!irt_ispri(kt)) { key = ra_alloc1(as, refkey, allow); rset_clear(allow, key); type = ra_allock(as, irt_toitype(irkey->t), allow); rset_clear(allow, type); } tmp2 = ra_scratch(as, allow); rset_clear(allow, tmp2); /* Key not found in chain: load niltv. */ l_end = emit_label(as); if (destused) emit_loada(as, dest, niltvg(J2G(as->J))); else *--as->mcp = MIPSI_NOP; /* Follow hash chain until the end. */ emit_move(as, dest, tmp1); l_loop = --as->mcp; emit_tsi(as, MIPSI_LW, tmp1, dest, (int32_t)offsetof(Node, next)); l_next = emit_label(as); /* Type and value comparison. */ if (irt_isnum(kt)) { emit_branch(as, MIPSI_BC1T, 0, 0, l_end); emit_fgh(as, MIPSI_C_EQ_D, 0, tmpnum, key); emit_tg(as, MIPSI_MFC1, tmp1, key+1); emit_branch(as, MIPSI_BEQ, tmp1, RID_ZERO, l_next); emit_tsi(as, MIPSI_SLTIU, tmp1, tmp1, (int32_t)LJ_TISNUM); emit_hsi(as, MIPSI_LDC1, tmpnum, dest, (int32_t)offsetof(Node, key.n)); } else { if (irt_ispri(kt)) { emit_branch(as, MIPSI_BEQ, tmp1, type, l_end); } else { emit_branch(as, MIPSI_BEQ, tmp2, key, l_end); emit_tsi(as, MIPSI_LW, tmp2, dest, (int32_t)offsetof(Node, key.gcr)); emit_branch(as, MIPSI_BNE, tmp1, type, l_next); } } emit_tsi(as, MIPSI_LW, tmp1, dest, (int32_t)offsetof(Node, key.it)); *l_loop = MIPSI_BNE | MIPSF_S(tmp1) | ((as->mcp-l_loop-1) & 0xffffu); /* Load main position relative to tab->node into dest. */ khash = irref_isk(refkey) ? ir_khash(irkey) : 1; if (khash == 0) { emit_tsi(as, MIPSI_LW, dest, tab, (int32_t)offsetof(GCtab, node)); } else { Reg tmphash = tmp1; if (irref_isk(refkey)) tmphash = ra_allock(as, khash, allow); emit_dst(as, MIPSI_ADDU, dest, dest, tmp1); lua_assert(sizeof(Node) == 24); emit_dst(as, MIPSI_SUBU, tmp1, tmp2, tmp1); emit_dta(as, MIPSI_SLL, tmp1, tmp1, 3); emit_dta(as, MIPSI_SLL, tmp2, tmp1, 5); emit_dst(as, MIPSI_AND, tmp1, tmp2, tmphash); emit_tsi(as, MIPSI_LW, dest, tab, (int32_t)offsetof(GCtab, node)); emit_tsi(as, MIPSI_LW, tmp2, tab, (int32_t)offsetof(GCtab, hmask)); if (irref_isk(refkey)) { /* Nothing to do. */ } else if (irt_isstr(kt)) { emit_tsi(as, MIPSI_LW, tmp1, key, (int32_t)offsetof(GCstr, hash)); } else { /* Must match with hash*() in lj_tab.c. */ emit_dst(as, MIPSI_SUBU, tmp1, tmp1, tmp2); emit_rotr(as, tmp2, tmp2, dest, (-HASH_ROT3)&31); emit_dst(as, MIPSI_XOR, tmp1, tmp1, tmp2); emit_rotr(as, tmp1, tmp1, dest, (-HASH_ROT2-HASH_ROT1)&31); emit_dst(as, MIPSI_SUBU, tmp2, tmp2, dest); if (irt_isnum(kt)) { emit_dst(as, MIPSI_XOR, tmp2, tmp2, tmp1); if ((as->flags & JIT_F_MIPS32R2)) { emit_dta(as, MIPSI_ROTR, dest, tmp1, (-HASH_ROT1)&31); } else { emit_dst(as, MIPSI_OR, dest, dest, tmp1); emit_dta(as, MIPSI_SLL, tmp1, tmp1, HASH_ROT1); emit_dta(as, MIPSI_SRL, dest, tmp1, (-HASH_ROT1)&31); } emit_dst(as, MIPSI_ADDU, tmp1, tmp1, tmp1); emit_tg(as, MIPSI_MFC1, tmp2, key); emit_tg(as, MIPSI_MFC1, tmp1, key+1); } else { emit_dst(as, MIPSI_XOR, tmp2, key, tmp1); emit_rotr(as, dest, tmp1, tmp2, (-HASH_ROT1)&31); emit_dst(as, MIPSI_ADDU, tmp1, key, ra_allock(as, HASH_BIAS, allow)); } } } } static void asm_hrefk(ASMState *as, IRIns *ir) { IRIns *kslot = IR(ir->op2); IRIns *irkey = IR(kslot->op1); int32_t ofs = (int32_t)(kslot->op2 * sizeof(Node)); int32_t kofs = ofs + (int32_t)offsetof(Node, key); Reg dest = (ra_used(ir)||ofs > 32736) ? ra_dest(as, ir, RSET_GPR) : RID_NONE; Reg node = ra_alloc1(as, ir->op1, RSET_GPR); Reg key = RID_NONE, type = RID_TMP, idx = node; RegSet allow = rset_exclude(RSET_GPR, node); int32_t lo, hi; lua_assert(ofs % sizeof(Node) == 0); if (ofs > 32736) { idx = dest; rset_clear(allow, dest); kofs = (int32_t)offsetof(Node, key); } else if (ra_hasreg(dest)) { emit_tsi(as, MIPSI_ADDIU, dest, node, ofs); } if (!irt_ispri(irkey->t)) { key = ra_scratch(as, allow); rset_clear(allow, key); } if (irt_isnum(irkey->t)) { lo = (int32_t)ir_knum(irkey)->u32.lo; hi = (int32_t)ir_knum(irkey)->u32.hi; } else { lo = irkey->i; hi = irt_toitype(irkey->t); if (!ra_hasreg(key)) goto nolo; } asm_guard(as, MIPSI_BNE, key, lo ? ra_allock(as, lo, allow) : RID_ZERO); nolo: asm_guard(as, MIPSI_BNE, type, hi ? ra_allock(as, hi, allow) : RID_ZERO); if (ra_hasreg(key)) emit_tsi(as, MIPSI_LW, key, idx, kofs+(LJ_BE?4:0)); emit_tsi(as, MIPSI_LW, type, idx, kofs+(LJ_BE?0:4)); if (ofs > 32736) emit_tsi(as, MIPSI_ADDU, dest, node, ra_allock(as, ofs, allow)); } static void asm_newref(ASMState *as, IRIns *ir) { if (ir->r != RID_SINK) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_tab_newkey]; IRRef args[3]; args[0] = ASMREF_L; /* lua_State *L */ args[1] = ir->op1; /* GCtab *t */ args[2] = ASMREF_TMP1; /* cTValue *key */ asm_setupresult(as, ir, ci); /* TValue * */ asm_gencall(as, ci, args); asm_tvptr(as, ra_releasetmp(as, ASMREF_TMP1), ir->op2); } } static void asm_uref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); MRef *v = &gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv.v; emit_lsptr(as, MIPSI_LW, dest, v, RSET_GPR); } else { Reg uv = ra_scratch(as, RSET_GPR); Reg func = ra_alloc1(as, ir->op1, RSET_GPR); if (ir->o == IR_UREFC) { asm_guard(as, MIPSI_BEQ, RID_TMP, RID_ZERO); emit_tsi(as, MIPSI_ADDIU, dest, uv, (int32_t)offsetof(GCupval, tv)); emit_tsi(as, MIPSI_LBU, RID_TMP, uv, (int32_t)offsetof(GCupval, closed)); } else { emit_tsi(as, MIPSI_LW, dest, uv, (int32_t)offsetof(GCupval, v)); } emit_tsi(as, MIPSI_LW, uv, func, (int32_t)offsetof(GCfuncL, uvptr) + 4*(int32_t)(ir->op2 >> 8)); } } static void asm_fref(ASMState *as, IRIns *ir) { UNUSED(as); UNUSED(ir); lua_assert(!ra_used(ir)); } static void asm_strref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); IRRef ref = ir->op2, refk = ir->op1; int32_t ofs = (int32_t)sizeof(GCstr); Reg r; if (irref_isk(ref)) { IRRef tmp = refk; refk = ref; ref = tmp; } else if (!irref_isk(refk)) { Reg right, left = ra_alloc1(as, ir->op1, RSET_GPR); IRIns *irr = IR(ir->op2); if (ra_hasreg(irr->r)) { ra_noweak(as, irr->r); right = irr->r; } else if (mayfuse(as, irr->op2) && irr->o == IR_ADD && irref_isk(irr->op2) && checki16(ofs + IR(irr->op2)->i)) { ofs += IR(irr->op2)->i; right = ra_alloc1(as, irr->op1, rset_exclude(RSET_GPR, left)); } else { right = ra_allocref(as, ir->op2, rset_exclude(RSET_GPR, left)); } emit_tsi(as, MIPSI_ADDIU, dest, dest, ofs); emit_dst(as, MIPSI_ADDU, dest, left, right); return; } r = ra_alloc1(as, ref, RSET_GPR); ofs += IR(refk)->i; if (checki16(ofs)) emit_tsi(as, MIPSI_ADDIU, dest, r, ofs); else emit_dst(as, MIPSI_ADDU, dest, r, ra_allock(as, ofs, rset_exclude(RSET_GPR, r))); } /* -- Loads and stores ---------------------------------------------------- */ static MIPSIns asm_fxloadins(IRIns *ir) { switch (irt_type(ir->t)) { case IRT_I8: return MIPSI_LB; case IRT_U8: return MIPSI_LBU; case IRT_I16: return MIPSI_LH; case IRT_U16: return MIPSI_LHU; case IRT_NUM: return MIPSI_LDC1; case IRT_FLOAT: return MIPSI_LWC1; default: return MIPSI_LW; } } static MIPSIns asm_fxstoreins(IRIns *ir) { switch (irt_type(ir->t)) { case IRT_I8: case IRT_U8: return MIPSI_SB; case IRT_I16: case IRT_U16: return MIPSI_SH; case IRT_NUM: return MIPSI_SDC1; case IRT_FLOAT: return MIPSI_SWC1; default: return MIPSI_SW; } } static void asm_fload(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg idx = ra_alloc1(as, ir->op1, RSET_GPR); MIPSIns mi = asm_fxloadins(ir); int32_t ofs; if (ir->op2 == IRFL_TAB_ARRAY) { ofs = asm_fuseabase(as, ir->op1); if (ofs) { /* Turn the t->array load into an add for colocated arrays. */ emit_tsi(as, MIPSI_ADDIU, dest, idx, ofs); return; } } ofs = field_ofs[ir->op2]; lua_assert(!irt_isfp(ir->t)); emit_tsi(as, mi, dest, idx, ofs); } static void asm_fstore(ASMState *as, IRIns *ir) { if (ir->r != RID_SINK) { Reg src = ra_alloc1z(as, ir->op2, RSET_GPR); IRIns *irf = IR(ir->op1); Reg idx = ra_alloc1(as, irf->op1, rset_exclude(RSET_GPR, src)); int32_t ofs = field_ofs[irf->op2]; MIPSIns mi = asm_fxstoreins(ir); lua_assert(!irt_isfp(ir->t)); emit_tsi(as, mi, src, idx, ofs); } } static void asm_xload(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); lua_assert(!(ir->op2 & IRXLOAD_UNALIGNED)); asm_fusexref(as, asm_fxloadins(ir), dest, ir->op1, RSET_GPR, 0); } static void asm_xstore(ASMState *as, IRIns *ir, int32_t ofs) { if (ir->r != RID_SINK) { Reg src = ra_alloc1z(as, ir->op2, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); asm_fusexref(as, asm_fxstoreins(ir), src, ir->op1, rset_exclude(RSET_GPR, src), ofs); } } static void asm_ahuvload(ASMState *as, IRIns *ir) { IRType1 t = ir->t; Reg dest = RID_NONE, type = RID_TMP, idx; RegSet allow = RSET_GPR; int32_t ofs = 0; if (ra_used(ir)) { lua_assert(irt_isnum(t) || irt_isint(t) || irt_isaddr(t)); dest = ra_dest(as, ir, irt_isnum(t) ? RSET_FPR : RSET_GPR); rset_clear(allow, dest); } idx = asm_fuseahuref(as, ir->op1, &ofs, allow); rset_clear(allow, idx); if (irt_isnum(t)) { asm_guard(as, MIPSI_BEQ, type, RID_ZERO); emit_tsi(as, MIPSI_SLTIU, type, type, (int32_t)LJ_TISNUM); if (ra_hasreg(dest)) emit_hsi(as, MIPSI_LDC1, dest, idx, ofs); } else { asm_guard(as, MIPSI_BNE, type, ra_allock(as, irt_toitype(t), allow)); if (ra_hasreg(dest)) emit_tsi(as, MIPSI_LW, dest, idx, ofs+(LJ_BE?4:0)); } emit_tsi(as, MIPSI_LW, type, idx, ofs+(LJ_BE?0:4)); } static void asm_ahustore(ASMState *as, IRIns *ir) { RegSet allow = RSET_GPR; Reg idx, src = RID_NONE, type = RID_NONE; int32_t ofs = 0; if (ir->r == RID_SINK) return; if (irt_isnum(ir->t)) { src = ra_alloc1(as, ir->op2, RSET_FPR); } else { if (!irt_ispri(ir->t)) { src = ra_alloc1(as, ir->op2, allow); rset_clear(allow, src); } type = ra_allock(as, (int32_t)irt_toitype(ir->t), allow); rset_clear(allow, type); } idx = asm_fuseahuref(as, ir->op1, &ofs, allow); if (irt_isnum(ir->t)) { emit_hsi(as, MIPSI_SDC1, src, idx, ofs); } else { if (ra_hasreg(src)) emit_tsi(as, MIPSI_SW, src, idx, ofs+(LJ_BE?4:0)); emit_tsi(as, MIPSI_SW, type, idx, ofs+(LJ_BE?0:4)); } } static void asm_sload(ASMState *as, IRIns *ir) { int32_t ofs = 8*((int32_t)ir->op1-1) + ((ir->op2 & IRSLOAD_FRAME) ? 4 : 0); IRType1 t = ir->t; Reg dest = RID_NONE, type = RID_NONE, base; RegSet allow = RSET_GPR; lua_assert(!(ir->op2 & IRSLOAD_PARENT)); /* Handled by asm_head_side(). */ lua_assert(irt_isguard(t) || !(ir->op2 & IRSLOAD_TYPECHECK)); lua_assert(!irt_isint(t) || (ir->op2 & (IRSLOAD_CONVERT|IRSLOAD_FRAME))); if ((ir->op2 & IRSLOAD_CONVERT) && irt_isguard(t) && irt_isint(t)) { dest = ra_scratch(as, RSET_FPR); asm_tointg(as, ir, dest); t.irt = IRT_NUM; /* Continue with a regular number type check. */ } else if (ra_used(ir)) { lua_assert(irt_isnum(t) || irt_isint(t) || irt_isaddr(t)); dest = ra_dest(as, ir, irt_isnum(t) ? RSET_FPR : RSET_GPR); rset_clear(allow, dest); base = ra_alloc1(as, REF_BASE, allow); rset_clear(allow, base); if ((ir->op2 & IRSLOAD_CONVERT)) { if (irt_isint(t)) { Reg tmp = ra_scratch(as, RSET_FPR); emit_tg(as, MIPSI_MFC1, dest, tmp); emit_fg(as, MIPSI_CVT_W_D, tmp, tmp); dest = tmp; t.irt = IRT_NUM; /* Check for original type. */ } else { Reg tmp = ra_scratch(as, RSET_GPR); emit_fg(as, MIPSI_CVT_D_W, dest, dest); emit_tg(as, MIPSI_MTC1, tmp, dest); dest = tmp; t.irt = IRT_INT; /* Check for original type. */ } } goto dotypecheck; } base = ra_alloc1(as, REF_BASE, allow); rset_clear(allow, base); dotypecheck: if (irt_isnum(t)) { if ((ir->op2 & IRSLOAD_TYPECHECK)) { asm_guard(as, MIPSI_BEQ, RID_TMP, RID_ZERO); emit_tsi(as, MIPSI_SLTIU, RID_TMP, RID_TMP, (int32_t)LJ_TISNUM); type = RID_TMP; } if (ra_hasreg(dest)) emit_hsi(as, MIPSI_LDC1, dest, base, ofs); } else { if ((ir->op2 & IRSLOAD_TYPECHECK)) { Reg ktype = ra_allock(as, irt_toitype(t), allow); asm_guard(as, MIPSI_BNE, RID_TMP, ktype); type = RID_TMP; } if (ra_hasreg(dest)) emit_tsi(as, MIPSI_LW, dest, base, ofs ^ (LJ_BE?4:0)); } if (ra_hasreg(type)) emit_tsi(as, MIPSI_LW, type, base, ofs ^ (LJ_BE?0:4)); } /* -- Allocations --------------------------------------------------------- */ #if LJ_HASFFI static void asm_cnew(ASMState *as, IRIns *ir) { CTState *cts = ctype_ctsG(J2G(as->J)); CTypeID ctypeid = (CTypeID)IR(ir->op1)->i; CTSize sz = (ir->o == IR_CNEWI || ir->op2 == REF_NIL) ? lj_ctype_size(cts, ctypeid) : (CTSize)IR(ir->op2)->i; const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_mem_newgco]; IRRef args[2]; RegSet allow = (RSET_GPR & ~RSET_SCRATCH); RegSet drop = RSET_SCRATCH; lua_assert(sz != CTSIZE_INVALID); args[0] = ASMREF_L; /* lua_State *L */ args[1] = ASMREF_TMP1; /* MSize size */ as->gcsteps++; if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ ra_evictset(as, drop); if (ra_used(ir)) ra_destreg(as, ir, RID_RET); /* GCcdata * */ /* Initialize immutable cdata object. */ if (ir->o == IR_CNEWI) { int32_t ofs = sizeof(GCcdata); lua_assert(sz == 4 || sz == 8); if (sz == 8) { ofs += 4; lua_assert((ir+1)->o == IR_HIOP); if (LJ_LE) ir++; } for (;;) { Reg r = ra_alloc1z(as, ir->op2, allow); emit_tsi(as, MIPSI_SW, r, RID_RET, ofs); rset_clear(allow, r); if (ofs == sizeof(GCcdata)) break; ofs -= 4; if (LJ_BE) ir++; else ir--; } } /* Initialize gct and ctypeid. lj_mem_newgco() already sets marked. */ emit_tsi(as, MIPSI_SB, RID_RET+1, RID_RET, offsetof(GCcdata, gct)); emit_tsi(as, MIPSI_SH, RID_TMP, RID_RET, offsetof(GCcdata, ctypeid)); emit_ti(as, MIPSI_LI, RID_RET+1, ~LJ_TCDATA); emit_ti(as, MIPSI_LI, RID_TMP, ctypeid); /* Lower 16 bit used. Sign-ext ok. */ asm_gencall(as, ci, args); ra_allockreg(as, (int32_t)(sz+sizeof(GCcdata)), ra_releasetmp(as, ASMREF_TMP1)); } #else #define asm_cnew(as, ir) ((void)0) #endif /* -- Write barriers ------------------------------------------------------ */ static void asm_tbar(ASMState *as, IRIns *ir) { Reg tab = ra_alloc1(as, ir->op1, RSET_GPR); Reg mark = ra_scratch(as, rset_exclude(RSET_GPR, tab)); Reg link = RID_TMP; MCLabel l_end = emit_label(as); emit_tsi(as, MIPSI_SW, link, tab, (int32_t)offsetof(GCtab, gclist)); emit_tsi(as, MIPSI_SB, mark, tab, (int32_t)offsetof(GCtab, marked)); emit_setgl(as, tab, gc.grayagain); emit_getgl(as, link, gc.grayagain); emit_dst(as, MIPSI_XOR, mark, mark, RID_TMP); /* Clear black bit. */ emit_branch(as, MIPSI_BEQ, RID_TMP, RID_ZERO, l_end); emit_tsi(as, MIPSI_ANDI, RID_TMP, mark, LJ_GC_BLACK); emit_tsi(as, MIPSI_LBU, mark, tab, (int32_t)offsetof(GCtab, marked)); } static void asm_obar(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_barrieruv]; IRRef args[2]; MCLabel l_end; Reg obj, val, tmp; /* No need for other object barriers (yet). */ lua_assert(IR(ir->op1)->o == IR_UREFC); ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ir->op1; /* TValue *tv */ asm_gencall(as, ci, args); emit_tsi(as, MIPSI_ADDIU, ra_releasetmp(as, ASMREF_TMP1), RID_JGL, -32768); obj = IR(ir->op1)->r; tmp = ra_scratch(as, rset_exclude(RSET_GPR, obj)); emit_branch(as, MIPSI_BEQ, RID_TMP, RID_ZERO, l_end); emit_tsi(as, MIPSI_ANDI, tmp, tmp, LJ_GC_BLACK); emit_branch(as, MIPSI_BEQ, RID_TMP, RID_ZERO, l_end); emit_tsi(as, MIPSI_ANDI, RID_TMP, RID_TMP, LJ_GC_WHITES); val = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, obj)); emit_tsi(as, MIPSI_LBU, tmp, obj, (int32_t)offsetof(GCupval, marked)-(int32_t)offsetof(GCupval, tv)); emit_tsi(as, MIPSI_LBU, RID_TMP, val, (int32_t)offsetof(GChead, marked)); } /* -- Arithmetic and logic operations ------------------------------------- */ static void asm_fparith(ASMState *as, IRIns *ir, MIPSIns mi) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = (left >> 8); left &= 255; emit_fgh(as, mi, dest, left, right); } static void asm_fpunary(ASMState *as, IRIns *ir, MIPSIns mi) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg left = ra_hintalloc(as, ir->op1, dest, RSET_FPR); emit_fg(as, mi, dest, left); } static int asm_fpjoin_pow(ASMState *as, IRIns *ir) { IRIns *irp = IR(ir->op1); if (irp == ir-1 && irp->o == IR_MUL && !ra_used(irp)) { IRIns *irpp = IR(irp->op1); if (irpp == ir-2 && irpp->o == IR_FPMATH && irpp->op2 == IRFPM_LOG2 && !ra_used(irpp)) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_pow]; IRRef args[2]; args[0] = irpp->op1; args[1] = irp->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); return 1; } } return 0; } static void asm_add(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { asm_fparith(as, ir, MIPSI_ADD_D); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (checki16(k)) { emit_tsi(as, MIPSI_ADDIU, dest, left, k); return; } } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_dst(as, MIPSI_ADDU, dest, left, right); } } static void asm_sub(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { asm_fparith(as, ir, MIPSI_SUB_D); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; emit_dst(as, MIPSI_SUBU, dest, left, right); } } static void asm_mul(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { asm_fparith(as, ir, MIPSI_MUL_D); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; emit_dst(as, MIPSI_MUL, dest, left, right); } } static void asm_neg(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) { asm_fpunary(as, ir, MIPSI_NEG_D); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); emit_dst(as, MIPSI_SUBU, dest, RID_ZERO, left); } } static void asm_arithov(ASMState *as, IRIns *ir) { Reg right, left, tmp, dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op2)) { int k = IR(ir->op2)->i; if (ir->o == IR_SUBOV) k = -k; if (checki16(k)) { /* (dest < left) == (k >= 0 ? 1 : 0) */ left = ra_alloc1(as, ir->op1, RSET_GPR); asm_guard(as, k >= 0 ? MIPSI_BNE : MIPSI_BEQ, RID_TMP, RID_ZERO); emit_dst(as, MIPSI_SLT, RID_TMP, dest, dest == left ? RID_TMP : left); emit_tsi(as, MIPSI_ADDIU, dest, left, k); if (dest == left) emit_move(as, RID_TMP, left); return; } } left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; tmp = ra_scratch(as, rset_exclude(rset_exclude(rset_exclude(RSET_GPR, left), right), dest)); asm_guard(as, MIPSI_BLTZ, RID_TMP, 0); emit_dst(as, MIPSI_AND, RID_TMP, RID_TMP, tmp); if (ir->o == IR_ADDOV) { /* ((dest^left) & (dest^right)) < 0 */ emit_dst(as, MIPSI_XOR, RID_TMP, dest, dest == right ? RID_TMP : right); } else { /* ((dest^left) & (dest^~right)) < 0 */ emit_dst(as, MIPSI_XOR, RID_TMP, RID_TMP, dest); emit_dst(as, MIPSI_NOR, RID_TMP, dest == right ? RID_TMP : right, RID_ZERO); } emit_dst(as, MIPSI_XOR, tmp, dest, dest == left ? RID_TMP : left); emit_dst(as, ir->o == IR_ADDOV ? MIPSI_ADDU : MIPSI_SUBU, dest, left, right); if (dest == left || dest == right) emit_move(as, RID_TMP, dest == left ? left : right); } static void asm_mulov(ASMState *as, IRIns *ir) { #if LJ_DUALNUM #error "NYI: MULOV" #else UNUSED(as); UNUSED(ir); lua_assert(0); /* Unused in single-number mode. */ #endif } #if LJ_HASFFI static void asm_add64(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_alloc1(as, ir->op1, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (k == 0) { emit_dst(as, MIPSI_ADDU, dest, left, RID_TMP); goto loarith; } else if (checki16(k)) { emit_dst(as, MIPSI_ADDU, dest, dest, RID_TMP); emit_tsi(as, MIPSI_ADDIU, dest, left, k); goto loarith; } } emit_dst(as, MIPSI_ADDU, dest, dest, RID_TMP); right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_dst(as, MIPSI_ADDU, dest, left, right); loarith: ir--; dest = ra_dest(as, ir, RSET_GPR); left = ra_alloc1(as, ir->op1, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (k == 0) { if (dest != left) emit_move(as, dest, left); return; } else if (checki16(k)) { if (dest == left) { Reg tmp = ra_scratch(as, rset_exclude(RSET_GPR, left)); emit_move(as, dest, tmp); dest = tmp; } emit_dst(as, MIPSI_SLTU, RID_TMP, dest, left); emit_tsi(as, MIPSI_ADDIU, dest, left, k); return; } } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); if (dest == left && dest == right) { Reg tmp = ra_scratch(as, rset_exclude(rset_exclude(RSET_GPR, left), right)); emit_move(as, dest, tmp); dest = tmp; } emit_dst(as, MIPSI_SLTU, RID_TMP, dest, dest == left ? right : left); emit_dst(as, MIPSI_ADDU, dest, left, right); } static void asm_sub64(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; emit_dst(as, MIPSI_SUBU, dest, dest, RID_TMP); emit_dst(as, MIPSI_SUBU, dest, left, right); ir--; dest = ra_dest(as, ir, RSET_GPR); left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; if (dest == left) { Reg tmp = ra_scratch(as, rset_exclude(rset_exclude(RSET_GPR, left), right)); emit_move(as, dest, tmp); dest = tmp; } emit_dst(as, MIPSI_SLTU, RID_TMP, left, dest); emit_dst(as, MIPSI_SUBU, dest, left, right); } static void asm_neg64(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, RSET_GPR); emit_dst(as, MIPSI_SUBU, dest, dest, RID_TMP); emit_dst(as, MIPSI_SUBU, dest, RID_ZERO, left); ir--; dest = ra_dest(as, ir, RSET_GPR); left = ra_alloc1(as, ir->op1, RSET_GPR); emit_dst(as, MIPSI_SLTU, RID_TMP, RID_ZERO, dest); emit_dst(as, MIPSI_SUBU, dest, RID_ZERO, left); } #endif static void asm_bitnot(ASMState *as, IRIns *ir) { Reg left, right, dest = ra_dest(as, ir, RSET_GPR); IRIns *irl = IR(ir->op1); if (mayfuse(as, ir->op1) && irl->o == IR_BOR) { left = ra_alloc2(as, irl, RSET_GPR); right = (left >> 8); left &= 255; } else { left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); right = RID_ZERO; } emit_dst(as, MIPSI_NOR, dest, left, right); } static void asm_bitswap(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg left = ra_alloc1(as, ir->op1, RSET_GPR); if ((as->flags & JIT_F_MIPS32R2)) { emit_dta(as, MIPSI_ROTR, dest, RID_TMP, 16); emit_dst(as, MIPSI_WSBH, RID_TMP, 0, left); } else { Reg tmp = ra_scratch(as, rset_exclude(rset_exclude(RSET_GPR, left), dest)); emit_dst(as, MIPSI_OR, dest, dest, tmp); emit_dst(as, MIPSI_OR, dest, dest, RID_TMP); emit_tsi(as, MIPSI_ANDI, dest, dest, 0xff00); emit_dta(as, MIPSI_SLL, RID_TMP, RID_TMP, 8); emit_dta(as, MIPSI_SRL, dest, left, 8); emit_tsi(as, MIPSI_ANDI, RID_TMP, left, 0xff00); emit_dst(as, MIPSI_OR, tmp, tmp, RID_TMP); emit_dta(as, MIPSI_SRL, tmp, left, 24); emit_dta(as, MIPSI_SLL, RID_TMP, left, 24); } } static void asm_bitop(ASMState *as, IRIns *ir, MIPSIns mi, MIPSIns mik) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (checku16(k)) { emit_tsi(as, mik, dest, left, k); return; } } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); emit_dst(as, mi, dest, left, right); } static void asm_bitshift(ASMState *as, IRIns *ir, MIPSIns mi, MIPSIns mik) { Reg dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op2)) { /* Constant shifts. */ uint32_t shift = (uint32_t)(IR(ir->op2)->i & 31); emit_dta(as, mik, dest, ra_hintalloc(as, ir->op1, dest, RSET_GPR), shift); } else { Reg right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; emit_dst(as, mi, dest, right, left); /* Shift amount is in rs. */ } } static void asm_bitror(ASMState *as, IRIns *ir) { if ((as->flags & JIT_F_MIPS32R2)) { asm_bitshift(as, ir, MIPSI_ROTRV, MIPSI_ROTR); } else { Reg dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op2)) { /* Constant shifts. */ uint32_t shift = (uint32_t)(IR(ir->op2)->i & 31); Reg left = ra_hintalloc(as, ir->op1, dest, RSET_GPR); emit_rotr(as, dest, left, RID_TMP, shift); } else { Reg right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; emit_dst(as, MIPSI_OR, dest, dest, RID_TMP); emit_dst(as, MIPSI_SRLV, dest, right, left); emit_dst(as, MIPSI_SLLV, RID_TMP, RID_TMP, left); emit_dst(as, MIPSI_SUBU, RID_TMP, ra_allock(as, 32, RSET_GPR), right); } } } static void asm_min_max(ASMState *as, IRIns *ir, int ismax) { if (irt_isnum(ir->t)) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = (left >> 8); left &= 255; if (dest == left) { emit_fg(as, MIPSI_MOVT_D, dest, right); } else { emit_fg(as, MIPSI_MOVF_D, dest, left); if (dest != right) emit_fg(as, MIPSI_MOV_D, dest, right); } emit_fgh(as, MIPSI_C_OLT_D, 0, ismax ? left : right, ismax ? right : left); } else { Reg dest = ra_dest(as, ir, RSET_GPR); Reg right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; if (dest == left) { emit_dst(as, MIPSI_MOVN, dest, right, RID_TMP); } else { emit_dst(as, MIPSI_MOVZ, dest, left, RID_TMP); if (dest != right) emit_move(as, dest, right); } emit_dst(as, MIPSI_SLT, RID_TMP, ismax ? left : right, ismax ? right : left); } } /* -- Comparisons --------------------------------------------------------- */ static void asm_comp(ASMState *as, IRIns *ir) { /* ORDER IR: LT GE LE GT ULT UGE ULE UGT. */ IROp op = ir->o; if (irt_isnum(ir->t)) { Reg right, left = ra_alloc2(as, ir, RSET_FPR); right = (left >> 8); left &= 255; asm_guard(as, (op&1) ? MIPSI_BC1T : MIPSI_BC1F, 0, 0); emit_fgh(as, MIPSI_C_OLT_D + ((op&3) ^ ((op>>2)&1)), 0, left, right); } else { Reg right, left = ra_alloc1(as, ir->op1, RSET_GPR); if (op == IR_ABC) op = IR_UGT; if ((op&4) == 0 && irref_isk(ir->op2) && IR(ir->op2)->i == 0) { MIPSIns mi = (op&2) ? ((op&1) ? MIPSI_BLEZ : MIPSI_BGTZ) : ((op&1) ? MIPSI_BLTZ : MIPSI_BGEZ); asm_guard(as, mi, left, 0); } else { if (irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if ((op&2)) k++; if (checki16(k)) { asm_guard(as, (op&1) ? MIPSI_BNE : MIPSI_BEQ, RID_TMP, RID_ZERO); emit_tsi(as, (op&4) ? MIPSI_SLTIU : MIPSI_SLTI, RID_TMP, left, k); return; } } right = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, left)); asm_guard(as, ((op^(op>>1))&1) ? MIPSI_BNE : MIPSI_BEQ, RID_TMP, RID_ZERO); emit_dst(as, (op&4) ? MIPSI_SLTU : MIPSI_SLT, RID_TMP, (op&2) ? right : left, (op&2) ? left : right); } } } static void asm_compeq(ASMState *as, IRIns *ir) { Reg right, left = ra_alloc2(as, ir, irt_isnum(ir->t) ? RSET_FPR : RSET_GPR); right = (left >> 8); left &= 255; if (irt_isnum(ir->t)) { asm_guard(as, (ir->o & 1) ? MIPSI_BC1T : MIPSI_BC1F, 0, 0); emit_fgh(as, MIPSI_C_EQ_D, 0, left, right); } else { asm_guard(as, (ir->o & 1) ? MIPSI_BEQ : MIPSI_BNE, left, right); } } #if LJ_HASFFI /* 64 bit integer comparisons. */ static void asm_comp64(ASMState *as, IRIns *ir) { /* ORDER IR: LT GE LE GT ULT UGE ULE UGT. */ IROp op = (ir-1)->o; MCLabel l_end; Reg rightlo, leftlo, righthi, lefthi = ra_alloc2(as, ir, RSET_GPR); righthi = (lefthi >> 8); lefthi &= 255; leftlo = ra_alloc2(as, ir-1, rset_exclude(rset_exclude(RSET_GPR, lefthi), righthi)); rightlo = (leftlo >> 8); leftlo &= 255; asm_guard(as, ((op^(op>>1))&1) ? MIPSI_BNE : MIPSI_BEQ, RID_TMP, RID_ZERO); l_end = emit_label(as); if (lefthi != righthi) emit_dst(as, (op&4) ? MIPSI_SLTU : MIPSI_SLT, RID_TMP, (op&2) ? righthi : lefthi, (op&2) ? lefthi : righthi); emit_dst(as, MIPSI_SLTU, RID_TMP, (op&2) ? rightlo : leftlo, (op&2) ? leftlo : rightlo); if (lefthi != righthi) emit_branch(as, MIPSI_BEQ, lefthi, righthi, l_end); } static void asm_comp64eq(ASMState *as, IRIns *ir) { Reg tmp, right, left = ra_alloc2(as, ir, RSET_GPR); right = (left >> 8); left &= 255; asm_guard(as, ((ir-1)->o & 1) ? MIPSI_BEQ : MIPSI_BNE, RID_TMP, RID_ZERO); tmp = ra_scratch(as, rset_exclude(rset_exclude(RSET_GPR, left), right)); emit_dst(as, MIPSI_OR, RID_TMP, RID_TMP, tmp); emit_dst(as, MIPSI_XOR, tmp, left, right); left = ra_alloc2(as, ir-1, RSET_GPR); right = (left >> 8); left &= 255; emit_dst(as, MIPSI_XOR, RID_TMP, left, right); } #endif /* -- Support for 64 bit ops in 32 bit mode ------------------------------- */ /* Hiword op of a split 64 bit op. Previous op must be the loword op. */ static void asm_hiop(ASMState *as, IRIns *ir) { #if LJ_HASFFI /* HIOP is marked as a store because it needs its own DCE logic. */ int uselo = ra_used(ir-1), usehi = ra_used(ir); /* Loword/hiword used? */ if (LJ_UNLIKELY(!(as->flags & JIT_F_OPT_DCE))) uselo = usehi = 1; if ((ir-1)->o == IR_CONV) { /* Conversions to/from 64 bit. */ as->curins--; /* Always skip the CONV. */ if (usehi || uselo) asm_conv64(as, ir); return; } else if ((ir-1)->o < IR_EQ) { /* 64 bit integer comparisons. ORDER IR. */ as->curins--; /* Always skip the loword comparison. */ asm_comp64(as, ir); return; } else if ((ir-1)->o <= IR_NE) { /* 64 bit integer comparisons. ORDER IR. */ as->curins--; /* Always skip the loword comparison. */ asm_comp64eq(as, ir); return; } else if ((ir-1)->o == IR_XSTORE) { as->curins--; /* Handle both stores here. */ if ((ir-1)->r != RID_SINK) { asm_xstore(as, ir, LJ_LE ? 4 : 0); asm_xstore(as, ir-1, LJ_LE ? 0 : 4); } return; } if (!usehi) return; /* Skip unused hiword op for all remaining ops. */ switch ((ir-1)->o) { case IR_ADD: as->curins--; asm_add64(as, ir); break; case IR_SUB: as->curins--; asm_sub64(as, ir); break; case IR_NEG: as->curins--; asm_neg64(as, ir); break; case IR_CALLN: case IR_CALLXS: if (!uselo) ra_allocref(as, ir->op1, RID2RSET(RID_RETLO)); /* Mark lo op as used. */ break; case IR_CNEWI: /* Nothing to do here. Handled by lo op itself. */ break; default: lua_assert(0); break; } #else UNUSED(as); UNUSED(ir); lua_assert(0); /* Unused without FFI. */ #endif } /* -- Stack handling ------------------------------------------------------ */ /* Check Lua stack size for overflow. Use exit handler as fallback. */ static void asm_stack_check(ASMState *as, BCReg topslot, IRIns *irp, RegSet allow, ExitNo exitno) { /* Try to get an unused temp. register, otherwise spill/restore RID_RET*. */ Reg tmp, pbase = irp ? (ra_hasreg(irp->r) ? irp->r : RID_TMP) : RID_BASE; ExitNo oldsnap = as->snapno; rset_clear(allow, pbase); tmp = allow ? rset_pickbot(allow) : (pbase == RID_RETHI ? RID_RETLO : RID_RETHI); as->snapno = exitno; asm_guard(as, MIPSI_BNE, RID_TMP, RID_ZERO); as->snapno = oldsnap; if (allow == RSET_EMPTY) /* Restore temp. register. */ emit_tsi(as, MIPSI_LW, tmp, RID_SP, 0); else ra_modified(as, tmp); emit_tsi(as, MIPSI_SLTIU, RID_TMP, RID_TMP, (int32_t)(8*topslot)); emit_dst(as, MIPSI_SUBU, RID_TMP, tmp, pbase); emit_tsi(as, MIPSI_LW, tmp, tmp, offsetof(lua_State, maxstack)); if (pbase == RID_TMP) emit_getgl(as, RID_TMP, jit_base); emit_getgl(as, tmp, jit_L); if (allow == RSET_EMPTY) /* Spill temp. register. */ emit_tsi(as, MIPSI_SW, tmp, RID_SP, 0); } /* Restore Lua stack from on-trace state. */ static void asm_stack_restore(ASMState *as, SnapShot *snap) { SnapEntry *map = &as->T->snapmap[snap->mapofs]; SnapEntry *flinks = &as->T->snapmap[snap_nextofs(as->T, snap)-1]; MSize n, nent = snap->nent; /* Store the value of all modified slots to the Lua stack. */ for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; BCReg s = snap_slot(sn); int32_t ofs = 8*((int32_t)s-1); IRRef ref = snap_ref(sn); IRIns *ir = IR(ref); if ((sn & SNAP_NORESTORE)) continue; if (irt_isnum(ir->t)) { Reg src = ra_alloc1(as, ref, RSET_FPR); emit_hsi(as, MIPSI_SDC1, src, RID_BASE, ofs); } else { Reg type; RegSet allow = rset_exclude(RSET_GPR, RID_BASE); lua_assert(irt_ispri(ir->t) || irt_isaddr(ir->t) || irt_isinteger(ir->t)); if (!irt_ispri(ir->t)) { Reg src = ra_alloc1(as, ref, allow); rset_clear(allow, src); emit_tsi(as, MIPSI_SW, src, RID_BASE, ofs+(LJ_BE?4:0)); } if ((sn & (SNAP_CONT|SNAP_FRAME))) { if (s == 0) continue; /* Do not overwrite link to previous frame. */ type = ra_allock(as, (int32_t)(*flinks--), allow); } else { type = ra_allock(as, (int32_t)irt_toitype(ir->t), allow); } emit_tsi(as, MIPSI_SW, type, RID_BASE, ofs+(LJ_BE?0:4)); } checkmclim(as); } lua_assert(map + nent == flinks); } /* -- GC handling --------------------------------------------------------- */ /* Check GC threshold and do one or more GC steps. */ static void asm_gc_check(ASMState *as) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_step_jit]; IRRef args[2]; MCLabel l_end; Reg tmp; ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); /* Exit trace if in GCSatomic or GCSfinalize. Avoids syncing GC objects. */ /* Assumes asm_snap_prep() already done. */ asm_guard(as, MIPSI_BNE, RID_RET, RID_ZERO); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ASMREF_TMP2; /* MSize steps */ asm_gencall(as, ci, args); emit_tsi(as, MIPSI_ADDIU, ra_releasetmp(as, ASMREF_TMP1), RID_JGL, -32768); tmp = ra_releasetmp(as, ASMREF_TMP2); emit_loadi(as, tmp, as->gcsteps); /* Jump around GC step if GC total < GC threshold. */ emit_branch(as, MIPSI_BNE, RID_TMP, RID_ZERO, l_end); emit_dst(as, MIPSI_SLTU, RID_TMP, RID_TMP, tmp); emit_getgl(as, tmp, gc.threshold); emit_getgl(as, RID_TMP, gc.total); as->gcsteps = 0; checkmclim(as); } /* -- Loop handling ------------------------------------------------------- */ /* Fixup the loop branch. */ static void asm_loop_fixup(ASMState *as) { MCode *p = as->mctop; MCode *target = as->mcp; p[-1] = MIPSI_NOP; if (as->loopinv) { /* Inverted loop branch? */ /* asm_guard already inverted the cond branch. Only patch the target. */ p[-3] |= ((target-p+2) & 0x0000ffffu); } else { p[-2] = MIPSI_J|(((uintptr_t)target>>2)&0x03ffffffu); } } /* -- Head of trace ------------------------------------------------------- */ /* Coalesce BASE register for a root trace. */ static void asm_head_root_base(ASMState *as) { IRIns *ir = IR(REF_BASE); Reg r = ir->r; if (as->loopinv) as->mctop--; if (ra_hasreg(r)) { ra_free(as, r); if (rset_test(as->modset, r) || irt_ismarked(ir->t)) ir->r = RID_INIT; /* No inheritance for modified BASE register. */ if (r != RID_BASE) emit_move(as, r, RID_BASE); } } /* Coalesce BASE register for a side trace. */ static RegSet asm_head_side_base(ASMState *as, IRIns *irp, RegSet allow) { IRIns *ir = IR(REF_BASE); Reg r = ir->r; if (as->loopinv) as->mctop--; if (ra_hasreg(r)) { ra_free(as, r); if (rset_test(as->modset, r) || irt_ismarked(ir->t)) ir->r = RID_INIT; /* No inheritance for modified BASE register. */ if (irp->r == r) { rset_clear(allow, r); /* Mark same BASE register as coalesced. */ } else if (ra_hasreg(irp->r) && rset_test(as->freeset, irp->r)) { rset_clear(allow, irp->r); emit_move(as, r, irp->r); /* Move from coalesced parent reg. */ } else { emit_getgl(as, r, jit_base); /* Otherwise reload BASE. */ } } return allow; } /* -- Tail of trace ------------------------------------------------------- */ /* Fixup the tail code. */ static void asm_tail_fixup(ASMState *as, TraceNo lnk) { MCode *target = lnk ? traceref(as->J,lnk)->mcode : (MCode *)lj_vm_exit_interp; int32_t spadj = as->T->spadjust; MCode *p = as->mctop-1; *p = spadj ? (MIPSI_ADDIU|MIPSF_T(RID_SP)|MIPSF_S(RID_SP)|spadj) : MIPSI_NOP; p[-1] = MIPSI_J|(((uintptr_t)target>>2)&0x03ffffffu); } /* Prepare tail of code. */ static void asm_tail_prep(ASMState *as) { as->mcp = as->mctop-2; /* Leave room for branch plus nop or stack adj. */ as->invmcp = as->loopref ? as->mcp : NULL; } /* -- Instruction dispatch ------------------------------------------------ */ /* Assemble a single instruction. */ static void asm_ir(ASMState *as, IRIns *ir) { switch ((IROp)ir->o) { /* Miscellaneous ops. */ case IR_LOOP: asm_loop(as); break; case IR_NOP: case IR_XBAR: lua_assert(!ra_used(ir)); break; case IR_USE: ra_alloc1(as, ir->op1, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); break; case IR_PHI: asm_phi(as, ir); break; case IR_HIOP: asm_hiop(as, ir); break; case IR_GCSTEP: asm_gcstep(as, ir); break; /* Guarded assertions. */ case IR_EQ: case IR_NE: asm_compeq(as, ir); break; case IR_LT: case IR_GE: case IR_LE: case IR_GT: case IR_ULT: case IR_UGE: case IR_ULE: case IR_UGT: case IR_ABC: asm_comp(as, ir); break; case IR_RETF: asm_retf(as, ir); break; /* Bit ops. */ case IR_BNOT: asm_bitnot(as, ir); break; case IR_BSWAP: asm_bitswap(as, ir); break; case IR_BAND: asm_bitop(as, ir, MIPSI_AND, MIPSI_ANDI); break; case IR_BOR: asm_bitop(as, ir, MIPSI_OR, MIPSI_ORI); break; case IR_BXOR: asm_bitop(as, ir, MIPSI_XOR, MIPSI_XORI); break; case IR_BSHL: asm_bitshift(as, ir, MIPSI_SLLV, MIPSI_SLL); break; case IR_BSHR: asm_bitshift(as, ir, MIPSI_SRLV, MIPSI_SRL); break; case IR_BSAR: asm_bitshift(as, ir, MIPSI_SRAV, MIPSI_SRA); break; case IR_BROL: lua_assert(0); break; case IR_BROR: asm_bitror(as, ir); break; /* Arithmetic ops. */ case IR_ADD: asm_add(as, ir); break; case IR_SUB: asm_sub(as, ir); break; case IR_MUL: asm_mul(as, ir); break; case IR_DIV: asm_fparith(as, ir, MIPSI_DIV_D); break; case IR_MOD: asm_callid(as, ir, IRCALL_lj_vm_modi); break; case IR_POW: asm_callid(as, ir, IRCALL_lj_vm_powi); break; case IR_NEG: asm_neg(as, ir); break; case IR_ABS: asm_fpunary(as, ir, MIPSI_ABS_D); break; case IR_ATAN2: asm_callid(as, ir, IRCALL_atan2); break; case IR_LDEXP: asm_callid(as, ir, IRCALL_ldexp); break; case IR_MIN: asm_min_max(as, ir, 0); break; case IR_MAX: asm_min_max(as, ir, 1); break; case IR_FPMATH: if (ir->op2 == IRFPM_EXP2 && asm_fpjoin_pow(as, ir)) break; if (ir->op2 <= IRFPM_TRUNC) asm_callround(as, ir, IRCALL_lj_vm_floor + ir->op2); else if (ir->op2 == IRFPM_SQRT) asm_fpunary(as, ir, MIPSI_SQRT_D); else asm_callid(as, ir, IRCALL_lj_vm_floor + ir->op2); break; /* Overflow-checking arithmetic ops. */ case IR_ADDOV: asm_arithov(as, ir); break; case IR_SUBOV: asm_arithov(as, ir); break; case IR_MULOV: asm_mulov(as, ir); break; /* Memory references. */ case IR_AREF: asm_aref(as, ir); break; case IR_HREF: asm_href(as, ir); break; case IR_HREFK: asm_hrefk(as, ir); break; case IR_NEWREF: asm_newref(as, ir); break; case IR_UREFO: case IR_UREFC: asm_uref(as, ir); break; case IR_FREF: asm_fref(as, ir); break; case IR_STRREF: asm_strref(as, ir); break; /* Loads and stores. */ case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: asm_ahuvload(as, ir); break; case IR_FLOAD: asm_fload(as, ir); break; case IR_XLOAD: asm_xload(as, ir); break; case IR_SLOAD: asm_sload(as, ir); break; case IR_ASTORE: case IR_HSTORE: case IR_USTORE: asm_ahustore(as, ir); break; case IR_FSTORE: asm_fstore(as, ir); break; case IR_XSTORE: asm_xstore(as, ir, 0); break; /* Allocations. */ case IR_SNEW: case IR_XSNEW: asm_snew(as, ir); break; case IR_TNEW: asm_tnew(as, ir); break; case IR_TDUP: asm_tdup(as, ir); break; case IR_CNEW: case IR_CNEWI: asm_cnew(as, ir); break; /* Write barriers. */ case IR_TBAR: asm_tbar(as, ir); break; case IR_OBAR: asm_obar(as, ir); break; /* Type conversions. */ case IR_CONV: asm_conv(as, ir); break; case IR_TOBIT: asm_tobit(as, ir); break; case IR_TOSTR: asm_tostr(as, ir); break; case IR_STRTO: asm_strto(as, ir); break; /* Calls. */ case IR_CALLN: case IR_CALLL: case IR_CALLS: asm_call(as, ir); break; case IR_CALLXS: asm_callx(as, ir); break; case IR_CARG: break; default: setintV(&as->J->errinfo, ir->o); lj_trace_err_info(as->J, LJ_TRERR_NYIIR); break; } } /* -- Trace setup --------------------------------------------------------- */ /* Ensure there are enough stack slots for call arguments. */ static Reg asm_setup_call_slots(ASMState *as, IRIns *ir, const CCallInfo *ci) { IRRef args[CCI_NARGS_MAX*2]; uint32_t i, nargs = (int)CCI_NARGS(ci); int nslots = 4, ngpr = REGARG_NUMGPR, nfpr = REGARG_NUMFPR; asm_collectargs(as, ir, ci, args); for (i = 0; i < nargs; i++) { if (args[i] && irt_isfp(IR(args[i])->t) && nfpr > 0 && !(ci->flags & CCI_VARARG)) { nfpr--; ngpr -= irt_isnum(IR(args[i])->t) ? 2 : 1; } else if (args[i] && irt_isnum(IR(args[i])->t)) { nfpr = 0; ngpr = ngpr & ~1; if (ngpr > 0) ngpr -= 2; else nslots = (nslots+3) & ~1; } else { nfpr = 0; if (ngpr > 0) ngpr--; else nslots++; } } if (nslots > as->evenspill) /* Leave room for args in stack slots. */ as->evenspill = nslots; return irt_isfp(ir->t) ? REGSP_HINT(RID_FPRET) : REGSP_HINT(RID_RET); } static void asm_setup_target(ASMState *as) { asm_sparejump_setup(as); asm_exitstub_setup(as); } /* -- Trace patching ------------------------------------------------------ */ /* Patch exit jumps of existing machine code to a new target. */ void lj_asm_patchexit(jit_State *J, GCtrace *T, ExitNo exitno, MCode *target) { MCode *p = T->mcode; MCode *pe = (MCode *)((char *)p + T->szmcode); MCode *px = exitstub_trace_addr(T, exitno); MCode *cstart = NULL, *cstop = NULL; MCode *mcarea = lj_mcode_patch(J, p, 0); MCode exitload = MIPSI_LI | MIPSF_T(RID_TMP) | exitno; MCode tjump = MIPSI_J|(((uintptr_t)target>>2)&0x03ffffffu); for (p++; p < pe; p++) { if (*p == exitload) { /* Look for load of exit number. */ if (((p[-1] ^ (px-p)) & 0xffffu) == 0) { /* Look for exitstub branch. */ ptrdiff_t delta = target - p; if (((delta + 0x8000) >> 16) == 0) { /* Patch in-range branch. */ patchbranch: p[-1] = (p[-1] & 0xffff0000u) | (delta & 0xffffu); *p = MIPSI_NOP; /* Replace the load of the exit number. */ cstop = p; if (!cstart) cstart = p-1; } else { /* Branch out of range. Use spare jump slot in mcarea. */ int i; for (i = 2; i < 2+MIPS_SPAREJUMP*2; i += 2) { if (mcarea[i] == tjump) { delta = mcarea+i - p; goto patchbranch; } else if (mcarea[i] == MIPSI_NOP) { mcarea[i] = tjump; cstart = mcarea+i; delta = mcarea+i - p; goto patchbranch; } } /* Ignore jump slot overflow. Child trace is simply not attached. */ } } else if (p+1 == pe) { /* Patch NOP after code for inverted loop branch. Use of J is ok. */ lua_assert(p[1] == MIPSI_NOP); p[1] = tjump; *p = MIPSI_NOP; /* Replace the load of the exit number. */ cstop = p+2; if (!cstart) cstart = p+1; } } } if (cstart) lj_mcode_sync(cstart, cstop); lj_mcode_patch(J, mcarea, 1); } wcc-0.0.2/src/wsh/luajit-2.0/src/lib_bit.c0000644000175000017500000000350213122010155016441 0ustar philphil/* ** Bit manipulation library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lib_bit_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_err.h" #include "lj_str.h" #include "lj_lib.h" /* ------------------------------------------------------------------------ */ #define LJLIB_MODULE_bit LJLIB_ASM(bit_tobit) LJLIB_REC(bit_unary IR_TOBIT) { lj_lib_checknumber(L, 1); return FFH_RETRY; } LJLIB_ASM_(bit_bnot) LJLIB_REC(bit_unary IR_BNOT) LJLIB_ASM_(bit_bswap) LJLIB_REC(bit_unary IR_BSWAP) LJLIB_ASM(bit_lshift) LJLIB_REC(bit_shift IR_BSHL) { lj_lib_checknumber(L, 1); lj_lib_checkbit(L, 2); return FFH_RETRY; } LJLIB_ASM_(bit_rshift) LJLIB_REC(bit_shift IR_BSHR) LJLIB_ASM_(bit_arshift) LJLIB_REC(bit_shift IR_BSAR) LJLIB_ASM_(bit_rol) LJLIB_REC(bit_shift IR_BROL) LJLIB_ASM_(bit_ror) LJLIB_REC(bit_shift IR_BROR) LJLIB_ASM(bit_band) LJLIB_REC(bit_nary IR_BAND) { int i = 0; do { lj_lib_checknumber(L, ++i); } while (L->base+i < L->top); return FFH_RETRY; } LJLIB_ASM_(bit_bor) LJLIB_REC(bit_nary IR_BOR) LJLIB_ASM_(bit_bxor) LJLIB_REC(bit_nary IR_BXOR) /* ------------------------------------------------------------------------ */ LJLIB_CF(bit_tohex) { uint32_t b = (uint32_t)lj_lib_checkbit(L, 1); int32_t i, n = L->base+1 >= L->top ? 8 : lj_lib_checkbit(L, 2); const char *hexdigits = "0123456789abcdef"; char buf[8]; if (n < 0) { n = -n; hexdigits = "0123456789ABCDEF"; } if (n > 8) n = 8; for (i = n; --i >= 0; ) { buf[i] = hexdigits[b & 15]; b >>= 4; } lua_pushlstring(L, buf, (size_t)n); return 1; } /* ------------------------------------------------------------------------ */ #include "lj_libdef.h" LUALIB_API int luaopen_bit(lua_State *L) { LJ_LIB_REG(L, LUA_BITLIBNAME, bit); return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lua.h0000644000175000017500000002727413122010155015637 0ustar philphil/* ** $Id: lua.h,v 1.218.1.5 2008/08/06 13:30:12 roberto Exp $ ** Lua - An Extensible Extension Language ** Lua.org, PUC-Rio, Brazil (http://www.lua.org) ** See Copyright Notice at the end of this file */ #ifndef lua_h #define lua_h #include #include #include "luaconf.h" #define LUA_VERSION "Lua 5.1" #define LUA_RELEASE "Lua 5.1.4" #define LUA_VERSION_NUM 501 #define LUA_COPYRIGHT "Copyright (C) 1994-2008 Lua.org, PUC-Rio" #define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo & W. Celes" /* mark for precompiled code (`Lua') */ #define LUA_SIGNATURE "\033Lua" /* option for multiple returns in `lua_pcall' and `lua_call' */ #define LUA_MULTRET (-1) /* ** pseudo-indices */ #define LUA_REGISTRYINDEX (-10000) #define LUA_ENVIRONINDEX (-10001) #define LUA_GLOBALSINDEX (-10002) #define lua_upvalueindex(i) (LUA_GLOBALSINDEX-(i)) /* thread status; 0 is OK */ #define LUA_YIELD 1 #define LUA_ERRRUN 2 #define LUA_ERRSYNTAX 3 #define LUA_ERRMEM 4 #define LUA_ERRERR 5 typedef struct lua_State lua_State; typedef int (*lua_CFunction) (lua_State *L); /* ** functions that read/write blocks when loading/dumping Lua chunks */ typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz); typedef int (*lua_Writer) (lua_State *L, const void* p, size_t sz, void* ud); /* ** prototype for memory-allocation functions */ typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize); /* ** basic types */ #define LUA_TNONE (-1) #define LUA_TNIL 0 #define LUA_TBOOLEAN 1 #define LUA_TLIGHTUSERDATA 2 #define LUA_TNUMBER 3 #define LUA_TSTRING 4 #define LUA_TTABLE 5 #define LUA_TFUNCTION 6 #define LUA_TUSERDATA 7 #define LUA_TTHREAD 8 /* minimum Lua stack available to a C function */ #define LUA_MINSTACK 20 /* ** generic extra include file */ #if defined(LUA_USER_H) #include LUA_USER_H #endif /* type of numbers in Lua */ typedef LUA_NUMBER lua_Number; /* type for integer functions */ typedef LUA_INTEGER lua_Integer; /* ** state manipulation */ LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud); LUA_API void (lua_close) (lua_State *L); LUA_API lua_State *(lua_newthread) (lua_State *L); LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf); /* ** basic stack manipulation */ LUA_API int (lua_gettop) (lua_State *L); LUA_API void (lua_settop) (lua_State *L, int idx); LUA_API void (lua_pushvalue) (lua_State *L, int idx); LUA_API void (lua_remove) (lua_State *L, int idx); LUA_API void (lua_insert) (lua_State *L, int idx); LUA_API void (lua_replace) (lua_State *L, int idx); LUA_API int (lua_checkstack) (lua_State *L, int sz); LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n); /* ** access functions (stack -> C) */ LUA_API int (lua_isnumber) (lua_State *L, int idx); LUA_API int (lua_isstring) (lua_State *L, int idx); LUA_API int (lua_iscfunction) (lua_State *L, int idx); LUA_API int (lua_isuserdata) (lua_State *L, int idx); LUA_API int (lua_type) (lua_State *L, int idx); LUA_API const char *(lua_typename) (lua_State *L, int tp); LUA_API int (lua_equal) (lua_State *L, int idx1, int idx2); LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2); LUA_API int (lua_lessthan) (lua_State *L, int idx1, int idx2); LUA_API lua_Number (lua_tonumber) (lua_State *L, int idx); LUA_API lua_Integer (lua_tointeger) (lua_State *L, int idx); LUA_API int (lua_toboolean) (lua_State *L, int idx); LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len); LUA_API size_t (lua_objlen) (lua_State *L, int idx); LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx); LUA_API void *(lua_touserdata) (lua_State *L, int idx); LUA_API lua_State *(lua_tothread) (lua_State *L, int idx); LUA_API const void *(lua_topointer) (lua_State *L, int idx); /* ** push functions (C -> stack) */ LUA_API void (lua_pushnil) (lua_State *L); LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n); LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n); LUA_API void (lua_pushlstring) (lua_State *L, const char *s, size_t l); LUA_API void (lua_pushstring) (lua_State *L, const char *s); LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt, va_list argp); LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...); LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n); LUA_API void (lua_pushboolean) (lua_State *L, int b); LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p); LUA_API int (lua_pushthread) (lua_State *L); /* ** get functions (Lua -> stack) */ LUA_API void (lua_gettable) (lua_State *L, int idx); LUA_API void (lua_getfield) (lua_State *L, int idx, const char *k); LUA_API void (lua_rawget) (lua_State *L, int idx); LUA_API void (lua_rawgeti) (lua_State *L, int idx, int n); LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec); LUA_API void *(lua_newuserdata) (lua_State *L, size_t sz); LUA_API int (lua_getmetatable) (lua_State *L, int objindex); LUA_API void (lua_getfenv) (lua_State *L, int idx); /* ** set functions (stack -> Lua) */ LUA_API void (lua_settable) (lua_State *L, int idx); LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k); LUA_API void (lua_rawset) (lua_State *L, int idx); LUA_API void (lua_rawseti) (lua_State *L, int idx, int n); LUA_API int (lua_setmetatable) (lua_State *L, int objindex); LUA_API int (lua_setfenv) (lua_State *L, int idx); /* ** `load' and `call' functions (load and run Lua code) */ LUA_API void (lua_call) (lua_State *L, int nargs, int nresults); LUA_API int (lua_pcall) (lua_State *L, int nargs, int nresults, int errfunc); LUA_API int (lua_cpcall) (lua_State *L, lua_CFunction func, void *ud); LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt, const char *chunkname); LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data); /* ** coroutine functions */ LUA_API int (lua_yield) (lua_State *L, int nresults); LUA_API int (lua_resume) (lua_State *L, int narg); LUA_API int (lua_status) (lua_State *L); /* ** garbage-collection function and options */ #define LUA_GCSTOP 0 #define LUA_GCRESTART 1 #define LUA_GCCOLLECT 2 #define LUA_GCCOUNT 3 #define LUA_GCCOUNTB 4 #define LUA_GCSTEP 5 #define LUA_GCSETPAUSE 6 #define LUA_GCSETSTEPMUL 7 LUA_API int (lua_gc) (lua_State *L, int what, int data); /* ** miscellaneous functions */ LUA_API int (lua_error) (lua_State *L); LUA_API int (lua_next) (lua_State *L, int idx); LUA_API void (lua_concat) (lua_State *L, int n); LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud); LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud); /* ** =============================================================== ** some useful macros ** =============================================================== */ #define lua_pop(L,n) lua_settop(L, -(n)-1) #define lua_newtable(L) lua_createtable(L, 0, 0) #define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n))) #define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0) #define lua_strlen(L,i) lua_objlen(L, (i)) #define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION) #define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE) #define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA) #define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL) #define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN) #define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD) #define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE) #define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0) #define lua_pushliteral(L, s) \ lua_pushlstring(L, "" s, (sizeof(s)/sizeof(char))-1) #define lua_setglobal(L,s) lua_setfield(L, LUA_GLOBALSINDEX, (s)) #define lua_getglobal(L,s) lua_getfield(L, LUA_GLOBALSINDEX, (s)) #define lua_tostring(L,i) lua_tolstring(L, (i), NULL) /* ** compatibility macros and functions */ #define lua_open() luaL_newstate() #define lua_getregistry(L) lua_pushvalue(L, LUA_REGISTRYINDEX) #define lua_getgccount(L) lua_gc(L, LUA_GCCOUNT, 0) #define lua_Chunkreader lua_Reader #define lua_Chunkwriter lua_Writer /* hack */ LUA_API void lua_setlevel (lua_State *from, lua_State *to); /* ** {====================================================================== ** Debug API ** ======================================================================= */ /* ** Event codes */ #define LUA_HOOKCALL 0 #define LUA_HOOKRET 1 #define LUA_HOOKLINE 2 #define LUA_HOOKCOUNT 3 #define LUA_HOOKTAILRET 4 /* ** Event masks */ #define LUA_MASKCALL (1 << LUA_HOOKCALL) #define LUA_MASKRET (1 << LUA_HOOKRET) #define LUA_MASKLINE (1 << LUA_HOOKLINE) #define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT) typedef struct lua_Debug lua_Debug; /* activation record */ /* Functions to be called by the debuger in specific events */ typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar); LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar); LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar); LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n); LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n); LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n); LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n); LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count); LUA_API lua_Hook lua_gethook (lua_State *L); LUA_API int lua_gethookmask (lua_State *L); LUA_API int lua_gethookcount (lua_State *L); /* From Lua 5.2. */ LUA_API void *lua_upvalueid (lua_State *L, int idx, int n); LUA_API void lua_upvaluejoin (lua_State *L, int idx1, int n1, int idx2, int n2); LUA_API int lua_loadx (lua_State *L, lua_Reader reader, void *dt, const char *chunkname, const char *mode); struct lua_Debug { int event; const char *name; /* (n) */ const char *namewhat; /* (n) `global', `local', `field', `method' */ const char *what; /* (S) `Lua', `C', `main', `tail' */ const char *source; /* (S) */ int currentline; /* (l) */ int nups; /* (u) number of upvalues */ int linedefined; /* (S) */ int lastlinedefined; /* (S) */ char short_src[LUA_IDSIZE]; /* (S) */ /* private part */ int i_ci; /* active function */ }; /* }====================================================================== */ /****************************************************************************** * Copyright (C) 1994-2008 Lua.org, PUC-Rio. All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ******************************************************************************/ #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ir.c0000644000175000017500000003240013122010155016133 0ustar philphil/* ** SSA IR (Intermediate Representation) emitter. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_ir_c #define LUA_CORE /* For pointers to libc/libm functions. */ #include #include #include "lj_obj.h" #if LJ_HASJIT #include "lj_gc.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_ircall.h" #include "lj_iropt.h" #include "lj_trace.h" #if LJ_HASFFI #include "lj_ctype.h" #include "lj_cdata.h" #include "lj_carith.h" #endif #include "lj_vm.h" #include "lj_strscan.h" #include "lj_lib.h" /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) #define fins (&J->fold.ins) /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) /* -- IR tables ----------------------------------------------------------- */ /* IR instruction modes. */ LJ_DATADEF const uint8_t lj_ir_mode[IR__MAX+1] = { IRDEF(IRMODE) 0 }; /* IR type sizes. */ LJ_DATADEF const uint8_t lj_ir_type_size[IRT__MAX+1] = { #define IRTSIZE(name, size) size, IRTDEF(IRTSIZE) #undef IRTSIZE 0 }; /* C call info for CALL* instructions. */ LJ_DATADEF const CCallInfo lj_ir_callinfo[] = { #define IRCALLCI(cond, name, nargs, kind, type, flags) \ { (ASMFunction)IRCALLCOND_##cond(name), \ (nargs)|(CCI_CALL_##kind)|(IRT_##type<irbuf + J->irbotlim; MSize szins = J->irtoplim - J->irbotlim; if (szins) { baseir = (IRIns *)lj_mem_realloc(J->L, baseir, szins*sizeof(IRIns), 2*szins*sizeof(IRIns)); J->irtoplim = J->irbotlim + 2*szins; } else { baseir = (IRIns *)lj_mem_realloc(J->L, NULL, 0, LJ_MIN_IRSZ*sizeof(IRIns)); J->irbotlim = REF_BASE - LJ_MIN_IRSZ/4; J->irtoplim = J->irbotlim + LJ_MIN_IRSZ; } J->cur.ir = J->irbuf = baseir - J->irbotlim; } /* Grow IR buffer at the bottom or shift it up. */ static void lj_ir_growbot(jit_State *J) { IRIns *baseir = J->irbuf + J->irbotlim; MSize szins = J->irtoplim - J->irbotlim; lua_assert(szins != 0); lua_assert(J->cur.nk == J->irbotlim); if (J->cur.nins + (szins >> 1) < J->irtoplim) { /* More than half of the buffer is free on top: shift up by a quarter. */ MSize ofs = szins >> 2; memmove(baseir + ofs, baseir, (J->cur.nins - J->irbotlim)*sizeof(IRIns)); J->irbotlim -= ofs; J->irtoplim -= ofs; J->cur.ir = J->irbuf = baseir - J->irbotlim; } else { /* Double the buffer size, but split the growth amongst top/bottom. */ IRIns *newbase = lj_mem_newt(J->L, 2*szins*sizeof(IRIns), IRIns); MSize ofs = szins >= 256 ? 128 : (szins >> 1); /* Limit bottom growth. */ memcpy(newbase + ofs, baseir, (J->cur.nins - J->irbotlim)*sizeof(IRIns)); lj_mem_free(G(J->L), baseir, szins*sizeof(IRIns)); J->irbotlim -= ofs; J->irtoplim = J->irbotlim + 2*szins; J->cur.ir = J->irbuf = newbase - J->irbotlim; } } /* Emit IR without any optimizations. */ TRef LJ_FASTCALL lj_ir_emit(jit_State *J) { IRRef ref = lj_ir_nextins(J); IRIns *ir = IR(ref); IROp op = fins->o; ir->prev = J->chain[op]; J->chain[op] = (IRRef1)ref; ir->o = op; ir->op1 = fins->op1; ir->op2 = fins->op2; J->guardemit.irt |= fins->t.irt; return TREF(ref, irt_t((ir->t = fins->t))); } /* Emit call to a C function. */ TRef lj_ir_call(jit_State *J, IRCallID id, ...) { const CCallInfo *ci = &lj_ir_callinfo[id]; uint32_t n = CCI_NARGS(ci); TRef tr = TREF_NIL; va_list argp; va_start(argp, id); if ((ci->flags & CCI_L)) n--; if (n > 0) tr = va_arg(argp, IRRef); while (n-- > 1) tr = emitir(IRT(IR_CARG, IRT_NIL), tr, va_arg(argp, IRRef)); va_end(argp); if (CCI_OP(ci) == IR_CALLS) J->needsnap = 1; /* Need snapshot after call with side effect. */ return emitir(CCI_OPTYPE(ci), tr, id); } /* -- Interning of constants ---------------------------------------------- */ /* ** IR instructions for constants are kept between J->cur.nk >= ref < REF_BIAS. ** They are chained like all other instructions, but grow downwards. ** The are interned (like strings in the VM) to facilitate reference ** comparisons. The same constant must get the same reference. */ /* Get ref of next IR constant and optionally grow IR. ** Note: this may invalidate all IRIns *! */ static LJ_AINLINE IRRef ir_nextk(jit_State *J) { IRRef ref = J->cur.nk; if (LJ_UNLIKELY(ref <= J->irbotlim)) lj_ir_growbot(J); J->cur.nk = --ref; return ref; } /* Intern int32_t constant. */ TRef LJ_FASTCALL lj_ir_kint(jit_State *J, int32_t k) { IRIns *ir, *cir = J->cur.ir; IRRef ref; for (ref = J->chain[IR_KINT]; ref; ref = cir[ref].prev) if (cir[ref].i == k) goto found; ref = ir_nextk(J); ir = IR(ref); ir->i = k; ir->t.irt = IRT_INT; ir->o = IR_KINT; ir->prev = J->chain[IR_KINT]; J->chain[IR_KINT] = (IRRef1)ref; found: return TREF(ref, IRT_INT); } /* The MRef inside the KNUM/KINT64 IR instructions holds the address of the ** 64 bit constant. The constants themselves are stored in a chained array ** and shared across traces. ** ** Rationale for choosing this data structure: ** - The address of the constants is embedded in the generated machine code ** and must never move. A resizable array or hash table wouldn't work. ** - Most apps need very few non-32 bit integer constants (less than a dozen). ** - Linear search is hard to beat in terms of speed and low complexity. */ typedef struct K64Array { MRef next; /* Pointer to next list. */ MSize numk; /* Number of used elements in this array. */ TValue k[LJ_MIN_K64SZ]; /* Array of constants. */ } K64Array; /* Free all chained arrays. */ void lj_ir_k64_freeall(jit_State *J) { K64Array *k; for (k = mref(J->k64, K64Array); k; ) { K64Array *next = mref(k->next, K64Array); lj_mem_free(J2G(J), k, sizeof(K64Array)); k = next; } } /* Find 64 bit constant in chained array or add it. */ cTValue *lj_ir_k64_find(jit_State *J, uint64_t u64) { K64Array *k, *kp = NULL; TValue *ntv; MSize idx; /* Search for the constant in the whole chain of arrays. */ for (k = mref(J->k64, K64Array); k; k = mref(k->next, K64Array)) { kp = k; /* Remember previous element in list. */ for (idx = 0; idx < k->numk; idx++) { /* Search one array. */ TValue *tv = &k->k[idx]; if (tv->u64 == u64) /* Needed for +-0/NaN/absmask. */ return tv; } } /* Constant was not found, need to add it. */ if (!(kp && kp->numk < LJ_MIN_K64SZ)) { /* Allocate a new array. */ K64Array *kn = lj_mem_newt(J->L, sizeof(K64Array), K64Array); setmref(kn->next, NULL); kn->numk = 0; if (kp) setmref(kp->next, kn); /* Chain to the end of the list. */ else setmref(J->k64, kn); /* Link first array. */ kp = kn; } ntv = &kp->k[kp->numk++]; /* Add to current array. */ ntv->u64 = u64; return ntv; } /* Intern 64 bit constant, given by its address. */ TRef lj_ir_k64(jit_State *J, IROp op, cTValue *tv) { IRIns *ir, *cir = J->cur.ir; IRRef ref; IRType t = op == IR_KNUM ? IRT_NUM : IRT_I64; for (ref = J->chain[op]; ref; ref = cir[ref].prev) if (ir_k64(&cir[ref]) == tv) goto found; ref = ir_nextk(J); ir = IR(ref); lua_assert(checkptr32(tv)); setmref(ir->ptr, tv); ir->t.irt = t; ir->o = op; ir->prev = J->chain[op]; J->chain[op] = (IRRef1)ref; found: return TREF(ref, t); } /* Intern FP constant, given by its 64 bit pattern. */ TRef lj_ir_knum_u64(jit_State *J, uint64_t u64) { return lj_ir_k64(J, IR_KNUM, lj_ir_k64_find(J, u64)); } /* Intern 64 bit integer constant. */ TRef lj_ir_kint64(jit_State *J, uint64_t u64) { return lj_ir_k64(J, IR_KINT64, lj_ir_k64_find(J, u64)); } /* Check whether a number is int and return it. -0 is NOT considered an int. */ static int numistrueint(lua_Number n, int32_t *kp) { int32_t k = lj_num2int(n); if (n == (lua_Number)k) { if (kp) *kp = k; if (k == 0) { /* Special check for -0. */ TValue tv; setnumV(&tv, n); if (tv.u32.hi != 0) return 0; } return 1; } return 0; } /* Intern number as int32_t constant if possible, otherwise as FP constant. */ TRef lj_ir_knumint(jit_State *J, lua_Number n) { int32_t k; if (numistrueint(n, &k)) return lj_ir_kint(J, k); else return lj_ir_knum(J, n); } /* Intern GC object "constant". */ TRef lj_ir_kgc(jit_State *J, GCobj *o, IRType t) { IRIns *ir, *cir = J->cur.ir; IRRef ref; lua_assert(!isdead(J2G(J), o)); for (ref = J->chain[IR_KGC]; ref; ref = cir[ref].prev) if (ir_kgc(&cir[ref]) == o) goto found; ref = ir_nextk(J); ir = IR(ref); /* NOBARRIER: Current trace is a GC root. */ setgcref(ir->gcr, o); ir->t.irt = (uint8_t)t; ir->o = IR_KGC; ir->prev = J->chain[IR_KGC]; J->chain[IR_KGC] = (IRRef1)ref; found: return TREF(ref, t); } /* Intern 32 bit pointer constant. */ TRef lj_ir_kptr_(jit_State *J, IROp op, void *ptr) { IRIns *ir, *cir = J->cur.ir; IRRef ref; lua_assert((void *)(intptr_t)i32ptr(ptr) == ptr); for (ref = J->chain[op]; ref; ref = cir[ref].prev) if (mref(cir[ref].ptr, void) == ptr) goto found; ref = ir_nextk(J); ir = IR(ref); setmref(ir->ptr, ptr); ir->t.irt = IRT_P32; ir->o = op; ir->prev = J->chain[op]; J->chain[op] = (IRRef1)ref; found: return TREF(ref, IRT_P32); } /* Intern typed NULL constant. */ TRef lj_ir_knull(jit_State *J, IRType t) { IRIns *ir, *cir = J->cur.ir; IRRef ref; for (ref = J->chain[IR_KNULL]; ref; ref = cir[ref].prev) if (irt_t(cir[ref].t) == t) goto found; ref = ir_nextk(J); ir = IR(ref); ir->i = 0; ir->t.irt = (uint8_t)t; ir->o = IR_KNULL; ir->prev = J->chain[IR_KNULL]; J->chain[IR_KNULL] = (IRRef1)ref; found: return TREF(ref, t); } /* Intern key slot. */ TRef lj_ir_kslot(jit_State *J, TRef key, IRRef slot) { IRIns *ir, *cir = J->cur.ir; IRRef2 op12 = IRREF2((IRRef1)key, (IRRef1)slot); IRRef ref; /* Const part is not touched by CSE/DCE, so 0-65535 is ok for IRMlit here. */ lua_assert(tref_isk(key) && slot == (IRRef)(IRRef1)slot); for (ref = J->chain[IR_KSLOT]; ref; ref = cir[ref].prev) if (cir[ref].op12 == op12) goto found; ref = ir_nextk(J); ir = IR(ref); ir->op12 = op12; ir->t.irt = IRT_P32; ir->o = IR_KSLOT; ir->prev = J->chain[IR_KSLOT]; J->chain[IR_KSLOT] = (IRRef1)ref; found: return TREF(ref, IRT_P32); } /* -- Access to IR constants ---------------------------------------------- */ /* Copy value of IR constant. */ void lj_ir_kvalue(lua_State *L, TValue *tv, const IRIns *ir) { UNUSED(L); lua_assert(ir->o != IR_KSLOT); /* Common mistake. */ switch (ir->o) { case IR_KPRI: setitype(tv, irt_toitype(ir->t)); break; case IR_KINT: setintV(tv, ir->i); break; case IR_KGC: setgcV(L, tv, ir_kgc(ir), irt_toitype(ir->t)); break; case IR_KPTR: case IR_KKPTR: case IR_KNULL: setlightudV(tv, mref(ir->ptr, void)); break; case IR_KNUM: setnumV(tv, ir_knum(ir)->n); break; #if LJ_HASFFI case IR_KINT64: { GCcdata *cd = lj_cdata_new_(L, CTID_INT64, 8); *(uint64_t *)cdataptr(cd) = ir_kint64(ir)->u64; setcdataV(L, tv, cd); break; } #endif default: lua_assert(0); break; } } /* -- Convert IR operand types -------------------------------------------- */ /* Convert from string to number. */ TRef LJ_FASTCALL lj_ir_tonumber(jit_State *J, TRef tr) { if (!tref_isnumber(tr)) { if (tref_isstr(tr)) tr = emitir(IRTG(IR_STRTO, IRT_NUM), tr, 0); else lj_trace_err(J, LJ_TRERR_BADTYPE); } return tr; } /* Convert from integer or string to number. */ TRef LJ_FASTCALL lj_ir_tonum(jit_State *J, TRef tr) { if (!tref_isnum(tr)) { if (tref_isinteger(tr)) tr = emitir(IRTN(IR_CONV), tr, IRCONV_NUM_INT); else if (tref_isstr(tr)) tr = emitir(IRTG(IR_STRTO, IRT_NUM), tr, 0); else lj_trace_err(J, LJ_TRERR_BADTYPE); } return tr; } /* Convert from integer or number to string. */ TRef LJ_FASTCALL lj_ir_tostr(jit_State *J, TRef tr) { if (!tref_isstr(tr)) { if (!tref_isnumber(tr)) lj_trace_err(J, LJ_TRERR_BADTYPE); tr = emitir(IRT(IR_TOSTR, IRT_STR), tr, 0); } return tr; } /* -- Miscellaneous IR ops ------------------------------------------------ */ /* Evaluate numeric comparison. */ int lj_ir_numcmp(lua_Number a, lua_Number b, IROp op) { switch (op) { case IR_EQ: return (a == b); case IR_NE: return (a != b); case IR_LT: return (a < b); case IR_GE: return (a >= b); case IR_LE: return (a <= b); case IR_GT: return (a > b); case IR_ULT: return !(a >= b); case IR_UGE: return !(a < b); case IR_ULE: return !(a > b); case IR_UGT: return !(a <= b); default: lua_assert(0); return 0; } } /* Evaluate string comparison. */ int lj_ir_strcmp(GCstr *a, GCstr *b, IROp op) { int res = lj_str_cmp(a, b); switch (op) { case IR_LT: return (res < 0); case IR_GE: return (res >= 0); case IR_LE: return (res <= 0); case IR_GT: return (res > 0); default: lua_assert(0); return 0; } } /* Rollback IR to previous state. */ void lj_ir_rollback(jit_State *J, IRRef ref) { IRRef nins = J->cur.nins; while (nins > ref) { IRIns *ir; nins--; ir = IR(nins); J->chain[ir->o] = ir->prev; } J->cur.nins = nins; } #undef IR #undef fins #undef emitir #endif wcc-0.0.2/src/wsh/luajit-2.0/src/ps4build.bat0000644000175000017500000000626313122010155017116 0ustar philphil@rem Script to build LuaJIT with the PS4 SDK. @rem Donated to the public domain. @rem @rem Open a "Visual Studio .NET Command Prompt" (64 bit host compiler) @rem Then cd to this directory and run this script. @if not defined INCLUDE goto :FAIL @if not defined SCE_ORBIS_SDK_DIR goto :FAIL @setlocal @rem ---- Host compiler ---- @set LJCOMPILE=cl /nologo /c /MD /O2 /W3 /D_CRT_SECURE_NO_DEPRECATE @set LJLINK=link /nologo @set LJMT=mt /nologo @set DASMDIR=..\dynasm @set DASM=%DASMDIR%\dynasm.lua @set ALL_LIB=lib_base.c lib_math.c lib_bit.c lib_string.c lib_table.c lib_io.c lib_os.c lib_package.c lib_debug.c lib_jit.c lib_ffi.c %LJCOMPILE% host\minilua.c @if errorlevel 1 goto :BAD %LJLINK% /out:minilua.exe minilua.obj @if errorlevel 1 goto :BAD if exist minilua.exe.manifest^ %LJMT% -manifest minilua.exe.manifest -outputresource:minilua.exe @rem Check for 64 bit host compiler. @minilua @if not errorlevel 8 goto :FAIL @set DASMFLAGS=-D P64 -D NO_UNWIND minilua %DASM% -LN %DASMFLAGS% -o host\buildvm_arch.h vm_x86.dasc @if errorlevel 1 goto :BAD %LJCOMPILE% /I "." /I %DASMDIR% -DLUAJIT_TARGET=LUAJIT_ARCH_X64 -DLUAJIT_OS=LUAJIT_OS_OTHER -DLUAJIT_DISABLE_JIT -DLUAJIT_DISABLE_FFI -DLUAJIT_NO_UNWIND host\buildvm*.c @if errorlevel 1 goto :BAD %LJLINK% /out:buildvm.exe buildvm*.obj @if errorlevel 1 goto :BAD if exist buildvm.exe.manifest^ %LJMT% -manifest buildvm.exe.manifest -outputresource:buildvm.exe buildvm -m elfasm -o lj_vm.s @if errorlevel 1 goto :BAD buildvm -m bcdef -o lj_bcdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m ffdef -o lj_ffdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m libdef -o lj_libdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m recdef -o lj_recdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m vmdef -o jit\vmdef.lua %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m folddef -o lj_folddef.h lj_opt_fold.c @if errorlevel 1 goto :BAD @rem ---- Cross compiler ---- @set LJCOMPILE="%SCE_ORBIS_SDK_DIR%\host_tools\bin\orbis-clang" -c -Wall -DLUAJIT_DISABLE_FFI @set LJLIB="%SCE_ORBIS_SDK_DIR%\host_tools\bin\orbis-ar" rcus @set INCLUDE="" orbis-as -o lj_vm.o lj_vm.s @if "%1" neq "debug" goto :NODEBUG @shift @set LJCOMPILE=%LJCOMPILE% -g -O0 @set TARGETLIB=libluajitD.a goto :BUILD :NODEBUG @set LJCOMPILE=%LJCOMPILE% -O2 @set TARGETLIB=libluajit.a :BUILD del %TARGETLIB% @if "%1"=="amalg" goto :AMALG for %%f in (lj_*.c lib_*.c) do ( %LJCOMPILE% %%f @if errorlevel 1 goto :BAD ) %LJLIB% %TARGETLIB% lj_*.o lib_*.o @if errorlevel 1 goto :BAD @goto :NOAMALG :AMALG %LJCOMPILE% ljamalg.c @if errorlevel 1 goto :BAD %LJLIB% %TARGETLIB% ljamalg.o lj_vm.o @if errorlevel 1 goto :BAD :NOAMALG @del *.o *.obj *.manifest minilua.exe buildvm.exe @echo. @echo === Successfully built LuaJIT for PS4 === @goto :END :BAD @echo. @echo ******************************************************* @echo *** Build FAILED -- Please check the error messages *** @echo ******************************************************* @goto :END :FAIL @echo To run this script you must open a "Visual Studio .NET Command Prompt" @echo (64 bit host compiler). The PS4 Orbis SDK must be installed, too. :END wcc-0.0.2/src/wsh/luajit-2.0/src/lib_math.c0000644000175000017500000001405613122010155016622 0ustar philphil/* ** Math library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include #define lib_math_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_lib.h" #include "lj_vm.h" /* ------------------------------------------------------------------------ */ #define LJLIB_MODULE_math LJLIB_ASM(math_abs) LJLIB_REC(.) { lj_lib_checknumber(L, 1); return FFH_RETRY; } LJLIB_ASM_(math_floor) LJLIB_REC(math_round IRFPM_FLOOR) LJLIB_ASM_(math_ceil) LJLIB_REC(math_round IRFPM_CEIL) LJLIB_ASM(math_sqrt) LJLIB_REC(math_unary IRFPM_SQRT) { lj_lib_checknum(L, 1); return FFH_RETRY; } LJLIB_ASM_(math_log10) LJLIB_REC(math_unary IRFPM_LOG10) LJLIB_ASM_(math_exp) LJLIB_REC(math_unary IRFPM_EXP) LJLIB_ASM_(math_sin) LJLIB_REC(math_unary IRFPM_SIN) LJLIB_ASM_(math_cos) LJLIB_REC(math_unary IRFPM_COS) LJLIB_ASM_(math_tan) LJLIB_REC(math_unary IRFPM_TAN) LJLIB_ASM_(math_asin) LJLIB_REC(math_atrig FF_math_asin) LJLIB_ASM_(math_acos) LJLIB_REC(math_atrig FF_math_acos) LJLIB_ASM_(math_atan) LJLIB_REC(math_atrig FF_math_atan) LJLIB_ASM_(math_sinh) LJLIB_REC(math_htrig IRCALL_sinh) LJLIB_ASM_(math_cosh) LJLIB_REC(math_htrig IRCALL_cosh) LJLIB_ASM_(math_tanh) LJLIB_REC(math_htrig IRCALL_tanh) LJLIB_ASM_(math_frexp) LJLIB_ASM_(math_modf) LJLIB_REC(.) LJLIB_PUSH(57.29577951308232) LJLIB_ASM_(math_deg) LJLIB_REC(math_degrad) LJLIB_PUSH(0.017453292519943295) LJLIB_ASM_(math_rad) LJLIB_REC(math_degrad) LJLIB_ASM(math_log) LJLIB_REC(math_log) { double x = lj_lib_checknum(L, 1); if (L->base+1 < L->top) { double y = lj_lib_checknum(L, 2); #ifdef LUAJIT_NO_LOG2 x = log(x); y = 1.0 / log(y); #else x = lj_vm_log2(x); y = 1.0 / lj_vm_log2(y); #endif setnumV(L->base-1, x*y); /* Do NOT join the expression to x / y. */ return FFH_RES(1); } return FFH_RETRY; } LJLIB_ASM(math_atan2) LJLIB_REC(.) { lj_lib_checknum(L, 1); lj_lib_checknum(L, 2); return FFH_RETRY; } LJLIB_ASM_(math_pow) LJLIB_REC(.) LJLIB_ASM_(math_fmod) LJLIB_ASM(math_ldexp) LJLIB_REC(.) { lj_lib_checknum(L, 1); #if LJ_DUALNUM && !LJ_TARGET_X86ORX64 lj_lib_checkint(L, 2); #else lj_lib_checknum(L, 2); #endif return FFH_RETRY; } LJLIB_ASM(math_min) LJLIB_REC(math_minmax IR_MIN) { int i = 0; do { lj_lib_checknumber(L, ++i); } while (L->base+i < L->top); return FFH_RETRY; } LJLIB_ASM_(math_max) LJLIB_REC(math_minmax IR_MAX) LJLIB_PUSH(3.14159265358979323846) LJLIB_SET(pi) LJLIB_PUSH(1e310) LJLIB_SET(huge) /* ------------------------------------------------------------------------ */ /* This implements a Tausworthe PRNG with period 2^223. Based on: ** Tables of maximally-equidistributed combined LFSR generators, ** Pierre L'Ecuyer, 1991, table 3, 1st entry. ** Full-period ME-CF generator with L=64, J=4, k=223, N1=49. */ /* PRNG state. */ struct RandomState { uint64_t gen[4]; /* State of the 4 LFSR generators. */ int valid; /* State is valid. */ }; /* Union needed for bit-pattern conversion between uint64_t and double. */ typedef union { uint64_t u64; double d; } U64double; /* Update generator i and compute a running xor of all states. */ #define TW223_GEN(i, k, q, s) \ z = rs->gen[i]; \ z = (((z<> (k-s)) ^ ((z&((uint64_t)(int64_t)-1 << (64-k)))<gen[i] = z; /* PRNG step function. Returns a double in the range 1.0 <= d < 2.0. */ LJ_NOINLINE uint64_t LJ_FASTCALL lj_math_random_step(RandomState *rs) { uint64_t z, r = 0; TW223_GEN(0, 63, 31, 18) TW223_GEN(1, 58, 19, 28) TW223_GEN(2, 55, 24, 7) TW223_GEN(3, 47, 21, 8) return (r & U64x(000fffff,ffffffff)) | U64x(3ff00000,00000000); } /* PRNG initialization function. */ static void random_init(RandomState *rs, double d) { uint32_t r = 0x11090601; /* 64-k[i] as four 8 bit constants. */ int i; for (i = 0; i < 4; i++) { U64double u; uint32_t m = 1u << (r&255); r >>= 8; u.d = d = d * 3.14159265358979323846 + 2.7182818284590452354; if (u.u64 < m) u.u64 += m; /* Ensure k[i] MSB of gen[i] are non-zero. */ rs->gen[i] = u.u64; } rs->valid = 1; for (i = 0; i < 10; i++) lj_math_random_step(rs); } /* PRNG extract function. */ LJLIB_PUSH(top-2) /* Upvalue holds userdata with RandomState. */ LJLIB_CF(math_random) LJLIB_REC(.) { int n = (int)(L->top - L->base); RandomState *rs = (RandomState *)(uddata(udataV(lj_lib_upvalue(L, 1)))); U64double u; double d; if (LJ_UNLIKELY(!rs->valid)) random_init(rs, 0.0); u.u64 = lj_math_random_step(rs); d = u.d - 1.0; if (n > 0) { #if LJ_DUALNUM int isint = 1; double r1; lj_lib_checknumber(L, 1); if (tvisint(L->base)) { r1 = (lua_Number)intV(L->base); } else { isint = 0; r1 = numV(L->base); } #else double r1 = lj_lib_checknum(L, 1); #endif if (n == 1) { d = lj_vm_floor(d*r1) + 1.0; /* d is an int in range [1, r1] */ } else { #if LJ_DUALNUM double r2; lj_lib_checknumber(L, 2); if (tvisint(L->base+1)) { r2 = (lua_Number)intV(L->base+1); } else { isint = 0; r2 = numV(L->base+1); } #else double r2 = lj_lib_checknum(L, 2); #endif d = lj_vm_floor(d*(r2-r1+1.0)) + r1; /* d is an int in range [r1, r2] */ } #if LJ_DUALNUM if (isint) { setintV(L->top-1, lj_num2int(d)); return 1; } #endif } /* else: d is a double in range [0, 1] */ setnumV(L->top++, d); return 1; } /* PRNG seed function. */ LJLIB_PUSH(top-2) /* Upvalue holds userdata with RandomState. */ LJLIB_CF(math_randomseed) { RandomState *rs = (RandomState *)(uddata(udataV(lj_lib_upvalue(L, 1)))); random_init(rs, lj_lib_checknum(L, 1)); return 0; } /* ------------------------------------------------------------------------ */ #include "lj_libdef.h" LUALIB_API int luaopen_math(lua_State *L) { RandomState *rs; rs = (RandomState *)lua_newuserdata(L, sizeof(RandomState)); rs->valid = 0; /* Use lazy initialization to save some time on startup. */ LJ_LIB_REG(L, LUA_MATHLIBNAME, math); #if defined(LUA_COMPAT_MOD) && !LJ_52 lua_getfield(L, -1, "fmod"); lua_setfield(L, -2, "mod"); #endif return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lib_string.c0000644000175000017500000006074313122010155017203 0ustar philphil/* ** String library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #include #define lib_string_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_meta.h" #include "lj_state.h" #include "lj_ff.h" #include "lj_bcdump.h" #include "lj_char.h" #include "lj_lib.h" /* ------------------------------------------------------------------------ */ #define LJLIB_MODULE_string LJLIB_ASM(string_len) LJLIB_REC(.) { lj_lib_checkstr(L, 1); return FFH_RETRY; } LJLIB_ASM(string_byte) LJLIB_REC(string_range 0) { GCstr *s = lj_lib_checkstr(L, 1); int32_t len = (int32_t)s->len; int32_t start = lj_lib_optint(L, 2, 1); int32_t stop = lj_lib_optint(L, 3, start); int32_t n, i; const unsigned char *p; if (stop < 0) stop += len+1; if (start < 0) start += len+1; if (start <= 0) start = 1; if (stop > len) stop = len; if (start > stop) return FFH_RES(0); /* Empty interval: return no results. */ start--; n = stop - start; if ((uint32_t)n > LUAI_MAXCSTACK) lj_err_caller(L, LJ_ERR_STRSLC); lj_state_checkstack(L, (MSize)n); p = (const unsigned char *)strdata(s) + start; for (i = 0; i < n; i++) setintV(L->base + i-1, p[i]); return FFH_RES(n); } LJLIB_ASM(string_char) { int i, nargs = (int)(L->top - L->base); char *buf = lj_str_needbuf(L, &G(L)->tmpbuf, (MSize)nargs); for (i = 1; i <= nargs; i++) { int32_t k = lj_lib_checkint(L, i); if (!checku8(k)) lj_err_arg(L, i, LJ_ERR_BADVAL); buf[i-1] = (char)k; } setstrV(L, L->base-1, lj_str_new(L, buf, (size_t)nargs)); return FFH_RES(1); } LJLIB_ASM(string_sub) LJLIB_REC(string_range 1) { lj_lib_checkstr(L, 1); lj_lib_checkint(L, 2); setintV(L->base+2, lj_lib_optint(L, 3, -1)); return FFH_RETRY; } LJLIB_ASM(string_rep) { GCstr *s = lj_lib_checkstr(L, 1); int32_t k = lj_lib_checkint(L, 2); GCstr *sep = lj_lib_optstr(L, 3); int32_t len = (int32_t)s->len; global_State *g = G(L); int64_t tlen; const char *src; char *buf; if (k <= 0) { empty: setstrV(L, L->base-1, &g->strempty); return FFH_RES(1); } if (sep) { tlen = (int64_t)len + sep->len; if (tlen > LJ_MAX_STR) lj_err_caller(L, LJ_ERR_STROV); tlen *= k; if (tlen > LJ_MAX_STR) lj_err_caller(L, LJ_ERR_STROV); } else { tlen = (int64_t)k * len; if (tlen > LJ_MAX_STR) lj_err_caller(L, LJ_ERR_STROV); } if (tlen == 0) goto empty; buf = lj_str_needbuf(L, &g->tmpbuf, (MSize)tlen); src = strdata(s); if (sep) { tlen -= sep->len; /* Ignore trailing separator. */ if (k > 1) { /* Paste one string and one separator. */ int32_t i; i = 0; while (i < len) *buf++ = src[i++]; src = strdata(sep); len = sep->len; i = 0; while (i < len) *buf++ = src[i++]; src = g->tmpbuf.buf; len += s->len; k--; /* Now copy that k-1 times. */ } } do { int32_t i = 0; do { *buf++ = src[i++]; } while (i < len); } while (--k > 0); setstrV(L, L->base-1, lj_str_new(L, g->tmpbuf.buf, (size_t)tlen)); return FFH_RES(1); } LJLIB_ASM(string_reverse) { GCstr *s = lj_lib_checkstr(L, 1); lj_str_needbuf(L, &G(L)->tmpbuf, s->len); return FFH_RETRY; } LJLIB_ASM_(string_lower) LJLIB_ASM_(string_upper) /* ------------------------------------------------------------------------ */ static int writer_buf(lua_State *L, const void *p, size_t size, void *b) { luaL_addlstring((luaL_Buffer *)b, (const char *)p, size); UNUSED(L); return 0; } LJLIB_CF(string_dump) { GCfunc *fn = lj_lib_checkfunc(L, 1); int strip = L->base+1 < L->top && tvistruecond(L->base+1); luaL_Buffer b; L->top = L->base+1; luaL_buffinit(L, &b); if (!isluafunc(fn) || lj_bcwrite(L, funcproto(fn), writer_buf, &b, strip)) lj_err_caller(L, LJ_ERR_STRDUMP); luaL_pushresult(&b); return 1; } /* ------------------------------------------------------------------------ */ /* macro to `unsign' a character */ #define uchar(c) ((unsigned char)(c)) #define CAP_UNFINISHED (-1) #define CAP_POSITION (-2) typedef struct MatchState { const char *src_init; /* init of source string */ const char *src_end; /* end (`\0') of source string */ lua_State *L; int level; /* total number of captures (finished or unfinished) */ int depth; struct { const char *init; ptrdiff_t len; } capture[LUA_MAXCAPTURES]; } MatchState; #define L_ESC '%' #define SPECIALS "^$*+?.([%-" static int check_capture(MatchState *ms, int l) { l -= '1'; if (l < 0 || l >= ms->level || ms->capture[l].len == CAP_UNFINISHED) lj_err_caller(ms->L, LJ_ERR_STRCAPI); return l; } static int capture_to_close(MatchState *ms) { int level = ms->level; for (level--; level>=0; level--) if (ms->capture[level].len == CAP_UNFINISHED) return level; lj_err_caller(ms->L, LJ_ERR_STRPATC); return 0; /* unreachable */ } static const char *classend(MatchState *ms, const char *p) { switch (*p++) { case L_ESC: if (*p == '\0') lj_err_caller(ms->L, LJ_ERR_STRPATE); return p+1; case '[': if (*p == '^') p++; do { /* look for a `]' */ if (*p == '\0') lj_err_caller(ms->L, LJ_ERR_STRPATM); if (*(p++) == L_ESC && *p != '\0') p++; /* skip escapes (e.g. `%]') */ } while (*p != ']'); return p+1; default: return p; } } static const unsigned char match_class_map[32] = { 0,LJ_CHAR_ALPHA,0,LJ_CHAR_CNTRL,LJ_CHAR_DIGIT,0,0,LJ_CHAR_GRAPH,0,0,0,0, LJ_CHAR_LOWER,0,0,0,LJ_CHAR_PUNCT,0,0,LJ_CHAR_SPACE,0, LJ_CHAR_UPPER,0,LJ_CHAR_ALNUM,LJ_CHAR_XDIGIT,0,0,0,0,0,0,0 }; static int match_class(int c, int cl) { if ((cl & 0xc0) == 0x40) { int t = match_class_map[(cl&0x1f)]; if (t) { t = lj_char_isa(c, t); return (cl & 0x20) ? t : !t; } if (cl == 'z') return c == 0; if (cl == 'Z') return c != 0; } return (cl == c); } static int matchbracketclass(int c, const char *p, const char *ec) { int sig = 1; if (*(p+1) == '^') { sig = 0; p++; /* skip the `^' */ } while (++p < ec) { if (*p == L_ESC) { p++; if (match_class(c, uchar(*p))) return sig; } else if ((*(p+1) == '-') && (p+2 < ec)) { p+=2; if (uchar(*(p-2)) <= c && c <= uchar(*p)) return sig; } else if (uchar(*p) == c) return sig; } return !sig; } static int singlematch(int c, const char *p, const char *ep) { switch (*p) { case '.': return 1; /* matches any char */ case L_ESC: return match_class(c, uchar(*(p+1))); case '[': return matchbracketclass(c, p, ep-1); default: return (uchar(*p) == c); } } static const char *match(MatchState *ms, const char *s, const char *p); static const char *matchbalance(MatchState *ms, const char *s, const char *p) { if (*p == 0 || *(p+1) == 0) lj_err_caller(ms->L, LJ_ERR_STRPATU); if (*s != *p) { return NULL; } else { int b = *p; int e = *(p+1); int cont = 1; while (++s < ms->src_end) { if (*s == e) { if (--cont == 0) return s+1; } else if (*s == b) { cont++; } } } return NULL; /* string ends out of balance */ } static const char *max_expand(MatchState *ms, const char *s, const char *p, const char *ep) { ptrdiff_t i = 0; /* counts maximum expand for item */ while ((s+i)src_end && singlematch(uchar(*(s+i)), p, ep)) i++; /* keeps trying to match with the maximum repetitions */ while (i>=0) { const char *res = match(ms, (s+i), ep+1); if (res) return res; i--; /* else didn't match; reduce 1 repetition to try again */ } return NULL; } static const char *min_expand(MatchState *ms, const char *s, const char *p, const char *ep) { for (;;) { const char *res = match(ms, s, ep+1); if (res != NULL) return res; else if (ssrc_end && singlematch(uchar(*s), p, ep)) s++; /* try with one more repetition */ else return NULL; } } static const char *start_capture(MatchState *ms, const char *s, const char *p, int what) { const char *res; int level = ms->level; if (level >= LUA_MAXCAPTURES) lj_err_caller(ms->L, LJ_ERR_STRCAPN); ms->capture[level].init = s; ms->capture[level].len = what; ms->level = level+1; if ((res=match(ms, s, p)) == NULL) /* match failed? */ ms->level--; /* undo capture */ return res; } static const char *end_capture(MatchState *ms, const char *s, const char *p) { int l = capture_to_close(ms); const char *res; ms->capture[l].len = s - ms->capture[l].init; /* close capture */ if ((res = match(ms, s, p)) == NULL) /* match failed? */ ms->capture[l].len = CAP_UNFINISHED; /* undo capture */ return res; } static const char *match_capture(MatchState *ms, const char *s, int l) { size_t len; l = check_capture(ms, l); len = (size_t)ms->capture[l].len; if ((size_t)(ms->src_end-s) >= len && memcmp(ms->capture[l].init, s, len) == 0) return s+len; else return NULL; } static const char *match(MatchState *ms, const char *s, const char *p) { if (++ms->depth > LJ_MAX_XLEVEL) lj_err_caller(ms->L, LJ_ERR_STRPATX); init: /* using goto's to optimize tail recursion */ switch (*p) { case '(': /* start capture */ if (*(p+1) == ')') /* position capture? */ s = start_capture(ms, s, p+2, CAP_POSITION); else s = start_capture(ms, s, p+1, CAP_UNFINISHED); break; case ')': /* end capture */ s = end_capture(ms, s, p+1); break; case L_ESC: switch (*(p+1)) { case 'b': /* balanced string? */ s = matchbalance(ms, s, p+2); if (s == NULL) break; p+=4; goto init; /* else s = match(ms, s, p+4); */ case 'f': { /* frontier? */ const char *ep; char previous; p += 2; if (*p != '[') lj_err_caller(ms->L, LJ_ERR_STRPATB); ep = classend(ms, p); /* points to what is next */ previous = (s == ms->src_init) ? '\0' : *(s-1); if (matchbracketclass(uchar(previous), p, ep-1) || !matchbracketclass(uchar(*s), p, ep-1)) { s = NULL; break; } p=ep; goto init; /* else s = match(ms, s, ep); */ } default: if (lj_char_isdigit(uchar(*(p+1)))) { /* capture results (%0-%9)? */ s = match_capture(ms, s, uchar(*(p+1))); if (s == NULL) break; p+=2; goto init; /* else s = match(ms, s, p+2) */ } goto dflt; /* case default */ } break; case '\0': /* end of pattern */ break; /* match succeeded */ case '$': /* is the `$' the last char in pattern? */ if (*(p+1) != '\0') goto dflt; if (s != ms->src_end) s = NULL; /* check end of string */ break; default: dflt: { /* it is a pattern item */ const char *ep = classend(ms, p); /* points to what is next */ int m = ssrc_end && singlematch(uchar(*s), p, ep); switch (*ep) { case '?': { /* optional */ const char *res; if (m && ((res=match(ms, s+1, ep+1)) != NULL)) { s = res; break; } p=ep+1; goto init; /* else s = match(ms, s, ep+1); */ } case '*': /* 0 or more repetitions */ s = max_expand(ms, s, p, ep); break; case '+': /* 1 or more repetitions */ s = (m ? max_expand(ms, s+1, p, ep) : NULL); break; case '-': /* 0 or more repetitions (minimum) */ s = min_expand(ms, s, p, ep); break; default: if (m) { s++; p=ep; goto init; } /* else s = match(ms, s+1, ep); */ s = NULL; break; } break; } } ms->depth--; return s; } static const char *lmemfind(const char *s1, size_t l1, const char *s2, size_t l2) { if (l2 == 0) { return s1; /* empty strings are everywhere */ } else if (l2 > l1) { return NULL; /* avoids a negative `l1' */ } else { const char *init; /* to search for a `*s2' inside `s1' */ l2--; /* 1st char will be checked by `memchr' */ l1 = l1-l2; /* `s2' cannot be found after that */ while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) { init++; /* 1st char is already checked */ if (memcmp(init, s2+1, l2) == 0) { return init-1; } else { /* correct `l1' and `s1' to try again */ l1 -= (size_t)(init-s1); s1 = init; } } return NULL; /* not found */ } } static void push_onecapture(MatchState *ms, int i, const char *s, const char *e) { if (i >= ms->level) { if (i == 0) /* ms->level == 0, too */ lua_pushlstring(ms->L, s, (size_t)(e - s)); /* add whole match */ else lj_err_caller(ms->L, LJ_ERR_STRCAPI); } else { ptrdiff_t l = ms->capture[i].len; if (l == CAP_UNFINISHED) lj_err_caller(ms->L, LJ_ERR_STRCAPU); if (l == CAP_POSITION) lua_pushinteger(ms->L, ms->capture[i].init - ms->src_init + 1); else lua_pushlstring(ms->L, ms->capture[i].init, (size_t)l); } } static int push_captures(MatchState *ms, const char *s, const char *e) { int i; int nlevels = (ms->level == 0 && s) ? 1 : ms->level; luaL_checkstack(ms->L, nlevels, "too many captures"); for (i = 0; i < nlevels; i++) push_onecapture(ms, i, s, e); return nlevels; /* number of strings pushed */ } static ptrdiff_t posrelat(ptrdiff_t pos, size_t len) { /* relative string position: negative means back from end */ if (pos < 0) pos += (ptrdiff_t)len + 1; return (pos >= 0) ? pos : 0; } static int str_find_aux(lua_State *L, int find) { size_t l1, l2; const char *s = luaL_checklstring(L, 1, &l1); const char *p = luaL_checklstring(L, 2, &l2); ptrdiff_t init = posrelat(luaL_optinteger(L, 3, 1), l1) - 1; if (init < 0) { init = 0; } else if ((size_t)(init) > l1) { #if LJ_52 setnilV(L->top-1); return 1; #else init = (ptrdiff_t)l1; #endif } if (find && (lua_toboolean(L, 4) || /* explicit request? */ strpbrk(p, SPECIALS) == NULL)) { /* or no special characters? */ /* do a plain search */ const char *s2 = lmemfind(s+init, l1-(size_t)init, p, l2); if (s2) { lua_pushinteger(L, s2-s+1); lua_pushinteger(L, s2-s+(ptrdiff_t)l2); return 2; } } else { MatchState ms; int anchor = (*p == '^') ? (p++, 1) : 0; const char *s1=s+init; ms.L = L; ms.src_init = s; ms.src_end = s+l1; do { const char *res; ms.level = ms.depth = 0; if ((res=match(&ms, s1, p)) != NULL) { if (find) { lua_pushinteger(L, s1-s+1); /* start */ lua_pushinteger(L, res-s); /* end */ return push_captures(&ms, NULL, 0) + 2; } else { return push_captures(&ms, s1, res); } } } while (s1++ < ms.src_end && !anchor); } lua_pushnil(L); /* not found */ return 1; } LJLIB_CF(string_find) { return str_find_aux(L, 1); } LJLIB_CF(string_match) { return str_find_aux(L, 0); } LJLIB_NOREG LJLIB_CF(string_gmatch_aux) { const char *p = strVdata(lj_lib_upvalue(L, 2)); GCstr *str = strV(lj_lib_upvalue(L, 1)); const char *s = strdata(str); TValue *tvpos = lj_lib_upvalue(L, 3); const char *src = s + tvpos->u32.lo; MatchState ms; ms.L = L; ms.src_init = s; ms.src_end = s + str->len; for (; src <= ms.src_end; src++) { const char *e; ms.level = ms.depth = 0; if ((e = match(&ms, src, p)) != NULL) { int32_t pos = (int32_t)(e - s); if (e == src) pos++; /* Ensure progress for empty match. */ tvpos->u32.lo = (uint32_t)pos; return push_captures(&ms, src, e); } } return 0; /* not found */ } LJLIB_CF(string_gmatch) { lj_lib_checkstr(L, 1); lj_lib_checkstr(L, 2); L->top = L->base+3; (L->top-1)->u64 = 0; lj_lib_pushcc(L, lj_cf_string_gmatch_aux, FF_string_gmatch_aux, 3); return 1; } static void add_s(MatchState *ms, luaL_Buffer *b, const char *s, const char *e) { size_t l, i; const char *news = lua_tolstring(ms->L, 3, &l); for (i = 0; i < l; i++) { if (news[i] != L_ESC) { luaL_addchar(b, news[i]); } else { i++; /* skip ESC */ if (!lj_char_isdigit(uchar(news[i]))) { luaL_addchar(b, news[i]); } else if (news[i] == '0') { luaL_addlstring(b, s, (size_t)(e - s)); } else { push_onecapture(ms, news[i] - '1', s, e); luaL_addvalue(b); /* add capture to accumulated result */ } } } } static void add_value(MatchState *ms, luaL_Buffer *b, const char *s, const char *e) { lua_State *L = ms->L; switch (lua_type(L, 3)) { case LUA_TNUMBER: case LUA_TSTRING: { add_s(ms, b, s, e); return; } case LUA_TFUNCTION: { int n; lua_pushvalue(L, 3); n = push_captures(ms, s, e); lua_call(L, n, 1); break; } case LUA_TTABLE: { push_onecapture(ms, 0, s, e); lua_gettable(L, 3); break; } } if (!lua_toboolean(L, -1)) { /* nil or false? */ lua_pop(L, 1); lua_pushlstring(L, s, (size_t)(e - s)); /* keep original text */ } else if (!lua_isstring(L, -1)) { lj_err_callerv(L, LJ_ERR_STRGSRV, luaL_typename(L, -1)); } luaL_addvalue(b); /* add result to accumulator */ } LJLIB_CF(string_gsub) { size_t srcl; const char *src = luaL_checklstring(L, 1, &srcl); const char *p = luaL_checkstring(L, 2); int tr = lua_type(L, 3); int max_s = luaL_optint(L, 4, (int)(srcl+1)); int anchor = (*p == '^') ? (p++, 1) : 0; int n = 0; MatchState ms; luaL_Buffer b; if (!(tr == LUA_TNUMBER || tr == LUA_TSTRING || tr == LUA_TFUNCTION || tr == LUA_TTABLE)) lj_err_arg(L, 3, LJ_ERR_NOSFT); luaL_buffinit(L, &b); ms.L = L; ms.src_init = src; ms.src_end = src+srcl; while (n < max_s) { const char *e; ms.level = ms.depth = 0; e = match(&ms, src, p); if (e) { n++; add_value(&ms, &b, src, e); } if (e && e>src) /* non empty match? */ src = e; /* skip it */ else if (src < ms.src_end) luaL_addchar(&b, *src++); else break; if (anchor) break; } luaL_addlstring(&b, src, (size_t)(ms.src_end-src)); luaL_pushresult(&b); lua_pushinteger(L, n); /* number of substitutions */ return 2; } /* ------------------------------------------------------------------------ */ /* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */ #define MAX_FMTITEM 512 /* valid flags in a format specification */ #define FMT_FLAGS "-+ #0" /* ** maximum size of each format specification (such as '%-099.99d') ** (+10 accounts for %99.99x plus margin of error) */ #define MAX_FMTSPEC (sizeof(FMT_FLAGS) + sizeof(LUA_INTFRMLEN) + 10) static void addquoted(lua_State *L, luaL_Buffer *b, int arg) { GCstr *str = lj_lib_checkstr(L, arg); int32_t len = (int32_t)str->len; const char *s = strdata(str); luaL_addchar(b, '"'); while (len--) { uint32_t c = uchar(*s); if (c == '"' || c == '\\' || c == '\n') { luaL_addchar(b, '\\'); } else if (lj_char_iscntrl(c)) { /* This can only be 0-31 or 127. */ uint32_t d; luaL_addchar(b, '\\'); if (c >= 100 || lj_char_isdigit(uchar(s[1]))) { luaL_addchar(b, '0'+(c >= 100)); if (c >= 100) c -= 100; goto tens; } else if (c >= 10) { tens: d = (c * 205) >> 11; c -= d * 10; luaL_addchar(b, '0'+d); } c += '0'; } luaL_addchar(b, c); s++; } luaL_addchar(b, '"'); } static const char *scanformat(lua_State *L, const char *strfrmt, char *form) { const char *p = strfrmt; while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL) p++; /* skip flags */ if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) lj_err_caller(L, LJ_ERR_STRFMTR); if (lj_char_isdigit(uchar(*p))) p++; /* skip width */ if (lj_char_isdigit(uchar(*p))) p++; /* (2 digits at most) */ if (*p == '.') { p++; if (lj_char_isdigit(uchar(*p))) p++; /* skip precision */ if (lj_char_isdigit(uchar(*p))) p++; /* (2 digits at most) */ } if (lj_char_isdigit(uchar(*p))) lj_err_caller(L, LJ_ERR_STRFMTW); *(form++) = '%'; strncpy(form, strfrmt, (size_t)(p - strfrmt + 1)); form += p - strfrmt + 1; *form = '\0'; return p; } static void addintlen(char *form) { size_t l = strlen(form); char spec = form[l - 1]; strcpy(form + l - 1, LUA_INTFRMLEN); form[l + sizeof(LUA_INTFRMLEN) - 2] = spec; form[l + sizeof(LUA_INTFRMLEN) - 1] = '\0'; } static unsigned LUA_INTFRM_T num2intfrm(lua_State *L, int arg) { if (sizeof(LUA_INTFRM_T) == 4) { return (LUA_INTFRM_T)lj_lib_checkbit(L, arg); } else { cTValue *o; lj_lib_checknumber(L, arg); o = L->base+arg-1; if (tvisint(o)) return (LUA_INTFRM_T)intV(o); else return (LUA_INTFRM_T)numV(o); } } static unsigned LUA_INTFRM_T num2uintfrm(lua_State *L, int arg) { if (sizeof(LUA_INTFRM_T) == 4) { return (unsigned LUA_INTFRM_T)lj_lib_checkbit(L, arg); } else { cTValue *o; lj_lib_checknumber(L, arg); o = L->base+arg-1; if (tvisint(o)) return (unsigned LUA_INTFRM_T)intV(o); else if ((int32_t)o->u32.hi < 0) return (unsigned LUA_INTFRM_T)(LUA_INTFRM_T)numV(o); else return (unsigned LUA_INTFRM_T)numV(o); } } static GCstr *meta_tostring(lua_State *L, int arg) { TValue *o = L->base+arg-1; cTValue *mo; lua_assert(o < L->top); /* Caller already checks for existence. */ if (LJ_LIKELY(tvisstr(o))) return strV(o); if (!tvisnil(mo = lj_meta_lookup(L, o, MM_tostring))) { copyTV(L, L->top++, mo); copyTV(L, L->top++, o); lua_call(L, 1, 1); L->top--; if (tvisstr(L->top)) return strV(L->top); o = L->base+arg-1; copyTV(L, o, L->top); } if (tvisnumber(o)) { return lj_str_fromnumber(L, o); } else if (tvisnil(o)) { return lj_str_newlit(L, "nil"); } else if (tvisfalse(o)) { return lj_str_newlit(L, "false"); } else if (tvistrue(o)) { return lj_str_newlit(L, "true"); } else { if (tvisfunc(o) && isffunc(funcV(o))) lj_str_pushf(L, "function: builtin#%d", funcV(o)->c.ffid); else lj_str_pushf(L, "%s: %p", lj_typename(o), lua_topointer(L, arg)); L->top--; return strV(L->top); } } LJLIB_CF(string_format) { int arg = 1, top = (int)(L->top - L->base); GCstr *fmt = lj_lib_checkstr(L, arg); const char *strfrmt = strdata(fmt); const char *strfrmt_end = strfrmt + fmt->len; luaL_Buffer b; luaL_buffinit(L, &b); while (strfrmt < strfrmt_end) { if (*strfrmt != L_ESC) { luaL_addchar(&b, *strfrmt++); } else if (*++strfrmt == L_ESC) { luaL_addchar(&b, *strfrmt++); /* %% */ } else { /* format item */ char form[MAX_FMTSPEC]; /* to store the format (`%...') */ char buff[MAX_FMTITEM]; /* to store the formatted item */ if (++arg > top) luaL_argerror(L, arg, lj_obj_typename[0]); strfrmt = scanformat(L, strfrmt, form); switch (*strfrmt++) { case 'c': sprintf(buff, form, lj_lib_checkint(L, arg)); break; case 'd': case 'i': addintlen(form); sprintf(buff, form, num2intfrm(L, arg)); break; case 'o': case 'u': case 'x': case 'X': addintlen(form); sprintf(buff, form, num2uintfrm(L, arg)); break; case 'e': case 'E': case 'f': case 'g': case 'G': case 'a': case 'A': { TValue tv; tv.n = lj_lib_checknum(L, arg); if (LJ_UNLIKELY((tv.u32.hi << 1) >= 0xffe00000)) { /* Canonicalize output of non-finite values. */ char *p, nbuf[LJ_STR_NUMBUF]; size_t len = lj_str_bufnum(nbuf, &tv); if (strfrmt[-1] < 'a') { nbuf[len-3] = nbuf[len-3] - 0x20; nbuf[len-2] = nbuf[len-2] - 0x20; nbuf[len-1] = nbuf[len-1] - 0x20; } nbuf[len] = '\0'; for (p = form; *p < 'A' && *p != '.'; p++) ; *p++ = 's'; *p = '\0'; sprintf(buff, form, nbuf); break; } sprintf(buff, form, (double)tv.n); break; } case 'q': addquoted(L, &b, arg); continue; case 'p': lj_str_pushf(L, "%p", lua_topointer(L, arg)); luaL_addvalue(&b); continue; case 's': { GCstr *str = meta_tostring(L, arg); if (!strchr(form, '.') && str->len >= 100) { /* no precision and string is too long to be formatted; keep original string */ setstrV(L, L->top++, str); luaL_addvalue(&b); continue; } sprintf(buff, form, strdata(str)); break; } default: lj_err_callerv(L, LJ_ERR_STRFMTO, *(strfrmt -1)); break; } luaL_addlstring(&b, buff, strlen(buff)); } } luaL_pushresult(&b); return 1; } /* ------------------------------------------------------------------------ */ #include "lj_libdef.h" LUALIB_API int luaopen_string(lua_State *L) { GCtab *mt; global_State *g; LJ_LIB_REG(L, LUA_STRLIBNAME, string); #if defined(LUA_COMPAT_GFIND) && !LJ_52 lua_getfield(L, -1, "gmatch"); lua_setfield(L, -2, "gfind"); #endif mt = lj_tab_new(L, 0, 1); /* NOBARRIER: basemt is a GC root. */ g = G(L); setgcref(basemt_it(g, LJ_TSTR), obj2gco(mt)); settabV(L, lj_tab_setstr(L, mt, mmname_str(g, MM_index)), tabV(L->top-1)); mt->nomm = (uint8_t)(~(1u<top-1)) { L->top--; if (luaL_findtable(L, LUA_GLOBALSINDEX, libname, hsize) != NULL) lj_err_callerv(L, LJ_ERR_BADMODN, libname); settabV(L, L->top, tabV(L->top-1)); L->top++; lua_setfield(L, -3, libname); /* _LOADED[libname] = new table */ } L->top--; settabV(L, L->top-1, tabV(L->top)); } else { lua_createtable(L, 0, hsize); } return tabV(L->top-1); } void lj_lib_register(lua_State *L, const char *libname, const uint8_t *p, const lua_CFunction *cf) { GCtab *env = tabref(L->env); GCfunc *ofn = NULL; int ffid = *p++; BCIns *bcff = &L2GG(L)->bcff[*p++]; GCtab *tab = lib_create_table(L, libname, *p++); ptrdiff_t tpos = L->top - L->base; /* Avoid barriers further down. */ lj_gc_anybarriert(L, tab); tab->nomm = 0; for (;;) { uint32_t tag = *p++; MSize len = tag & LIBINIT_LENMASK; tag &= LIBINIT_TAGMASK; if (tag != LIBINIT_STRING) { const char *name; MSize nuv = (MSize)(L->top - L->base - tpos); GCfunc *fn = lj_func_newC(L, nuv, env); if (nuv) { L->top = L->base + tpos; memcpy(fn->c.upvalue, L->top, sizeof(TValue)*nuv); } fn->c.ffid = (uint8_t)(ffid++); name = (const char *)p; p += len; if (tag == LIBINIT_CF) setmref(fn->c.pc, &G(L)->bc_cfunc_int); else setmref(fn->c.pc, bcff++); if (tag == LIBINIT_ASM_) fn->c.f = ofn->c.f; /* Copy handler from previous function. */ else fn->c.f = *cf++; /* Get cf or handler from C function table. */ if (len) { /* NOBARRIER: See above for common barrier. */ setfuncV(L, lj_tab_setstr(L, tab, lj_str_new(L, name, len)), fn); } ofn = fn; } else { switch (tag | len) { case LIBINIT_SET: L->top -= 2; if (tvisstr(L->top+1) && strV(L->top+1)->len == 0) env = tabV(L->top); else /* NOBARRIER: See above for common barrier. */ copyTV(L, lj_tab_set(L, tab, L->top+1), L->top); break; case LIBINIT_NUMBER: memcpy(&L->top->n, p, sizeof(double)); L->top++; p += sizeof(double); break; case LIBINIT_COPY: copyTV(L, L->top, L->top - *p++); L->top++; break; case LIBINIT_LASTCL: setfuncV(L, L->top++, ofn); break; case LIBINIT_FFID: ffid++; break; case LIBINIT_END: return; default: setstrV(L, L->top++, lj_str_new(L, (const char *)p, len)); p += len; break; } } } } /* -- Type checks --------------------------------------------------------- */ TValue *lj_lib_checkany(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (o >= L->top) lj_err_arg(L, narg, LJ_ERR_NOVAL); return o; } GCstr *lj_lib_checkstr(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (o < L->top) { if (LJ_LIKELY(tvisstr(o))) { return strV(o); } else if (tvisnumber(o)) { GCstr *s = lj_str_fromnumber(L, o); setstrV(L, o, s); return s; } } lj_err_argt(L, narg, LUA_TSTRING); return NULL; /* unreachable */ } GCstr *lj_lib_optstr(lua_State *L, int narg) { TValue *o = L->base + narg-1; return (o < L->top && !tvisnil(o)) ? lj_lib_checkstr(L, narg) : NULL; } #if LJ_DUALNUM void lj_lib_checknumber(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (!(o < L->top && lj_strscan_numberobj(o))) lj_err_argt(L, narg, LUA_TNUMBER); } #endif lua_Number lj_lib_checknum(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (!(o < L->top && (tvisnumber(o) || (tvisstr(o) && lj_strscan_num(strV(o), o))))) lj_err_argt(L, narg, LUA_TNUMBER); if (LJ_UNLIKELY(tvisint(o))) { lua_Number n = (lua_Number)intV(o); setnumV(o, n); return n; } else { return numV(o); } } int32_t lj_lib_checkint(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (!(o < L->top && lj_strscan_numberobj(o))) lj_err_argt(L, narg, LUA_TNUMBER); if (LJ_LIKELY(tvisint(o))) { return intV(o); } else { int32_t i = lj_num2int(numV(o)); if (LJ_DUALNUM) setintV(o, i); return i; } } int32_t lj_lib_optint(lua_State *L, int narg, int32_t def) { TValue *o = L->base + narg-1; return (o < L->top && !tvisnil(o)) ? lj_lib_checkint(L, narg) : def; } int32_t lj_lib_checkbit(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (!(o < L->top && lj_strscan_numberobj(o))) lj_err_argt(L, narg, LUA_TNUMBER); if (LJ_LIKELY(tvisint(o))) { return intV(o); } else { int32_t i = lj_num2bit(numV(o)); if (LJ_DUALNUM) setintV(o, i); return i; } } GCfunc *lj_lib_checkfunc(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (!(o < L->top && tvisfunc(o))) lj_err_argt(L, narg, LUA_TFUNCTION); return funcV(o); } GCtab *lj_lib_checktab(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (!(o < L->top && tvistab(o))) lj_err_argt(L, narg, LUA_TTABLE); return tabV(o); } GCtab *lj_lib_checktabornil(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (o < L->top) { if (tvistab(o)) return tabV(o); else if (tvisnil(o)) return NULL; } lj_err_arg(L, narg, LJ_ERR_NOTABN); return NULL; /* unreachable */ } int lj_lib_checkopt(lua_State *L, int narg, int def, const char *lst) { GCstr *s = def >= 0 ? lj_lib_optstr(L, narg) : lj_lib_checkstr(L, narg); if (s) { const char *opt = strdata(s); MSize len = s->len; int i; for (i = 0; *(const uint8_t *)lst; i++) { if (*(const uint8_t *)lst == len && memcmp(opt, lst+1, len) == 0) return i; lst += 1+*(const uint8_t *)lst; } lj_err_argv(L, narg, LJ_ERR_INVOPTM, opt); } return def; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_load.c0000644000175000017500000000777513122010155016461 0ustar philphil/* ** Load and dump code. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include #include #define lj_load_c #define LUA_CORE #include "lua.h" #include "lauxlib.h" #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_func.h" #include "lj_frame.h" #include "lj_vm.h" #include "lj_lex.h" #include "lj_bcdump.h" #include "lj_parse.h" /* -- Load Lua source code and bytecode ----------------------------------- */ static TValue *cpparser(lua_State *L, lua_CFunction dummy, void *ud) { LexState *ls = (LexState *)ud; GCproto *pt; GCfunc *fn; int bc; UNUSED(dummy); cframe_errfunc(L->cframe) = -1; /* Inherit error function. */ bc = lj_lex_setup(L, ls); if (ls->mode && !strchr(ls->mode, bc ? 'b' : 't')) { setstrV(L, L->top++, lj_err_str(L, LJ_ERR_XMODE)); lj_err_throw(L, LUA_ERRSYNTAX); } pt = bc ? lj_bcread(ls) : lj_parse(ls); fn = lj_func_newL_empty(L, pt, tabref(L->env)); /* Don't combine above/below into one statement. */ setfuncV(L, L->top++, fn); return NULL; } LUA_API int lua_loadx(lua_State *L, lua_Reader reader, void *data, const char *chunkname, const char *mode) { LexState ls; int status; ls.rfunc = reader; ls.rdata = data; ls.chunkarg = chunkname ? chunkname : "?"; ls.mode = mode; lj_str_initbuf(&ls.sb); status = lj_vm_cpcall(L, NULL, &ls, cpparser); lj_lex_cleanup(L, &ls); lj_gc_check(L); return status; } LUA_API int lua_load(lua_State *L, lua_Reader reader, void *data, const char *chunkname) { return lua_loadx(L, reader, data, chunkname, NULL); } typedef struct FileReaderCtx { FILE *fp; char buf[LUAL_BUFFERSIZE]; } FileReaderCtx; static const char *reader_file(lua_State *L, void *ud, size_t *size) { FileReaderCtx *ctx = (FileReaderCtx *)ud; UNUSED(L); if (feof(ctx->fp)) return NULL; *size = fread(ctx->buf, 1, sizeof(ctx->buf), ctx->fp); return *size > 0 ? ctx->buf : NULL; } LUALIB_API int luaL_loadfilex(lua_State *L, const char *filename, const char *mode) { FileReaderCtx ctx; int status; const char *chunkname; if (filename) { ctx.fp = fopen(filename, "rb"); if (ctx.fp == NULL) { lua_pushfstring(L, "cannot open %s: %s", filename, strerror(errno)); return LUA_ERRFILE; } chunkname = lua_pushfstring(L, "@%s", filename); } else { ctx.fp = stdin; chunkname = "=stdin"; } status = lua_loadx(L, reader_file, &ctx, chunkname, mode); if (ferror(ctx.fp)) { L->top -= filename ? 2 : 1; lua_pushfstring(L, "cannot read %s: %s", chunkname+1, strerror(errno)); if (filename) fclose(ctx.fp); return LUA_ERRFILE; } if (filename) { L->top--; copyTV(L, L->top-1, L->top); fclose(ctx.fp); } return status; } LUALIB_API int luaL_loadfile(lua_State *L, const char *filename) { return luaL_loadfilex(L, filename, NULL); } typedef struct StringReaderCtx { const char *str; size_t size; } StringReaderCtx; static const char *reader_string(lua_State *L, void *ud, size_t *size) { StringReaderCtx *ctx = (StringReaderCtx *)ud; UNUSED(L); if (ctx->size == 0) return NULL; *size = ctx->size; ctx->size = 0; return ctx->str; } LUALIB_API int luaL_loadbufferx(lua_State *L, const char *buf, size_t size, const char *name, const char *mode) { StringReaderCtx ctx; ctx.str = buf; ctx.size = size; return lua_loadx(L, reader_string, &ctx, name, mode); } LUALIB_API int luaL_loadbuffer(lua_State *L, const char *buf, size_t size, const char *name) { return luaL_loadbufferx(L, buf, size, name, NULL); } LUALIB_API int luaL_loadstring(lua_State *L, const char *s) { return luaL_loadbuffer(L, s, strlen(s), s); } /* -- Dump bytecode ------------------------------------------------------- */ LUA_API int lua_dump(lua_State *L, lua_Writer writer, void *data) { cTValue *o = L->top-1; api_check(L, L->top > L->base); if (tvisfunc(o) && isluafunc(funcV(o))) return lj_bcwrite(L, funcproto(funcV(o)), writer, data, 0); else return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_parse.c0000644000175000017500000023502213122010155016640 0ustar philphil/* ** Lua parser (source code -> bytecode). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_parse_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_func.h" #include "lj_state.h" #include "lj_bc.h" #if LJ_HASFFI #include "lj_ctype.h" #endif #include "lj_lex.h" #include "lj_parse.h" #include "lj_vm.h" #include "lj_vmevent.h" /* -- Parser structures and definitions ----------------------------------- */ /* Expression kinds. */ typedef enum { /* Constant expressions must be first and in this order: */ VKNIL, VKFALSE, VKTRUE, VKSTR, /* sval = string value */ VKNUM, /* nval = number value */ VKLAST = VKNUM, VKCDATA, /* nval = cdata value, not treated as a constant expression */ /* Non-constant expressions follow: */ VLOCAL, /* info = local register, aux = vstack index */ VUPVAL, /* info = upvalue index, aux = vstack index */ VGLOBAL, /* sval = string value */ VINDEXED, /* info = table register, aux = index reg/byte/string const */ VJMP, /* info = instruction PC */ VRELOCABLE, /* info = instruction PC */ VNONRELOC, /* info = result register */ VCALL, /* info = instruction PC, aux = base */ VVOID } ExpKind; /* Expression descriptor. */ typedef struct ExpDesc { union { struct { uint32_t info; /* Primary info. */ uint32_t aux; /* Secondary info. */ } s; TValue nval; /* Number value. */ GCstr *sval; /* String value. */ } u; ExpKind k; BCPos t; /* True condition jump list. */ BCPos f; /* False condition jump list. */ } ExpDesc; /* Macros for expressions. */ #define expr_hasjump(e) ((e)->t != (e)->f) #define expr_isk(e) ((e)->k <= VKLAST) #define expr_isk_nojump(e) (expr_isk(e) && !expr_hasjump(e)) #define expr_isnumk(e) ((e)->k == VKNUM) #define expr_isnumk_nojump(e) (expr_isnumk(e) && !expr_hasjump(e)) #define expr_isstrk(e) ((e)->k == VKSTR) #define expr_numtv(e) check_exp(expr_isnumk((e)), &(e)->u.nval) #define expr_numberV(e) numberVnum(expr_numtv((e))) /* Initialize expression. */ static LJ_AINLINE void expr_init(ExpDesc *e, ExpKind k, uint32_t info) { e->k = k; e->u.s.info = info; e->f = e->t = NO_JMP; } /* Check number constant for +-0. */ static int expr_numiszero(ExpDesc *e) { TValue *o = expr_numtv(e); return tvisint(o) ? (intV(o) == 0) : tviszero(o); } /* Per-function linked list of scope blocks. */ typedef struct FuncScope { struct FuncScope *prev; /* Link to outer scope. */ MSize vstart; /* Start of block-local variables. */ uint8_t nactvar; /* Number of active vars outside the scope. */ uint8_t flags; /* Scope flags. */ } FuncScope; #define FSCOPE_LOOP 0x01 /* Scope is a (breakable) loop. */ #define FSCOPE_BREAK 0x02 /* Break used in scope. */ #define FSCOPE_GOLA 0x04 /* Goto or label used in scope. */ #define FSCOPE_UPVAL 0x08 /* Upvalue in scope. */ #define FSCOPE_NOCLOSE 0x10 /* Do not close upvalues. */ #define NAME_BREAK ((GCstr *)(uintptr_t)1) /* Index into variable stack. */ typedef uint16_t VarIndex; #define LJ_MAX_VSTACK (65536 - LJ_MAX_UPVAL) /* Variable/goto/label info. */ #define VSTACK_VAR_RW 0x01 /* R/W variable. */ #define VSTACK_GOTO 0x02 /* Pending goto. */ #define VSTACK_LABEL 0x04 /* Label. */ /* Per-function state. */ typedef struct FuncState { GCtab *kt; /* Hash table for constants. */ LexState *ls; /* Lexer state. */ lua_State *L; /* Lua state. */ FuncScope *bl; /* Current scope. */ struct FuncState *prev; /* Enclosing function. */ BCPos pc; /* Next bytecode position. */ BCPos lasttarget; /* Bytecode position of last jump target. */ BCPos jpc; /* Pending jump list to next bytecode. */ BCReg freereg; /* First free register. */ BCReg nactvar; /* Number of active local variables. */ BCReg nkn, nkgc; /* Number of lua_Number/GCobj constants */ BCLine linedefined; /* First line of the function definition. */ BCInsLine *bcbase; /* Base of bytecode stack. */ BCPos bclim; /* Limit of bytecode stack. */ MSize vbase; /* Base of variable stack for this function. */ uint8_t flags; /* Prototype flags. */ uint8_t numparams; /* Number of parameters. */ uint8_t framesize; /* Fixed frame size. */ uint8_t nuv; /* Number of upvalues */ VarIndex varmap[LJ_MAX_LOCVAR]; /* Map from register to variable idx. */ VarIndex uvmap[LJ_MAX_UPVAL]; /* Map from upvalue to variable idx. */ VarIndex uvtmp[LJ_MAX_UPVAL]; /* Temporary upvalue map. */ } FuncState; /* Binary and unary operators. ORDER OPR */ typedef enum BinOpr { OPR_ADD, OPR_SUB, OPR_MUL, OPR_DIV, OPR_MOD, OPR_POW, /* ORDER ARITH */ OPR_CONCAT, OPR_NE, OPR_EQ, OPR_LT, OPR_GE, OPR_LE, OPR_GT, OPR_AND, OPR_OR, OPR_NOBINOPR } BinOpr; LJ_STATIC_ASSERT((int)BC_ISGE-(int)BC_ISLT == (int)OPR_GE-(int)OPR_LT); LJ_STATIC_ASSERT((int)BC_ISLE-(int)BC_ISLT == (int)OPR_LE-(int)OPR_LT); LJ_STATIC_ASSERT((int)BC_ISGT-(int)BC_ISLT == (int)OPR_GT-(int)OPR_LT); LJ_STATIC_ASSERT((int)BC_SUBVV-(int)BC_ADDVV == (int)OPR_SUB-(int)OPR_ADD); LJ_STATIC_ASSERT((int)BC_MULVV-(int)BC_ADDVV == (int)OPR_MUL-(int)OPR_ADD); LJ_STATIC_ASSERT((int)BC_DIVVV-(int)BC_ADDVV == (int)OPR_DIV-(int)OPR_ADD); LJ_STATIC_ASSERT((int)BC_MODVV-(int)BC_ADDVV == (int)OPR_MOD-(int)OPR_ADD); /* -- Error handling ------------------------------------------------------ */ LJ_NORET LJ_NOINLINE static void err_syntax(LexState *ls, ErrMsg em) { lj_lex_error(ls, ls->token, em); } LJ_NORET LJ_NOINLINE static void err_token(LexState *ls, LexToken token) { lj_lex_error(ls, ls->token, LJ_ERR_XTOKEN, lj_lex_token2str(ls, token)); } LJ_NORET static void err_limit(FuncState *fs, uint32_t limit, const char *what) { if (fs->linedefined == 0) lj_lex_error(fs->ls, 0, LJ_ERR_XLIMM, limit, what); else lj_lex_error(fs->ls, 0, LJ_ERR_XLIMF, fs->linedefined, limit, what); } #define checklimit(fs, v, l, m) if ((v) >= (l)) err_limit(fs, l, m) #define checklimitgt(fs, v, l, m) if ((v) > (l)) err_limit(fs, l, m) #define checkcond(ls, c, em) { if (!(c)) err_syntax(ls, em); } /* -- Management of constants --------------------------------------------- */ /* Return bytecode encoding for primitive constant. */ #define const_pri(e) check_exp((e)->k <= VKTRUE, (e)->k) #define tvhaskslot(o) ((o)->u32.hi == 0) #define tvkslot(o) ((o)->u32.lo) /* Add a number constant. */ static BCReg const_num(FuncState *fs, ExpDesc *e) { lua_State *L = fs->L; TValue *o; lua_assert(expr_isnumk(e)); o = lj_tab_set(L, fs->kt, &e->u.nval); if (tvhaskslot(o)) return tvkslot(o); o->u64 = fs->nkn; return fs->nkn++; } /* Add a GC object constant. */ static BCReg const_gc(FuncState *fs, GCobj *gc, uint32_t itype) { lua_State *L = fs->L; TValue key, *o; setgcV(L, &key, gc, itype); /* NOBARRIER: the key is new or kept alive. */ o = lj_tab_set(L, fs->kt, &key); if (tvhaskslot(o)) return tvkslot(o); o->u64 = fs->nkgc; return fs->nkgc++; } /* Add a string constant. */ static BCReg const_str(FuncState *fs, ExpDesc *e) { lua_assert(expr_isstrk(e) || e->k == VGLOBAL); return const_gc(fs, obj2gco(e->u.sval), LJ_TSTR); } /* Anchor string constant to avoid GC. */ GCstr *lj_parse_keepstr(LexState *ls, const char *str, size_t len) { /* NOBARRIER: the key is new or kept alive. */ lua_State *L = ls->L; GCstr *s = lj_str_new(L, str, len); TValue *tv = lj_tab_setstr(L, ls->fs->kt, s); if (tvisnil(tv)) setboolV(tv, 1); lj_gc_check(L); return s; } #if LJ_HASFFI /* Anchor cdata to avoid GC. */ void lj_parse_keepcdata(LexState *ls, TValue *tv, GCcdata *cd) { /* NOBARRIER: the key is new or kept alive. */ lua_State *L = ls->L; setcdataV(L, tv, cd); setboolV(lj_tab_set(L, ls->fs->kt, tv), 1); } #endif /* -- Jump list handling -------------------------------------------------- */ /* Get next element in jump list. */ static BCPos jmp_next(FuncState *fs, BCPos pc) { ptrdiff_t delta = bc_j(fs->bcbase[pc].ins); if ((BCPos)delta == NO_JMP) return NO_JMP; else return (BCPos)(((ptrdiff_t)pc+1)+delta); } /* Check if any of the instructions on the jump list produce no value. */ static int jmp_novalue(FuncState *fs, BCPos list) { for (; list != NO_JMP; list = jmp_next(fs, list)) { BCIns p = fs->bcbase[list >= 1 ? list-1 : list].ins; if (!(bc_op(p) == BC_ISTC || bc_op(p) == BC_ISFC || bc_a(p) == NO_REG)) return 1; } return 0; } /* Patch register of test instructions. */ static int jmp_patchtestreg(FuncState *fs, BCPos pc, BCReg reg) { BCInsLine *ilp = &fs->bcbase[pc >= 1 ? pc-1 : pc]; BCOp op = bc_op(ilp->ins); if (op == BC_ISTC || op == BC_ISFC) { if (reg != NO_REG && reg != bc_d(ilp->ins)) { setbc_a(&ilp->ins, reg); } else { /* Nothing to store or already in the right register. */ setbc_op(&ilp->ins, op+(BC_IST-BC_ISTC)); setbc_a(&ilp->ins, 0); } } else if (bc_a(ilp->ins) == NO_REG) { if (reg == NO_REG) { ilp->ins = BCINS_AJ(BC_JMP, bc_a(fs->bcbase[pc].ins), 0); } else { setbc_a(&ilp->ins, reg); if (reg >= bc_a(ilp[1].ins)) setbc_a(&ilp[1].ins, reg+1); } } else { return 0; /* Cannot patch other instructions. */ } return 1; } /* Drop values for all instructions on jump list. */ static void jmp_dropval(FuncState *fs, BCPos list) { for (; list != NO_JMP; list = jmp_next(fs, list)) jmp_patchtestreg(fs, list, NO_REG); } /* Patch jump instruction to target. */ static void jmp_patchins(FuncState *fs, BCPos pc, BCPos dest) { BCIns *jmp = &fs->bcbase[pc].ins; BCPos offset = dest-(pc+1)+BCBIAS_J; lua_assert(dest != NO_JMP); if (offset > BCMAX_D) err_syntax(fs->ls, LJ_ERR_XJUMP); setbc_d(jmp, offset); } /* Append to jump list. */ static void jmp_append(FuncState *fs, BCPos *l1, BCPos l2) { if (l2 == NO_JMP) { return; } else if (*l1 == NO_JMP) { *l1 = l2; } else { BCPos list = *l1; BCPos next; while ((next = jmp_next(fs, list)) != NO_JMP) /* Find last element. */ list = next; jmp_patchins(fs, list, l2); } } /* Patch jump list and preserve produced values. */ static void jmp_patchval(FuncState *fs, BCPos list, BCPos vtarget, BCReg reg, BCPos dtarget) { while (list != NO_JMP) { BCPos next = jmp_next(fs, list); if (jmp_patchtestreg(fs, list, reg)) jmp_patchins(fs, list, vtarget); /* Jump to target with value. */ else jmp_patchins(fs, list, dtarget); /* Jump to default target. */ list = next; } } /* Jump to following instruction. Append to list of pending jumps. */ static void jmp_tohere(FuncState *fs, BCPos list) { fs->lasttarget = fs->pc; jmp_append(fs, &fs->jpc, list); } /* Patch jump list to target. */ static void jmp_patch(FuncState *fs, BCPos list, BCPos target) { if (target == fs->pc) { jmp_tohere(fs, list); } else { lua_assert(target < fs->pc); jmp_patchval(fs, list, target, NO_REG, target); } } /* -- Bytecode register allocator ----------------------------------------- */ /* Bump frame size. */ static void bcreg_bump(FuncState *fs, BCReg n) { BCReg sz = fs->freereg + n; if (sz > fs->framesize) { if (sz >= LJ_MAX_SLOTS) err_syntax(fs->ls, LJ_ERR_XSLOTS); fs->framesize = (uint8_t)sz; } } /* Reserve registers. */ static void bcreg_reserve(FuncState *fs, BCReg n) { bcreg_bump(fs, n); fs->freereg += n; } /* Free register. */ static void bcreg_free(FuncState *fs, BCReg reg) { if (reg >= fs->nactvar) { fs->freereg--; lua_assert(reg == fs->freereg); } } /* Free register for expression. */ static void expr_free(FuncState *fs, ExpDesc *e) { if (e->k == VNONRELOC) bcreg_free(fs, e->u.s.info); } /* -- Bytecode emitter ---------------------------------------------------- */ /* Emit bytecode instruction. */ static BCPos bcemit_INS(FuncState *fs, BCIns ins) { BCPos pc = fs->pc; LexState *ls = fs->ls; jmp_patchval(fs, fs->jpc, pc, NO_REG, pc); fs->jpc = NO_JMP; if (LJ_UNLIKELY(pc >= fs->bclim)) { ptrdiff_t base = fs->bcbase - ls->bcstack; checklimit(fs, ls->sizebcstack, LJ_MAX_BCINS, "bytecode instructions"); lj_mem_growvec(fs->L, ls->bcstack, ls->sizebcstack, LJ_MAX_BCINS,BCInsLine); fs->bclim = (BCPos)(ls->sizebcstack - base); fs->bcbase = ls->bcstack + base; } fs->bcbase[pc].ins = ins; fs->bcbase[pc].line = ls->lastline; fs->pc = pc+1; return pc; } #define bcemit_ABC(fs, o, a, b, c) bcemit_INS(fs, BCINS_ABC(o, a, b, c)) #define bcemit_AD(fs, o, a, d) bcemit_INS(fs, BCINS_AD(o, a, d)) #define bcemit_AJ(fs, o, a, j) bcemit_INS(fs, BCINS_AJ(o, a, j)) #define bcptr(fs, e) (&(fs)->bcbase[(e)->u.s.info].ins) /* -- Bytecode emitter for expressions ------------------------------------ */ /* Discharge non-constant expression to any register. */ static void expr_discharge(FuncState *fs, ExpDesc *e) { BCIns ins; if (e->k == VUPVAL) { ins = BCINS_AD(BC_UGET, 0, e->u.s.info); } else if (e->k == VGLOBAL) { ins = BCINS_AD(BC_GGET, 0, const_str(fs, e)); } else if (e->k == VINDEXED) { BCReg rc = e->u.s.aux; if ((int32_t)rc < 0) { ins = BCINS_ABC(BC_TGETS, 0, e->u.s.info, ~rc); } else if (rc > BCMAX_C) { ins = BCINS_ABC(BC_TGETB, 0, e->u.s.info, rc-(BCMAX_C+1)); } else { bcreg_free(fs, rc); ins = BCINS_ABC(BC_TGETV, 0, e->u.s.info, rc); } bcreg_free(fs, e->u.s.info); } else if (e->k == VCALL) { e->u.s.info = e->u.s.aux; e->k = VNONRELOC; return; } else if (e->k == VLOCAL) { e->k = VNONRELOC; return; } else { return; } e->u.s.info = bcemit_INS(fs, ins); e->k = VRELOCABLE; } /* Emit bytecode to set a range of registers to nil. */ static void bcemit_nil(FuncState *fs, BCReg from, BCReg n) { if (fs->pc > fs->lasttarget) { /* No jumps to current position? */ BCIns *ip = &fs->bcbase[fs->pc-1].ins; BCReg pto, pfrom = bc_a(*ip); switch (bc_op(*ip)) { /* Try to merge with the previous instruction. */ case BC_KPRI: if (bc_d(*ip) != ~LJ_TNIL) break; if (from == pfrom) { if (n == 1) return; } else if (from == pfrom+1) { from = pfrom; n++; } else { break; } *ip = BCINS_AD(BC_KNIL, from, from+n-1); /* Replace KPRI. */ return; case BC_KNIL: pto = bc_d(*ip); if (pfrom <= from && from <= pto+1) { /* Can we connect both ranges? */ if (from+n-1 > pto) setbc_d(ip, from+n-1); /* Patch previous instruction range. */ return; } break; default: break; } } /* Emit new instruction or replace old instruction. */ bcemit_INS(fs, n == 1 ? BCINS_AD(BC_KPRI, from, VKNIL) : BCINS_AD(BC_KNIL, from, from+n-1)); } /* Discharge an expression to a specific register. Ignore branches. */ static void expr_toreg_nobranch(FuncState *fs, ExpDesc *e, BCReg reg) { BCIns ins; expr_discharge(fs, e); if (e->k == VKSTR) { ins = BCINS_AD(BC_KSTR, reg, const_str(fs, e)); } else if (e->k == VKNUM) { #if LJ_DUALNUM cTValue *tv = expr_numtv(e); if (tvisint(tv) && checki16(intV(tv))) ins = BCINS_AD(BC_KSHORT, reg, (BCReg)(uint16_t)intV(tv)); else #else lua_Number n = expr_numberV(e); int32_t k = lj_num2int(n); if (checki16(k) && n == (lua_Number)k) ins = BCINS_AD(BC_KSHORT, reg, (BCReg)(uint16_t)k); else #endif ins = BCINS_AD(BC_KNUM, reg, const_num(fs, e)); #if LJ_HASFFI } else if (e->k == VKCDATA) { fs->flags |= PROTO_FFI; ins = BCINS_AD(BC_KCDATA, reg, const_gc(fs, obj2gco(cdataV(&e->u.nval)), LJ_TCDATA)); #endif } else if (e->k == VRELOCABLE) { setbc_a(bcptr(fs, e), reg); goto noins; } else if (e->k == VNONRELOC) { if (reg == e->u.s.info) goto noins; ins = BCINS_AD(BC_MOV, reg, e->u.s.info); } else if (e->k == VKNIL) { bcemit_nil(fs, reg, 1); goto noins; } else if (e->k <= VKTRUE) { ins = BCINS_AD(BC_KPRI, reg, const_pri(e)); } else { lua_assert(e->k == VVOID || e->k == VJMP); return; } bcemit_INS(fs, ins); noins: e->u.s.info = reg; e->k = VNONRELOC; } /* Forward declaration. */ static BCPos bcemit_jmp(FuncState *fs); /* Discharge an expression to a specific register. */ static void expr_toreg(FuncState *fs, ExpDesc *e, BCReg reg) { expr_toreg_nobranch(fs, e, reg); if (e->k == VJMP) jmp_append(fs, &e->t, e->u.s.info); /* Add it to the true jump list. */ if (expr_hasjump(e)) { /* Discharge expression with branches. */ BCPos jend, jfalse = NO_JMP, jtrue = NO_JMP; if (jmp_novalue(fs, e->t) || jmp_novalue(fs, e->f)) { BCPos jval = (e->k == VJMP) ? NO_JMP : bcemit_jmp(fs); jfalse = bcemit_AD(fs, BC_KPRI, reg, VKFALSE); bcemit_AJ(fs, BC_JMP, fs->freereg, 1); jtrue = bcemit_AD(fs, BC_KPRI, reg, VKTRUE); jmp_tohere(fs, jval); } jend = fs->pc; fs->lasttarget = jend; jmp_patchval(fs, e->f, jend, reg, jfalse); jmp_patchval(fs, e->t, jend, reg, jtrue); } e->f = e->t = NO_JMP; e->u.s.info = reg; e->k = VNONRELOC; } /* Discharge an expression to the next free register. */ static void expr_tonextreg(FuncState *fs, ExpDesc *e) { expr_discharge(fs, e); expr_free(fs, e); bcreg_reserve(fs, 1); expr_toreg(fs, e, fs->freereg - 1); } /* Discharge an expression to any register. */ static BCReg expr_toanyreg(FuncState *fs, ExpDesc *e) { expr_discharge(fs, e); if (e->k == VNONRELOC) { if (!expr_hasjump(e)) return e->u.s.info; /* Already in a register. */ if (e->u.s.info >= fs->nactvar) { expr_toreg(fs, e, e->u.s.info); /* Discharge to temp. register. */ return e->u.s.info; } } expr_tonextreg(fs, e); /* Discharge to next register. */ return e->u.s.info; } /* Partially discharge expression to a value. */ static void expr_toval(FuncState *fs, ExpDesc *e) { if (expr_hasjump(e)) expr_toanyreg(fs, e); else expr_discharge(fs, e); } /* Emit store for LHS expression. */ static void bcemit_store(FuncState *fs, ExpDesc *var, ExpDesc *e) { BCIns ins; if (var->k == VLOCAL) { fs->ls->vstack[var->u.s.aux].info |= VSTACK_VAR_RW; expr_free(fs, e); expr_toreg(fs, e, var->u.s.info); return; } else if (var->k == VUPVAL) { fs->ls->vstack[var->u.s.aux].info |= VSTACK_VAR_RW; expr_toval(fs, e); if (e->k <= VKTRUE) ins = BCINS_AD(BC_USETP, var->u.s.info, const_pri(e)); else if (e->k == VKSTR) ins = BCINS_AD(BC_USETS, var->u.s.info, const_str(fs, e)); else if (e->k == VKNUM) ins = BCINS_AD(BC_USETN, var->u.s.info, const_num(fs, e)); else ins = BCINS_AD(BC_USETV, var->u.s.info, expr_toanyreg(fs, e)); } else if (var->k == VGLOBAL) { BCReg ra = expr_toanyreg(fs, e); ins = BCINS_AD(BC_GSET, ra, const_str(fs, var)); } else { BCReg ra, rc; lua_assert(var->k == VINDEXED); ra = expr_toanyreg(fs, e); rc = var->u.s.aux; if ((int32_t)rc < 0) { ins = BCINS_ABC(BC_TSETS, ra, var->u.s.info, ~rc); } else if (rc > BCMAX_C) { ins = BCINS_ABC(BC_TSETB, ra, var->u.s.info, rc-(BCMAX_C+1)); } else { /* Free late alloced key reg to avoid assert on free of value reg. */ /* This can only happen when called from expr_table(). */ lua_assert(e->k != VNONRELOC || ra < fs->nactvar || rc < ra || (bcreg_free(fs, rc),1)); ins = BCINS_ABC(BC_TSETV, ra, var->u.s.info, rc); } } bcemit_INS(fs, ins); expr_free(fs, e); } /* Emit method lookup expression. */ static void bcemit_method(FuncState *fs, ExpDesc *e, ExpDesc *key) { BCReg idx, func, obj = expr_toanyreg(fs, e); expr_free(fs, e); func = fs->freereg; bcemit_AD(fs, BC_MOV, func+1, obj); /* Copy object to first argument. */ lua_assert(expr_isstrk(key)); idx = const_str(fs, key); if (idx <= BCMAX_C) { bcreg_reserve(fs, 2); bcemit_ABC(fs, BC_TGETS, func, obj, idx); } else { bcreg_reserve(fs, 3); bcemit_AD(fs, BC_KSTR, func+2, idx); bcemit_ABC(fs, BC_TGETV, func, obj, func+2); fs->freereg--; } e->u.s.info = func; e->k = VNONRELOC; } /* -- Bytecode emitter for branches --------------------------------------- */ /* Emit unconditional branch. */ static BCPos bcemit_jmp(FuncState *fs) { BCPos jpc = fs->jpc; BCPos j = fs->pc - 1; BCIns *ip = &fs->bcbase[j].ins; fs->jpc = NO_JMP; if ((int32_t)j >= (int32_t)fs->lasttarget && bc_op(*ip) == BC_UCLO) { setbc_j(ip, NO_JMP); fs->lasttarget = j+1; } else { j = bcemit_AJ(fs, BC_JMP, fs->freereg, NO_JMP); } jmp_append(fs, &j, jpc); return j; } /* Invert branch condition of bytecode instruction. */ static void invertcond(FuncState *fs, ExpDesc *e) { BCIns *ip = &fs->bcbase[e->u.s.info - 1].ins; setbc_op(ip, bc_op(*ip)^1); } /* Emit conditional branch. */ static BCPos bcemit_branch(FuncState *fs, ExpDesc *e, int cond) { BCPos pc; if (e->k == VRELOCABLE) { BCIns *ip = bcptr(fs, e); if (bc_op(*ip) == BC_NOT) { *ip = BCINS_AD(cond ? BC_ISF : BC_IST, 0, bc_d(*ip)); return bcemit_jmp(fs); } } if (e->k != VNONRELOC) { bcreg_reserve(fs, 1); expr_toreg_nobranch(fs, e, fs->freereg-1); } bcemit_AD(fs, cond ? BC_ISTC : BC_ISFC, NO_REG, e->u.s.info); pc = bcemit_jmp(fs); expr_free(fs, e); return pc; } /* Emit branch on true condition. */ static void bcemit_branch_t(FuncState *fs, ExpDesc *e) { BCPos pc; expr_discharge(fs, e); if (e->k == VKSTR || e->k == VKNUM || e->k == VKTRUE) pc = NO_JMP; /* Never jump. */ else if (e->k == VJMP) invertcond(fs, e), pc = e->u.s.info; else if (e->k == VKFALSE || e->k == VKNIL) expr_toreg_nobranch(fs, e, NO_REG), pc = bcemit_jmp(fs); else pc = bcemit_branch(fs, e, 0); jmp_append(fs, &e->f, pc); jmp_tohere(fs, e->t); e->t = NO_JMP; } /* Emit branch on false condition. */ static void bcemit_branch_f(FuncState *fs, ExpDesc *e) { BCPos pc; expr_discharge(fs, e); if (e->k == VKNIL || e->k == VKFALSE) pc = NO_JMP; /* Never jump. */ else if (e->k == VJMP) pc = e->u.s.info; else if (e->k == VKSTR || e->k == VKNUM || e->k == VKTRUE) expr_toreg_nobranch(fs, e, NO_REG), pc = bcemit_jmp(fs); else pc = bcemit_branch(fs, e, 1); jmp_append(fs, &e->t, pc); jmp_tohere(fs, e->f); e->f = NO_JMP; } /* -- Bytecode emitter for operators -------------------------------------- */ /* Try constant-folding of arithmetic operators. */ static int foldarith(BinOpr opr, ExpDesc *e1, ExpDesc *e2) { TValue o; lua_Number n; if (!expr_isnumk_nojump(e1) || !expr_isnumk_nojump(e2)) return 0; n = lj_vm_foldarith(expr_numberV(e1), expr_numberV(e2), (int)opr-OPR_ADD); setnumV(&o, n); if (tvisnan(&o) || tvismzero(&o)) return 0; /* Avoid NaN and -0 as consts. */ if (LJ_DUALNUM) { int32_t k = lj_num2int(n); if ((lua_Number)k == n) { setintV(&e1->u.nval, k); return 1; } } setnumV(&e1->u.nval, n); return 1; } /* Emit arithmetic operator. */ static void bcemit_arith(FuncState *fs, BinOpr opr, ExpDesc *e1, ExpDesc *e2) { BCReg rb, rc, t; uint32_t op; if (foldarith(opr, e1, e2)) return; if (opr == OPR_POW) { op = BC_POW; rc = expr_toanyreg(fs, e2); rb = expr_toanyreg(fs, e1); } else { op = opr-OPR_ADD+BC_ADDVV; /* Must discharge 2nd operand first since VINDEXED might free regs. */ expr_toval(fs, e2); if (expr_isnumk(e2) && (rc = const_num(fs, e2)) <= BCMAX_C) op -= BC_ADDVV-BC_ADDVN; else rc = expr_toanyreg(fs, e2); /* 1st operand discharged by bcemit_binop_left, but need KNUM/KSHORT. */ lua_assert(expr_isnumk(e1) || e1->k == VNONRELOC); expr_toval(fs, e1); /* Avoid two consts to satisfy bytecode constraints. */ if (expr_isnumk(e1) && !expr_isnumk(e2) && (t = const_num(fs, e1)) <= BCMAX_B) { rb = rc; rc = t; op -= BC_ADDVV-BC_ADDNV; } else { rb = expr_toanyreg(fs, e1); } } /* Using expr_free might cause asserts if the order is wrong. */ if (e1->k == VNONRELOC && e1->u.s.info >= fs->nactvar) fs->freereg--; if (e2->k == VNONRELOC && e2->u.s.info >= fs->nactvar) fs->freereg--; e1->u.s.info = bcemit_ABC(fs, op, 0, rb, rc); e1->k = VRELOCABLE; } /* Emit comparison operator. */ static void bcemit_comp(FuncState *fs, BinOpr opr, ExpDesc *e1, ExpDesc *e2) { ExpDesc *eret = e1; BCIns ins; expr_toval(fs, e1); if (opr == OPR_EQ || opr == OPR_NE) { BCOp op = opr == OPR_EQ ? BC_ISEQV : BC_ISNEV; BCReg ra; if (expr_isk(e1)) { e1 = e2; e2 = eret; } /* Need constant in 2nd arg. */ ra = expr_toanyreg(fs, e1); /* First arg must be in a reg. */ expr_toval(fs, e2); switch (e2->k) { case VKNIL: case VKFALSE: case VKTRUE: ins = BCINS_AD(op+(BC_ISEQP-BC_ISEQV), ra, const_pri(e2)); break; case VKSTR: ins = BCINS_AD(op+(BC_ISEQS-BC_ISEQV), ra, const_str(fs, e2)); break; case VKNUM: ins = BCINS_AD(op+(BC_ISEQN-BC_ISEQV), ra, const_num(fs, e2)); break; default: ins = BCINS_AD(op, ra, expr_toanyreg(fs, e2)); break; } } else { uint32_t op = opr-OPR_LT+BC_ISLT; BCReg ra, rd; if ((op-BC_ISLT) & 1) { /* GT -> LT, GE -> LE */ e1 = e2; e2 = eret; /* Swap operands. */ op = ((op-BC_ISLT)^3)+BC_ISLT; expr_toval(fs, e1); } rd = expr_toanyreg(fs, e2); ra = expr_toanyreg(fs, e1); ins = BCINS_AD(op, ra, rd); } /* Using expr_free might cause asserts if the order is wrong. */ if (e1->k == VNONRELOC && e1->u.s.info >= fs->nactvar) fs->freereg--; if (e2->k == VNONRELOC && e2->u.s.info >= fs->nactvar) fs->freereg--; bcemit_INS(fs, ins); eret->u.s.info = bcemit_jmp(fs); eret->k = VJMP; } /* Fixup left side of binary operator. */ static void bcemit_binop_left(FuncState *fs, BinOpr op, ExpDesc *e) { if (op == OPR_AND) { bcemit_branch_t(fs, e); } else if (op == OPR_OR) { bcemit_branch_f(fs, e); } else if (op == OPR_CONCAT) { expr_tonextreg(fs, e); } else if (op == OPR_EQ || op == OPR_NE) { if (!expr_isk_nojump(e)) expr_toanyreg(fs, e); } else { if (!expr_isnumk_nojump(e)) expr_toanyreg(fs, e); } } /* Emit binary operator. */ static void bcemit_binop(FuncState *fs, BinOpr op, ExpDesc *e1, ExpDesc *e2) { if (op <= OPR_POW) { bcemit_arith(fs, op, e1, e2); } else if (op == OPR_AND) { lua_assert(e1->t == NO_JMP); /* List must be closed. */ expr_discharge(fs, e2); jmp_append(fs, &e2->f, e1->f); *e1 = *e2; } else if (op == OPR_OR) { lua_assert(e1->f == NO_JMP); /* List must be closed. */ expr_discharge(fs, e2); jmp_append(fs, &e2->t, e1->t); *e1 = *e2; } else if (op == OPR_CONCAT) { expr_toval(fs, e2); if (e2->k == VRELOCABLE && bc_op(*bcptr(fs, e2)) == BC_CAT) { lua_assert(e1->u.s.info == bc_b(*bcptr(fs, e2))-1); expr_free(fs, e1); setbc_b(bcptr(fs, e2), e1->u.s.info); e1->u.s.info = e2->u.s.info; } else { expr_tonextreg(fs, e2); expr_free(fs, e2); expr_free(fs, e1); e1->u.s.info = bcemit_ABC(fs, BC_CAT, 0, e1->u.s.info, e2->u.s.info); } e1->k = VRELOCABLE; } else { lua_assert(op == OPR_NE || op == OPR_EQ || op == OPR_LT || op == OPR_GE || op == OPR_LE || op == OPR_GT); bcemit_comp(fs, op, e1, e2); } } /* Emit unary operator. */ static void bcemit_unop(FuncState *fs, BCOp op, ExpDesc *e) { if (op == BC_NOT) { /* Swap true and false lists. */ { BCPos temp = e->f; e->f = e->t; e->t = temp; } jmp_dropval(fs, e->f); jmp_dropval(fs, e->t); expr_discharge(fs, e); if (e->k == VKNIL || e->k == VKFALSE) { e->k = VKTRUE; return; } else if (expr_isk(e) || (LJ_HASFFI && e->k == VKCDATA)) { e->k = VKFALSE; return; } else if (e->k == VJMP) { invertcond(fs, e); return; } else if (e->k == VRELOCABLE) { bcreg_reserve(fs, 1); setbc_a(bcptr(fs, e), fs->freereg-1); e->u.s.info = fs->freereg-1; e->k = VNONRELOC; } else { lua_assert(e->k == VNONRELOC); } } else { lua_assert(op == BC_UNM || op == BC_LEN); if (op == BC_UNM && !expr_hasjump(e)) { /* Constant-fold negations. */ #if LJ_HASFFI if (e->k == VKCDATA) { /* Fold in-place since cdata is not interned. */ GCcdata *cd = cdataV(&e->u.nval); int64_t *p = (int64_t *)cdataptr(cd); if (cd->ctypeid == CTID_COMPLEX_DOUBLE) p[1] ^= (int64_t)U64x(80000000,00000000); else *p = -*p; return; } else #endif if (expr_isnumk(e) && !expr_numiszero(e)) { /* Avoid folding to -0. */ TValue *o = expr_numtv(e); if (tvisint(o)) { int32_t k = intV(o); if (k == -k) setnumV(o, -(lua_Number)k); else setintV(o, -k); return; } else { o->u64 ^= U64x(80000000,00000000); return; } } } expr_toanyreg(fs, e); } expr_free(fs, e); e->u.s.info = bcemit_AD(fs, op, 0, e->u.s.info); e->k = VRELOCABLE; } /* -- Lexer support ------------------------------------------------------- */ /* Check and consume optional token. */ static int lex_opt(LexState *ls, LexToken tok) { if (ls->token == tok) { lj_lex_next(ls); return 1; } return 0; } /* Check and consume token. */ static void lex_check(LexState *ls, LexToken tok) { if (ls->token != tok) err_token(ls, tok); lj_lex_next(ls); } /* Check for matching token. */ static void lex_match(LexState *ls, LexToken what, LexToken who, BCLine line) { if (!lex_opt(ls, what)) { if (line == ls->linenumber) { err_token(ls, what); } else { const char *swhat = lj_lex_token2str(ls, what); const char *swho = lj_lex_token2str(ls, who); lj_lex_error(ls, ls->token, LJ_ERR_XMATCH, swhat, swho, line); } } } /* Check for string token. */ static GCstr *lex_str(LexState *ls) { GCstr *s; if (ls->token != TK_name && (LJ_52 || ls->token != TK_goto)) err_token(ls, TK_name); s = strV(&ls->tokenval); lj_lex_next(ls); return s; } /* -- Variable handling --------------------------------------------------- */ #define var_get(ls, fs, i) ((ls)->vstack[(fs)->varmap[(i)]]) /* Define a new local variable. */ static void var_new(LexState *ls, BCReg n, GCstr *name) { FuncState *fs = ls->fs; MSize vtop = ls->vtop; checklimit(fs, fs->nactvar+n, LJ_MAX_LOCVAR, "local variables"); if (LJ_UNLIKELY(vtop >= ls->sizevstack)) { if (ls->sizevstack >= LJ_MAX_VSTACK) lj_lex_error(ls, 0, LJ_ERR_XLIMC, LJ_MAX_VSTACK); lj_mem_growvec(ls->L, ls->vstack, ls->sizevstack, LJ_MAX_VSTACK, VarInfo); } lua_assert((uintptr_t)name < VARNAME__MAX || lj_tab_getstr(fs->kt, name) != NULL); /* NOBARRIER: name is anchored in fs->kt and ls->vstack is not a GCobj. */ setgcref(ls->vstack[vtop].name, obj2gco(name)); fs->varmap[fs->nactvar+n] = (uint16_t)vtop; ls->vtop = vtop+1; } #define var_new_lit(ls, n, v) \ var_new(ls, (n), lj_parse_keepstr(ls, "" v, sizeof(v)-1)) #define var_new_fixed(ls, n, vn) \ var_new(ls, (n), (GCstr *)(uintptr_t)(vn)) /* Add local variables. */ static void var_add(LexState *ls, BCReg nvars) { FuncState *fs = ls->fs; BCReg nactvar = fs->nactvar; while (nvars--) { VarInfo *v = &var_get(ls, fs, nactvar); v->startpc = fs->pc; v->slot = nactvar++; v->info = 0; } fs->nactvar = nactvar; } /* Remove local variables. */ static void var_remove(LexState *ls, BCReg tolevel) { FuncState *fs = ls->fs; while (fs->nactvar > tolevel) var_get(ls, fs, --fs->nactvar).endpc = fs->pc; } /* Lookup local variable name. */ static BCReg var_lookup_local(FuncState *fs, GCstr *n) { int i; for (i = fs->nactvar-1; i >= 0; i--) { if (n == strref(var_get(fs->ls, fs, i).name)) return (BCReg)i; } return (BCReg)-1; /* Not found. */ } /* Lookup or add upvalue index. */ static MSize var_lookup_uv(FuncState *fs, MSize vidx, ExpDesc *e) { MSize i, n = fs->nuv; for (i = 0; i < n; i++) if (fs->uvmap[i] == vidx) return i; /* Already exists. */ /* Otherwise create a new one. */ checklimit(fs, fs->nuv, LJ_MAX_UPVAL, "upvalues"); lua_assert(e->k == VLOCAL || e->k == VUPVAL); fs->uvmap[n] = (uint16_t)vidx; fs->uvtmp[n] = (uint16_t)(e->k == VLOCAL ? vidx : LJ_MAX_VSTACK+e->u.s.info); fs->nuv = n+1; return n; } /* Forward declaration. */ static void fscope_uvmark(FuncState *fs, BCReg level); /* Recursively lookup variables in enclosing functions. */ static MSize var_lookup_(FuncState *fs, GCstr *name, ExpDesc *e, int first) { if (fs) { BCReg reg = var_lookup_local(fs, name); if ((int32_t)reg >= 0) { /* Local in this function? */ expr_init(e, VLOCAL, reg); if (!first) fscope_uvmark(fs, reg); /* Scope now has an upvalue. */ return (MSize)(e->u.s.aux = (uint32_t)fs->varmap[reg]); } else { MSize vidx = var_lookup_(fs->prev, name, e, 0); /* Var in outer func? */ if ((int32_t)vidx >= 0) { /* Yes, make it an upvalue here. */ e->u.s.info = (uint8_t)var_lookup_uv(fs, vidx, e); e->k = VUPVAL; return vidx; } } } else { /* Not found in any function, must be a global. */ expr_init(e, VGLOBAL, 0); e->u.sval = name; } return (MSize)-1; /* Global. */ } /* Lookup variable name. */ #define var_lookup(ls, e) \ var_lookup_((ls)->fs, lex_str(ls), (e), 1) /* -- Goto an label handling ---------------------------------------------- */ /* Add a new goto or label. */ static MSize gola_new(LexState *ls, GCstr *name, uint8_t info, BCPos pc) { FuncState *fs = ls->fs; MSize vtop = ls->vtop; if (LJ_UNLIKELY(vtop >= ls->sizevstack)) { if (ls->sizevstack >= LJ_MAX_VSTACK) lj_lex_error(ls, 0, LJ_ERR_XLIMC, LJ_MAX_VSTACK); lj_mem_growvec(ls->L, ls->vstack, ls->sizevstack, LJ_MAX_VSTACK, VarInfo); } lua_assert(name == NAME_BREAK || lj_tab_getstr(fs->kt, name) != NULL); /* NOBARRIER: name is anchored in fs->kt and ls->vstack is not a GCobj. */ setgcref(ls->vstack[vtop].name, obj2gco(name)); ls->vstack[vtop].startpc = pc; ls->vstack[vtop].slot = (uint8_t)fs->nactvar; ls->vstack[vtop].info = info; ls->vtop = vtop+1; return vtop; } #define gola_isgoto(v) ((v)->info & VSTACK_GOTO) #define gola_islabel(v) ((v)->info & VSTACK_LABEL) #define gola_isgotolabel(v) ((v)->info & (VSTACK_GOTO|VSTACK_LABEL)) /* Patch goto to jump to label. */ static void gola_patch(LexState *ls, VarInfo *vg, VarInfo *vl) { FuncState *fs = ls->fs; BCPos pc = vg->startpc; setgcrefnull(vg->name); /* Invalidate pending goto. */ setbc_a(&fs->bcbase[pc].ins, vl->slot); jmp_patch(fs, pc, vl->startpc); } /* Patch goto to close upvalues. */ static void gola_close(LexState *ls, VarInfo *vg) { FuncState *fs = ls->fs; BCPos pc = vg->startpc; BCIns *ip = &fs->bcbase[pc].ins; lua_assert(gola_isgoto(vg)); lua_assert(bc_op(*ip) == BC_JMP || bc_op(*ip) == BC_UCLO); setbc_a(ip, vg->slot); if (bc_op(*ip) == BC_JMP) { BCPos next = jmp_next(fs, pc); if (next != NO_JMP) jmp_patch(fs, next, pc); /* Jump to UCLO. */ setbc_op(ip, BC_UCLO); /* Turn into UCLO. */ setbc_j(ip, NO_JMP); } } /* Resolve pending forward gotos for label. */ static void gola_resolve(LexState *ls, FuncScope *bl, MSize idx) { VarInfo *vg = ls->vstack + bl->vstart; VarInfo *vl = ls->vstack + idx; for (; vg < vl; vg++) if (gcrefeq(vg->name, vl->name) && gola_isgoto(vg)) { if (vg->slot < vl->slot) { GCstr *name = strref(var_get(ls, ls->fs, vg->slot).name); lua_assert((uintptr_t)name >= VARNAME__MAX); ls->linenumber = ls->fs->bcbase[vg->startpc].line; lua_assert(strref(vg->name) != NAME_BREAK); lj_lex_error(ls, 0, LJ_ERR_XGSCOPE, strdata(strref(vg->name)), strdata(name)); } gola_patch(ls, vg, vl); } } /* Fixup remaining gotos and labels for scope. */ static void gola_fixup(LexState *ls, FuncScope *bl) { VarInfo *v = ls->vstack + bl->vstart; VarInfo *ve = ls->vstack + ls->vtop; for (; v < ve; v++) { GCstr *name = strref(v->name); if (name != NULL) { /* Only consider remaining valid gotos/labels. */ if (gola_islabel(v)) { VarInfo *vg; setgcrefnull(v->name); /* Invalidate label that goes out of scope. */ for (vg = v+1; vg < ve; vg++) /* Resolve pending backward gotos. */ if (strref(vg->name) == name && gola_isgoto(vg)) { if ((bl->flags&FSCOPE_UPVAL) && vg->slot > v->slot) gola_close(ls, vg); gola_patch(ls, vg, v); } } else if (gola_isgoto(v)) { if (bl->prev) { /* Propagate goto or break to outer scope. */ bl->prev->flags |= name == NAME_BREAK ? FSCOPE_BREAK : FSCOPE_GOLA; v->slot = bl->nactvar; if ((bl->flags & FSCOPE_UPVAL)) gola_close(ls, v); } else { /* No outer scope: undefined goto label or no loop. */ ls->linenumber = ls->fs->bcbase[v->startpc].line; if (name == NAME_BREAK) lj_lex_error(ls, 0, LJ_ERR_XBREAK); else lj_lex_error(ls, 0, LJ_ERR_XLUNDEF, strdata(name)); } } } } } /* Find existing label. */ static VarInfo *gola_findlabel(LexState *ls, GCstr *name) { VarInfo *v = ls->vstack + ls->fs->bl->vstart; VarInfo *ve = ls->vstack + ls->vtop; for (; v < ve; v++) if (strref(v->name) == name && gola_islabel(v)) return v; return NULL; } /* -- Scope handling ------------------------------------------------------ */ /* Begin a scope. */ static void fscope_begin(FuncState *fs, FuncScope *bl, int flags) { bl->nactvar = (uint8_t)fs->nactvar; bl->flags = flags; bl->vstart = fs->ls->vtop; bl->prev = fs->bl; fs->bl = bl; lua_assert(fs->freereg == fs->nactvar); } /* End a scope. */ static void fscope_end(FuncState *fs) { FuncScope *bl = fs->bl; LexState *ls = fs->ls; fs->bl = bl->prev; var_remove(ls, bl->nactvar); fs->freereg = fs->nactvar; lua_assert(bl->nactvar == fs->nactvar); if ((bl->flags & (FSCOPE_UPVAL|FSCOPE_NOCLOSE)) == FSCOPE_UPVAL) bcemit_AJ(fs, BC_UCLO, bl->nactvar, 0); if ((bl->flags & FSCOPE_BREAK)) { if ((bl->flags & FSCOPE_LOOP)) { MSize idx = gola_new(ls, NAME_BREAK, VSTACK_LABEL, fs->pc); ls->vtop = idx; /* Drop break label immediately. */ gola_resolve(ls, bl, idx); return; } /* else: need the fixup step to propagate the breaks. */ } else if (!(bl->flags & FSCOPE_GOLA)) { return; } gola_fixup(ls, bl); } /* Mark scope as having an upvalue. */ static void fscope_uvmark(FuncState *fs, BCReg level) { FuncScope *bl; for (bl = fs->bl; bl && bl->nactvar > level; bl = bl->prev) ; if (bl) bl->flags |= FSCOPE_UPVAL; } /* -- Function state management ------------------------------------------- */ /* Fixup bytecode for prototype. */ static void fs_fixup_bc(FuncState *fs, GCproto *pt, BCIns *bc, MSize n) { BCInsLine *base = fs->bcbase; MSize i; pt->sizebc = n; bc[0] = BCINS_AD((fs->flags & PROTO_VARARG) ? BC_FUNCV : BC_FUNCF, fs->framesize, 0); for (i = 1; i < n; i++) bc[i] = base[i].ins; } /* Fixup upvalues for child prototype, step #2. */ static void fs_fixup_uv2(FuncState *fs, GCproto *pt) { VarInfo *vstack = fs->ls->vstack; uint16_t *uv = proto_uv(pt); MSize i, n = pt->sizeuv; for (i = 0; i < n; i++) { VarIndex vidx = uv[i]; if (vidx >= LJ_MAX_VSTACK) uv[i] = vidx - LJ_MAX_VSTACK; else if ((vstack[vidx].info & VSTACK_VAR_RW)) uv[i] = vstack[vidx].slot | PROTO_UV_LOCAL; else uv[i] = vstack[vidx].slot | PROTO_UV_LOCAL | PROTO_UV_IMMUTABLE; } } /* Fixup constants for prototype. */ static void fs_fixup_k(FuncState *fs, GCproto *pt, void *kptr) { GCtab *kt; TValue *array; Node *node; MSize i, hmask; checklimitgt(fs, fs->nkn, BCMAX_D+1, "constants"); checklimitgt(fs, fs->nkgc, BCMAX_D+1, "constants"); setmref(pt->k, kptr); pt->sizekn = fs->nkn; pt->sizekgc = fs->nkgc; kt = fs->kt; array = tvref(kt->array); for (i = 0; i < kt->asize; i++) if (tvhaskslot(&array[i])) { TValue *tv = &((TValue *)kptr)[tvkslot(&array[i])]; if (LJ_DUALNUM) setintV(tv, (int32_t)i); else setnumV(tv, (lua_Number)i); } node = noderef(kt->node); hmask = kt->hmask; for (i = 0; i <= hmask; i++) { Node *n = &node[i]; if (tvhaskslot(&n->val)) { ptrdiff_t kidx = (ptrdiff_t)tvkslot(&n->val); lua_assert(!tvisint(&n->key)); if (tvisnum(&n->key)) { TValue *tv = &((TValue *)kptr)[kidx]; if (LJ_DUALNUM) { lua_Number nn = numV(&n->key); int32_t k = lj_num2int(nn); lua_assert(!tvismzero(&n->key)); if ((lua_Number)k == nn) setintV(tv, k); else *tv = n->key; } else { *tv = n->key; } } else { GCobj *o = gcV(&n->key); setgcref(((GCRef *)kptr)[~kidx], o); lj_gc_objbarrier(fs->L, pt, o); if (tvisproto(&n->key)) fs_fixup_uv2(fs, gco2pt(o)); } } } } /* Fixup upvalues for prototype, step #1. */ static void fs_fixup_uv1(FuncState *fs, GCproto *pt, uint16_t *uv) { setmref(pt->uv, uv); pt->sizeuv = fs->nuv; memcpy(uv, fs->uvtmp, fs->nuv*sizeof(VarIndex)); } #ifndef LUAJIT_DISABLE_DEBUGINFO /* Prepare lineinfo for prototype. */ static size_t fs_prep_line(FuncState *fs, BCLine numline) { return (fs->pc-1) << (numline < 256 ? 0 : numline < 65536 ? 1 : 2); } /* Fixup lineinfo for prototype. */ static void fs_fixup_line(FuncState *fs, GCproto *pt, void *lineinfo, BCLine numline) { BCInsLine *base = fs->bcbase + 1; BCLine first = fs->linedefined; MSize i = 0, n = fs->pc-1; pt->firstline = fs->linedefined; pt->numline = numline; setmref(pt->lineinfo, lineinfo); if (LJ_LIKELY(numline < 256)) { uint8_t *li = (uint8_t *)lineinfo; do { BCLine delta = base[i].line - first; lua_assert(delta >= 0 && delta < 256); li[i] = (uint8_t)delta; } while (++i < n); } else if (LJ_LIKELY(numline < 65536)) { uint16_t *li = (uint16_t *)lineinfo; do { BCLine delta = base[i].line - first; lua_assert(delta >= 0 && delta < 65536); li[i] = (uint16_t)delta; } while (++i < n); } else { uint32_t *li = (uint32_t *)lineinfo; do { BCLine delta = base[i].line - first; lua_assert(delta >= 0); li[i] = (uint32_t)delta; } while (++i < n); } } /* Resize buffer if needed. */ static LJ_NOINLINE void fs_buf_resize(LexState *ls, MSize len) { MSize sz = ls->sb.sz * 2; while (ls->sb.n + len > sz) sz = sz * 2; lj_str_resizebuf(ls->L, &ls->sb, sz); } static LJ_AINLINE void fs_buf_need(LexState *ls, MSize len) { if (LJ_UNLIKELY(ls->sb.n + len > ls->sb.sz)) fs_buf_resize(ls, len); } /* Add string to buffer. */ static void fs_buf_str(LexState *ls, const char *str, MSize len) { char *p = ls->sb.buf + ls->sb.n; MSize i; ls->sb.n += len; for (i = 0; i < len; i++) p[i] = str[i]; } /* Add ULEB128 value to buffer. */ static void fs_buf_uleb128(LexState *ls, uint32_t v) { MSize n = ls->sb.n; uint8_t *p = (uint8_t *)ls->sb.buf; for (; v >= 0x80; v >>= 7) p[n++] = (uint8_t)((v & 0x7f) | 0x80); p[n++] = (uint8_t)v; ls->sb.n = n; } /* Prepare variable info for prototype. */ static size_t fs_prep_var(LexState *ls, FuncState *fs, size_t *ofsvar) { VarInfo *vs =ls->vstack, *ve; MSize i, n; BCPos lastpc; lj_str_resetbuf(&ls->sb); /* Copy to temp. string buffer. */ /* Store upvalue names. */ for (i = 0, n = fs->nuv; i < n; i++) { GCstr *s = strref(vs[fs->uvmap[i]].name); MSize len = s->len+1; fs_buf_need(ls, len); fs_buf_str(ls, strdata(s), len); } *ofsvar = ls->sb.n; lastpc = 0; /* Store local variable names and compressed ranges. */ for (ve = vs + ls->vtop, vs += fs->vbase; vs < ve; vs++) { if (!gola_isgotolabel(vs)) { GCstr *s = strref(vs->name); BCPos startpc; if ((uintptr_t)s < VARNAME__MAX) { fs_buf_need(ls, 1 + 2*5); ls->sb.buf[ls->sb.n++] = (uint8_t)(uintptr_t)s; } else { MSize len = s->len+1; fs_buf_need(ls, len + 2*5); fs_buf_str(ls, strdata(s), len); } startpc = vs->startpc; fs_buf_uleb128(ls, startpc-lastpc); fs_buf_uleb128(ls, vs->endpc-startpc); lastpc = startpc; } } fs_buf_need(ls, 1); ls->sb.buf[ls->sb.n++] = '\0'; /* Terminator for varinfo. */ return ls->sb.n; } /* Fixup variable info for prototype. */ static void fs_fixup_var(LexState *ls, GCproto *pt, uint8_t *p, size_t ofsvar) { setmref(pt->uvinfo, p); setmref(pt->varinfo, (char *)p + ofsvar); memcpy(p, ls->sb.buf, ls->sb.n); /* Copy from temp. string buffer. */ } #else /* Initialize with empty debug info, if disabled. */ #define fs_prep_line(fs, numline) (UNUSED(numline), 0) #define fs_fixup_line(fs, pt, li, numline) \ pt->firstline = pt->numline = 0, setmref((pt)->lineinfo, NULL) #define fs_prep_var(ls, fs, ofsvar) (UNUSED(ofsvar), 0) #define fs_fixup_var(ls, pt, p, ofsvar) \ setmref((pt)->uvinfo, NULL), setmref((pt)->varinfo, NULL) #endif /* Check if bytecode op returns. */ static int bcopisret(BCOp op) { switch (op) { case BC_CALLMT: case BC_CALLT: case BC_RETM: case BC_RET: case BC_RET0: case BC_RET1: return 1; default: return 0; } } /* Fixup return instruction for prototype. */ static void fs_fixup_ret(FuncState *fs) { BCPos lastpc = fs->pc; if (lastpc <= fs->lasttarget || !bcopisret(bc_op(fs->bcbase[lastpc-1].ins))) { if ((fs->bl->flags & FSCOPE_UPVAL)) bcemit_AJ(fs, BC_UCLO, 0, 0); bcemit_AD(fs, BC_RET0, 0, 1); /* Need final return. */ } fs->bl->flags |= FSCOPE_NOCLOSE; /* Handled above. */ fscope_end(fs); lua_assert(fs->bl == NULL); /* May need to fixup returns encoded before first function was created. */ if (fs->flags & PROTO_FIXUP_RETURN) { BCPos pc; for (pc = 1; pc < lastpc; pc++) { BCIns ins = fs->bcbase[pc].ins; BCPos offset; switch (bc_op(ins)) { case BC_CALLMT: case BC_CALLT: case BC_RETM: case BC_RET: case BC_RET0: case BC_RET1: offset = bcemit_INS(fs, ins); /* Copy original instruction. */ fs->bcbase[offset].line = fs->bcbase[pc].line; offset = offset-(pc+1)+BCBIAS_J; if (offset > BCMAX_D) err_syntax(fs->ls, LJ_ERR_XFIXUP); /* Replace with UCLO plus branch. */ fs->bcbase[pc].ins = BCINS_AD(BC_UCLO, 0, offset); break; case BC_UCLO: return; /* We're done. */ default: break; } } } } /* Finish a FuncState and return the new prototype. */ static GCproto *fs_finish(LexState *ls, BCLine line) { lua_State *L = ls->L; FuncState *fs = ls->fs; BCLine numline = line - fs->linedefined; size_t sizept, ofsk, ofsuv, ofsli, ofsdbg, ofsvar; GCproto *pt; /* Apply final fixups. */ fs_fixup_ret(fs); /* Calculate total size of prototype including all colocated arrays. */ sizept = sizeof(GCproto) + fs->pc*sizeof(BCIns) + fs->nkgc*sizeof(GCRef); sizept = (sizept + sizeof(TValue)-1) & ~(sizeof(TValue)-1); ofsk = sizept; sizept += fs->nkn*sizeof(TValue); ofsuv = sizept; sizept += ((fs->nuv+1)&~1)*2; ofsli = sizept; sizept += fs_prep_line(fs, numline); ofsdbg = sizept; sizept += fs_prep_var(ls, fs, &ofsvar); /* Allocate prototype and initialize its fields. */ pt = (GCproto *)lj_mem_newgco(L, (MSize)sizept); pt->gct = ~LJ_TPROTO; pt->sizept = (MSize)sizept; pt->trace = 0; pt->flags = (uint8_t)(fs->flags & ~(PROTO_HAS_RETURN|PROTO_FIXUP_RETURN)); pt->numparams = fs->numparams; pt->framesize = fs->framesize; setgcref(pt->chunkname, obj2gco(ls->chunkname)); /* Close potentially uninitialized gap between bc and kgc. */ *(uint32_t *)((char *)pt + ofsk - sizeof(GCRef)*(fs->nkgc+1)) = 0; fs_fixup_bc(fs, pt, (BCIns *)((char *)pt + sizeof(GCproto)), fs->pc); fs_fixup_k(fs, pt, (void *)((char *)pt + ofsk)); fs_fixup_uv1(fs, pt, (uint16_t *)((char *)pt + ofsuv)); fs_fixup_line(fs, pt, (void *)((char *)pt + ofsli), numline); fs_fixup_var(ls, pt, (uint8_t *)((char *)pt + ofsdbg), ofsvar); lj_vmevent_send(L, BC, setprotoV(L, L->top++, pt); ); L->top--; /* Pop table of constants. */ ls->vtop = fs->vbase; /* Reset variable stack. */ ls->fs = fs->prev; lua_assert(ls->fs != NULL || ls->token == TK_eof); return pt; } /* Initialize a new FuncState. */ static void fs_init(LexState *ls, FuncState *fs) { lua_State *L = ls->L; fs->prev = ls->fs; ls->fs = fs; /* Append to list. */ fs->ls = ls; fs->vbase = ls->vtop; fs->L = L; fs->pc = 0; fs->lasttarget = 0; fs->jpc = NO_JMP; fs->freereg = 0; fs->nkgc = 0; fs->nkn = 0; fs->nactvar = 0; fs->nuv = 0; fs->bl = NULL; fs->flags = 0; fs->framesize = 1; /* Minimum frame size. */ fs->kt = lj_tab_new(L, 0, 0); /* Anchor table of constants in stack to avoid being collected. */ settabV(L, L->top, fs->kt); incr_top(L); } /* -- Expressions --------------------------------------------------------- */ /* Forward declaration. */ static void expr(LexState *ls, ExpDesc *v); /* Return string expression. */ static void expr_str(LexState *ls, ExpDesc *e) { expr_init(e, VKSTR, 0); e->u.sval = lex_str(ls); } /* Return index expression. */ static void expr_index(FuncState *fs, ExpDesc *t, ExpDesc *e) { /* Already called: expr_toval(fs, e). */ t->k = VINDEXED; if (expr_isnumk(e)) { #if LJ_DUALNUM if (tvisint(expr_numtv(e))) { int32_t k = intV(expr_numtv(e)); if (checku8(k)) { t->u.s.aux = BCMAX_C+1+(uint32_t)k; /* 256..511: const byte key */ return; } } #else lua_Number n = expr_numberV(e); int32_t k = lj_num2int(n); if (checku8(k) && n == (lua_Number)k) { t->u.s.aux = BCMAX_C+1+(uint32_t)k; /* 256..511: const byte key */ return; } #endif } else if (expr_isstrk(e)) { BCReg idx = const_str(fs, e); if (idx <= BCMAX_C) { t->u.s.aux = ~idx; /* -256..-1: const string key */ return; } } t->u.s.aux = expr_toanyreg(fs, e); /* 0..255: register */ } /* Parse index expression with named field. */ static void expr_field(LexState *ls, ExpDesc *v) { FuncState *fs = ls->fs; ExpDesc key; expr_toanyreg(fs, v); lj_lex_next(ls); /* Skip dot or colon. */ expr_str(ls, &key); expr_index(fs, v, &key); } /* Parse index expression with brackets. */ static void expr_bracket(LexState *ls, ExpDesc *v) { lj_lex_next(ls); /* Skip '['. */ expr(ls, v); expr_toval(ls->fs, v); lex_check(ls, ']'); } /* Get value of constant expression. */ static void expr_kvalue(TValue *v, ExpDesc *e) { if (e->k <= VKTRUE) { setitype(v, ~(uint32_t)e->k); } else if (e->k == VKSTR) { setgcref(v->gcr, obj2gco(e->u.sval)); setitype(v, LJ_TSTR); } else { lua_assert(tvisnumber(expr_numtv(e))); *v = *expr_numtv(e); } } /* Parse table constructor expression. */ static void expr_table(LexState *ls, ExpDesc *e) { FuncState *fs = ls->fs; BCLine line = ls->linenumber; GCtab *t = NULL; int vcall = 0, needarr = 0, fixt = 0; uint32_t narr = 1; /* First array index. */ uint32_t nhash = 0; /* Number of hash entries. */ BCReg freg = fs->freereg; BCPos pc = bcemit_AD(fs, BC_TNEW, freg, 0); expr_init(e, VNONRELOC, freg); bcreg_reserve(fs, 1); freg++; lex_check(ls, '{'); while (ls->token != '}') { ExpDesc key, val; vcall = 0; if (ls->token == '[') { expr_bracket(ls, &key); /* Already calls expr_toval. */ if (!expr_isk(&key)) expr_index(fs, e, &key); if (expr_isnumk(&key) && expr_numiszero(&key)) needarr = 1; else nhash++; lex_check(ls, '='); } else if ((ls->token == TK_name || (!LJ_52 && ls->token == TK_goto)) && lj_lex_lookahead(ls) == '=') { expr_str(ls, &key); lex_check(ls, '='); nhash++; } else { expr_init(&key, VKNUM, 0); setintV(&key.u.nval, (int)narr); narr++; needarr = vcall = 1; } expr(ls, &val); if (expr_isk(&key) && key.k != VKNIL && (key.k == VKSTR || expr_isk_nojump(&val))) { TValue k, *v; if (!t) { /* Create template table on demand. */ BCReg kidx; t = lj_tab_new(fs->L, needarr ? narr : 0, hsize2hbits(nhash)); kidx = const_gc(fs, obj2gco(t), LJ_TTAB); fs->bcbase[pc].ins = BCINS_AD(BC_TDUP, freg-1, kidx); } vcall = 0; expr_kvalue(&k, &key); v = lj_tab_set(fs->L, t, &k); lj_gc_anybarriert(fs->L, t); if (expr_isk_nojump(&val)) { /* Add const key/value to template table. */ expr_kvalue(v, &val); } else { /* Otherwise create dummy string key (avoids lj_tab_newkey). */ settabV(fs->L, v, t); /* Preserve key with table itself as value. */ fixt = 1; /* Fix this later, after all resizes. */ goto nonconst; } } else { nonconst: if (val.k != VCALL) { expr_toanyreg(fs, &val); vcall = 0; } if (expr_isk(&key)) expr_index(fs, e, &key); bcemit_store(fs, e, &val); } fs->freereg = freg; if (!lex_opt(ls, ',') && !lex_opt(ls, ';')) break; } lex_match(ls, '}', '{', line); if (vcall) { BCInsLine *ilp = &fs->bcbase[fs->pc-1]; ExpDesc en; lua_assert(bc_a(ilp->ins) == freg && bc_op(ilp->ins) == (narr > 256 ? BC_TSETV : BC_TSETB)); expr_init(&en, VKNUM, 0); en.u.nval.u32.lo = narr-1; en.u.nval.u32.hi = 0x43300000; /* Biased integer to avoid denormals. */ if (narr > 256) { fs->pc--; ilp--; } ilp->ins = BCINS_AD(BC_TSETM, freg, const_num(fs, &en)); setbc_b(&ilp[-1].ins, 0); } if (pc == fs->pc-1) { /* Make expr relocable if possible. */ e->u.s.info = pc; fs->freereg--; e->k = VRELOCABLE; } else { e->k = VNONRELOC; /* May have been changed by expr_index. */ } if (!t) { /* Construct TNEW RD: hhhhhaaaaaaaaaaa. */ BCIns *ip = &fs->bcbase[pc].ins; if (!needarr) narr = 0; else if (narr < 3) narr = 3; else if (narr > 0x7ff) narr = 0x7ff; setbc_d(ip, narr|(hsize2hbits(nhash)<<11)); } else { if (needarr && t->asize < narr) lj_tab_reasize(fs->L, t, narr-1); if (fixt) { /* Fix value for dummy keys in template table. */ Node *node = noderef(t->node); uint32_t i, hmask = t->hmask; for (i = 0; i <= hmask; i++) { Node *n = &node[i]; if (tvistab(&n->val)) { lua_assert(tabV(&n->val) == t); setnilV(&n->val); /* Turn value into nil. */ } } } lj_gc_check(fs->L); } } /* Parse function parameters. */ static BCReg parse_params(LexState *ls, int needself) { FuncState *fs = ls->fs; BCReg nparams = 0; lex_check(ls, '('); if (needself) var_new_lit(ls, nparams++, "self"); if (ls->token != ')') { do { if (ls->token == TK_name || (!LJ_52 && ls->token == TK_goto)) { var_new(ls, nparams++, lex_str(ls)); } else if (ls->token == TK_dots) { lj_lex_next(ls); fs->flags |= PROTO_VARARG; break; } else { err_syntax(ls, LJ_ERR_XPARAM); } } while (lex_opt(ls, ',')); } var_add(ls, nparams); lua_assert(fs->nactvar == nparams); bcreg_reserve(fs, nparams); lex_check(ls, ')'); return nparams; } /* Forward declaration. */ static void parse_chunk(LexState *ls); /* Parse body of a function. */ static void parse_body(LexState *ls, ExpDesc *e, int needself, BCLine line) { FuncState fs, *pfs = ls->fs; FuncScope bl; GCproto *pt; ptrdiff_t oldbase = pfs->bcbase - ls->bcstack; fs_init(ls, &fs); fscope_begin(&fs, &bl, 0); fs.linedefined = line; fs.numparams = (uint8_t)parse_params(ls, needself); fs.bcbase = pfs->bcbase + pfs->pc; fs.bclim = pfs->bclim - pfs->pc; bcemit_AD(&fs, BC_FUNCF, 0, 0); /* Placeholder. */ parse_chunk(ls); if (ls->token != TK_end) lex_match(ls, TK_end, TK_function, line); pt = fs_finish(ls, (ls->lastline = ls->linenumber)); pfs->bcbase = ls->bcstack + oldbase; /* May have been reallocated. */ pfs->bclim = (BCPos)(ls->sizebcstack - oldbase); /* Store new prototype in the constant array of the parent. */ expr_init(e, VRELOCABLE, bcemit_AD(pfs, BC_FNEW, 0, const_gc(pfs, obj2gco(pt), LJ_TPROTO))); #if LJ_HASFFI pfs->flags |= (fs.flags & PROTO_FFI); #endif if (!(pfs->flags & PROTO_CHILD)) { if (pfs->flags & PROTO_HAS_RETURN) pfs->flags |= PROTO_FIXUP_RETURN; pfs->flags |= PROTO_CHILD; } lj_lex_next(ls); } /* Parse expression list. Last expression is left open. */ static BCReg expr_list(LexState *ls, ExpDesc *v) { BCReg n = 1; expr(ls, v); while (lex_opt(ls, ',')) { expr_tonextreg(ls->fs, v); expr(ls, v); n++; } return n; } /* Parse function argument list. */ static void parse_args(LexState *ls, ExpDesc *e) { FuncState *fs = ls->fs; ExpDesc args; BCIns ins; BCReg base; BCLine line = ls->linenumber; if (ls->token == '(') { #if !LJ_52 if (line != ls->lastline) err_syntax(ls, LJ_ERR_XAMBIG); #endif lj_lex_next(ls); if (ls->token == ')') { /* f(). */ args.k = VVOID; } else { expr_list(ls, &args); if (args.k == VCALL) /* f(a, b, g()) or f(a, b, ...). */ setbc_b(bcptr(fs, &args), 0); /* Pass on multiple results. */ } lex_match(ls, ')', '(', line); } else if (ls->token == '{') { expr_table(ls, &args); } else if (ls->token == TK_string) { expr_init(&args, VKSTR, 0); args.u.sval = strV(&ls->tokenval); lj_lex_next(ls); } else { err_syntax(ls, LJ_ERR_XFUNARG); return; /* Silence compiler. */ } lua_assert(e->k == VNONRELOC); base = e->u.s.info; /* Base register for call. */ if (args.k == VCALL) { ins = BCINS_ABC(BC_CALLM, base, 2, args.u.s.aux - base - 1); } else { if (args.k != VVOID) expr_tonextreg(fs, &args); ins = BCINS_ABC(BC_CALL, base, 2, fs->freereg - base); } expr_init(e, VCALL, bcemit_INS(fs, ins)); e->u.s.aux = base; fs->bcbase[fs->pc - 1].line = line; fs->freereg = base+1; /* Leave one result by default. */ } /* Parse primary expression. */ static void expr_primary(LexState *ls, ExpDesc *v) { FuncState *fs = ls->fs; /* Parse prefix expression. */ if (ls->token == '(') { BCLine line = ls->linenumber; lj_lex_next(ls); expr(ls, v); lex_match(ls, ')', '(', line); expr_discharge(ls->fs, v); } else if (ls->token == TK_name || (!LJ_52 && ls->token == TK_goto)) { var_lookup(ls, v); } else { err_syntax(ls, LJ_ERR_XSYMBOL); } for (;;) { /* Parse multiple expression suffixes. */ if (ls->token == '.') { expr_field(ls, v); } else if (ls->token == '[') { ExpDesc key; expr_toanyreg(fs, v); expr_bracket(ls, &key); expr_index(fs, v, &key); } else if (ls->token == ':') { ExpDesc key; lj_lex_next(ls); expr_str(ls, &key); bcemit_method(fs, v, &key); parse_args(ls, v); } else if (ls->token == '(' || ls->token == TK_string || ls->token == '{') { expr_tonextreg(fs, v); parse_args(ls, v); } else { break; } } } /* Parse simple expression. */ static void expr_simple(LexState *ls, ExpDesc *v) { switch (ls->token) { case TK_number: expr_init(v, (LJ_HASFFI && tviscdata(&ls->tokenval)) ? VKCDATA : VKNUM, 0); copyTV(ls->L, &v->u.nval, &ls->tokenval); break; case TK_string: expr_init(v, VKSTR, 0); v->u.sval = strV(&ls->tokenval); break; case TK_nil: expr_init(v, VKNIL, 0); break; case TK_true: expr_init(v, VKTRUE, 0); break; case TK_false: expr_init(v, VKFALSE, 0); break; case TK_dots: { /* Vararg. */ FuncState *fs = ls->fs; BCReg base; checkcond(ls, fs->flags & PROTO_VARARG, LJ_ERR_XDOTS); bcreg_reserve(fs, 1); base = fs->freereg-1; expr_init(v, VCALL, bcemit_ABC(fs, BC_VARG, base, 2, fs->numparams)); v->u.s.aux = base; break; } case '{': /* Table constructor. */ expr_table(ls, v); return; case TK_function: lj_lex_next(ls); parse_body(ls, v, 0, ls->linenumber); return; default: expr_primary(ls, v); return; } lj_lex_next(ls); } /* Manage syntactic levels to avoid blowing up the stack. */ static void synlevel_begin(LexState *ls) { if (++ls->level >= LJ_MAX_XLEVEL) lj_lex_error(ls, 0, LJ_ERR_XLEVELS); } #define synlevel_end(ls) ((ls)->level--) /* Convert token to binary operator. */ static BinOpr token2binop(LexToken tok) { switch (tok) { case '+': return OPR_ADD; case '-': return OPR_SUB; case '*': return OPR_MUL; case '/': return OPR_DIV; case '%': return OPR_MOD; case '^': return OPR_POW; case TK_concat: return OPR_CONCAT; case TK_ne: return OPR_NE; case TK_eq: return OPR_EQ; case '<': return OPR_LT; case TK_le: return OPR_LE; case '>': return OPR_GT; case TK_ge: return OPR_GE; case TK_and: return OPR_AND; case TK_or: return OPR_OR; default: return OPR_NOBINOPR; } } /* Priorities for each binary operator. ORDER OPR. */ static const struct { uint8_t left; /* Left priority. */ uint8_t right; /* Right priority. */ } priority[] = { {6,6}, {6,6}, {7,7}, {7,7}, {7,7}, /* ADD SUB MUL DIV MOD */ {10,9}, {5,4}, /* POW CONCAT (right associative) */ {3,3}, {3,3}, /* EQ NE */ {3,3}, {3,3}, {3,3}, {3,3}, /* LT GE GT LE */ {2,2}, {1,1} /* AND OR */ }; #define UNARY_PRIORITY 8 /* Priority for unary operators. */ /* Forward declaration. */ static BinOpr expr_binop(LexState *ls, ExpDesc *v, uint32_t limit); /* Parse unary expression. */ static void expr_unop(LexState *ls, ExpDesc *v) { BCOp op; if (ls->token == TK_not) { op = BC_NOT; } else if (ls->token == '-') { op = BC_UNM; } else if (ls->token == '#') { op = BC_LEN; } else { expr_simple(ls, v); return; } lj_lex_next(ls); expr_binop(ls, v, UNARY_PRIORITY); bcemit_unop(ls->fs, op, v); } /* Parse binary expressions with priority higher than the limit. */ static BinOpr expr_binop(LexState *ls, ExpDesc *v, uint32_t limit) { BinOpr op; synlevel_begin(ls); expr_unop(ls, v); op = token2binop(ls->token); while (op != OPR_NOBINOPR && priority[op].left > limit) { ExpDesc v2; BinOpr nextop; lj_lex_next(ls); bcemit_binop_left(ls->fs, op, v); /* Parse binary expression with higher priority. */ nextop = expr_binop(ls, &v2, priority[op].right); bcemit_binop(ls->fs, op, v, &v2); op = nextop; } synlevel_end(ls); return op; /* Return unconsumed binary operator (if any). */ } /* Parse expression. */ static void expr(LexState *ls, ExpDesc *v) { expr_binop(ls, v, 0); /* Priority 0: parse whole expression. */ } /* Assign expression to the next register. */ static void expr_next(LexState *ls) { ExpDesc e; expr(ls, &e); expr_tonextreg(ls->fs, &e); } /* Parse conditional expression. */ static BCPos expr_cond(LexState *ls) { ExpDesc v; expr(ls, &v); if (v.k == VKNIL) v.k = VKFALSE; bcemit_branch_t(ls->fs, &v); return v.f; } /* -- Assignments --------------------------------------------------------- */ /* List of LHS variables. */ typedef struct LHSVarList { ExpDesc v; /* LHS variable. */ struct LHSVarList *prev; /* Link to previous LHS variable. */ } LHSVarList; /* Eliminate write-after-read hazards for local variable assignment. */ static void assign_hazard(LexState *ls, LHSVarList *lh, const ExpDesc *v) { FuncState *fs = ls->fs; BCReg reg = v->u.s.info; /* Check against this variable. */ BCReg tmp = fs->freereg; /* Rename to this temp. register (if needed). */ int hazard = 0; for (; lh; lh = lh->prev) { if (lh->v.k == VINDEXED) { if (lh->v.u.s.info == reg) { /* t[i], t = 1, 2 */ hazard = 1; lh->v.u.s.info = tmp; } if (lh->v.u.s.aux == reg) { /* t[i], i = 1, 2 */ hazard = 1; lh->v.u.s.aux = tmp; } } } if (hazard) { bcemit_AD(fs, BC_MOV, tmp, reg); /* Rename conflicting variable. */ bcreg_reserve(fs, 1); } } /* Adjust LHS/RHS of an assignment. */ static void assign_adjust(LexState *ls, BCReg nvars, BCReg nexps, ExpDesc *e) { FuncState *fs = ls->fs; int32_t extra = (int32_t)nvars - (int32_t)nexps; if (e->k == VCALL) { extra++; /* Compensate for the VCALL itself. */ if (extra < 0) extra = 0; setbc_b(bcptr(fs, e), extra+1); /* Fixup call results. */ if (extra > 1) bcreg_reserve(fs, (BCReg)extra-1); } else { if (e->k != VVOID) expr_tonextreg(fs, e); /* Close last expression. */ if (extra > 0) { /* Leftover LHS are set to nil. */ BCReg reg = fs->freereg; bcreg_reserve(fs, (BCReg)extra); bcemit_nil(fs, reg, (BCReg)extra); } } if (nexps > nvars) ls->fs->freereg -= nexps - nvars; /* Drop leftover regs. */ } /* Recursively parse assignment statement. */ static void parse_assignment(LexState *ls, LHSVarList *lh, BCReg nvars) { ExpDesc e; checkcond(ls, VLOCAL <= lh->v.k && lh->v.k <= VINDEXED, LJ_ERR_XSYNTAX); if (lex_opt(ls, ',')) { /* Collect LHS list and recurse upwards. */ LHSVarList vl; vl.prev = lh; expr_primary(ls, &vl.v); if (vl.v.k == VLOCAL) assign_hazard(ls, lh, &vl.v); checklimit(ls->fs, ls->level + nvars, LJ_MAX_XLEVEL, "variable names"); parse_assignment(ls, &vl, nvars+1); } else { /* Parse RHS. */ BCReg nexps; lex_check(ls, '='); nexps = expr_list(ls, &e); if (nexps == nvars) { if (e.k == VCALL) { if (bc_op(*bcptr(ls->fs, &e)) == BC_VARG) { /* Vararg assignment. */ ls->fs->freereg--; e.k = VRELOCABLE; } else { /* Multiple call results. */ e.u.s.info = e.u.s.aux; /* Base of call is not relocatable. */ e.k = VNONRELOC; } } bcemit_store(ls->fs, &lh->v, &e); return; } assign_adjust(ls, nvars, nexps, &e); } /* Assign RHS to LHS and recurse downwards. */ expr_init(&e, VNONRELOC, ls->fs->freereg-1); bcemit_store(ls->fs, &lh->v, &e); } /* Parse call statement or assignment. */ static void parse_call_assign(LexState *ls) { FuncState *fs = ls->fs; LHSVarList vl; expr_primary(ls, &vl.v); if (vl.v.k == VCALL) { /* Function call statement. */ setbc_b(bcptr(fs, &vl.v), 1); /* No results. */ } else { /* Start of an assignment. */ vl.prev = NULL; parse_assignment(ls, &vl, 1); } } /* Parse 'local' statement. */ static void parse_local(LexState *ls) { if (lex_opt(ls, TK_function)) { /* Local function declaration. */ ExpDesc v, b; FuncState *fs = ls->fs; var_new(ls, 0, lex_str(ls)); expr_init(&v, VLOCAL, fs->freereg); v.u.s.aux = fs->varmap[fs->freereg]; bcreg_reserve(fs, 1); var_add(ls, 1); parse_body(ls, &b, 0, ls->linenumber); /* bcemit_store(fs, &v, &b) without setting VSTACK_VAR_RW. */ expr_free(fs, &b); expr_toreg(fs, &b, v.u.s.info); /* The upvalue is in scope, but the local is only valid after the store. */ var_get(ls, fs, fs->nactvar - 1).startpc = fs->pc; } else { /* Local variable declaration. */ ExpDesc e; BCReg nexps, nvars = 0; do { /* Collect LHS. */ var_new(ls, nvars++, lex_str(ls)); } while (lex_opt(ls, ',')); if (lex_opt(ls, '=')) { /* Optional RHS. */ nexps = expr_list(ls, &e); } else { /* Or implicitly set to nil. */ e.k = VVOID; nexps = 0; } assign_adjust(ls, nvars, nexps, &e); var_add(ls, nvars); } } /* Parse 'function' statement. */ static void parse_func(LexState *ls, BCLine line) { FuncState *fs; ExpDesc v, b; int needself = 0; lj_lex_next(ls); /* Skip 'function'. */ /* Parse function name. */ var_lookup(ls, &v); while (ls->token == '.') /* Multiple dot-separated fields. */ expr_field(ls, &v); if (ls->token == ':') { /* Optional colon to signify method call. */ needself = 1; expr_field(ls, &v); } parse_body(ls, &b, needself, line); fs = ls->fs; bcemit_store(fs, &v, &b); fs->bcbase[fs->pc - 1].line = line; /* Set line for the store. */ } /* -- Control transfer statements ----------------------------------------- */ /* Check for end of block. */ static int endofblock(LexToken token) { switch (token) { case TK_else: case TK_elseif: case TK_end: case TK_until: case TK_eof: return 1; default: return 0; } } /* Parse 'return' statement. */ static void parse_return(LexState *ls) { BCIns ins; FuncState *fs = ls->fs; lj_lex_next(ls); /* Skip 'return'. */ fs->flags |= PROTO_HAS_RETURN; if (endofblock(ls->token) || ls->token == ';') { /* Bare return. */ ins = BCINS_AD(BC_RET0, 0, 1); } else { /* Return with one or more values. */ ExpDesc e; /* Receives the _last_ expression in the list. */ BCReg nret = expr_list(ls, &e); if (nret == 1) { /* Return one result. */ if (e.k == VCALL) { /* Check for tail call. */ BCIns *ip = bcptr(fs, &e); /* It doesn't pay off to add BC_VARGT just for 'return ...'. */ if (bc_op(*ip) == BC_VARG) goto notailcall; fs->pc--; ins = BCINS_AD(bc_op(*ip)-BC_CALL+BC_CALLT, bc_a(*ip), bc_c(*ip)); } else { /* Can return the result from any register. */ ins = BCINS_AD(BC_RET1, expr_toanyreg(fs, &e), 2); } } else { if (e.k == VCALL) { /* Append all results from a call. */ notailcall: setbc_b(bcptr(fs, &e), 0); ins = BCINS_AD(BC_RETM, fs->nactvar, e.u.s.aux - fs->nactvar); } else { expr_tonextreg(fs, &e); /* Force contiguous registers. */ ins = BCINS_AD(BC_RET, fs->nactvar, nret+1); } } } if (fs->flags & PROTO_CHILD) bcemit_AJ(fs, BC_UCLO, 0, 0); /* May need to close upvalues first. */ bcemit_INS(fs, ins); } /* Parse 'break' statement. */ static void parse_break(LexState *ls) { ls->fs->bl->flags |= FSCOPE_BREAK; gola_new(ls, NAME_BREAK, VSTACK_GOTO, bcemit_jmp(ls->fs)); } /* Parse 'goto' statement. */ static void parse_goto(LexState *ls) { FuncState *fs = ls->fs; GCstr *name = lex_str(ls); VarInfo *vl = gola_findlabel(ls, name); if (vl) /* Treat backwards goto within same scope like a loop. */ bcemit_AJ(fs, BC_LOOP, vl->slot, -1); /* No BC range check. */ fs->bl->flags |= FSCOPE_GOLA; gola_new(ls, name, VSTACK_GOTO, bcemit_jmp(fs)); } /* Parse label. */ static void parse_label(LexState *ls) { FuncState *fs = ls->fs; GCstr *name; MSize idx; fs->lasttarget = fs->pc; fs->bl->flags |= FSCOPE_GOLA; lj_lex_next(ls); /* Skip '::'. */ name = lex_str(ls); if (gola_findlabel(ls, name)) lj_lex_error(ls, 0, LJ_ERR_XLDUP, strdata(name)); idx = gola_new(ls, name, VSTACK_LABEL, fs->pc); lex_check(ls, TK_label); /* Recursively parse trailing statements: labels and ';' (Lua 5.2 only). */ for (;;) { if (ls->token == TK_label) { synlevel_begin(ls); parse_label(ls); synlevel_end(ls); } else if (LJ_52 && ls->token == ';') { lj_lex_next(ls); } else { break; } } /* Trailing label is considered to be outside of scope. */ if (endofblock(ls->token) && ls->token != TK_until) ls->vstack[idx].slot = fs->bl->nactvar; gola_resolve(ls, fs->bl, idx); } /* -- Blocks, loops and conditional statements ---------------------------- */ /* Parse a block. */ static void parse_block(LexState *ls) { FuncState *fs = ls->fs; FuncScope bl; fscope_begin(fs, &bl, 0); parse_chunk(ls); fscope_end(fs); } /* Parse 'while' statement. */ static void parse_while(LexState *ls, BCLine line) { FuncState *fs = ls->fs; BCPos start, loop, condexit; FuncScope bl; lj_lex_next(ls); /* Skip 'while'. */ start = fs->lasttarget = fs->pc; condexit = expr_cond(ls); fscope_begin(fs, &bl, FSCOPE_LOOP); lex_check(ls, TK_do); loop = bcemit_AD(fs, BC_LOOP, fs->nactvar, 0); parse_block(ls); jmp_patch(fs, bcemit_jmp(fs), start); lex_match(ls, TK_end, TK_while, line); fscope_end(fs); jmp_tohere(fs, condexit); jmp_patchins(fs, loop, fs->pc); } /* Parse 'repeat' statement. */ static void parse_repeat(LexState *ls, BCLine line) { FuncState *fs = ls->fs; BCPos loop = fs->lasttarget = fs->pc; BCPos condexit; FuncScope bl1, bl2; fscope_begin(fs, &bl1, FSCOPE_LOOP); /* Breakable loop scope. */ fscope_begin(fs, &bl2, 0); /* Inner scope. */ lj_lex_next(ls); /* Skip 'repeat'. */ bcemit_AD(fs, BC_LOOP, fs->nactvar, 0); parse_chunk(ls); lex_match(ls, TK_until, TK_repeat, line); condexit = expr_cond(ls); /* Parse condition (still inside inner scope). */ if (!(bl2.flags & FSCOPE_UPVAL)) { /* No upvalues? Just end inner scope. */ fscope_end(fs); } else { /* Otherwise generate: cond: UCLO+JMP out, !cond: UCLO+JMP loop. */ parse_break(ls); /* Break from loop and close upvalues. */ jmp_tohere(fs, condexit); fscope_end(fs); /* End inner scope and close upvalues. */ condexit = bcemit_jmp(fs); } jmp_patch(fs, condexit, loop); /* Jump backwards if !cond. */ jmp_patchins(fs, loop, fs->pc); fscope_end(fs); /* End loop scope. */ } /* Parse numeric 'for'. */ static void parse_for_num(LexState *ls, GCstr *varname, BCLine line) { FuncState *fs = ls->fs; BCReg base = fs->freereg; FuncScope bl; BCPos loop, loopend; /* Hidden control variables. */ var_new_fixed(ls, FORL_IDX, VARNAME_FOR_IDX); var_new_fixed(ls, FORL_STOP, VARNAME_FOR_STOP); var_new_fixed(ls, FORL_STEP, VARNAME_FOR_STEP); /* Visible copy of index variable. */ var_new(ls, FORL_EXT, varname); lex_check(ls, '='); expr_next(ls); lex_check(ls, ','); expr_next(ls); if (lex_opt(ls, ',')) { expr_next(ls); } else { bcemit_AD(fs, BC_KSHORT, fs->freereg, 1); /* Default step is 1. */ bcreg_reserve(fs, 1); } var_add(ls, 3); /* Hidden control variables. */ lex_check(ls, TK_do); loop = bcemit_AJ(fs, BC_FORI, base, NO_JMP); fscope_begin(fs, &bl, 0); /* Scope for visible variables. */ var_add(ls, 1); bcreg_reserve(fs, 1); parse_block(ls); fscope_end(fs); /* Perform loop inversion. Loop control instructions are at the end. */ loopend = bcemit_AJ(fs, BC_FORL, base, NO_JMP); fs->bcbase[loopend].line = line; /* Fix line for control ins. */ jmp_patchins(fs, loopend, loop+1); jmp_patchins(fs, loop, fs->pc); } /* Try to predict whether the iterator is next() and specialize the bytecode. ** Detecting next() and pairs() by name is simplistic, but quite effective. ** The interpreter backs off if the check for the closure fails at runtime. */ static int predict_next(LexState *ls, FuncState *fs, BCPos pc) { BCIns ins = fs->bcbase[pc].ins; GCstr *name; cTValue *o; switch (bc_op(ins)) { case BC_MOV: name = gco2str(gcref(var_get(ls, fs, bc_d(ins)).name)); break; case BC_UGET: name = gco2str(gcref(ls->vstack[fs->uvmap[bc_d(ins)]].name)); break; case BC_GGET: /* There's no inverse index (yet), so lookup the strings. */ o = lj_tab_getstr(fs->kt, lj_str_newlit(ls->L, "pairs")); if (o && tvhaskslot(o) && tvkslot(o) == bc_d(ins)) return 1; o = lj_tab_getstr(fs->kt, lj_str_newlit(ls->L, "next")); if (o && tvhaskslot(o) && tvkslot(o) == bc_d(ins)) return 1; return 0; default: return 0; } return (name->len == 5 && !strcmp(strdata(name), "pairs")) || (name->len == 4 && !strcmp(strdata(name), "next")); } /* Parse 'for' iterator. */ static void parse_for_iter(LexState *ls, GCstr *indexname) { FuncState *fs = ls->fs; ExpDesc e; BCReg nvars = 0; BCLine line; BCReg base = fs->freereg + 3; BCPos loop, loopend, exprpc = fs->pc; FuncScope bl; int isnext; /* Hidden control variables. */ var_new_fixed(ls, nvars++, VARNAME_FOR_GEN); var_new_fixed(ls, nvars++, VARNAME_FOR_STATE); var_new_fixed(ls, nvars++, VARNAME_FOR_CTL); /* Visible variables returned from iterator. */ var_new(ls, nvars++, indexname); while (lex_opt(ls, ',')) var_new(ls, nvars++, lex_str(ls)); lex_check(ls, TK_in); line = ls->linenumber; assign_adjust(ls, 3, expr_list(ls, &e), &e); bcreg_bump(fs, 3); /* The iterator needs another 3 slots (func + 2 args). */ isnext = (nvars <= 5 && predict_next(ls, fs, exprpc)); var_add(ls, 3); /* Hidden control variables. */ lex_check(ls, TK_do); loop = bcemit_AJ(fs, isnext ? BC_ISNEXT : BC_JMP, base, NO_JMP); fscope_begin(fs, &bl, 0); /* Scope for visible variables. */ var_add(ls, nvars-3); bcreg_reserve(fs, nvars-3); parse_block(ls); fscope_end(fs); /* Perform loop inversion. Loop control instructions are at the end. */ jmp_patchins(fs, loop, fs->pc); bcemit_ABC(fs, isnext ? BC_ITERN : BC_ITERC, base, nvars-3+1, 2+1); loopend = bcemit_AJ(fs, BC_ITERL, base, NO_JMP); fs->bcbase[loopend-1].line = line; /* Fix line for control ins. */ fs->bcbase[loopend].line = line; jmp_patchins(fs, loopend, loop+1); } /* Parse 'for' statement. */ static void parse_for(LexState *ls, BCLine line) { FuncState *fs = ls->fs; GCstr *varname; FuncScope bl; fscope_begin(fs, &bl, FSCOPE_LOOP); lj_lex_next(ls); /* Skip 'for'. */ varname = lex_str(ls); /* Get first variable name. */ if (ls->token == '=') parse_for_num(ls, varname, line); else if (ls->token == ',' || ls->token == TK_in) parse_for_iter(ls, varname); else err_syntax(ls, LJ_ERR_XFOR); lex_match(ls, TK_end, TK_for, line); fscope_end(fs); /* Resolve break list. */ } /* Parse condition and 'then' block. */ static BCPos parse_then(LexState *ls) { BCPos condexit; lj_lex_next(ls); /* Skip 'if' or 'elseif'. */ condexit = expr_cond(ls); lex_check(ls, TK_then); parse_block(ls); return condexit; } /* Parse 'if' statement. */ static void parse_if(LexState *ls, BCLine line) { FuncState *fs = ls->fs; BCPos flist; BCPos escapelist = NO_JMP; flist = parse_then(ls); while (ls->token == TK_elseif) { /* Parse multiple 'elseif' blocks. */ jmp_append(fs, &escapelist, bcemit_jmp(fs)); jmp_tohere(fs, flist); flist = parse_then(ls); } if (ls->token == TK_else) { /* Parse optional 'else' block. */ jmp_append(fs, &escapelist, bcemit_jmp(fs)); jmp_tohere(fs, flist); lj_lex_next(ls); /* Skip 'else'. */ parse_block(ls); } else { jmp_append(fs, &escapelist, flist); } jmp_tohere(fs, escapelist); lex_match(ls, TK_end, TK_if, line); } /* -- Parse statements ---------------------------------------------------- */ /* Parse a statement. Returns 1 if it must be the last one in a chunk. */ static int parse_stmt(LexState *ls) { BCLine line = ls->linenumber; switch (ls->token) { case TK_if: parse_if(ls, line); break; case TK_while: parse_while(ls, line); break; case TK_do: lj_lex_next(ls); parse_block(ls); lex_match(ls, TK_end, TK_do, line); break; case TK_for: parse_for(ls, line); break; case TK_repeat: parse_repeat(ls, line); break; case TK_function: parse_func(ls, line); break; case TK_local: lj_lex_next(ls); parse_local(ls); break; case TK_return: parse_return(ls); return 1; /* Must be last. */ case TK_break: lj_lex_next(ls); parse_break(ls); return !LJ_52; /* Must be last in Lua 5.1. */ #if LJ_52 case ';': lj_lex_next(ls); break; #endif case TK_label: parse_label(ls); break; case TK_goto: if (LJ_52 || lj_lex_lookahead(ls) == TK_name) { lj_lex_next(ls); parse_goto(ls); break; } /* else: fallthrough */ default: parse_call_assign(ls); break; } return 0; } /* A chunk is a list of statements optionally separated by semicolons. */ static void parse_chunk(LexState *ls) { int islast = 0; synlevel_begin(ls); while (!islast && !endofblock(ls->token)) { islast = parse_stmt(ls); lex_opt(ls, ';'); lua_assert(ls->fs->framesize >= ls->fs->freereg && ls->fs->freereg >= ls->fs->nactvar); ls->fs->freereg = ls->fs->nactvar; /* Free registers after each stmt. */ } synlevel_end(ls); } /* Entry point of bytecode parser. */ GCproto *lj_parse(LexState *ls) { FuncState fs; FuncScope bl; GCproto *pt; lua_State *L = ls->L; #ifdef LUAJIT_DISABLE_DEBUGINFO ls->chunkname = lj_str_newlit(L, "="); #else ls->chunkname = lj_str_newz(L, ls->chunkarg); #endif setstrV(L, L->top, ls->chunkname); /* Anchor chunkname string. */ incr_top(L); ls->level = 0; fs_init(ls, &fs); fs.linedefined = 0; fs.numparams = 0; fs.bcbase = NULL; fs.bclim = 0; fs.flags |= PROTO_VARARG; /* Main chunk is always a vararg func. */ fscope_begin(&fs, &bl, 0); bcemit_AD(&fs, BC_FUNCV, 0, 0); /* Placeholder. */ lj_lex_next(ls); /* Read-ahead first token. */ parse_chunk(ls); if (ls->token != TK_eof) err_token(ls, TK_eof); pt = fs_finish(ls, ls->linenumber); L->top--; /* Drop chunkname. */ lua_assert(fs.prev == NULL); lua_assert(ls->fs == NULL); lua_assert(pt->sizeuv == 0); return pt; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ccallback.h0000644000175000017500000000116713122010155017433 0ustar philphil/* ** FFI C callback handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CCALLBACK_H #define _LJ_CCALLBACK_H #include "lj_obj.h" #include "lj_ctype.h" #if LJ_HASFFI /* Really belongs to lj_vm.h. */ LJ_ASMF void lj_vm_ffi_callback(void); LJ_FUNC MSize lj_ccallback_ptr2slot(CTState *cts, void *p); LJ_FUNCA lua_State * LJ_FASTCALL lj_ccallback_enter(CTState *cts, void *cf); LJ_FUNCA void LJ_FASTCALL lj_ccallback_leave(CTState *cts, TValue *o); LJ_FUNC void *lj_ccallback_new(CTState *cts, CType *ct, GCfunc *fn); LJ_FUNC void lj_ccallback_mcode_free(CTState *cts); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_vm.h0000644000175000017500000000661213122010155016156 0ustar philphil/* ** Assembler VM interface definitions. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_VM_H #define _LJ_VM_H #include "lj_obj.h" /* Entry points for ASM parts of VM. */ LJ_ASMF void lj_vm_call(lua_State *L, TValue *base, int nres1); LJ_ASMF int lj_vm_pcall(lua_State *L, TValue *base, int nres1, ptrdiff_t ef); typedef TValue *(*lua_CPFunction)(lua_State *L, lua_CFunction func, void *ud); LJ_ASMF int lj_vm_cpcall(lua_State *L, lua_CFunction func, void *ud, lua_CPFunction cp); LJ_ASMF int lj_vm_resume(lua_State *L, TValue *base, int nres1, ptrdiff_t ef); LJ_ASMF_NORET void LJ_FASTCALL lj_vm_unwind_c(void *cframe, int errcode); LJ_ASMF_NORET void LJ_FASTCALL lj_vm_unwind_ff(void *cframe); LJ_ASMF void lj_vm_unwind_c_eh(void); LJ_ASMF void lj_vm_unwind_ff_eh(void); #if LJ_TARGET_X86ORX64 LJ_ASMF void lj_vm_unwind_rethrow(void); #endif /* Miscellaneous functions. */ #if LJ_TARGET_X86ORX64 LJ_ASMF int lj_vm_cpuid(uint32_t f, uint32_t res[4]); #endif #if LJ_TARGET_PPC void lj_vm_cachesync(void *start, void *end); #endif LJ_ASMF double lj_vm_foldarith(double x, double y, int op); #if LJ_HASJIT LJ_ASMF double lj_vm_foldfpm(double x, int op); #endif #if !LJ_ARCH_HASFPU /* Declared in lj_obj.h: LJ_ASMF int32_t lj_vm_tobit(double x); */ #endif /* Dispatch targets for recording and hooks. */ LJ_ASMF void lj_vm_record(void); LJ_ASMF void lj_vm_inshook(void); LJ_ASMF void lj_vm_rethook(void); LJ_ASMF void lj_vm_callhook(void); /* Trace exit handling. */ LJ_ASMF void lj_vm_exit_handler(void); LJ_ASMF void lj_vm_exit_interp(void); /* Internal math helper functions. */ #if LJ_TARGET_X86ORX64 || LJ_TARGET_PPC #define lj_vm_floor floor #define lj_vm_ceil ceil #else LJ_ASMF double lj_vm_floor(double); LJ_ASMF double lj_vm_ceil(double); #if LJ_TARGET_ARM LJ_ASMF double lj_vm_floor_sf(double); LJ_ASMF double lj_vm_ceil_sf(double); #endif #endif #if defined(LUAJIT_NO_LOG2) || LJ_TARGET_X86ORX64 LJ_ASMF double lj_vm_log2(double); #else #define lj_vm_log2 log2 #endif #if LJ_HASJIT #if LJ_TARGET_X86ORX64 LJ_ASMF void lj_vm_floor_sse(void); LJ_ASMF void lj_vm_ceil_sse(void); LJ_ASMF void lj_vm_trunc_sse(void); LJ_ASMF void lj_vm_exp_x87(void); LJ_ASMF void lj_vm_exp2_x87(void); LJ_ASMF void lj_vm_pow_sse(void); LJ_ASMF void lj_vm_powi_sse(void); #else #if LJ_TARGET_PPC #define lj_vm_trunc trunc #else LJ_ASMF double lj_vm_trunc(double); #if LJ_TARGET_ARM LJ_ASMF double lj_vm_trunc_sf(double); #endif #endif LJ_ASMF double lj_vm_powi(double, int32_t); #ifdef LUAJIT_NO_EXP2 LJ_ASMF double lj_vm_exp2(double); #else #define lj_vm_exp2 exp2 #endif #endif LJ_ASMF int32_t LJ_FASTCALL lj_vm_modi(int32_t, int32_t); #if LJ_HASFFI LJ_ASMF int lj_vm_errno(void); #endif #endif /* Continuations for metamethods. */ LJ_ASMF void lj_cont_cat(void); /* Continue with concatenation. */ LJ_ASMF void lj_cont_ra(void); /* Store result in RA from instruction. */ LJ_ASMF void lj_cont_nop(void); /* Do nothing, just continue execution. */ LJ_ASMF void lj_cont_condt(void); /* Branch if result is true. */ LJ_ASMF void lj_cont_condf(void); /* Branch if result is false. */ LJ_ASMF void lj_cont_hook(void); /* Continue from hook yield. */ enum { LJ_CONT_TAILCALL, LJ_CONT_FFI_CALLBACK }; /* Special continuations. */ /* Start of the ASM code. */ LJ_ASMF char lj_vm_asm_begin[]; /* Bytecode offsets are relative to lj_vm_asm_begin. */ #define makeasmfunc(ofs) ((ASMFunction)(lj_vm_asm_begin + (ofs))) #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_opt_dce.c0000644000175000017500000000375713122010155017153 0ustar philphil/* ** DCE: Dead Code Elimination. Pre-LOOP only -- ASM already performs DCE. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_opt_dce_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) /* Scan through all snapshots and mark all referenced instructions. */ static void dce_marksnap(jit_State *J) { SnapNo i, nsnap = J->cur.nsnap; for (i = 0; i < nsnap; i++) { SnapShot *snap = &J->cur.snap[i]; SnapEntry *map = &J->cur.snapmap[snap->mapofs]; MSize n, nent = snap->nent; for (n = 0; n < nent; n++) { IRRef ref = snap_ref(map[n]); if (ref >= REF_FIRST) irt_setmark(IR(ref)->t); } } } /* Backwards propagate marks. Replace unused instructions with NOPs. */ static void dce_propagate(jit_State *J) { IRRef1 *pchain[IR__MAX]; IRRef ins; uint32_t i; for (i = 0; i < IR__MAX; i++) pchain[i] = &J->chain[i]; for (ins = J->cur.nins-1; ins >= REF_FIRST; ins--) { IRIns *ir = IR(ins); if (irt_ismarked(ir->t)) { irt_clearmark(ir->t); pchain[ir->o] = &ir->prev; } else if (!ir_sideeff(ir)) { *pchain[ir->o] = ir->prev; /* Reroute original instruction chain. */ ir->t.irt = IRT_NIL; ir->o = IR_NOP; /* Replace instruction with NOP. */ ir->op1 = ir->op2 = 0; ir->prev = 0; continue; } if (ir->op1 >= REF_FIRST) irt_setmark(IR(ir->op1)->t); if (ir->op2 >= REF_FIRST) irt_setmark(IR(ir->op2)->t); } } /* Dead Code Elimination. ** ** First backpropagate marks for all used instructions. Then replace ** the unused ones with a NOP. Note that compressing the IR to eliminate ** the NOPs does not pay off. */ void lj_opt_dce(jit_State *J) { if ((J->flags & JIT_F_OPT_DCE)) { dce_marksnap(J); dce_propagate(J); memset(J->bpropcache, 0, sizeof(J->bpropcache)); /* Invalidate cache. */ } } #undef IR #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_trace.h0000644000175000017500000000274113122010155016631 0ustar philphil/* ** Trace management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_TRACE_H #define _LJ_TRACE_H #include "lj_obj.h" #if LJ_HASJIT #include "lj_jit.h" #include "lj_dispatch.h" /* Trace errors. */ typedef enum { #define TREDEF(name, msg) LJ_TRERR_##name, #include "lj_traceerr.h" LJ_TRERR__MAX } TraceError; LJ_FUNC_NORET void lj_trace_err(jit_State *J, TraceError e); LJ_FUNC_NORET void lj_trace_err_info(jit_State *J, TraceError e); /* Trace management. */ LJ_FUNC void LJ_FASTCALL lj_trace_free(global_State *g, GCtrace *T); LJ_FUNC void lj_trace_reenableproto(GCproto *pt); LJ_FUNC void lj_trace_flushproto(global_State *g, GCproto *pt); LJ_FUNC void lj_trace_flush(jit_State *J, TraceNo traceno); LJ_FUNC int lj_trace_flushall(lua_State *L); LJ_FUNC void lj_trace_initstate(global_State *g); LJ_FUNC void lj_trace_freestate(global_State *g); /* Event handling. */ LJ_FUNC void lj_trace_ins(jit_State *J, const BCIns *pc); LJ_FUNCA void LJ_FASTCALL lj_trace_hot(jit_State *J, const BCIns *pc); LJ_FUNCA int LJ_FASTCALL lj_trace_exit(jit_State *J, void *exptr); /* Signal asynchronous abort of trace or end of trace. */ #define lj_trace_abort(g) (G2J(g)->state &= ~LJ_TRACE_ACTIVE) #define lj_trace_end(J) (J->state = LJ_TRACE_END) #else #define lj_trace_flushall(L) (UNUSED(L), 0) #define lj_trace_initstate(g) UNUSED(g) #define lj_trace_freestate(g) UNUSED(g) #define lj_trace_abort(g) UNUSED(g) #define lj_trace_end(J) UNUSED(J) #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lib_table.c0000644000175000017500000001674713122010155016771 0ustar philphil/* ** Table library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lib_table_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_tab.h" #include "lj_lib.h" /* ------------------------------------------------------------------------ */ #define LJLIB_MODULE_table LJLIB_CF(table_foreachi) { GCtab *t = lj_lib_checktab(L, 1); GCfunc *func = lj_lib_checkfunc(L, 2); MSize i, n = lj_tab_len(t); for (i = 1; i <= n; i++) { cTValue *val; setfuncV(L, L->top, func); setintV(L->top+1, i); val = lj_tab_getint(t, (int32_t)i); if (val) { copyTV(L, L->top+2, val); } else { setnilV(L->top+2); } L->top += 3; lua_call(L, 2, 1); if (!tvisnil(L->top-1)) return 1; L->top--; } return 0; } LJLIB_CF(table_foreach) { GCtab *t = lj_lib_checktab(L, 1); GCfunc *func = lj_lib_checkfunc(L, 2); L->top = L->base+3; setnilV(L->top-1); while (lj_tab_next(L, t, L->top-1)) { copyTV(L, L->top+2, L->top); copyTV(L, L->top+1, L->top-1); setfuncV(L, L->top, func); L->top += 3; lua_call(L, 2, 1); if (!tvisnil(L->top-1)) return 1; L->top--; } return 0; } LJLIB_ASM(table_getn) LJLIB_REC(.) { lj_lib_checktab(L, 1); return FFH_UNREACHABLE; } LJLIB_CF(table_maxn) { GCtab *t = lj_lib_checktab(L, 1); TValue *array = tvref(t->array); Node *node; lua_Number m = 0; ptrdiff_t i; for (i = (ptrdiff_t)t->asize - 1; i >= 0; i--) if (!tvisnil(&array[i])) { m = (lua_Number)(int32_t)i; break; } node = noderef(t->node); for (i = (ptrdiff_t)t->hmask; i >= 0; i--) if (!tvisnil(&node[i].val) && tvisnumber(&node[i].key)) { lua_Number n = numberVnum(&node[i].key); if (n > m) m = n; } setnumV(L->top-1, m); return 1; } LJLIB_CF(table_insert) LJLIB_REC(.) { GCtab *t = lj_lib_checktab(L, 1); int32_t n, i = (int32_t)lj_tab_len(t) + 1; int nargs = (int)((char *)L->top - (char *)L->base); if (nargs != 2*sizeof(TValue)) { if (nargs != 3*sizeof(TValue)) lj_err_caller(L, LJ_ERR_TABINS); /* NOBARRIER: This just moves existing elements around. */ for (n = lj_lib_checkint(L, 2); i > n; i--) { /* The set may invalidate the get pointer, so need to do it first! */ TValue *dst = lj_tab_setint(L, t, i); cTValue *src = lj_tab_getint(t, i-1); if (src) { copyTV(L, dst, src); } else { setnilV(dst); } } i = n; } { TValue *dst = lj_tab_setint(L, t, i); copyTV(L, dst, L->top-1); /* Set new value. */ lj_gc_barriert(L, t, dst); } return 0; } LJLIB_CF(table_remove) LJLIB_REC(.) { GCtab *t = lj_lib_checktab(L, 1); int32_t e = (int32_t)lj_tab_len(t); int32_t pos = lj_lib_optint(L, 2, e); if (!(1 <= pos && pos <= e)) /* Nothing to remove? */ return 0; lua_rawgeti(L, 1, pos); /* Get previous value. */ /* NOBARRIER: This just moves existing elements around. */ for (; pos < e; pos++) { cTValue *src = lj_tab_getint(t, pos+1); TValue *dst = lj_tab_setint(L, t, pos); if (src) { copyTV(L, dst, src); } else { setnilV(dst); } } setnilV(lj_tab_setint(L, t, e)); /* Remove (last) value. */ return 1; /* Return previous value. */ } LJLIB_CF(table_concat) { luaL_Buffer b; GCtab *t = lj_lib_checktab(L, 1); GCstr *sep = lj_lib_optstr(L, 2); MSize seplen = sep ? sep->len : 0; int32_t i = lj_lib_optint(L, 3, 1); int32_t e = (L->base+3 < L->top && !tvisnil(L->base+3)) ? lj_lib_checkint(L, 4) : (int32_t)lj_tab_len(t); luaL_buffinit(L, &b); if (i <= e) { for (;;) { cTValue *o; lua_rawgeti(L, 1, i); o = L->top-1; if (!(tvisstr(o) || tvisnumber(o))) lj_err_callerv(L, LJ_ERR_TABCAT, lj_typename(o), i); luaL_addvalue(&b); if (i++ == e) break; if (seplen) luaL_addlstring(&b, strdata(sep), seplen); } } luaL_pushresult(&b); return 1; } /* ------------------------------------------------------------------------ */ static void set2(lua_State *L, int i, int j) { lua_rawseti(L, 1, i); lua_rawseti(L, 1, j); } static int sort_comp(lua_State *L, int a, int b) { if (!lua_isnil(L, 2)) { /* function? */ int res; lua_pushvalue(L, 2); lua_pushvalue(L, a-1); /* -1 to compensate function */ lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */ lua_call(L, 2, 1); res = lua_toboolean(L, -1); lua_pop(L, 1); return res; } else { /* a < b? */ return lua_lessthan(L, a, b); } } static void auxsort(lua_State *L, int l, int u) { while (l < u) { /* for tail recursion */ int i, j; /* sort elements a[l], a[(l+u)/2] and a[u] */ lua_rawgeti(L, 1, l); lua_rawgeti(L, 1, u); if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */ set2(L, l, u); /* swap a[l] - a[u] */ else lua_pop(L, 2); if (u-l == 1) break; /* only 2 elements */ i = (l+u)/2; lua_rawgeti(L, 1, i); lua_rawgeti(L, 1, l); if (sort_comp(L, -2, -1)) { /* a[i]= P */ while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) { if (i>=u) lj_err_caller(L, LJ_ERR_TABSORT); lua_pop(L, 1); /* remove a[i] */ } /* repeat --j until a[j] <= P */ while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) { if (j<=l) lj_err_caller(L, LJ_ERR_TABSORT); lua_pop(L, 1); /* remove a[j] */ } if (jbase+1)) lj_lib_checkfunc(L, 2); auxsort(L, 1, n); return 0; } #if LJ_52 LJLIB_PUSH("n") LJLIB_CF(table_pack) { TValue *array, *base = L->base; MSize i, n = (uint32_t)(L->top - base); GCtab *t = lj_tab_new(L, n ? n+1 : 0, 1); /* NOBARRIER: The table is new (marked white). */ setintV(lj_tab_setstr(L, t, strV(lj_lib_upvalue(L, 1))), (int32_t)n); for (array = tvref(t->array) + 1, i = 0; i < n; i++) copyTV(L, &array[i], &base[i]); settabV(L, base, t); L->top = base+1; lj_gc_check(L); return 1; } #endif /* ------------------------------------------------------------------------ */ #include "lj_libdef.h" LUALIB_API int luaopen_table(lua_State *L) { LJ_LIB_REG(L, LUA_TABLIBNAME, table); #if LJ_52 lua_getglobal(L, "unpack"); lua_setfield(L, -2, "unpack"); #endif return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_bcwrite.c0000644000175000017500000002620413122010155017165 0ustar philphil/* ** Bytecode writer. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_bcwrite_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_str.h" #include "lj_bc.h" #if LJ_HASFFI #include "lj_ctype.h" #endif #if LJ_HASJIT #include "lj_dispatch.h" #include "lj_jit.h" #endif #include "lj_bcdump.h" #include "lj_vm.h" /* Context for bytecode writer. */ typedef struct BCWriteCtx { SBuf sb; /* Output buffer. */ lua_State *L; /* Lua state. */ GCproto *pt; /* Root prototype. */ lua_Writer wfunc; /* Writer callback. */ void *wdata; /* Writer callback data. */ int strip; /* Strip debug info. */ int status; /* Status from writer callback. */ } BCWriteCtx; /* -- Output buffer handling ---------------------------------------------- */ /* Resize buffer if needed. */ static LJ_NOINLINE void bcwrite_resize(BCWriteCtx *ctx, MSize len) { MSize sz = ctx->sb.sz * 2; while (ctx->sb.n + len > sz) sz = sz * 2; lj_str_resizebuf(ctx->L, &ctx->sb, sz); } /* Need a certain amount of buffer space. */ static LJ_AINLINE void bcwrite_need(BCWriteCtx *ctx, MSize len) { if (LJ_UNLIKELY(ctx->sb.n + len > ctx->sb.sz)) bcwrite_resize(ctx, len); } /* Add memory block to buffer. */ static void bcwrite_block(BCWriteCtx *ctx, const void *p, MSize len) { uint8_t *q = (uint8_t *)(ctx->sb.buf + ctx->sb.n); MSize i; ctx->sb.n += len; for (i = 0; i < len; i++) q[i] = ((uint8_t *)p)[i]; } /* Add byte to buffer. */ static LJ_AINLINE void bcwrite_byte(BCWriteCtx *ctx, uint8_t b) { ctx->sb.buf[ctx->sb.n++] = b; } /* Add ULEB128 value to buffer. */ static void bcwrite_uleb128(BCWriteCtx *ctx, uint32_t v) { MSize n = ctx->sb.n; uint8_t *p = (uint8_t *)ctx->sb.buf; for (; v >= 0x80; v >>= 7) p[n++] = (uint8_t)((v & 0x7f) | 0x80); p[n++] = (uint8_t)v; ctx->sb.n = n; } /* -- Bytecode writer ----------------------------------------------------- */ /* Write a single constant key/value of a template table. */ static void bcwrite_ktabk(BCWriteCtx *ctx, cTValue *o, int narrow) { bcwrite_need(ctx, 1+10); if (tvisstr(o)) { const GCstr *str = strV(o); MSize len = str->len; bcwrite_need(ctx, 5+len); bcwrite_uleb128(ctx, BCDUMP_KTAB_STR+len); bcwrite_block(ctx, strdata(str), len); } else if (tvisint(o)) { bcwrite_byte(ctx, BCDUMP_KTAB_INT); bcwrite_uleb128(ctx, intV(o)); } else if (tvisnum(o)) { if (!LJ_DUALNUM && narrow) { /* Narrow number constants to integers. */ lua_Number num = numV(o); int32_t k = lj_num2int(num); if (num == (lua_Number)k) { /* -0 is never a constant. */ bcwrite_byte(ctx, BCDUMP_KTAB_INT); bcwrite_uleb128(ctx, k); return; } } bcwrite_byte(ctx, BCDUMP_KTAB_NUM); bcwrite_uleb128(ctx, o->u32.lo); bcwrite_uleb128(ctx, o->u32.hi); } else { lua_assert(tvispri(o)); bcwrite_byte(ctx, BCDUMP_KTAB_NIL+~itype(o)); } } /* Write a template table. */ static void bcwrite_ktab(BCWriteCtx *ctx, const GCtab *t) { MSize narray = 0, nhash = 0; if (t->asize > 0) { /* Determine max. length of array part. */ ptrdiff_t i; TValue *array = tvref(t->array); for (i = (ptrdiff_t)t->asize-1; i >= 0; i--) if (!tvisnil(&array[i])) break; narray = (MSize)(i+1); } if (t->hmask > 0) { /* Count number of used hash slots. */ MSize i, hmask = t->hmask; Node *node = noderef(t->node); for (i = 0; i <= hmask; i++) nhash += !tvisnil(&node[i].val); } /* Write number of array slots and hash slots. */ bcwrite_uleb128(ctx, narray); bcwrite_uleb128(ctx, nhash); if (narray) { /* Write array entries (may contain nil). */ MSize i; TValue *o = tvref(t->array); for (i = 0; i < narray; i++, o++) bcwrite_ktabk(ctx, o, 1); } if (nhash) { /* Write hash entries. */ MSize i = nhash; Node *node = noderef(t->node) + t->hmask; for (;; node--) if (!tvisnil(&node->val)) { bcwrite_ktabk(ctx, &node->key, 0); bcwrite_ktabk(ctx, &node->val, 1); if (--i == 0) break; } } } /* Write GC constants of a prototype. */ static void bcwrite_kgc(BCWriteCtx *ctx, GCproto *pt) { MSize i, sizekgc = pt->sizekgc; GCRef *kr = mref(pt->k, GCRef) - (ptrdiff_t)sizekgc; for (i = 0; i < sizekgc; i++, kr++) { GCobj *o = gcref(*kr); MSize tp, need = 1; /* Determine constant type and needed size. */ if (o->gch.gct == ~LJ_TSTR) { tp = BCDUMP_KGC_STR + gco2str(o)->len; need = 5+gco2str(o)->len; } else if (o->gch.gct == ~LJ_TPROTO) { lua_assert((pt->flags & PROTO_CHILD)); tp = BCDUMP_KGC_CHILD; #if LJ_HASFFI } else if (o->gch.gct == ~LJ_TCDATA) { CTypeID id = gco2cd(o)->ctypeid; need = 1+4*5; if (id == CTID_INT64) { tp = BCDUMP_KGC_I64; } else if (id == CTID_UINT64) { tp = BCDUMP_KGC_U64; } else { lua_assert(id == CTID_COMPLEX_DOUBLE); tp = BCDUMP_KGC_COMPLEX; } #endif } else { lua_assert(o->gch.gct == ~LJ_TTAB); tp = BCDUMP_KGC_TAB; need = 1+2*5; } /* Write constant type. */ bcwrite_need(ctx, need); bcwrite_uleb128(ctx, tp); /* Write constant data (if any). */ if (tp >= BCDUMP_KGC_STR) { bcwrite_block(ctx, strdata(gco2str(o)), gco2str(o)->len); } else if (tp == BCDUMP_KGC_TAB) { bcwrite_ktab(ctx, gco2tab(o)); #if LJ_HASFFI } else if (tp != BCDUMP_KGC_CHILD) { cTValue *p = (TValue *)cdataptr(gco2cd(o)); bcwrite_uleb128(ctx, p[0].u32.lo); bcwrite_uleb128(ctx, p[0].u32.hi); if (tp == BCDUMP_KGC_COMPLEX) { bcwrite_uleb128(ctx, p[1].u32.lo); bcwrite_uleb128(ctx, p[1].u32.hi); } #endif } } } /* Write number constants of a prototype. */ static void bcwrite_knum(BCWriteCtx *ctx, GCproto *pt) { MSize i, sizekn = pt->sizekn; cTValue *o = mref(pt->k, TValue); bcwrite_need(ctx, 10*sizekn); for (i = 0; i < sizekn; i++, o++) { int32_t k; if (tvisint(o)) { k = intV(o); goto save_int; } else { /* Write a 33 bit ULEB128 for the int (lsb=0) or loword (lsb=1). */ if (!LJ_DUALNUM) { /* Narrow number constants to integers. */ lua_Number num = numV(o); k = lj_num2int(num); if (num == (lua_Number)k) { /* -0 is never a constant. */ save_int: bcwrite_uleb128(ctx, 2*(uint32_t)k | ((uint32_t)k & 0x80000000u)); if (k < 0) { char *p = &ctx->sb.buf[ctx->sb.n-1]; *p = (*p & 7) | ((k>>27) & 0x18); } continue; } } bcwrite_uleb128(ctx, 1+(2*o->u32.lo | (o->u32.lo & 0x80000000u))); if (o->u32.lo >= 0x80000000u) { char *p = &ctx->sb.buf[ctx->sb.n-1]; *p = (*p & 7) | ((o->u32.lo>>27) & 0x18); } bcwrite_uleb128(ctx, o->u32.hi); } } } /* Write bytecode instructions. */ static void bcwrite_bytecode(BCWriteCtx *ctx, GCproto *pt) { MSize nbc = pt->sizebc-1; /* Omit the [JI]FUNC* header. */ #if LJ_HASJIT uint8_t *p = (uint8_t *)&ctx->sb.buf[ctx->sb.n]; #endif bcwrite_block(ctx, proto_bc(pt)+1, nbc*(MSize)sizeof(BCIns)); #if LJ_HASJIT /* Unpatch modified bytecode containing ILOOP/JLOOP etc. */ if ((pt->flags & PROTO_ILOOP) || pt->trace) { jit_State *J = L2J(ctx->L); MSize i; for (i = 0; i < nbc; i++, p += sizeof(BCIns)) { BCOp op = (BCOp)p[LJ_ENDIAN_SELECT(0, 3)]; if (op == BC_IFORL || op == BC_IITERL || op == BC_ILOOP || op == BC_JFORI) { p[LJ_ENDIAN_SELECT(0, 3)] = (uint8_t)(op-BC_IFORL+BC_FORL); } else if (op == BC_JFORL || op == BC_JITERL || op == BC_JLOOP) { BCReg rd = p[LJ_ENDIAN_SELECT(2, 1)] + (p[LJ_ENDIAN_SELECT(3, 0)] << 8); BCIns ins = traceref(J, rd)->startins; p[LJ_ENDIAN_SELECT(0, 3)] = (uint8_t)(op-BC_JFORL+BC_FORL); p[LJ_ENDIAN_SELECT(2, 1)] = bc_c(ins); p[LJ_ENDIAN_SELECT(3, 0)] = bc_b(ins); } } } #endif } /* Write prototype. */ static void bcwrite_proto(BCWriteCtx *ctx, GCproto *pt) { MSize sizedbg = 0; /* Recursively write children of prototype. */ if ((pt->flags & PROTO_CHILD)) { ptrdiff_t i, n = pt->sizekgc; GCRef *kr = mref(pt->k, GCRef) - 1; for (i = 0; i < n; i++, kr--) { GCobj *o = gcref(*kr); if (o->gch.gct == ~LJ_TPROTO) bcwrite_proto(ctx, gco2pt(o)); } } /* Start writing the prototype info to a buffer. */ lj_str_resetbuf(&ctx->sb); ctx->sb.n = 5; /* Leave room for final size. */ bcwrite_need(ctx, 4+6*5+(pt->sizebc-1)*(MSize)sizeof(BCIns)+pt->sizeuv*2); /* Write prototype header. */ bcwrite_byte(ctx, (pt->flags & (PROTO_CHILD|PROTO_VARARG|PROTO_FFI))); bcwrite_byte(ctx, pt->numparams); bcwrite_byte(ctx, pt->framesize); bcwrite_byte(ctx, pt->sizeuv); bcwrite_uleb128(ctx, pt->sizekgc); bcwrite_uleb128(ctx, pt->sizekn); bcwrite_uleb128(ctx, pt->sizebc-1); if (!ctx->strip) { if (proto_lineinfo(pt)) sizedbg = pt->sizept - (MSize)((char *)proto_lineinfo(pt) - (char *)pt); bcwrite_uleb128(ctx, sizedbg); if (sizedbg) { bcwrite_uleb128(ctx, pt->firstline); bcwrite_uleb128(ctx, pt->numline); } } /* Write bytecode instructions and upvalue refs. */ bcwrite_bytecode(ctx, pt); bcwrite_block(ctx, proto_uv(pt), pt->sizeuv*2); /* Write constants. */ bcwrite_kgc(ctx, pt); bcwrite_knum(ctx, pt); /* Write debug info, if not stripped. */ if (sizedbg) { bcwrite_need(ctx, sizedbg); bcwrite_block(ctx, proto_lineinfo(pt), sizedbg); } /* Pass buffer to writer function. */ if (ctx->status == 0) { MSize n = ctx->sb.n - 5; MSize nn = (lj_fls(n)+8)*9 >> 6; ctx->sb.n = 5 - nn; bcwrite_uleb128(ctx, n); /* Fill in final size. */ lua_assert(ctx->sb.n == 5); ctx->status = ctx->wfunc(ctx->L, ctx->sb.buf+5-nn, nn+n, ctx->wdata); } } /* Write header of bytecode dump. */ static void bcwrite_header(BCWriteCtx *ctx) { GCstr *chunkname = proto_chunkname(ctx->pt); const char *name = strdata(chunkname); MSize len = chunkname->len; lj_str_resetbuf(&ctx->sb); bcwrite_need(ctx, 5+5+len); bcwrite_byte(ctx, BCDUMP_HEAD1); bcwrite_byte(ctx, BCDUMP_HEAD2); bcwrite_byte(ctx, BCDUMP_HEAD3); bcwrite_byte(ctx, BCDUMP_VERSION); bcwrite_byte(ctx, (ctx->strip ? BCDUMP_F_STRIP : 0) + (LJ_BE ? BCDUMP_F_BE : 0) + ((ctx->pt->flags & PROTO_FFI) ? BCDUMP_F_FFI : 0)); if (!ctx->strip) { bcwrite_uleb128(ctx, len); bcwrite_block(ctx, name, len); } ctx->status = ctx->wfunc(ctx->L, ctx->sb.buf, ctx->sb.n, ctx->wdata); } /* Write footer of bytecode dump. */ static void bcwrite_footer(BCWriteCtx *ctx) { if (ctx->status == 0) { uint8_t zero = 0; ctx->status = ctx->wfunc(ctx->L, &zero, 1, ctx->wdata); } } /* Protected callback for bytecode writer. */ static TValue *cpwriter(lua_State *L, lua_CFunction dummy, void *ud) { BCWriteCtx *ctx = (BCWriteCtx *)ud; UNUSED(dummy); lj_str_resizebuf(L, &ctx->sb, 1024); /* Avoids resize for most prototypes. */ bcwrite_header(ctx); bcwrite_proto(ctx, ctx->pt); bcwrite_footer(ctx); return NULL; } /* Write bytecode for a prototype. */ int lj_bcwrite(lua_State *L, GCproto *pt, lua_Writer writer, void *data, int strip) { BCWriteCtx ctx; int status; ctx.L = L; ctx.pt = pt; ctx.wfunc = writer; ctx.wdata = data; ctx.strip = strip; ctx.status = 0; lj_str_initbuf(&ctx.sb); status = lj_vm_cpcall(L, NULL, &ctx, cpwriter); if (status == 0) status = ctx.status; lj_str_freebuf(G(ctx.L), &ctx.sb); return status; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_cdata.c0000644000175000017500000002073513122010155016605 0ustar philphil/* ** C data management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_ctype.h" #include "lj_cconv.h" #include "lj_cdata.h" /* -- C data allocation --------------------------------------------------- */ /* Allocate a new C data object holding a reference to another object. */ GCcdata *lj_cdata_newref(CTState *cts, const void *p, CTypeID id) { CTypeID refid = lj_ctype_intern(cts, CTINFO_REF(id), CTSIZE_PTR); GCcdata *cd = lj_cdata_new(cts, refid, CTSIZE_PTR); *(const void **)cdataptr(cd) = p; return cd; } /* Allocate variable-sized or specially aligned C data object. */ GCcdata *lj_cdata_newv(CTState *cts, CTypeID id, CTSize sz, CTSize align) { global_State *g; MSize extra = sizeof(GCcdataVar) + sizeof(GCcdata) + (align > CT_MEMALIGN ? (1u<L, extra + sz, char); uintptr_t adata = (uintptr_t)p + sizeof(GCcdataVar) + sizeof(GCcdata); uintptr_t almask = (1u << align) - 1u; GCcdata *cd = (GCcdata *)(((adata + almask) & ~almask) - sizeof(GCcdata)); lua_assert((char *)cd - p < 65536); cdatav(cd)->offset = (uint16_t)((char *)cd - p); cdatav(cd)->extra = extra; cdatav(cd)->len = sz; g = cts->g; setgcrefr(cd->nextgc, g->gc.root); setgcref(g->gc.root, obj2gco(cd)); newwhite(g, obj2gco(cd)); cd->marked |= 0x80; cd->gct = ~LJ_TCDATA; cd->ctypeid = id; return cd; } /* Free a C data object. */ void LJ_FASTCALL lj_cdata_free(global_State *g, GCcdata *cd) { if (LJ_UNLIKELY(cd->marked & LJ_GC_CDATA_FIN)) { GCobj *root; makewhite(g, obj2gco(cd)); markfinalized(obj2gco(cd)); if ((root = gcref(g->gc.mmudata)) != NULL) { setgcrefr(cd->nextgc, root->gch.nextgc); setgcref(root->gch.nextgc, obj2gco(cd)); setgcref(g->gc.mmudata, obj2gco(cd)); } else { setgcref(cd->nextgc, obj2gco(cd)); setgcref(g->gc.mmudata, obj2gco(cd)); } } else if (LJ_LIKELY(!cdataisv(cd))) { CType *ct = ctype_raw(ctype_ctsG(g), cd->ctypeid); CTSize sz = ctype_hassize(ct->info) ? ct->size : CTSIZE_PTR; lua_assert(ctype_hassize(ct->info) || ctype_isfunc(ct->info) || ctype_isextern(ct->info)); lj_mem_free(g, cd, sizeof(GCcdata) + sz); } else { lj_mem_free(g, memcdatav(cd), sizecdatav(cd)); } } TValue * LJ_FASTCALL lj_cdata_setfin(lua_State *L, GCcdata *cd) { global_State *g = G(L); GCtab *t = ctype_ctsG(g)->finalizer; if (gcref(t->metatable)) { /* Add cdata to finalizer table, if still enabled. */ TValue *tv, tmp; setcdataV(L, &tmp, cd); lj_gc_anybarriert(L, t); tv = lj_tab_set(L, t, &tmp); cd->marked |= LJ_GC_CDATA_FIN; return tv; } else { /* Otherwise return dummy TValue. */ return &g->tmptv; } } /* -- C data indexing ----------------------------------------------------- */ /* Index C data by a TValue. Return CType and pointer. */ CType *lj_cdata_index(CTState *cts, GCcdata *cd, cTValue *key, uint8_t **pp, CTInfo *qual) { uint8_t *p = (uint8_t *)cdataptr(cd); CType *ct = ctype_get(cts, cd->ctypeid); ptrdiff_t idx; /* Resolve reference for cdata object. */ if (ctype_isref(ct->info)) { lua_assert(ct->size == CTSIZE_PTR); p = *(uint8_t **)p; ct = ctype_child(cts, ct); } collect_attrib: /* Skip attributes and collect qualifiers. */ while (ctype_isattrib(ct->info)) { if (ctype_attrib(ct->info) == CTA_QUAL) *qual |= ct->size; ct = ctype_child(cts, ct); } lua_assert(!ctype_isref(ct->info)); /* Interning rejects refs to refs. */ if (tvisint(key)) { idx = (ptrdiff_t)intV(key); goto integer_key; } else if (tvisnum(key)) { /* Numeric key. */ idx = LJ_64 ? (ptrdiff_t)numV(key) : (ptrdiff_t)lj_num2int(numV(key)); integer_key: if (ctype_ispointer(ct->info)) { CTSize sz = lj_ctype_size(cts, ctype_cid(ct->info)); /* Element size. */ if (sz == CTSIZE_INVALID) lj_err_caller(cts->L, LJ_ERR_FFI_INVSIZE); if (ctype_isptr(ct->info)) { p = (uint8_t *)cdata_getptr(p, ct->size); } else if ((ct->info & (CTF_VECTOR|CTF_COMPLEX))) { if ((ct->info & CTF_COMPLEX)) idx &= 1; *qual |= CTF_CONST; /* Valarray elements are constant. */ } *pp = p + idx*(int32_t)sz; return ct; } } else if (tviscdata(key)) { /* Integer cdata key. */ GCcdata *cdk = cdataV(key); CType *ctk = ctype_raw(cts, cdk->ctypeid); if (ctype_isenum(ctk->info)) ctk = ctype_child(cts, ctk); if (ctype_isinteger(ctk->info)) { lj_cconv_ct_ct(cts, ctype_get(cts, CTID_INT_PSZ), ctk, (uint8_t *)&idx, cdataptr(cdk), 0); goto integer_key; } } else if (tvisstr(key)) { /* String key. */ GCstr *name = strV(key); if (ctype_isstruct(ct->info)) { CTSize ofs; CType *fct = lj_ctype_getfieldq(cts, ct, name, &ofs, qual); if (fct) { *pp = p + ofs; return fct; } } else if (ctype_iscomplex(ct->info)) { if (name->len == 2) { *qual |= CTF_CONST; /* Complex fields are constant. */ if (strdata(name)[0] == 'r' && strdata(name)[1] == 'e') { *pp = p; return ct; } else if (strdata(name)[0] == 'i' && strdata(name)[1] == 'm') { *pp = p + (ct->size >> 1); return ct; } } } else if (cd->ctypeid == CTID_CTYPEID) { /* Allow indexing a (pointer to) struct constructor to get constants. */ CType *sct = ctype_raw(cts, *(CTypeID *)p); if (ctype_isptr(sct->info)) sct = ctype_rawchild(cts, sct); if (ctype_isstruct(sct->info)) { CTSize ofs; CType *fct = lj_ctype_getfield(cts, sct, name, &ofs); if (fct && ctype_isconstval(fct->info)) return fct; } ct = sct; /* Allow resolving metamethods for constructors, too. */ } } if (ctype_isptr(ct->info)) { /* Automatically perform '->'. */ if (ctype_isstruct(ctype_rawchild(cts, ct)->info)) { p = (uint8_t *)cdata_getptr(p, ct->size); ct = ctype_child(cts, ct); goto collect_attrib; } } *qual |= 1; /* Lookup failed. */ return ct; /* But return the resolved raw type. */ } /* -- C data getters ------------------------------------------------------ */ /* Get constant value and convert to TValue. */ static void cdata_getconst(CTState *cts, TValue *o, CType *ct) { CType *ctt = ctype_child(cts, ct); lua_assert(ctype_isinteger(ctt->info) && ctt->size <= 4); /* Constants are already zero-extended/sign-extended to 32 bits. */ if ((ctt->info & CTF_UNSIGNED) && (int32_t)ct->size < 0) setnumV(o, (lua_Number)(uint32_t)ct->size); else setintV(o, (int32_t)ct->size); } /* Get C data value and convert to TValue. */ int lj_cdata_get(CTState *cts, CType *s, TValue *o, uint8_t *sp) { CTypeID sid; if (ctype_isconstval(s->info)) { cdata_getconst(cts, o, s); return 0; /* No GC step needed. */ } else if (ctype_isbitfield(s->info)) { return lj_cconv_tv_bf(cts, s, o, sp); } /* Get child type of pointer/array/field. */ lua_assert(ctype_ispointer(s->info) || ctype_isfield(s->info)); sid = ctype_cid(s->info); s = ctype_get(cts, sid); /* Resolve reference for field. */ if (ctype_isref(s->info)) { lua_assert(s->size == CTSIZE_PTR); sp = *(uint8_t **)sp; sid = ctype_cid(s->info); s = ctype_get(cts, sid); } /* Skip attributes. */ while (ctype_isattrib(s->info)) s = ctype_child(cts, s); return lj_cconv_tv_ct(cts, s, sid, o, sp); } /* -- C data setters ------------------------------------------------------ */ /* Convert TValue and set C data value. */ void lj_cdata_set(CTState *cts, CType *d, uint8_t *dp, TValue *o, CTInfo qual) { if (ctype_isconstval(d->info)) { goto err_const; } else if (ctype_isbitfield(d->info)) { if (((d->info|qual) & CTF_CONST)) goto err_const; lj_cconv_bf_tv(cts, d, dp, o); return; } /* Get child type of pointer/array/field. */ lua_assert(ctype_ispointer(d->info) || ctype_isfield(d->info)); d = ctype_child(cts, d); /* Resolve reference for field. */ if (ctype_isref(d->info)) { lua_assert(d->size == CTSIZE_PTR); dp = *(uint8_t **)dp; d = ctype_child(cts, d); } /* Skip attributes and collect qualifiers. */ for (;;) { if (ctype_isattrib(d->info)) { if (ctype_attrib(d->info) == CTA_QUAL) qual |= d->size; } else { break; } d = ctype_child(cts, d); } lua_assert(ctype_hassize(d->info) && !ctype_isvoid(d->info)); if (((d->info|qual) & CTF_CONST)) { err_const: lj_err_caller(cts->L, LJ_ERR_FFI_WRCONST); } lj_cconv_ct_tv(cts, d, dp, o, 0); } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_api.c0000644000175000017500000007040513122010155016301 0ustar philphil/* ** Public Lua/C API. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_api_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_debug.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_func.h" #include "lj_udata.h" #include "lj_meta.h" #include "lj_state.h" #include "lj_bc.h" #include "lj_frame.h" #include "lj_trace.h" #include "lj_vm.h" #include "lj_strscan.h" /* -- Common helper functions --------------------------------------------- */ #define api_checknelems(L, n) api_check(L, (n) <= (L->top - L->base)) #define api_checkvalidindex(L, i) api_check(L, (i) != niltv(L)) static TValue *index2adr(lua_State *L, int idx) { if (idx > 0) { TValue *o = L->base + (idx - 1); return o < L->top ? o : niltv(L); } else if (idx > LUA_REGISTRYINDEX) { api_check(L, idx != 0 && -idx <= L->top - L->base); return L->top + idx; } else if (idx == LUA_GLOBALSINDEX) { TValue *o = &G(L)->tmptv; settabV(L, o, tabref(L->env)); return o; } else if (idx == LUA_REGISTRYINDEX) { return registry(L); } else { GCfunc *fn = curr_func(L); api_check(L, fn->c.gct == ~LJ_TFUNC && !isluafunc(fn)); if (idx == LUA_ENVIRONINDEX) { TValue *o = &G(L)->tmptv; settabV(L, o, tabref(fn->c.env)); return o; } else { idx = LUA_GLOBALSINDEX - idx; return idx <= fn->c.nupvalues ? &fn->c.upvalue[idx-1] : niltv(L); } } } static TValue *stkindex2adr(lua_State *L, int idx) { if (idx > 0) { TValue *o = L->base + (idx - 1); return o < L->top ? o : niltv(L); } else { api_check(L, idx != 0 && -idx <= L->top - L->base); return L->top + idx; } } static GCtab *getcurrenv(lua_State *L) { GCfunc *fn = curr_func(L); return fn->c.gct == ~LJ_TFUNC ? tabref(fn->c.env) : tabref(L->env); } /* -- Miscellaneous API functions ----------------------------------------- */ LUA_API int lua_status(lua_State *L) { return L->status; } LUA_API int lua_checkstack(lua_State *L, int size) { if (size > LUAI_MAXCSTACK || (L->top - L->base + size) > LUAI_MAXCSTACK) { return 0; /* Stack overflow. */ } else if (size > 0) { lj_state_checkstack(L, (MSize)size); } return 1; } LUALIB_API void luaL_checkstack(lua_State *L, int size, const char *msg) { if (!lua_checkstack(L, size)) lj_err_callerv(L, LJ_ERR_STKOVM, msg); } LUA_API void lua_xmove(lua_State *from, lua_State *to, int n) { TValue *f, *t; if (from == to) return; api_checknelems(from, n); api_check(from, G(from) == G(to)); lj_state_checkstack(to, (MSize)n); f = from->top; t = to->top = to->top + n; while (--n >= 0) copyTV(to, --t, --f); from->top = f; } /* -- Stack manipulation -------------------------------------------------- */ LUA_API int lua_gettop(lua_State *L) { return (int)(L->top - L->base); } LUA_API void lua_settop(lua_State *L, int idx) { if (idx >= 0) { api_check(L, idx <= tvref(L->maxstack) - L->base); if (L->base + idx > L->top) { if (L->base + idx >= tvref(L->maxstack)) lj_state_growstack(L, (MSize)idx - (MSize)(L->top - L->base)); do { setnilV(L->top++); } while (L->top < L->base + idx); } else { L->top = L->base + idx; } } else { api_check(L, -(idx+1) <= (L->top - L->base)); L->top += idx+1; /* Shrinks top (idx < 0). */ } } LUA_API void lua_remove(lua_State *L, int idx) { TValue *p = stkindex2adr(L, idx); api_checkvalidindex(L, p); while (++p < L->top) copyTV(L, p-1, p); L->top--; } LUA_API void lua_insert(lua_State *L, int idx) { TValue *q, *p = stkindex2adr(L, idx); api_checkvalidindex(L, p); for (q = L->top; q > p; q--) copyTV(L, q, q-1); copyTV(L, p, L->top); } LUA_API void lua_replace(lua_State *L, int idx) { api_checknelems(L, 1); if (idx == LUA_GLOBALSINDEX) { api_check(L, tvistab(L->top-1)); /* NOBARRIER: A thread (i.e. L) is never black. */ setgcref(L->env, obj2gco(tabV(L->top-1))); } else if (idx == LUA_ENVIRONINDEX) { GCfunc *fn = curr_func(L); if (fn->c.gct != ~LJ_TFUNC) lj_err_msg(L, LJ_ERR_NOENV); api_check(L, tvistab(L->top-1)); setgcref(fn->c.env, obj2gco(tabV(L->top-1))); lj_gc_barrier(L, fn, L->top-1); } else { TValue *o = index2adr(L, idx); api_checkvalidindex(L, o); copyTV(L, o, L->top-1); if (idx < LUA_GLOBALSINDEX) /* Need a barrier for upvalues. */ lj_gc_barrier(L, curr_func(L), L->top-1); } L->top--; } LUA_API void lua_pushvalue(lua_State *L, int idx) { copyTV(L, L->top, index2adr(L, idx)); incr_top(L); } /* -- Stack getters ------------------------------------------------------- */ LUA_API int lua_type(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); if (tvisnumber(o)) { return LUA_TNUMBER; #if LJ_64 } else if (tvislightud(o)) { return LUA_TLIGHTUSERDATA; #endif } else if (o == niltv(L)) { return LUA_TNONE; } else { /* Magic internal/external tag conversion. ORDER LJ_T */ uint32_t t = ~itype(o); #if LJ_64 int tt = (int)((U64x(75a06,98042110) >> 4*t) & 15u); #else int tt = (int)(((t < 8 ? 0x98042110u : 0x75a06u) >> 4*(t&7)) & 15u); #endif lua_assert(tt != LUA_TNIL || tvisnil(o)); return tt; } } LUALIB_API void luaL_checktype(lua_State *L, int idx, int tt) { if (lua_type(L, idx) != tt) lj_err_argt(L, idx, tt); } LUALIB_API void luaL_checkany(lua_State *L, int idx) { if (index2adr(L, idx) == niltv(L)) lj_err_arg(L, idx, LJ_ERR_NOVAL); } LUA_API const char *lua_typename(lua_State *L, int t) { UNUSED(L); return lj_obj_typename[t+1]; } LUA_API int lua_iscfunction(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); return tvisfunc(o) && !isluafunc(funcV(o)); } LUA_API int lua_isnumber(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); TValue tmp; return (tvisnumber(o) || (tvisstr(o) && lj_strscan_number(strV(o), &tmp))); } LUA_API int lua_isstring(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); return (tvisstr(o) || tvisnumber(o)); } LUA_API int lua_isuserdata(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); return (tvisudata(o) || tvislightud(o)); } LUA_API int lua_rawequal(lua_State *L, int idx1, int idx2) { cTValue *o1 = index2adr(L, idx1); cTValue *o2 = index2adr(L, idx2); return (o1 == niltv(L) || o2 == niltv(L)) ? 0 : lj_obj_equal(o1, o2); } LUA_API int lua_equal(lua_State *L, int idx1, int idx2) { cTValue *o1 = index2adr(L, idx1); cTValue *o2 = index2adr(L, idx2); if (tvisint(o1) && tvisint(o2)) { return intV(o1) == intV(o2); } else if (tvisnumber(o1) && tvisnumber(o2)) { return numberVnum(o1) == numberVnum(o2); } else if (itype(o1) != itype(o2)) { return 0; } else if (tvispri(o1)) { return o1 != niltv(L) && o2 != niltv(L); #if LJ_64 } else if (tvislightud(o1)) { return o1->u64 == o2->u64; #endif } else if (gcrefeq(o1->gcr, o2->gcr)) { return 1; } else if (!tvistabud(o1)) { return 0; } else { TValue *base = lj_meta_equal(L, gcV(o1), gcV(o2), 0); if ((uintptr_t)base <= 1) { return (int)(uintptr_t)base; } else { L->top = base+2; lj_vm_call(L, base, 1+1); L->top -= 2; return tvistruecond(L->top+1); } } } LUA_API int lua_lessthan(lua_State *L, int idx1, int idx2) { cTValue *o1 = index2adr(L, idx1); cTValue *o2 = index2adr(L, idx2); if (o1 == niltv(L) || o2 == niltv(L)) { return 0; } else if (tvisint(o1) && tvisint(o2)) { return intV(o1) < intV(o2); } else if (tvisnumber(o1) && tvisnumber(o2)) { return numberVnum(o1) < numberVnum(o2); } else { TValue *base = lj_meta_comp(L, o1, o2, 0); if ((uintptr_t)base <= 1) { return (int)(uintptr_t)base; } else { L->top = base+2; lj_vm_call(L, base, 1+1); L->top -= 2; return tvistruecond(L->top+1); } } } LUA_API lua_Number lua_tonumber(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); TValue tmp; if (LJ_LIKELY(tvisnumber(o))) return numberVnum(o); else if (tvisstr(o) && lj_strscan_num(strV(o), &tmp)) return numV(&tmp); else return 0; } LUALIB_API lua_Number luaL_checknumber(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); TValue tmp; if (LJ_LIKELY(tvisnumber(o))) return numberVnum(o); else if (!(tvisstr(o) && lj_strscan_num(strV(o), &tmp))) lj_err_argt(L, idx, LUA_TNUMBER); return numV(&tmp); } LUALIB_API lua_Number luaL_optnumber(lua_State *L, int idx, lua_Number def) { cTValue *o = index2adr(L, idx); TValue tmp; if (LJ_LIKELY(tvisnumber(o))) return numberVnum(o); else if (tvisnil(o)) return def; else if (!(tvisstr(o) && lj_strscan_num(strV(o), &tmp))) lj_err_argt(L, idx, LUA_TNUMBER); return numV(&tmp); } LUA_API lua_Integer lua_tointeger(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); TValue tmp; lua_Number n; if (LJ_LIKELY(tvisint(o))) { return intV(o); } else if (LJ_LIKELY(tvisnum(o))) { n = numV(o); } else { if (!(tvisstr(o) && lj_strscan_number(strV(o), &tmp))) return 0; if (tvisint(&tmp)) return (lua_Integer)intV(&tmp); n = numV(&tmp); } #if LJ_64 return (lua_Integer)n; #else return lj_num2int(n); #endif } LUALIB_API lua_Integer luaL_checkinteger(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); TValue tmp; lua_Number n; if (LJ_LIKELY(tvisint(o))) { return intV(o); } else if (LJ_LIKELY(tvisnum(o))) { n = numV(o); } else { if (!(tvisstr(o) && lj_strscan_number(strV(o), &tmp))) lj_err_argt(L, idx, LUA_TNUMBER); if (tvisint(&tmp)) return (lua_Integer)intV(&tmp); n = numV(&tmp); } #if LJ_64 return (lua_Integer)n; #else return lj_num2int(n); #endif } LUALIB_API lua_Integer luaL_optinteger(lua_State *L, int idx, lua_Integer def) { cTValue *o = index2adr(L, idx); TValue tmp; lua_Number n; if (LJ_LIKELY(tvisint(o))) { return intV(o); } else if (LJ_LIKELY(tvisnum(o))) { n = numV(o); } else if (tvisnil(o)) { return def; } else { if (!(tvisstr(o) && lj_strscan_number(strV(o), &tmp))) lj_err_argt(L, idx, LUA_TNUMBER); if (tvisint(&tmp)) return (lua_Integer)intV(&tmp); n = numV(&tmp); } #if LJ_64 return (lua_Integer)n; #else return lj_num2int(n); #endif } LUA_API int lua_toboolean(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); return tvistruecond(o); } LUA_API const char *lua_tolstring(lua_State *L, int idx, size_t *len) { TValue *o = index2adr(L, idx); GCstr *s; if (LJ_LIKELY(tvisstr(o))) { s = strV(o); } else if (tvisnumber(o)) { lj_gc_check(L); o = index2adr(L, idx); /* GC may move the stack. */ s = lj_str_fromnumber(L, o); setstrV(L, o, s); } else { if (len != NULL) *len = 0; return NULL; } if (len != NULL) *len = s->len; return strdata(s); } LUALIB_API const char *luaL_checklstring(lua_State *L, int idx, size_t *len) { TValue *o = index2adr(L, idx); GCstr *s; if (LJ_LIKELY(tvisstr(o))) { s = strV(o); } else if (tvisnumber(o)) { lj_gc_check(L); o = index2adr(L, idx); /* GC may move the stack. */ s = lj_str_fromnumber(L, o); setstrV(L, o, s); } else { lj_err_argt(L, idx, LUA_TSTRING); } if (len != NULL) *len = s->len; return strdata(s); } LUALIB_API const char *luaL_optlstring(lua_State *L, int idx, const char *def, size_t *len) { TValue *o = index2adr(L, idx); GCstr *s; if (LJ_LIKELY(tvisstr(o))) { s = strV(o); } else if (tvisnil(o)) { if (len != NULL) *len = def ? strlen(def) : 0; return def; } else if (tvisnumber(o)) { lj_gc_check(L); o = index2adr(L, idx); /* GC may move the stack. */ s = lj_str_fromnumber(L, o); setstrV(L, o, s); } else { lj_err_argt(L, idx, LUA_TSTRING); } if (len != NULL) *len = s->len; return strdata(s); } LUALIB_API int luaL_checkoption(lua_State *L, int idx, const char *def, const char *const lst[]) { ptrdiff_t i; const char *s = lua_tolstring(L, idx, NULL); if (s == NULL && (s = def) == NULL) lj_err_argt(L, idx, LUA_TSTRING); for (i = 0; lst[i]; i++) if (strcmp(lst[i], s) == 0) return (int)i; lj_err_argv(L, idx, LJ_ERR_INVOPTM, s); } LUA_API size_t lua_objlen(lua_State *L, int idx) { TValue *o = index2adr(L, idx); if (tvisstr(o)) { return strV(o)->len; } else if (tvistab(o)) { return (size_t)lj_tab_len(tabV(o)); } else if (tvisudata(o)) { return udataV(o)->len; } else if (tvisnumber(o)) { GCstr *s = lj_str_fromnumber(L, o); setstrV(L, o, s); return s->len; } else { return 0; } } LUA_API lua_CFunction lua_tocfunction(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); if (tvisfunc(o)) { BCOp op = bc_op(*mref(funcV(o)->c.pc, BCIns)); if (op == BC_FUNCC || op == BC_FUNCCW) return funcV(o)->c.f; } return NULL; } LUA_API void *lua_touserdata(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); if (tvisudata(o)) return uddata(udataV(o)); else if (tvislightud(o)) return lightudV(o); else return NULL; } LUA_API lua_State *lua_tothread(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); return (!tvisthread(o)) ? NULL : threadV(o); } LUA_API const void *lua_topointer(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); if (tvisudata(o)) return uddata(udataV(o)); else if (tvislightud(o)) return lightudV(o); else if (tviscdata(o)) return cdataptr(cdataV(o)); else if (tvisgcv(o)) return gcV(o); else return NULL; } /* -- Stack setters (object creation) ------------------------------------- */ LUA_API void lua_pushnil(lua_State *L) { setnilV(L->top); incr_top(L); } LUA_API void lua_pushnumber(lua_State *L, lua_Number n) { setnumV(L->top, n); if (LJ_UNLIKELY(tvisnan(L->top))) setnanV(L->top); /* Canonicalize injected NaNs. */ incr_top(L); } LUA_API void lua_pushinteger(lua_State *L, lua_Integer n) { setintptrV(L->top, n); incr_top(L); } LUA_API void lua_pushlstring(lua_State *L, const char *str, size_t len) { GCstr *s; lj_gc_check(L); s = lj_str_new(L, str, len); setstrV(L, L->top, s); incr_top(L); } LUA_API void lua_pushstring(lua_State *L, const char *str) { if (str == NULL) { setnilV(L->top); } else { GCstr *s; lj_gc_check(L); s = lj_str_newz(L, str); setstrV(L, L->top, s); } incr_top(L); } LUA_API const char *lua_pushvfstring(lua_State *L, const char *fmt, va_list argp) { lj_gc_check(L); return lj_str_pushvf(L, fmt, argp); } LUA_API const char *lua_pushfstring(lua_State *L, const char *fmt, ...) { const char *ret; va_list argp; lj_gc_check(L); va_start(argp, fmt); ret = lj_str_pushvf(L, fmt, argp); va_end(argp); return ret; } LUA_API void lua_pushcclosure(lua_State *L, lua_CFunction f, int n) { GCfunc *fn; lj_gc_check(L); api_checknelems(L, n); fn = lj_func_newC(L, (MSize)n, getcurrenv(L)); fn->c.f = f; L->top -= n; while (n--) copyTV(L, &fn->c.upvalue[n], L->top+n); setfuncV(L, L->top, fn); lua_assert(iswhite(obj2gco(fn))); incr_top(L); } LUA_API void lua_pushboolean(lua_State *L, int b) { setboolV(L->top, (b != 0)); incr_top(L); } LUA_API void lua_pushlightuserdata(lua_State *L, void *p) { setlightudV(L->top, checklightudptr(L, p)); incr_top(L); } LUA_API void lua_createtable(lua_State *L, int narray, int nrec) { GCtab *t; lj_gc_check(L); t = lj_tab_new(L, (uint32_t)(narray > 0 ? narray+1 : 0), hsize2hbits(nrec)); settabV(L, L->top, t); incr_top(L); } LUALIB_API int luaL_newmetatable(lua_State *L, const char *tname) { GCtab *regt = tabV(registry(L)); TValue *tv = lj_tab_setstr(L, regt, lj_str_newz(L, tname)); if (tvisnil(tv)) { GCtab *mt = lj_tab_new(L, 0, 1); settabV(L, tv, mt); settabV(L, L->top++, mt); lj_gc_anybarriert(L, regt); return 1; } else { copyTV(L, L->top++, tv); return 0; } } LUA_API int lua_pushthread(lua_State *L) { setthreadV(L, L->top, L); incr_top(L); return (mainthread(G(L)) == L); } LUA_API lua_State *lua_newthread(lua_State *L) { lua_State *L1; lj_gc_check(L); L1 = lj_state_new(L); setthreadV(L, L->top, L1); incr_top(L); return L1; } LUA_API void *lua_newuserdata(lua_State *L, size_t size) { GCudata *ud; lj_gc_check(L); if (size > LJ_MAX_UDATA) lj_err_msg(L, LJ_ERR_UDATAOV); ud = lj_udata_new(L, (MSize)size, getcurrenv(L)); setudataV(L, L->top, ud); incr_top(L); return uddata(ud); } LUA_API void lua_concat(lua_State *L, int n) { api_checknelems(L, n); if (n >= 2) { n--; do { TValue *top = lj_meta_cat(L, L->top-1, -n); if (top == NULL) { L->top -= n; break; } n -= (int)(L->top - top); L->top = top+2; lj_vm_call(L, top, 1+1); L->top--; copyTV(L, L->top-1, L->top); } while (--n > 0); } else if (n == 0) { /* Push empty string. */ setstrV(L, L->top, &G(L)->strempty); incr_top(L); } /* else n == 1: nothing to do. */ } /* -- Object getters ------------------------------------------------------ */ LUA_API void lua_gettable(lua_State *L, int idx) { cTValue *v, *t = index2adr(L, idx); api_checkvalidindex(L, t); v = lj_meta_tget(L, t, L->top-1); if (v == NULL) { L->top += 2; lj_vm_call(L, L->top-2, 1+1); L->top -= 2; v = L->top+1; } copyTV(L, L->top-1, v); } LUA_API void lua_getfield(lua_State *L, int idx, const char *k) { cTValue *v, *t = index2adr(L, idx); TValue key; api_checkvalidindex(L, t); setstrV(L, &key, lj_str_newz(L, k)); v = lj_meta_tget(L, t, &key); if (v == NULL) { L->top += 2; lj_vm_call(L, L->top-2, 1+1); L->top -= 2; v = L->top+1; } copyTV(L, L->top, v); incr_top(L); } LUA_API void lua_rawget(lua_State *L, int idx) { cTValue *t = index2adr(L, idx); api_check(L, tvistab(t)); copyTV(L, L->top-1, lj_tab_get(L, tabV(t), L->top-1)); } LUA_API void lua_rawgeti(lua_State *L, int idx, int n) { cTValue *v, *t = index2adr(L, idx); api_check(L, tvistab(t)); v = lj_tab_getint(tabV(t), n); if (v) { copyTV(L, L->top, v); } else { setnilV(L->top); } incr_top(L); } LUA_API int lua_getmetatable(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); GCtab *mt = NULL; if (tvistab(o)) mt = tabref(tabV(o)->metatable); else if (tvisudata(o)) mt = tabref(udataV(o)->metatable); else mt = tabref(basemt_obj(G(L), o)); if (mt == NULL) return 0; settabV(L, L->top, mt); incr_top(L); return 1; } LUALIB_API int luaL_getmetafield(lua_State *L, int idx, const char *field) { if (lua_getmetatable(L, idx)) { cTValue *tv = lj_tab_getstr(tabV(L->top-1), lj_str_newz(L, field)); if (tv && !tvisnil(tv)) { copyTV(L, L->top-1, tv); return 1; } L->top--; } return 0; } LUA_API void lua_getfenv(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); api_checkvalidindex(L, o); if (tvisfunc(o)) { settabV(L, L->top, tabref(funcV(o)->c.env)); } else if (tvisudata(o)) { settabV(L, L->top, tabref(udataV(o)->env)); } else if (tvisthread(o)) { settabV(L, L->top, tabref(threadV(o)->env)); } else { setnilV(L->top); } incr_top(L); } LUA_API int lua_next(lua_State *L, int idx) { cTValue *t = index2adr(L, idx); int more; api_check(L, tvistab(t)); more = lj_tab_next(L, tabV(t), L->top-1); if (more) { incr_top(L); /* Return new key and value slot. */ } else { /* End of traversal. */ L->top--; /* Remove key slot. */ } return more; } LUA_API const char *lua_getupvalue(lua_State *L, int idx, int n) { TValue *val; const char *name = lj_debug_uvnamev(index2adr(L, idx), (uint32_t)(n-1), &val); if (name) { copyTV(L, L->top, val); incr_top(L); } return name; } LUA_API void *lua_upvalueid(lua_State *L, int idx, int n) { GCfunc *fn = funcV(index2adr(L, idx)); n--; api_check(L, (uint32_t)n < fn->l.nupvalues); return isluafunc(fn) ? (void *)gcref(fn->l.uvptr[n]) : (void *)&fn->c.upvalue[n]; } LUA_API void lua_upvaluejoin(lua_State *L, int idx1, int n1, int idx2, int n2) { GCfunc *fn1 = funcV(index2adr(L, idx1)); GCfunc *fn2 = funcV(index2adr(L, idx2)); n1--; n2--; api_check(L, isluafunc(fn1) && (uint32_t)n1 < fn1->l.nupvalues); api_check(L, isluafunc(fn2) && (uint32_t)n2 < fn2->l.nupvalues); setgcrefr(fn1->l.uvptr[n1], fn2->l.uvptr[n2]); lj_gc_objbarrier(L, fn1, gcref(fn1->l.uvptr[n1])); } LUALIB_API void *luaL_checkudata(lua_State *L, int idx, const char *tname) { cTValue *o = index2adr(L, idx); if (tvisudata(o)) { GCudata *ud = udataV(o); cTValue *tv = lj_tab_getstr(tabV(registry(L)), lj_str_newz(L, tname)); if (tv && tvistab(tv) && tabV(tv) == tabref(ud->metatable)) return uddata(ud); } lj_err_argtype(L, idx, tname); return NULL; /* unreachable */ } /* -- Object setters ------------------------------------------------------ */ LUA_API void lua_settable(lua_State *L, int idx) { TValue *o; cTValue *t = index2adr(L, idx); api_checknelems(L, 2); api_checkvalidindex(L, t); o = lj_meta_tset(L, t, L->top-2); if (o) { /* NOBARRIER: lj_meta_tset ensures the table is not black. */ copyTV(L, o, L->top-1); L->top -= 2; } else { L->top += 3; copyTV(L, L->top-1, L->top-6); lj_vm_call(L, L->top-3, 0+1); L->top -= 3; } } LUA_API void lua_setfield(lua_State *L, int idx, const char *k) { TValue *o; TValue key; cTValue *t = index2adr(L, idx); api_checknelems(L, 1); api_checkvalidindex(L, t); setstrV(L, &key, lj_str_newz(L, k)); o = lj_meta_tset(L, t, &key); if (o) { L->top--; /* NOBARRIER: lj_meta_tset ensures the table is not black. */ copyTV(L, o, L->top); } else { L->top += 3; copyTV(L, L->top-1, L->top-6); lj_vm_call(L, L->top-3, 0+1); L->top -= 2; } } LUA_API void lua_rawset(lua_State *L, int idx) { GCtab *t = tabV(index2adr(L, idx)); TValue *dst, *key; api_checknelems(L, 2); key = L->top-2; dst = lj_tab_set(L, t, key); copyTV(L, dst, key+1); lj_gc_anybarriert(L, t); L->top = key; } LUA_API void lua_rawseti(lua_State *L, int idx, int n) { GCtab *t = tabV(index2adr(L, idx)); TValue *dst, *src; api_checknelems(L, 1); dst = lj_tab_setint(L, t, n); src = L->top-1; copyTV(L, dst, src); lj_gc_barriert(L, t, dst); L->top = src; } LUA_API int lua_setmetatable(lua_State *L, int idx) { global_State *g; GCtab *mt; cTValue *o = index2adr(L, idx); api_checknelems(L, 1); api_checkvalidindex(L, o); if (tvisnil(L->top-1)) { mt = NULL; } else { api_check(L, tvistab(L->top-1)); mt = tabV(L->top-1); } g = G(L); if (tvistab(o)) { setgcref(tabV(o)->metatable, obj2gco(mt)); if (mt) lj_gc_objbarriert(L, tabV(o), mt); } else if (tvisudata(o)) { setgcref(udataV(o)->metatable, obj2gco(mt)); if (mt) lj_gc_objbarrier(L, udataV(o), mt); } else { /* Flush cache, since traces specialize to basemt. But not during __gc. */ if (lj_trace_flushall(L)) lj_err_caller(L, LJ_ERR_NOGCMM); if (tvisbool(o)) { /* NOBARRIER: basemt is a GC root. */ setgcref(basemt_it(g, LJ_TTRUE), obj2gco(mt)); setgcref(basemt_it(g, LJ_TFALSE), obj2gco(mt)); } else { /* NOBARRIER: basemt is a GC root. */ setgcref(basemt_obj(g, o), obj2gco(mt)); } } L->top--; return 1; } LUA_API int lua_setfenv(lua_State *L, int idx) { cTValue *o = index2adr(L, idx); GCtab *t; api_checknelems(L, 1); api_checkvalidindex(L, o); api_check(L, tvistab(L->top-1)); t = tabV(L->top-1); if (tvisfunc(o)) { setgcref(funcV(o)->c.env, obj2gco(t)); } else if (tvisudata(o)) { setgcref(udataV(o)->env, obj2gco(t)); } else if (tvisthread(o)) { setgcref(threadV(o)->env, obj2gco(t)); } else { L->top--; return 0; } lj_gc_objbarrier(L, gcV(o), t); L->top--; return 1; } LUA_API const char *lua_setupvalue(lua_State *L, int idx, int n) { cTValue *f = index2adr(L, idx); TValue *val; const char *name; api_checknelems(L, 1); name = lj_debug_uvnamev(f, (uint32_t)(n-1), &val); if (name) { L->top--; copyTV(L, val, L->top); lj_gc_barrier(L, funcV(f), L->top); } return name; } /* -- Calls --------------------------------------------------------------- */ LUA_API void lua_call(lua_State *L, int nargs, int nresults) { api_check(L, L->status == 0 || L->status == LUA_ERRERR); api_checknelems(L, nargs+1); lj_vm_call(L, L->top - nargs, nresults+1); } LUA_API int lua_pcall(lua_State *L, int nargs, int nresults, int errfunc) { global_State *g = G(L); uint8_t oldh = hook_save(g); ptrdiff_t ef; int status; api_check(L, L->status == 0 || L->status == LUA_ERRERR); api_checknelems(L, nargs+1); if (errfunc == 0) { ef = 0; } else { cTValue *o = stkindex2adr(L, errfunc); api_checkvalidindex(L, o); ef = savestack(L, o); } status = lj_vm_pcall(L, L->top - nargs, nresults+1, ef); if (status) hook_restore(g, oldh); return status; } static TValue *cpcall(lua_State *L, lua_CFunction func, void *ud) { GCfunc *fn = lj_func_newC(L, 0, getcurrenv(L)); fn->c.f = func; setfuncV(L, L->top, fn); setlightudV(L->top+1, checklightudptr(L, ud)); cframe_nres(L->cframe) = 1+0; /* Zero results. */ L->top += 2; return L->top-1; /* Now call the newly allocated C function. */ } LUA_API int lua_cpcall(lua_State *L, lua_CFunction func, void *ud) { global_State *g = G(L); uint8_t oldh = hook_save(g); int status; api_check(L, L->status == 0 || L->status == LUA_ERRERR); status = lj_vm_cpcall(L, func, ud, cpcall); if (status) hook_restore(g, oldh); return status; } LUALIB_API int luaL_callmeta(lua_State *L, int idx, const char *field) { if (luaL_getmetafield(L, idx, field)) { TValue *base = L->top--; copyTV(L, base, index2adr(L, idx)); L->top = base+1; lj_vm_call(L, base, 1+1); return 1; } return 0; } /* -- Coroutine yield and resume ------------------------------------------ */ LUA_API int lua_yield(lua_State *L, int nresults) { void *cf = L->cframe; global_State *g = G(L); if (cframe_canyield(cf)) { cf = cframe_raw(cf); if (!hook_active(g)) { /* Regular yield: move results down if needed. */ cTValue *f = L->top - nresults; if (f > L->base) { TValue *t = L->base; while (--nresults >= 0) copyTV(L, t++, f++); L->top = t; } L->cframe = NULL; L->status = LUA_YIELD; return -1; } else { /* Yield from hook: add a pseudo-frame. */ TValue *top = L->top; hook_leave(g); top->u64 = cframe_multres(cf); setcont(top+1, lj_cont_hook); setframe_pc(top+1, cframe_pc(cf)-1); setframe_gc(top+2, obj2gco(L)); setframe_ftsz(top+2, (int)((char *)(top+3)-(char *)L->base)+FRAME_CONT); L->top = L->base = top+3; #if LJ_TARGET_X64 lj_err_throw(L, LUA_YIELD); #else L->cframe = NULL; L->status = LUA_YIELD; lj_vm_unwind_c(cf, LUA_YIELD); #endif } } lj_err_msg(L, LJ_ERR_CYIELD); return 0; /* unreachable */ } LUA_API int lua_resume(lua_State *L, int nargs) { if (L->cframe == NULL && L->status <= LUA_YIELD) return lj_vm_resume(L, L->top - nargs, 0, 0); L->top = L->base; setstrV(L, L->top, lj_err_str(L, LJ_ERR_COSUSP)); incr_top(L); return LUA_ERRRUN; } /* -- GC and memory management -------------------------------------------- */ LUA_API int lua_gc(lua_State *L, int what, int data) { global_State *g = G(L); int res = 0; switch (what) { case LUA_GCSTOP: g->gc.threshold = LJ_MAX_MEM; break; case LUA_GCRESTART: g->gc.threshold = data == -1 ? (g->gc.total/100)*g->gc.pause : g->gc.total; break; case LUA_GCCOLLECT: lj_gc_fullgc(L); break; case LUA_GCCOUNT: res = (int)(g->gc.total >> 10); break; case LUA_GCCOUNTB: res = (int)(g->gc.total & 0x3ff); break; case LUA_GCSTEP: { MSize a = (MSize)data << 10; g->gc.threshold = (a <= g->gc.total) ? (g->gc.total - a) : 0; while (g->gc.total >= g->gc.threshold) if (lj_gc_step(L) > 0) { res = 1; break; } break; } case LUA_GCSETPAUSE: res = (int)(g->gc.pause); g->gc.pause = (MSize)data; break; case LUA_GCSETSTEPMUL: res = (int)(g->gc.stepmul); g->gc.stepmul = (MSize)data; break; default: res = -1; /* Invalid option. */ } return res; } LUA_API lua_Alloc lua_getallocf(lua_State *L, void **ud) { global_State *g = G(L); if (ud) *ud = g->allocd; return g->allocf; } LUA_API void lua_setallocf(lua_State *L, lua_Alloc f, void *ud) { global_State *g = G(L); g->allocd = ud; g->allocf = f; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_debug.h0000644000175000017500000000340213122010155016614 0ustar philphil/* ** Debugging and introspection. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_DEBUG_H #define _LJ_DEBUG_H #include "lj_obj.h" typedef struct lj_Debug { /* Common fields. Must be in the same order as in lua.h. */ int event; const char *name; const char *namewhat; const char *what; const char *source; int currentline; int nups; int linedefined; int lastlinedefined; char short_src[LUA_IDSIZE]; int i_ci; /* Extended fields. Only valid if lj_debug_getinfo() is called with ext = 1.*/ int nparams; int isvararg; } lj_Debug; LJ_FUNC cTValue *lj_debug_frame(lua_State *L, int level, int *size); LJ_FUNC BCLine LJ_FASTCALL lj_debug_line(GCproto *pt, BCPos pc); LJ_FUNC const char *lj_debug_uvname(GCproto *pt, uint32_t idx); LJ_FUNC const char *lj_debug_uvnamev(cTValue *o, uint32_t idx, TValue **tvp); LJ_FUNC const char *lj_debug_slotname(GCproto *pt, const BCIns *pc, BCReg slot, const char **name); LJ_FUNC const char *lj_debug_funcname(lua_State *L, TValue *frame, const char **name); LJ_FUNC void lj_debug_shortname(char *out, GCstr *str); LJ_FUNC void lj_debug_addloc(lua_State *L, const char *msg, cTValue *frame, cTValue *nextframe); LJ_FUNC void lj_debug_pushloc(lua_State *L, GCproto *pt, BCPos pc); LJ_FUNC int lj_debug_getinfo(lua_State *L, const char *what, lj_Debug *ar, int ext); /* Fixed internal variable names. */ #define VARNAMEDEF(_) \ _(FOR_IDX, "(for index)") \ _(FOR_STOP, "(for limit)") \ _(FOR_STEP, "(for step)") \ _(FOR_GEN, "(for generator)") \ _(FOR_STATE, "(for state)") \ _(FOR_CTL, "(for control)") enum { VARNAME_END, #define VARNAMEENUM(name, str) VARNAME_##name, VARNAMEDEF(VARNAMEENUM) #undef VARNAMEENUM VARNAME__MAX }; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_cconv.c0000644000175000017500000005751013122010155016642 0ustar philphil/* ** C type conversions. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_err.h" #include "lj_tab.h" #include "lj_ctype.h" #include "lj_cdata.h" #include "lj_cconv.h" #include "lj_ccallback.h" /* -- Conversion errors --------------------------------------------------- */ /* Bad conversion. */ LJ_NORET static void cconv_err_conv(CTState *cts, CType *d, CType *s, CTInfo flags) { const char *dst = strdata(lj_ctype_repr(cts->L, ctype_typeid(cts, d), NULL)); const char *src; if ((flags & CCF_FROMTV)) src = lj_obj_typename[1+(ctype_isnum(s->info) ? LUA_TNUMBER : ctype_isarray(s->info) ? LUA_TSTRING : LUA_TNIL)]; else src = strdata(lj_ctype_repr(cts->L, ctype_typeid(cts, s), NULL)); if (CCF_GETARG(flags)) lj_err_argv(cts->L, CCF_GETARG(flags), LJ_ERR_FFI_BADCONV, src, dst); else lj_err_callerv(cts->L, LJ_ERR_FFI_BADCONV, src, dst); } /* Bad conversion from TValue. */ LJ_NORET static void cconv_err_convtv(CTState *cts, CType *d, TValue *o, CTInfo flags) { const char *dst = strdata(lj_ctype_repr(cts->L, ctype_typeid(cts, d), NULL)); const char *src = lj_typename(o); if (CCF_GETARG(flags)) lj_err_argv(cts->L, CCF_GETARG(flags), LJ_ERR_FFI_BADCONV, src, dst); else lj_err_callerv(cts->L, LJ_ERR_FFI_BADCONV, src, dst); } /* Initializer overflow. */ LJ_NORET static void cconv_err_initov(CTState *cts, CType *d) { const char *dst = strdata(lj_ctype_repr(cts->L, ctype_typeid(cts, d), NULL)); lj_err_callerv(cts->L, LJ_ERR_FFI_INITOV, dst); } /* -- C type compatibility checks ----------------------------------------- */ /* Get raw type and qualifiers for a child type. Resolves enums, too. */ static CType *cconv_childqual(CTState *cts, CType *ct, CTInfo *qual) { ct = ctype_child(cts, ct); for (;;) { if (ctype_isattrib(ct->info)) { if (ctype_attrib(ct->info) == CTA_QUAL) *qual |= ct->size; } else if (!ctype_isenum(ct->info)) { break; } ct = ctype_child(cts, ct); } *qual |= (ct->info & CTF_QUAL); return ct; } /* Check for compatible types when converting to a pointer. ** Note: these checks are more relaxed than what C99 mandates. */ int lj_cconv_compatptr(CTState *cts, CType *d, CType *s, CTInfo flags) { if (!((flags & CCF_CAST) || d == s)) { CTInfo dqual = 0, squal = 0; d = cconv_childqual(cts, d, &dqual); if (!ctype_isstruct(s->info)) s = cconv_childqual(cts, s, &squal); if ((flags & CCF_SAME)) { if (dqual != squal) return 0; /* Different qualifiers. */ } else if (!(flags & CCF_IGNQUAL)) { if ((dqual & squal) != squal) return 0; /* Discarded qualifiers. */ if (ctype_isvoid(d->info) || ctype_isvoid(s->info)) return 1; /* Converting to/from void * is always ok. */ } if (ctype_type(d->info) != ctype_type(s->info) || d->size != s->size) return 0; /* Different type or different size. */ if (ctype_isnum(d->info)) { if (((d->info ^ s->info) & (CTF_BOOL|CTF_FP))) return 0; /* Different numeric types. */ } else if (ctype_ispointer(d->info)) { /* Check child types for compatibility. */ return lj_cconv_compatptr(cts, d, s, flags|CCF_SAME); } else if (ctype_isstruct(d->info)) { if (d != s) return 0; /* Must be exact same type for struct/union. */ } else if (ctype_isfunc(d->info)) { /* NYI: structural equality of functions. */ } } return 1; /* Types are compatible. */ } /* -- C type to C type conversion ----------------------------------------- */ /* Convert C type to C type. Caveat: expects to get the raw CType! ** ** Note: This is only used by the interpreter and not optimized at all. ** The JIT compiler will do a much better job specializing for each case. */ void lj_cconv_ct_ct(CTState *cts, CType *d, CType *s, uint8_t *dp, uint8_t *sp, CTInfo flags) { CTSize dsize = d->size, ssize = s->size; CTInfo dinfo = d->info, sinfo = s->info; void *tmpptr; lua_assert(!ctype_isenum(dinfo) && !ctype_isenum(sinfo)); lua_assert(!ctype_isattrib(dinfo) && !ctype_isattrib(sinfo)); if (ctype_type(dinfo) > CT_MAYCONVERT || ctype_type(sinfo) > CT_MAYCONVERT) goto err_conv; /* Some basic sanity checks. */ lua_assert(!ctype_isnum(dinfo) || dsize > 0); lua_assert(!ctype_isnum(sinfo) || ssize > 0); lua_assert(!ctype_isbool(dinfo) || dsize == 1 || dsize == 4); lua_assert(!ctype_isbool(sinfo) || ssize == 1 || ssize == 4); lua_assert(!ctype_isinteger(dinfo) || (1u< ssize) { /* Zero-extend or sign-extend LSB. */ #if LJ_LE uint8_t fill = (!(sinfo & CTF_UNSIGNED) && (sp[ssize-1]&0x80)) ? 0xff : 0; memcpy(dp, sp, ssize); memset(dp + ssize, fill, dsize-ssize); #else uint8_t fill = (!(sinfo & CTF_UNSIGNED) && (sp[0]&0x80)) ? 0xff : 0; memset(dp, fill, dsize-ssize); memcpy(dp + (dsize-ssize), sp, ssize); #endif } else { /* Copy LSB. */ #if LJ_LE memcpy(dp, sp, dsize); #else memcpy(dp, sp + (ssize-dsize), dsize); #endif } break; case CCX(I, F): { double n; /* Always convert via double. */ conv_I_F: /* Convert source to double. */ if (ssize == sizeof(double)) n = *(double *)sp; else if (ssize == sizeof(float)) n = (double)*(float *)sp; else goto err_conv; /* NYI: long double. */ /* Then convert double to integer. */ /* The conversion must exactly match the semantics of JIT-compiled code! */ if (dsize < 4 || (dsize == 4 && !(dinfo & CTF_UNSIGNED))) { int32_t i = (int32_t)n; if (dsize == 4) *(int32_t *)dp = i; else if (dsize == 2) *(int16_t *)dp = (int16_t)i; else *(int8_t *)dp = (int8_t)i; } else if (dsize == 4) { *(uint32_t *)dp = (uint32_t)n; } else if (dsize == 8) { if (!(dinfo & CTF_UNSIGNED)) *(int64_t *)dp = (int64_t)n; else *(uint64_t *)dp = lj_num2u64(n); } else { goto err_conv; /* NYI: conversion to >64 bit integers. */ } break; } case CCX(I, C): s = ctype_child(cts, s); sinfo = s->info; ssize = s->size; goto conv_I_F; /* Just convert re. */ case CCX(I, P): if (!(flags & CCF_CAST)) goto err_conv; sinfo = CTINFO(CT_NUM, CTF_UNSIGNED); goto conv_I_I; case CCX(I, A): if (!(flags & CCF_CAST)) goto err_conv; sinfo = CTINFO(CT_NUM, CTF_UNSIGNED); ssize = CTSIZE_PTR; tmpptr = sp; sp = (uint8_t *)&tmpptr; goto conv_I_I; /* Destination is a floating-point number. */ case CCX(F, B): case CCX(F, I): { double n; /* Always convert via double. */ conv_F_I: /* First convert source to double. */ /* The conversion must exactly match the semantics of JIT-compiled code! */ if (ssize < 4 || (ssize == 4 && !(sinfo & CTF_UNSIGNED))) { int32_t i; if (ssize == 4) { i = *(int32_t *)sp; } else if (!(sinfo & CTF_UNSIGNED)) { if (ssize == 2) i = *(int16_t *)sp; else i = *(int8_t *)sp; } else { if (ssize == 2) i = *(uint16_t *)sp; else i = *(uint8_t *)sp; } n = (double)i; } else if (ssize == 4) { n = (double)*(uint32_t *)sp; } else if (ssize == 8) { if (!(sinfo & CTF_UNSIGNED)) n = (double)*(int64_t *)sp; else n = (double)*(uint64_t *)sp; } else { goto err_conv; /* NYI: conversion from >64 bit integers. */ } /* Convert double to destination. */ if (dsize == sizeof(double)) *(double *)dp = n; else if (dsize == sizeof(float)) *(float *)dp = (float)n; else goto err_conv; /* NYI: long double. */ break; } case CCX(F, F): { double n; /* Always convert via double. */ conv_F_F: if (ssize == dsize) goto copyval; /* Convert source to double. */ if (ssize == sizeof(double)) n = *(double *)sp; else if (ssize == sizeof(float)) n = (double)*(float *)sp; else goto err_conv; /* NYI: long double. */ /* Convert double to destination. */ if (dsize == sizeof(double)) *(double *)dp = n; else if (dsize == sizeof(float)) *(float *)dp = (float)n; else goto err_conv; /* NYI: long double. */ break; } case CCX(F, C): s = ctype_child(cts, s); sinfo = s->info; ssize = s->size; goto conv_F_F; /* Ignore im, and convert from re. */ /* Destination is a complex number. */ case CCX(C, I): d = ctype_child(cts, d); dinfo = d->info; dsize = d->size; memset(dp + dsize, 0, dsize); /* Clear im. */ goto conv_F_I; /* Convert to re. */ case CCX(C, F): d = ctype_child(cts, d); dinfo = d->info; dsize = d->size; memset(dp + dsize, 0, dsize); /* Clear im. */ goto conv_F_F; /* Convert to re. */ case CCX(C, C): if (dsize != ssize) { /* Different types: convert re/im separately. */ CType *dc = ctype_child(cts, d); CType *sc = ctype_child(cts, s); lj_cconv_ct_ct(cts, dc, sc, dp, sp, flags); lj_cconv_ct_ct(cts, dc, sc, dp + dc->size, sp + sc->size, flags); return; } goto copyval; /* Otherwise this is easy. */ /* Destination is a vector. */ case CCX(V, I): case CCX(V, F): case CCX(V, C): { CType *dc = ctype_child(cts, d); CTSize esize; /* First convert the scalar to the first element. */ lj_cconv_ct_ct(cts, dc, s, dp, sp, flags); /* Then replicate it to the other elements (splat). */ for (sp = dp, esize = dc->size; dsize > esize; dsize -= esize) { dp += esize; memcpy(dp, sp, esize); } break; } case CCX(V, V): /* Copy same-sized vectors, even for different lengths/element-types. */ if (dsize != ssize) goto err_conv; goto copyval; /* Destination is a pointer. */ case CCX(P, I): if (!(flags & CCF_CAST)) goto err_conv; dinfo = CTINFO(CT_NUM, CTF_UNSIGNED); goto conv_I_I; case CCX(P, F): if (!(flags & CCF_CAST) || !(flags & CCF_FROMTV)) goto err_conv; /* The signed conversion is cheaper. x64 really has 47 bit pointers. */ dinfo = CTINFO(CT_NUM, (LJ_64 && dsize == 8) ? 0 : CTF_UNSIGNED); goto conv_I_F; case CCX(P, P): if (!lj_cconv_compatptr(cts, d, s, flags)) goto err_conv; cdata_setptr(dp, dsize, cdata_getptr(sp, ssize)); break; case CCX(P, A): case CCX(P, S): if (!lj_cconv_compatptr(cts, d, s, flags)) goto err_conv; cdata_setptr(dp, dsize, sp); break; /* Destination is an array. */ case CCX(A, A): if ((flags & CCF_CAST) || (d->info & CTF_VLA) || dsize != ssize || d->size == CTSIZE_INVALID || !lj_cconv_compatptr(cts, d, s, flags)) goto err_conv; goto copyval; /* Destination is a struct/union. */ case CCX(S, S): if ((flags & CCF_CAST) || (d->info & CTF_VLA) || d != s) goto err_conv; /* Must be exact same type. */ copyval: /* Copy value. */ lua_assert(dsize == ssize); memcpy(dp, sp, dsize); break; default: err_conv: cconv_err_conv(cts, d, s, flags); } } /* -- C type to TValue conversion ----------------------------------------- */ /* Convert C type to TValue. Caveat: expects to get the raw CType! */ int lj_cconv_tv_ct(CTState *cts, CType *s, CTypeID sid, TValue *o, uint8_t *sp) { CTInfo sinfo = s->info; if (ctype_isnum(sinfo)) { if (!ctype_isbool(sinfo)) { if (ctype_isinteger(sinfo) && s->size > 4) goto copyval; if (LJ_DUALNUM && ctype_isinteger(sinfo)) { int32_t i; lj_cconv_ct_ct(cts, ctype_get(cts, CTID_INT32), s, (uint8_t *)&i, sp, 0); if ((sinfo & CTF_UNSIGNED) && i < 0) setnumV(o, (lua_Number)(uint32_t)i); else setintV(o, i); } else { lj_cconv_ct_ct(cts, ctype_get(cts, CTID_DOUBLE), s, (uint8_t *)&o->n, sp, 0); /* Numbers are NOT canonicalized here! Beware of uninitialized data. */ lua_assert(tvisnum(o)); } } else { uint32_t b = s->size == 1 ? (*sp != 0) : (*(int *)sp != 0); setboolV(o, b); setboolV(&cts->g->tmptv2, b); /* Remember for trace recorder. */ } return 0; } else if (ctype_isrefarray(sinfo) || ctype_isstruct(sinfo)) { /* Create reference. */ setcdataV(cts->L, o, lj_cdata_newref(cts, sp, sid)); return 1; /* Need GC step. */ } else { GCcdata *cd; CTSize sz; copyval: /* Copy value. */ sz = s->size; lua_assert(sz != CTSIZE_INVALID); /* Attributes are stripped, qualifiers are kept (but mostly ignored). */ cd = lj_cdata_new(cts, ctype_typeid(cts, s), sz); setcdataV(cts->L, o, cd); memcpy(cdataptr(cd), sp, sz); return 1; /* Need GC step. */ } } /* Convert bitfield to TValue. */ int lj_cconv_tv_bf(CTState *cts, CType *s, TValue *o, uint8_t *sp) { CTInfo info = s->info; CTSize pos, bsz; uint32_t val; lua_assert(ctype_isbitfield(info)); /* NYI: packed bitfields may cause misaligned reads. */ switch (ctype_bitcsz(info)) { case 4: val = *(uint32_t *)sp; break; case 2: val = *(uint16_t *)sp; break; case 1: val = *(uint8_t *)sp; break; default: lua_assert(0); val = 0; break; } /* Check if a packed bitfield crosses a container boundary. */ pos = ctype_bitpos(info); bsz = ctype_bitbsz(info); lua_assert(pos < 8*ctype_bitcsz(info)); lua_assert(bsz > 0 && bsz <= 8*ctype_bitcsz(info)); if (pos + bsz > 8*ctype_bitcsz(info)) lj_err_caller(cts->L, LJ_ERR_FFI_NYIPACKBIT); if (!(info & CTF_BOOL)) { CTSize shift = 32 - bsz; if (!(info & CTF_UNSIGNED)) { setintV(o, (int32_t)(val << (shift-pos)) >> shift); } else { val = (val << (shift-pos)) >> shift; if (!LJ_DUALNUM || (int32_t)val < 0) setnumV(o, (lua_Number)(uint32_t)val); else setintV(o, (int32_t)val); } } else { lua_assert(bsz == 1); setboolV(o, (val >> pos) & 1); } return 0; /* No GC step needed. */ } /* -- TValue to C type conversion ----------------------------------------- */ /* Convert table to array. */ static void cconv_array_tab(CTState *cts, CType *d, uint8_t *dp, GCtab *t, CTInfo flags) { int32_t i; CType *dc = ctype_rawchild(cts, d); /* Array element type. */ CTSize size = d->size, esize = dc->size, ofs = 0; for (i = 0; ; i++) { TValue *tv = (TValue *)lj_tab_getint(t, i); if (!tv || tvisnil(tv)) { if (i == 0) continue; /* Try again for 1-based tables. */ break; /* Stop at first nil. */ } if (ofs >= size) cconv_err_initov(cts, d); lj_cconv_ct_tv(cts, dc, dp + ofs, tv, flags); ofs += esize; } if (size != CTSIZE_INVALID) { /* Only fill up arrays with known size. */ if (ofs == esize) { /* Replicate a single element. */ for (; ofs < size; ofs += esize) memcpy(dp + ofs, dp, esize); } else { /* Otherwise fill the remainder with zero. */ memset(dp + ofs, 0, size - ofs); } } } /* Convert table to sub-struct/union. */ static void cconv_substruct_tab(CTState *cts, CType *d, uint8_t *dp, GCtab *t, int32_t *ip, CTInfo flags) { CTypeID id = d->sib; while (id) { CType *df = ctype_get(cts, id); id = df->sib; if (ctype_isfield(df->info) || ctype_isbitfield(df->info)) { TValue *tv; int32_t i = *ip, iz = i; if (!gcref(df->name)) continue; /* Ignore unnamed fields. */ if (i >= 0) { retry: tv = (TValue *)lj_tab_getint(t, i); if (!tv || tvisnil(tv)) { if (i == 0) { i = 1; goto retry; } /* 1-based tables. */ if (iz == 0) { *ip = i = -1; goto tryname; } /* Init named fields. */ break; /* Stop at first nil. */ } *ip = i + 1; } else { tryname: tv = (TValue *)lj_tab_getstr(t, gco2str(gcref(df->name))); if (!tv || tvisnil(tv)) continue; } if (ctype_isfield(df->info)) lj_cconv_ct_tv(cts, ctype_rawchild(cts, df), dp+df->size, tv, flags); else lj_cconv_bf_tv(cts, df, dp+df->size, tv); if ((d->info & CTF_UNION)) break; } else if (ctype_isxattrib(df->info, CTA_SUBTYPE)) { cconv_substruct_tab(cts, ctype_rawchild(cts, df), dp+df->size, t, ip, flags); } /* Ignore all other entries in the chain. */ } } /* Convert table to struct/union. */ static void cconv_struct_tab(CTState *cts, CType *d, uint8_t *dp, GCtab *t, CTInfo flags) { int32_t i = 0; memset(dp, 0, d->size); /* Much simpler to clear the struct first. */ cconv_substruct_tab(cts, d, dp, t, &i, flags); } /* Convert TValue to C type. Caveat: expects to get the raw CType! */ void lj_cconv_ct_tv(CTState *cts, CType *d, uint8_t *dp, TValue *o, CTInfo flags) { CTypeID sid = CTID_P_VOID; CType *s; void *tmpptr; uint8_t tmpbool, *sp = (uint8_t *)&tmpptr; if (LJ_LIKELY(tvisint(o))) { sp = (uint8_t *)&o->i; sid = CTID_INT32; flags |= CCF_FROMTV; } else if (LJ_LIKELY(tvisnum(o))) { sp = (uint8_t *)&o->n; sid = CTID_DOUBLE; flags |= CCF_FROMTV; } else if (tviscdata(o)) { sp = cdataptr(cdataV(o)); sid = cdataV(o)->ctypeid; s = ctype_get(cts, sid); if (ctype_isref(s->info)) { /* Resolve reference for value. */ lua_assert(s->size == CTSIZE_PTR); sp = *(void **)sp; sid = ctype_cid(s->info); } s = ctype_raw(cts, sid); if (ctype_isfunc(s->info)) { sid = lj_ctype_intern(cts, CTINFO(CT_PTR, CTALIGN_PTR|sid), CTSIZE_PTR); } else { if (ctype_isenum(s->info)) s = ctype_child(cts, s); goto doconv; } } else if (tvisstr(o)) { GCstr *str = strV(o); if (ctype_isenum(d->info)) { /* Match string against enum constant. */ CTSize ofs; CType *cct = lj_ctype_getfield(cts, d, str, &ofs); if (!cct || !ctype_isconstval(cct->info)) goto err_conv; lua_assert(d->size == 4); sp = (uint8_t *)&cct->size; sid = ctype_cid(cct->info); } else if (ctype_isrefarray(d->info)) { /* Copy string to array. */ CType *dc = ctype_rawchild(cts, d); CTSize sz = str->len+1; if (!ctype_isinteger(dc->info) || dc->size != 1) goto err_conv; if (d->size != 0 && d->size < sz) sz = d->size; memcpy(dp, strdata(str), sz); return; } else { /* Otherwise pass it as a const char[]. */ sp = (uint8_t *)strdata(str); sid = CTID_A_CCHAR; flags |= CCF_FROMTV; } } else if (tvistab(o)) { if (ctype_isarray(d->info)) { cconv_array_tab(cts, d, dp, tabV(o), flags); return; } else if (ctype_isstruct(d->info)) { cconv_struct_tab(cts, d, dp, tabV(o), flags); return; } else { goto err_conv; } } else if (tvisbool(o)) { tmpbool = boolV(o); sp = &tmpbool; sid = CTID_BOOL; } else if (tvisnil(o)) { tmpptr = (void *)0; flags |= CCF_FROMTV; } else if (tvisudata(o)) { GCudata *ud = udataV(o); tmpptr = uddata(ud); if (ud->udtype == UDTYPE_IO_FILE) tmpptr = *(void **)tmpptr; } else if (tvislightud(o)) { tmpptr = lightudV(o); } else if (tvisfunc(o)) { void *p = lj_ccallback_new(cts, d, funcV(o)); if (p) { *(void **)dp = p; return; } goto err_conv; } else { err_conv: cconv_err_convtv(cts, d, o, flags); } s = ctype_get(cts, sid); doconv: if (ctype_isenum(d->info)) d = ctype_child(cts, d); lj_cconv_ct_ct(cts, d, s, dp, sp, flags); } /* Convert TValue to bitfield. */ void lj_cconv_bf_tv(CTState *cts, CType *d, uint8_t *dp, TValue *o) { CTInfo info = d->info; CTSize pos, bsz; uint32_t val, mask; lua_assert(ctype_isbitfield(info)); if ((info & CTF_BOOL)) { uint8_t tmpbool; lua_assert(ctype_bitbsz(info) == 1); lj_cconv_ct_tv(cts, ctype_get(cts, CTID_BOOL), &tmpbool, o, 0); val = tmpbool; } else { CTypeID did = (info & CTF_UNSIGNED) ? CTID_UINT32 : CTID_INT32; lj_cconv_ct_tv(cts, ctype_get(cts, did), (uint8_t *)&val, o, 0); } pos = ctype_bitpos(info); bsz = ctype_bitbsz(info); lua_assert(pos < 8*ctype_bitcsz(info)); lua_assert(bsz > 0 && bsz <= 8*ctype_bitcsz(info)); /* Check if a packed bitfield crosses a container boundary. */ if (pos + bsz > 8*ctype_bitcsz(info)) lj_err_caller(cts->L, LJ_ERR_FFI_NYIPACKBIT); mask = ((1u << bsz) - 1u) << pos; val = (val << pos) & mask; /* NYI: packed bitfields may cause misaligned reads/writes. */ switch (ctype_bitcsz(info)) { case 4: *(uint32_t *)dp = (*(uint32_t *)dp & ~mask) | (uint32_t)val; break; case 2: *(uint16_t *)dp = (*(uint16_t *)dp & ~mask) | (uint16_t)val; break; case 1: *(uint8_t *)dp = (*(uint8_t *)dp & ~mask) | (uint8_t)val; break; default: lua_assert(0); break; } } /* -- Initialize C type with TValues -------------------------------------- */ /* Initialize an array with TValues. */ static void cconv_array_init(CTState *cts, CType *d, CTSize sz, uint8_t *dp, TValue *o, MSize len) { CType *dc = ctype_rawchild(cts, d); /* Array element type. */ CTSize ofs, esize = dc->size; MSize i; if (len*esize > sz) cconv_err_initov(cts, d); for (i = 0, ofs = 0; i < len; i++, ofs += esize) lj_cconv_ct_tv(cts, dc, dp + ofs, o + i, 0); if (ofs == esize) { /* Replicate a single element. */ for (; ofs < sz; ofs += esize) memcpy(dp + ofs, dp, esize); } else { /* Otherwise fill the remainder with zero. */ memset(dp + ofs, 0, sz - ofs); } } /* Initialize a sub-struct/union with TValues. */ static void cconv_substruct_init(CTState *cts, CType *d, uint8_t *dp, TValue *o, MSize len, MSize *ip) { CTypeID id = d->sib; while (id) { CType *df = ctype_get(cts, id); id = df->sib; if (ctype_isfield(df->info) || ctype_isbitfield(df->info)) { MSize i = *ip; if (!gcref(df->name)) continue; /* Ignore unnamed fields. */ if (i >= len) break; *ip = i + 1; if (ctype_isfield(df->info)) lj_cconv_ct_tv(cts, ctype_rawchild(cts, df), dp+df->size, o + i, 0); else lj_cconv_bf_tv(cts, df, dp+df->size, o + i); if ((d->info & CTF_UNION)) break; } else if (ctype_isxattrib(df->info, CTA_SUBTYPE)) { cconv_substruct_init(cts, ctype_rawchild(cts, df), dp+df->size, o, len, ip); if ((d->info & CTF_UNION)) break; } /* Ignore all other entries in the chain. */ } } /* Initialize a struct/union with TValues. */ static void cconv_struct_init(CTState *cts, CType *d, CTSize sz, uint8_t *dp, TValue *o, MSize len) { MSize i = 0; memset(dp, 0, sz); /* Much simpler to clear the struct first. */ cconv_substruct_init(cts, d, dp, o, len, &i); if (i < len) cconv_err_initov(cts, d); } /* Check whether to use a multi-value initializer. ** This is true if an aggregate is to be initialized with a value. ** Valarrays are treated as values here so ct_tv handles (V|C, I|F). */ int lj_cconv_multi_init(CTState *cts, CType *d, TValue *o) { if (!(ctype_isrefarray(d->info) || ctype_isstruct(d->info))) return 0; /* Destination is not an aggregate. */ if (tvistab(o) || (tvisstr(o) && !ctype_isstruct(d->info))) return 0; /* Initializer is not a value. */ if (tviscdata(o) && lj_ctype_rawref(cts, cdataV(o)->ctypeid) == d) return 0; /* Source and destination are identical aggregates. */ return 1; /* Otherwise the initializer is a value. */ } /* Initialize C type with TValues. Caveat: expects to get the raw CType! */ void lj_cconv_ct_init(CTState *cts, CType *d, CTSize sz, uint8_t *dp, TValue *o, MSize len) { if (len == 0) memset(dp, 0, sz); else if (len == 1 && !lj_cconv_multi_init(cts, d, o)) lj_cconv_ct_tv(cts, d, dp, o, 0); else if (ctype_isarray(d->info)) /* Also handles valarray init with len>1. */ cconv_array_init(cts, d, sz, dp, o, len); else if (ctype_isstruct(d->info)) cconv_struct_init(cts, d, sz, dp, o, len); else cconv_err_initov(cts, d); } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ffrecord.c0000644000175000017500000006622513122010155017327 0ustar philphil/* ** Fast function call recorder. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_ffrecord_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_frame.h" #include "lj_bc.h" #include "lj_ff.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_ircall.h" #include "lj_iropt.h" #include "lj_trace.h" #include "lj_record.h" #include "lj_ffrecord.h" #include "lj_crecord.h" #include "lj_dispatch.h" #include "lj_vm.h" #include "lj_strscan.h" /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) /* -- Fast function recording handlers ------------------------------------ */ /* Conventions for fast function call handlers: ** ** The argument slots start at J->base[0]. All of them are guaranteed to be ** valid and type-specialized references. J->base[J->maxslot] is set to 0 ** as a sentinel. The runtime argument values start at rd->argv[0]. ** ** In general fast functions should check for presence of all of their ** arguments and for the correct argument types. Some simplifications ** are allowed if the interpreter throws instead. But even if recording ** is aborted, the generated IR must be consistent (no zero-refs). ** ** The number of results in rd->nres is set to 1. Handlers that return ** a different number of results need to override it. A negative value ** prevents return processing (e.g. for pending calls). ** ** Results need to be stored starting at J->base[0]. Return processing ** moves them to the right slots later. ** ** The per-ffid auxiliary data is the value of the 2nd part of the ** LJLIB_REC() annotation. This allows handling similar functionality ** in a common handler. */ /* Type of handler to record a fast function. */ typedef void (LJ_FASTCALL *RecordFunc)(jit_State *J, RecordFFData *rd); /* Get runtime value of int argument. */ static int32_t argv2int(jit_State *J, TValue *o) { if (!lj_strscan_numberobj(o)) lj_trace_err(J, LJ_TRERR_BADTYPE); return tvisint(o) ? intV(o) : lj_num2int(numV(o)); } /* Get runtime value of string argument. */ static GCstr *argv2str(jit_State *J, TValue *o) { if (LJ_LIKELY(tvisstr(o))) { return strV(o); } else { GCstr *s; if (!tvisnumber(o)) lj_trace_err(J, LJ_TRERR_BADTYPE); if (tvisint(o)) s = lj_str_fromint(J->L, intV(o)); else s = lj_str_fromnum(J->L, &o->n); setstrV(J->L, o, s); return s; } } /* Return number of results wanted by caller. */ static ptrdiff_t results_wanted(jit_State *J) { TValue *frame = J->L->base-1; if (frame_islua(frame)) return (ptrdiff_t)bc_b(frame_pc(frame)[-1]) - 1; else return -1; } /* Throw error for unsupported variant of fast function. */ LJ_NORET static void recff_nyiu(jit_State *J) { setfuncV(J->L, &J->errinfo, J->fn); lj_trace_err_info(J, LJ_TRERR_NYIFFU); } /* Fallback handler for all fast functions that are not recorded (yet). */ static void LJ_FASTCALL recff_nyi(jit_State *J, RecordFFData *rd) { setfuncV(J->L, &J->errinfo, J->fn); lj_trace_err_info(J, LJ_TRERR_NYIFF); UNUSED(rd); } /* C functions can have arbitrary side-effects and are not recorded (yet). */ static void LJ_FASTCALL recff_c(jit_State *J, RecordFFData *rd) { setfuncV(J->L, &J->errinfo, J->fn); lj_trace_err_info(J, LJ_TRERR_NYICF); UNUSED(rd); } /* -- Base library fast functions ----------------------------------------- */ static void LJ_FASTCALL recff_assert(jit_State *J, RecordFFData *rd) { /* Arguments already specialized. The interpreter throws for nil/false. */ rd->nres = J->maxslot; /* Pass through all arguments. */ } static void LJ_FASTCALL recff_type(jit_State *J, RecordFFData *rd) { /* Arguments already specialized. Result is a constant string. Neat, huh? */ uint32_t t; if (tvisnumber(&rd->argv[0])) t = ~LJ_TNUMX; else if (LJ_64 && tvislightud(&rd->argv[0])) t = ~LJ_TLIGHTUD; else t = ~itype(&rd->argv[0]); J->base[0] = lj_ir_kstr(J, strV(&J->fn->c.upvalue[t])); UNUSED(rd); } static void LJ_FASTCALL recff_getmetatable(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; if (tr) { RecordIndex ix; ix.tab = tr; copyTV(J->L, &ix.tabv, &rd->argv[0]); if (lj_record_mm_lookup(J, &ix, MM_metatable)) J->base[0] = ix.mobj; else J->base[0] = ix.mt; } /* else: Interpreter will throw. */ } static void LJ_FASTCALL recff_setmetatable(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; TRef mt = J->base[1]; if (tref_istab(tr) && (tref_istab(mt) || (mt && tref_isnil(mt)))) { TRef fref, mtref; RecordIndex ix; ix.tab = tr; copyTV(J->L, &ix.tabv, &rd->argv[0]); lj_record_mm_lookup(J, &ix, MM_metatable); /* Guard for no __metatable. */ fref = emitir(IRT(IR_FREF, IRT_P32), tr, IRFL_TAB_META); mtref = tref_isnil(mt) ? lj_ir_knull(J, IRT_TAB) : mt; emitir(IRT(IR_FSTORE, IRT_TAB), fref, mtref); if (!tref_isnil(mt)) emitir(IRT(IR_TBAR, IRT_TAB), tr, 0); J->base[0] = tr; J->needsnap = 1; } /* else: Interpreter will throw. */ } static void LJ_FASTCALL recff_rawget(jit_State *J, RecordFFData *rd) { RecordIndex ix; ix.tab = J->base[0]; ix.key = J->base[1]; if (tref_istab(ix.tab) && ix.key) { ix.val = 0; ix.idxchain = 0; settabV(J->L, &ix.tabv, tabV(&rd->argv[0])); copyTV(J->L, &ix.keyv, &rd->argv[1]); J->base[0] = lj_record_idx(J, &ix); } /* else: Interpreter will throw. */ } static void LJ_FASTCALL recff_rawset(jit_State *J, RecordFFData *rd) { RecordIndex ix; ix.tab = J->base[0]; ix.key = J->base[1]; ix.val = J->base[2]; if (tref_istab(ix.tab) && ix.key && ix.val) { ix.idxchain = 0; settabV(J->L, &ix.tabv, tabV(&rd->argv[0])); copyTV(J->L, &ix.keyv, &rd->argv[1]); copyTV(J->L, &ix.valv, &rd->argv[2]); lj_record_idx(J, &ix); /* Pass through table at J->base[0] as result. */ } /* else: Interpreter will throw. */ } static void LJ_FASTCALL recff_rawequal(jit_State *J, RecordFFData *rd) { TRef tra = J->base[0]; TRef trb = J->base[1]; if (tra && trb) { int diff = lj_record_objcmp(J, tra, trb, &rd->argv[0], &rd->argv[1]); J->base[0] = diff ? TREF_FALSE : TREF_TRUE; } /* else: Interpreter will throw. */ } #if LJ_52 static void LJ_FASTCALL recff_rawlen(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; if (tref_isstr(tr)) J->base[0] = emitir(IRTI(IR_FLOAD), tr, IRFL_STR_LEN); else if (tref_istab(tr)) J->base[0] = lj_ir_call(J, IRCALL_lj_tab_len, tr); /* else: Interpreter will throw. */ UNUSED(rd); } #endif /* Determine mode of select() call. */ int32_t lj_ffrecord_select_mode(jit_State *J, TRef tr, TValue *tv) { if (tref_isstr(tr) && *strVdata(tv) == '#') { /* select('#', ...) */ if (strV(tv)->len == 1) { emitir(IRTG(IR_EQ, IRT_STR), tr, lj_ir_kstr(J, strV(tv))); } else { TRef trptr = emitir(IRT(IR_STRREF, IRT_P32), tr, lj_ir_kint(J, 0)); TRef trchar = emitir(IRT(IR_XLOAD, IRT_U8), trptr, IRXLOAD_READONLY); emitir(IRTG(IR_EQ, IRT_INT), trchar, lj_ir_kint(J, '#')); } return 0; } else { /* select(n, ...) */ int32_t start = argv2int(J, tv); if (start == 0) lj_trace_err(J, LJ_TRERR_BADTYPE); /* A bit misleading. */ return start; } } static void LJ_FASTCALL recff_select(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; if (tr) { ptrdiff_t start = lj_ffrecord_select_mode(J, tr, &rd->argv[0]); if (start == 0) { /* select('#', ...) */ J->base[0] = lj_ir_kint(J, J->maxslot - 1); } else if (tref_isk(tr)) { /* select(k, ...) */ ptrdiff_t n = (ptrdiff_t)J->maxslot; if (start < 0) start += n; else if (start > n) start = n; rd->nres = n - start; if (start >= 1) { ptrdiff_t i; for (i = 0; i < n - start; i++) J->base[i] = J->base[start+i]; } /* else: Interpreter will throw. */ } else { recff_nyiu(J); } } /* else: Interpreter will throw. */ } static void LJ_FASTCALL recff_tonumber(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; TRef base = J->base[1]; if (tr && !tref_isnil(base)) { base = lj_opt_narrow_toint(J, base); if (!tref_isk(base) || IR(tref_ref(base))->i != 10) recff_nyiu(J); } if (tref_isnumber_str(tr)) { if (tref_isstr(tr)) { TValue tmp; if (!lj_strscan_num(strV(&rd->argv[0]), &tmp)) recff_nyiu(J); /* Would need an inverted STRTO for this case. */ tr = emitir(IRTG(IR_STRTO, IRT_NUM), tr, 0); } #if LJ_HASFFI } else if (tref_iscdata(tr)) { lj_crecord_tonumber(J, rd); return; #endif } else { tr = TREF_NIL; } J->base[0] = tr; UNUSED(rd); } static TValue *recff_metacall_cp(lua_State *L, lua_CFunction dummy, void *ud) { jit_State *J = (jit_State *)ud; lj_record_tailcall(J, 0, 1); UNUSED(L); UNUSED(dummy); return NULL; } static int recff_metacall(jit_State *J, RecordFFData *rd, MMS mm) { RecordIndex ix; ix.tab = J->base[0]; copyTV(J->L, &ix.tabv, &rd->argv[0]); if (lj_record_mm_lookup(J, &ix, mm)) { /* Has metamethod? */ int errcode; TValue argv0; /* Temporarily insert metamethod below object. */ J->base[1] = J->base[0]; J->base[0] = ix.mobj; copyTV(J->L, &argv0, &rd->argv[0]); copyTV(J->L, &rd->argv[1], &rd->argv[0]); copyTV(J->L, &rd->argv[0], &ix.mobjv); /* Need to protect lj_record_tailcall because it may throw. */ errcode = lj_vm_cpcall(J->L, NULL, J, recff_metacall_cp); /* Always undo Lua stack changes to avoid confusing the interpreter. */ copyTV(J->L, &rd->argv[0], &argv0); if (errcode) lj_err_throw(J->L, errcode); /* Propagate errors. */ rd->nres = -1; /* Pending call. */ return 1; /* Tailcalled to metamethod. */ } return 0; } static void LJ_FASTCALL recff_tostring(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; if (tref_isstr(tr)) { /* Ignore __tostring in the string base metatable. */ /* Pass on result in J->base[0]. */ } else if (!recff_metacall(J, rd, MM_tostring)) { if (tref_isnumber(tr)) { J->base[0] = emitir(IRT(IR_TOSTR, IRT_STR), tr, 0); } else if (tref_ispri(tr)) { J->base[0] = lj_ir_kstr(J, strV(&J->fn->c.upvalue[tref_type(tr)])); } else { recff_nyiu(J); } } } static void LJ_FASTCALL recff_ipairs_aux(jit_State *J, RecordFFData *rd) { RecordIndex ix; ix.tab = J->base[0]; if (tref_istab(ix.tab)) { if (!tvisnumber(&rd->argv[1])) /* No support for string coercion. */ lj_trace_err(J, LJ_TRERR_BADTYPE); setintV(&ix.keyv, numberVint(&rd->argv[1])+1); settabV(J->L, &ix.tabv, tabV(&rd->argv[0])); ix.val = 0; ix.idxchain = 0; ix.key = lj_opt_narrow_toint(J, J->base[1]); J->base[0] = ix.key = emitir(IRTI(IR_ADD), ix.key, lj_ir_kint(J, 1)); J->base[1] = lj_record_idx(J, &ix); rd->nres = tref_isnil(J->base[1]) ? 0 : 2; } /* else: Interpreter will throw. */ } static void LJ_FASTCALL recff_ipairs(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; if (!((LJ_52 || (LJ_HASFFI && tref_iscdata(tr))) && recff_metacall(J, rd, MM_ipairs))) { if (tref_istab(tr)) { J->base[0] = lj_ir_kfunc(J, funcV(&J->fn->c.upvalue[0])); J->base[1] = tr; J->base[2] = lj_ir_kint(J, 0); rd->nres = 3; } /* else: Interpreter will throw. */ } } static void LJ_FASTCALL recff_pcall(jit_State *J, RecordFFData *rd) { if (J->maxslot >= 1) { lj_record_call(J, 0, J->maxslot - 1); rd->nres = -1; /* Pending call. */ } /* else: Interpreter will throw. */ } static TValue *recff_xpcall_cp(lua_State *L, lua_CFunction dummy, void *ud) { jit_State *J = (jit_State *)ud; lj_record_call(J, 1, J->maxslot - 2); UNUSED(L); UNUSED(dummy); return NULL; } static void LJ_FASTCALL recff_xpcall(jit_State *J, RecordFFData *rd) { if (J->maxslot >= 2) { TValue argv0, argv1; TRef tmp; int errcode; /* Swap function and traceback. */ tmp = J->base[0]; J->base[0] = J->base[1]; J->base[1] = tmp; copyTV(J->L, &argv0, &rd->argv[0]); copyTV(J->L, &argv1, &rd->argv[1]); copyTV(J->L, &rd->argv[0], &argv1); copyTV(J->L, &rd->argv[1], &argv0); /* Need to protect lj_record_call because it may throw. */ errcode = lj_vm_cpcall(J->L, NULL, J, recff_xpcall_cp); /* Always undo Lua stack swap to avoid confusing the interpreter. */ copyTV(J->L, &rd->argv[0], &argv0); copyTV(J->L, &rd->argv[1], &argv1); if (errcode) lj_err_throw(J->L, errcode); /* Propagate errors. */ rd->nres = -1; /* Pending call. */ } /* else: Interpreter will throw. */ } /* -- Math library fast functions ----------------------------------------- */ static void LJ_FASTCALL recff_math_abs(jit_State *J, RecordFFData *rd) { TRef tr = lj_ir_tonum(J, J->base[0]); J->base[0] = emitir(IRTN(IR_ABS), tr, lj_ir_knum_abs(J)); UNUSED(rd); } /* Record rounding functions math.floor and math.ceil. */ static void LJ_FASTCALL recff_math_round(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; if (!tref_isinteger(tr)) { /* Pass through integers unmodified. */ tr = emitir(IRTN(IR_FPMATH), lj_ir_tonum(J, tr), rd->data); /* Result is integral (or NaN/Inf), but may not fit an int32_t. */ if (LJ_DUALNUM) { /* Try to narrow using a guarded conversion to int. */ lua_Number n = lj_vm_foldfpm(numberVnum(&rd->argv[0]), rd->data); if (n == (lua_Number)lj_num2int(n)) tr = emitir(IRTGI(IR_CONV), tr, IRCONV_INT_NUM|IRCONV_CHECK); } J->base[0] = tr; } } /* Record unary math.* functions, mapped to IR_FPMATH opcode. */ static void LJ_FASTCALL recff_math_unary(jit_State *J, RecordFFData *rd) { J->base[0] = emitir(IRTN(IR_FPMATH), lj_ir_tonum(J, J->base[0]), rd->data); } /* Record math.log. */ static void LJ_FASTCALL recff_math_log(jit_State *J, RecordFFData *rd) { TRef tr = lj_ir_tonum(J, J->base[0]); if (J->base[1]) { #ifdef LUAJIT_NO_LOG2 uint32_t fpm = IRFPM_LOG; #else uint32_t fpm = IRFPM_LOG2; #endif TRef trb = lj_ir_tonum(J, J->base[1]); tr = emitir(IRTN(IR_FPMATH), tr, fpm); trb = emitir(IRTN(IR_FPMATH), trb, fpm); trb = emitir(IRTN(IR_DIV), lj_ir_knum_one(J), trb); tr = emitir(IRTN(IR_MUL), tr, trb); } else { tr = emitir(IRTN(IR_FPMATH), tr, IRFPM_LOG); } J->base[0] = tr; UNUSED(rd); } /* Record math.atan2. */ static void LJ_FASTCALL recff_math_atan2(jit_State *J, RecordFFData *rd) { TRef tr = lj_ir_tonum(J, J->base[0]); TRef tr2 = lj_ir_tonum(J, J->base[1]); J->base[0] = emitir(IRTN(IR_ATAN2), tr, tr2); UNUSED(rd); } /* Record math.ldexp. */ static void LJ_FASTCALL recff_math_ldexp(jit_State *J, RecordFFData *rd) { TRef tr = lj_ir_tonum(J, J->base[0]); #if LJ_TARGET_X86ORX64 TRef tr2 = lj_ir_tonum(J, J->base[1]); #else TRef tr2 = lj_opt_narrow_toint(J, J->base[1]); #endif J->base[0] = emitir(IRTN(IR_LDEXP), tr, tr2); UNUSED(rd); } /* Record math.asin, math.acos, math.atan. */ static void LJ_FASTCALL recff_math_atrig(jit_State *J, RecordFFData *rd) { TRef y = lj_ir_tonum(J, J->base[0]); TRef x = lj_ir_knum_one(J); uint32_t ffid = rd->data; if (ffid != FF_math_atan) { TRef tmp = emitir(IRTN(IR_MUL), y, y); tmp = emitir(IRTN(IR_SUB), x, tmp); tmp = emitir(IRTN(IR_FPMATH), tmp, IRFPM_SQRT); if (ffid == FF_math_asin) { x = tmp; } else { x = y; y = tmp; } } J->base[0] = emitir(IRTN(IR_ATAN2), y, x); } static void LJ_FASTCALL recff_math_htrig(jit_State *J, RecordFFData *rd) { TRef tr = lj_ir_tonum(J, J->base[0]); J->base[0] = emitir(IRTN(IR_CALLN), tr, rd->data); } static void LJ_FASTCALL recff_math_modf(jit_State *J, RecordFFData *rd) { TRef tr = J->base[0]; if (tref_isinteger(tr)) { J->base[0] = tr; J->base[1] = lj_ir_kint(J, 0); } else { TRef trt; tr = lj_ir_tonum(J, tr); trt = emitir(IRTN(IR_FPMATH), tr, IRFPM_TRUNC); J->base[0] = trt; J->base[1] = emitir(IRTN(IR_SUB), tr, trt); } rd->nres = 2; } static void LJ_FASTCALL recff_math_degrad(jit_State *J, RecordFFData *rd) { TRef tr = lj_ir_tonum(J, J->base[0]); TRef trm = lj_ir_knum(J, numV(&J->fn->c.upvalue[0])); J->base[0] = emitir(IRTN(IR_MUL), tr, trm); UNUSED(rd); } static void LJ_FASTCALL recff_math_pow(jit_State *J, RecordFFData *rd) { J->base[0] = lj_opt_narrow_pow(J, J->base[0], J->base[1], &rd->argv[0], &rd->argv[1]); UNUSED(rd); } static void LJ_FASTCALL recff_math_minmax(jit_State *J, RecordFFData *rd) { TRef tr = lj_ir_tonumber(J, J->base[0]); uint32_t op = rd->data; BCReg i; for (i = 1; J->base[i] != 0; i++) { TRef tr2 = lj_ir_tonumber(J, J->base[i]); IRType t = IRT_INT; if (!(tref_isinteger(tr) && tref_isinteger(tr2))) { if (tref_isinteger(tr)) tr = emitir(IRTN(IR_CONV), tr, IRCONV_NUM_INT); if (tref_isinteger(tr2)) tr2 = emitir(IRTN(IR_CONV), tr2, IRCONV_NUM_INT); t = IRT_NUM; } tr = emitir(IRT(op, t), tr, tr2); } J->base[0] = tr; } static void LJ_FASTCALL recff_math_random(jit_State *J, RecordFFData *rd) { GCudata *ud = udataV(&J->fn->c.upvalue[0]); TRef tr, one; lj_ir_kgc(J, obj2gco(ud), IRT_UDATA); /* Prevent collection. */ tr = lj_ir_call(J, IRCALL_lj_math_random_step, lj_ir_kptr(J, uddata(ud))); one = lj_ir_knum_one(J); tr = emitir(IRTN(IR_SUB), tr, one); if (J->base[0]) { TRef tr1 = lj_ir_tonum(J, J->base[0]); if (J->base[1]) { /* d = floor(d*(r2-r1+1.0)) + r1 */ TRef tr2 = lj_ir_tonum(J, J->base[1]); tr2 = emitir(IRTN(IR_SUB), tr2, tr1); tr2 = emitir(IRTN(IR_ADD), tr2, one); tr = emitir(IRTN(IR_MUL), tr, tr2); tr = emitir(IRTN(IR_FPMATH), tr, IRFPM_FLOOR); tr = emitir(IRTN(IR_ADD), tr, tr1); } else { /* d = floor(d*r1) + 1.0 */ tr = emitir(IRTN(IR_MUL), tr, tr1); tr = emitir(IRTN(IR_FPMATH), tr, IRFPM_FLOOR); tr = emitir(IRTN(IR_ADD), tr, one); } } J->base[0] = tr; UNUSED(rd); } /* -- Bit library fast functions ------------------------------------------ */ /* Record unary bit.tobit, bit.bnot, bit.bswap. */ static void LJ_FASTCALL recff_bit_unary(jit_State *J, RecordFFData *rd) { TRef tr = lj_opt_narrow_tobit(J, J->base[0]); J->base[0] = (rd->data == IR_TOBIT) ? tr : emitir(IRTI(rd->data), tr, 0); } /* Record N-ary bit.band, bit.bor, bit.bxor. */ static void LJ_FASTCALL recff_bit_nary(jit_State *J, RecordFFData *rd) { TRef tr = lj_opt_narrow_tobit(J, J->base[0]); uint32_t op = rd->data; BCReg i; for (i = 1; J->base[i] != 0; i++) tr = emitir(IRTI(op), tr, lj_opt_narrow_tobit(J, J->base[i])); J->base[0] = tr; } /* Record bit shifts. */ static void LJ_FASTCALL recff_bit_shift(jit_State *J, RecordFFData *rd) { TRef tr = lj_opt_narrow_tobit(J, J->base[0]); TRef tsh = lj_opt_narrow_tobit(J, J->base[1]); IROp op = (IROp)rd->data; if (!(op < IR_BROL ? LJ_TARGET_MASKSHIFT : LJ_TARGET_MASKROT) && !tref_isk(tsh)) tsh = emitir(IRTI(IR_BAND), tsh, lj_ir_kint(J, 31)); #ifdef LJ_TARGET_UNIFYROT if (op == (LJ_TARGET_UNIFYROT == 1 ? IR_BROR : IR_BROL)) { op = LJ_TARGET_UNIFYROT == 1 ? IR_BROL : IR_BROR; tsh = emitir(IRTI(IR_NEG), tsh, tsh); } #endif J->base[0] = emitir(IRTI(op), tr, tsh); } /* -- String library fast functions --------------------------------------- */ static void LJ_FASTCALL recff_string_len(jit_State *J, RecordFFData *rd) { J->base[0] = emitir(IRTI(IR_FLOAD), lj_ir_tostr(J, J->base[0]), IRFL_STR_LEN); UNUSED(rd); } /* Handle string.byte (rd->data = 0) and string.sub (rd->data = 1). */ static void LJ_FASTCALL recff_string_range(jit_State *J, RecordFFData *rd) { TRef trstr = lj_ir_tostr(J, J->base[0]); TRef trlen = emitir(IRTI(IR_FLOAD), trstr, IRFL_STR_LEN); TRef tr0 = lj_ir_kint(J, 0); TRef trstart, trend; GCstr *str = argv2str(J, &rd->argv[0]); int32_t start, end; if (rd->data) { /* string.sub(str, start [,end]) */ start = argv2int(J, &rd->argv[1]); trstart = lj_opt_narrow_toint(J, J->base[1]); trend = J->base[2]; if (tref_isnil(trend)) { trend = lj_ir_kint(J, -1); end = -1; } else { trend = lj_opt_narrow_toint(J, trend); end = argv2int(J, &rd->argv[2]); } } else { /* string.byte(str, [,start [,end]]) */ if (tref_isnil(J->base[1])) { start = 1; trstart = lj_ir_kint(J, 1); } else { start = argv2int(J, &rd->argv[1]); trstart = lj_opt_narrow_toint(J, J->base[1]); } if (J->base[1] && !tref_isnil(J->base[2])) { trend = lj_opt_narrow_toint(J, J->base[2]); end = argv2int(J, &rd->argv[2]); } else { trend = trstart; end = start; } } if (end < 0) { emitir(IRTGI(IR_LT), trend, tr0); trend = emitir(IRTI(IR_ADD), emitir(IRTI(IR_ADD), trlen, trend), lj_ir_kint(J, 1)); end = end+(int32_t)str->len+1; } else if ((MSize)end <= str->len) { emitir(IRTGI(IR_ULE), trend, trlen); } else { emitir(IRTGI(IR_GT), trend, trlen); end = (int32_t)str->len; trend = trlen; } if (start < 0) { emitir(IRTGI(IR_LT), trstart, tr0); trstart = emitir(IRTI(IR_ADD), trlen, trstart); start = start+(int32_t)str->len; emitir(start < 0 ? IRTGI(IR_LT) : IRTGI(IR_GE), trstart, tr0); if (start < 0) { trstart = tr0; start = 0; } } else { if (start == 0) { emitir(IRTGI(IR_EQ), trstart, tr0); trstart = tr0; } else { trstart = emitir(IRTI(IR_ADD), trstart, lj_ir_kint(J, -1)); emitir(IRTGI(IR_GE), trstart, tr0); start--; } } if (rd->data) { /* Return string.sub result. */ if (end - start >= 0) { /* Also handle empty range here, to avoid extra traces. */ TRef trptr, trslen = emitir(IRTI(IR_SUB), trend, trstart); emitir(IRTGI(IR_GE), trslen, tr0); trptr = emitir(IRT(IR_STRREF, IRT_P32), trstr, trstart); J->base[0] = emitir(IRT(IR_SNEW, IRT_STR), trptr, trslen); } else { /* Range underflow: return empty string. */ emitir(IRTGI(IR_LT), trend, trstart); J->base[0] = lj_ir_kstr(J, lj_str_new(J->L, strdata(str), 0)); } } else { /* Return string.byte result(s). */ ptrdiff_t i, len = end - start; if (len > 0) { TRef trslen = emitir(IRTI(IR_SUB), trend, trstart); emitir(IRTGI(IR_EQ), trslen, lj_ir_kint(J, (int32_t)len)); if (J->baseslot + len > LJ_MAX_JSLOTS) lj_trace_err_info(J, LJ_TRERR_STACKOV); rd->nres = len; for (i = 0; i < len; i++) { TRef tmp = emitir(IRTI(IR_ADD), trstart, lj_ir_kint(J, (int32_t)i)); tmp = emitir(IRT(IR_STRREF, IRT_P32), trstr, tmp); J->base[i] = emitir(IRT(IR_XLOAD, IRT_U8), tmp, IRXLOAD_READONLY); } } else { /* Empty range or range underflow: return no results. */ emitir(IRTGI(IR_LE), trend, trstart); rd->nres = 0; } } } /* -- Table library fast functions ---------------------------------------- */ static void LJ_FASTCALL recff_table_getn(jit_State *J, RecordFFData *rd) { if (tref_istab(J->base[0])) J->base[0] = lj_ir_call(J, IRCALL_lj_tab_len, J->base[0]); /* else: Interpreter will throw. */ UNUSED(rd); } static void LJ_FASTCALL recff_table_remove(jit_State *J, RecordFFData *rd) { TRef tab = J->base[0]; rd->nres = 0; if (tref_istab(tab)) { if (tref_isnil(J->base[1])) { /* Simple pop: t[#t] = nil */ TRef trlen = lj_ir_call(J, IRCALL_lj_tab_len, tab); GCtab *t = tabV(&rd->argv[0]); MSize len = lj_tab_len(t); emitir(IRTGI(len ? IR_NE : IR_EQ), trlen, lj_ir_kint(J, 0)); if (len) { RecordIndex ix; ix.tab = tab; ix.key = trlen; settabV(J->L, &ix.tabv, t); setintV(&ix.keyv, len); ix.idxchain = 0; if (results_wanted(J) != 0) { /* Specialize load only if needed. */ ix.val = 0; J->base[0] = lj_record_idx(J, &ix); /* Load previous value. */ rd->nres = 1; /* Assumes ix.key/ix.tab is not modified for raw lj_record_idx(). */ } ix.val = TREF_NIL; lj_record_idx(J, &ix); /* Remove value. */ } } else { /* Complex case: remove in the middle. */ recff_nyiu(J); } } /* else: Interpreter will throw. */ } static void LJ_FASTCALL recff_table_insert(jit_State *J, RecordFFData *rd) { RecordIndex ix; ix.tab = J->base[0]; ix.val = J->base[1]; rd->nres = 0; if (tref_istab(ix.tab) && ix.val) { if (!J->base[2]) { /* Simple push: t[#t+1] = v */ TRef trlen = lj_ir_call(J, IRCALL_lj_tab_len, ix.tab); GCtab *t = tabV(&rd->argv[0]); ix.key = emitir(IRTI(IR_ADD), trlen, lj_ir_kint(J, 1)); settabV(J->L, &ix.tabv, t); setintV(&ix.keyv, lj_tab_len(t) + 1); ix.idxchain = 0; lj_record_idx(J, &ix); /* Set new value. */ } else { /* Complex case: insert in the middle. */ recff_nyiu(J); } } /* else: Interpreter will throw. */ } /* -- I/O library fast functions ------------------------------------------ */ /* Get FILE* for I/O function. Any I/O error aborts recording, so there's ** no need to encode the alternate cases for any of the guards. */ static TRef recff_io_fp(jit_State *J, TRef *udp, int32_t id) { TRef tr, ud, fp; if (id) { /* io.func() */ tr = lj_ir_kptr(J, &J2G(J)->gcroot[id]); ud = emitir(IRT(IR_XLOAD, IRT_UDATA), tr, 0); } else { /* fp:method() */ ud = J->base[0]; if (!tref_isudata(ud)) lj_trace_err(J, LJ_TRERR_BADTYPE); tr = emitir(IRT(IR_FLOAD, IRT_U8), ud, IRFL_UDATA_UDTYPE); emitir(IRTGI(IR_EQ), tr, lj_ir_kint(J, UDTYPE_IO_FILE)); } *udp = ud; fp = emitir(IRT(IR_FLOAD, IRT_PTR), ud, IRFL_UDATA_FILE); emitir(IRTG(IR_NE, IRT_PTR), fp, lj_ir_knull(J, IRT_PTR)); return fp; } static void LJ_FASTCALL recff_io_write(jit_State *J, RecordFFData *rd) { TRef ud, fp = recff_io_fp(J, &ud, rd->data); TRef zero = lj_ir_kint(J, 0); TRef one = lj_ir_kint(J, 1); ptrdiff_t i = rd->data == 0 ? 1 : 0; for (; J->base[i]; i++) { TRef str = lj_ir_tostr(J, J->base[i]); TRef buf = emitir(IRT(IR_STRREF, IRT_P32), str, zero); TRef len = emitir(IRTI(IR_FLOAD), str, IRFL_STR_LEN); if (tref_isk(len) && IR(tref_ref(len))->i == 1) { TRef tr = emitir(IRT(IR_XLOAD, IRT_U8), buf, IRXLOAD_READONLY); tr = lj_ir_call(J, IRCALL_fputc, tr, fp); if (results_wanted(J) != 0) /* Check result only if not ignored. */ emitir(IRTGI(IR_NE), tr, lj_ir_kint(J, -1)); } else { TRef tr = lj_ir_call(J, IRCALL_fwrite, buf, one, len, fp); if (results_wanted(J) != 0) /* Check result only if not ignored. */ emitir(IRTGI(IR_EQ), tr, len); } } J->base[0] = LJ_52 ? ud : TREF_TRUE; } static void LJ_FASTCALL recff_io_flush(jit_State *J, RecordFFData *rd) { TRef ud, fp = recff_io_fp(J, &ud, rd->data); TRef tr = lj_ir_call(J, IRCALL_fflush, fp); if (results_wanted(J) != 0) /* Check result only if not ignored. */ emitir(IRTGI(IR_EQ), tr, lj_ir_kint(J, 0)); J->base[0] = TREF_TRUE; } /* -- Record calls to fast functions -------------------------------------- */ #include "lj_recdef.h" static uint32_t recdef_lookup(GCfunc *fn) { if (fn->c.ffid < sizeof(recff_idmap)/sizeof(recff_idmap[0])) return recff_idmap[fn->c.ffid]; else return 0; } /* Record entry to a fast function or C function. */ void lj_ffrecord_func(jit_State *J) { RecordFFData rd; uint32_t m = recdef_lookup(J->fn); rd.data = m & 0xff; rd.nres = 1; /* Default is one result. */ rd.argv = J->L->base; J->base[J->maxslot] = 0; /* Mark end of arguments. */ (recff_func[m >> 8])(J, &rd); /* Call recff_* handler. */ if (rd.nres >= 0) { if (J->postproc == LJ_POST_NONE) J->postproc = LJ_POST_FFRETRY; lj_record_ret(J, 0, rd.nres); } } #undef IR #undef emitir #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_emit_arm.h0000644000175000017500000002503313122010155017327 0ustar philphil/* ** ARM instruction emitter. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Constant encoding --------------------------------------------------- */ static uint8_t emit_invai[16] = { /* AND */ (ARMI_AND^ARMI_BIC) >> 21, /* EOR */ 0, /* SUB */ (ARMI_SUB^ARMI_ADD) >> 21, /* RSB */ 0, /* ADD */ (ARMI_ADD^ARMI_SUB) >> 21, /* ADC */ (ARMI_ADC^ARMI_SBC) >> 21, /* SBC */ (ARMI_SBC^ARMI_ADC) >> 21, /* RSC */ 0, /* TST */ 0, /* TEQ */ 0, /* CMP */ (ARMI_CMP^ARMI_CMN) >> 21, /* CMN */ (ARMI_CMN^ARMI_CMP) >> 21, /* ORR */ 0, /* MOV */ (ARMI_MOV^ARMI_MVN) >> 21, /* BIC */ (ARMI_BIC^ARMI_AND) >> 21, /* MVN */ (ARMI_MVN^ARMI_MOV) >> 21 }; /* Encode constant in K12 format for data processing instructions. */ static uint32_t emit_isk12(ARMIns ai, int32_t n) { uint32_t invai, i, m = (uint32_t)n; /* K12: unsigned 8 bit value, rotated in steps of two bits. */ for (i = 0; i < 4096; i += 256, m = lj_rol(m, 2)) if (m <= 255) return ARMI_K12|m|i; /* Otherwise try negation/complement with the inverse instruction. */ invai = emit_invai[((ai >> 21) & 15)]; if (!invai) return 0; /* Failed. No inverse instruction. */ m = ~(uint32_t)n; if (invai == ((ARMI_SUB^ARMI_ADD) >> 21) || invai == (ARMI_CMP^ARMI_CMN) >> 21) m++; for (i = 0; i < 4096; i += 256, m = lj_rol(m, 2)) if (m <= 255) return ARMI_K12|(invai<<21)|m|i; return 0; /* Failed. */ } /* -- Emit basic instructions --------------------------------------------- */ static void emit_dnm(ASMState *as, ARMIns ai, Reg rd, Reg rn, Reg rm) { *--as->mcp = ai | ARMF_D(rd) | ARMF_N(rn) | ARMF_M(rm); } static void emit_dm(ASMState *as, ARMIns ai, Reg rd, Reg rm) { *--as->mcp = ai | ARMF_D(rd) | ARMF_M(rm); } static void emit_dn(ASMState *as, ARMIns ai, Reg rd, Reg rn) { *--as->mcp = ai | ARMF_D(rd) | ARMF_N(rn); } static void emit_nm(ASMState *as, ARMIns ai, Reg rn, Reg rm) { *--as->mcp = ai | ARMF_N(rn) | ARMF_M(rm); } static void emit_d(ASMState *as, ARMIns ai, Reg rd) { *--as->mcp = ai | ARMF_D(rd); } static void emit_n(ASMState *as, ARMIns ai, Reg rn) { *--as->mcp = ai | ARMF_N(rn); } static void emit_m(ASMState *as, ARMIns ai, Reg rm) { *--as->mcp = ai | ARMF_M(rm); } static void emit_lsox(ASMState *as, ARMIns ai, Reg rd, Reg rn, int32_t ofs) { lua_assert(ofs >= -255 && ofs <= 255); if (ofs < 0) ofs = -ofs; else ai |= ARMI_LS_U; *--as->mcp = ai | ARMI_LS_P | ARMI_LSX_I | ARMF_D(rd) | ARMF_N(rn) | ((ofs & 0xf0) << 4) | (ofs & 0x0f); } static void emit_lso(ASMState *as, ARMIns ai, Reg rd, Reg rn, int32_t ofs) { lua_assert(ofs >= -4095 && ofs <= 4095); /* Combine LDR/STR pairs to LDRD/STRD. */ if (*as->mcp == (ai|ARMI_LS_P|ARMI_LS_U|ARMF_D(rd^1)|ARMF_N(rn)|(ofs^4)) && (ai & ~(ARMI_LDR^ARMI_STR)) == ARMI_STR && rd != rn && (uint32_t)ofs <= 252 && !(ofs & 3) && !((rd ^ (ofs >>2)) & 1) && as->mcp != as->mcloop) { as->mcp++; emit_lsox(as, ai == ARMI_LDR ? ARMI_LDRD : ARMI_STRD, rd&~1, rn, ofs&~4); return; } if (ofs < 0) ofs = -ofs; else ai |= ARMI_LS_U; *--as->mcp = ai | ARMI_LS_P | ARMF_D(rd) | ARMF_N(rn) | ofs; } #if !LJ_SOFTFP static void emit_vlso(ASMState *as, ARMIns ai, Reg rd, Reg rn, int32_t ofs) { lua_assert(ofs >= -1020 && ofs <= 1020 && (ofs&3) == 0); if (ofs < 0) ofs = -ofs; else ai |= ARMI_LS_U; *--as->mcp = ai | ARMI_LS_P | ARMF_D(rd & 15) | ARMF_N(rn) | (ofs >> 2); } #endif /* -- Emit loads/stores --------------------------------------------------- */ /* Prefer spills of BASE/L. */ #define emit_canremat(ref) ((ref) < ASMREF_L) /* Try to find a one step delta relative to another constant. */ static int emit_kdelta1(ASMState *as, Reg d, int32_t i) { RegSet work = ~as->freeset & RSET_GPR; while (work) { Reg r = rset_picktop(work); IRRef ref = regcost_ref(as->cost[r]); lua_assert(r != d); if (emit_canremat(ref)) { int32_t delta = i - (ra_iskref(ref) ? ra_krefk(as, ref) : IR(ref)->i); uint32_t k = emit_isk12(ARMI_ADD, delta); if (k) { if (k == ARMI_K12) emit_dm(as, ARMI_MOV, d, r); else emit_dn(as, ARMI_ADD^k, d, r); return 1; } } rset_clear(work, r); } return 0; /* Failed. */ } /* Try to find a two step delta relative to another constant. */ static int emit_kdelta2(ASMState *as, Reg d, int32_t i) { RegSet work = ~as->freeset & RSET_GPR; while (work) { Reg r = rset_picktop(work); IRRef ref = regcost_ref(as->cost[r]); lua_assert(r != d); if (emit_canremat(ref)) { int32_t other = ra_iskref(ref) ? ra_krefk(as, ref) : IR(ref)->i; if (other) { int32_t delta = i - other; uint32_t sh, inv = 0, k2, k; if (delta < 0) { delta = -delta; inv = ARMI_ADD^ARMI_SUB; } sh = lj_ffs(delta) & ~1; k2 = emit_isk12(0, delta & (255 << sh)); k = emit_isk12(0, delta & ~(255 << sh)); if (k) { emit_dn(as, ARMI_ADD^k2^inv, d, d); emit_dn(as, ARMI_ADD^k^inv, d, r); return 1; } } } rset_clear(work, r); } return 0; /* Failed. */ } /* Load a 32 bit constant into a GPR. */ static void emit_loadi(ASMState *as, Reg r, int32_t i) { uint32_t k = emit_isk12(ARMI_MOV, i); lua_assert(rset_test(as->freeset, r) || r == RID_TMP); if (k) { /* Standard K12 constant. */ emit_d(as, ARMI_MOV^k, r); } else if ((as->flags & JIT_F_ARMV6T2) && (uint32_t)i < 0x00010000u) { /* 16 bit loword constant for ARMv6T2. */ emit_d(as, ARMI_MOVW|(i & 0x0fff)|((i & 0xf000)<<4), r); } else if (emit_kdelta1(as, r, i)) { /* One step delta relative to another constant. */ } else if ((as->flags & JIT_F_ARMV6T2)) { /* 32 bit hiword/loword constant for ARMv6T2. */ emit_d(as, ARMI_MOVT|((i>>16) & 0x0fff)|(((i>>16) & 0xf000)<<4), r); emit_d(as, ARMI_MOVW|(i & 0x0fff)|((i & 0xf000)<<4), r); } else if (emit_kdelta2(as, r, i)) { /* Two step delta relative to another constant. */ } else { /* Otherwise construct the constant with up to 4 instructions. */ /* NYI: use mvn+bic, use pc-relative loads. */ for (;;) { uint32_t sh = lj_ffs(i) & ~1; int32_t m = i & (255 << sh); i &= ~(255 << sh); if (i == 0) { emit_d(as, ARMI_MOV ^ emit_isk12(0, m), r); break; } emit_dn(as, ARMI_ORR ^ emit_isk12(0, m), r, r); } } } #define emit_loada(as, r, addr) emit_loadi(as, (r), i32ptr((addr))) static Reg ra_allock(ASMState *as, int32_t k, RegSet allow); /* Get/set from constant pointer. */ static void emit_lsptr(ASMState *as, ARMIns ai, Reg r, void *p) { int32_t i = i32ptr(p); emit_lso(as, ai, r, ra_allock(as, (i & ~4095), rset_exclude(RSET_GPR, r)), (i & 4095)); } #if !LJ_SOFTFP /* Load a number constant into an FPR. */ static void emit_loadn(ASMState *as, Reg r, cTValue *tv) { int32_t i; if ((as->flags & JIT_F_VFPV3) && !tv->u32.lo) { uint32_t hi = tv->u32.hi; uint32_t b = ((hi >> 22) & 0x1ff); if (!(hi & 0xffff) && (b == 0x100 || b == 0x0ff)) { *--as->mcp = ARMI_VMOVI_D | ARMF_D(r & 15) | ((tv->u32.hi >> 12) & 0x00080000) | ((tv->u32.hi >> 4) & 0x00070000) | ((tv->u32.hi >> 16) & 0x0000000f); return; } } i = i32ptr(tv); emit_vlso(as, ARMI_VLDR_D, r, ra_allock(as, (i & ~1020), RSET_GPR), (i & 1020)); } #endif /* Get/set global_State fields. */ #define emit_getgl(as, r, field) \ emit_lsptr(as, ARMI_LDR, (r), (void *)&J2G(as->J)->field) #define emit_setgl(as, r, field) \ emit_lsptr(as, ARMI_STR, (r), (void *)&J2G(as->J)->field) /* Trace number is determined from pc of exit instruction. */ #define emit_setvmstate(as, i) UNUSED(i) /* -- Emit control-flow instructions -------------------------------------- */ /* Label for internal jumps. */ typedef MCode *MCLabel; /* Return label pointing to current PC. */ #define emit_label(as) ((as)->mcp) static void emit_branch(ASMState *as, ARMIns ai, MCode *target) { MCode *p = as->mcp; ptrdiff_t delta = (target - p) - 1; lua_assert(((delta + 0x00800000) >> 24) == 0); *--p = ai | ((uint32_t)delta & 0x00ffffffu); as->mcp = p; } #define emit_jmp(as, target) emit_branch(as, ARMI_B, (target)) static void emit_call(ASMState *as, void *target) { MCode *p = --as->mcp; ptrdiff_t delta = ((char *)target - (char *)p) - 8; if ((((delta>>2) + 0x00800000) >> 24) == 0) { if ((delta & 1)) *p = ARMI_BLX | ((uint32_t)(delta>>2) & 0x00ffffffu) | ((delta&2) << 27); else *p = ARMI_BL | ((uint32_t)(delta>>2) & 0x00ffffffu); } else { /* Target out of range: need indirect call. But don't use R0-R3. */ Reg r = ra_allock(as, i32ptr(target), RSET_RANGE(RID_R4, RID_R12+1)); *p = ARMI_BLXr | ARMF_M(r); } } /* -- Emit generic operations --------------------------------------------- */ /* Generic move between two regs. */ static void emit_movrr(ASMState *as, IRIns *ir, Reg dst, Reg src) { #if LJ_SOFTFP lua_assert(!irt_isnum(ir->t)); UNUSED(ir); #else if (dst >= RID_MAX_GPR) { emit_dm(as, irt_isnum(ir->t) ? ARMI_VMOV_D : ARMI_VMOV_S, (dst & 15), (src & 15)); return; } #endif if (as->mcp != as->mcloop) { /* Swap early registers for loads/stores. */ MCode ins = *as->mcp, swp = (src^dst); if ((ins & 0x0c000000) == 0x04000000 && (ins & 0x02000010) != 0x02000010) { if (!((ins ^ (dst << 16)) & 0x000f0000)) *as->mcp = ins ^ (swp << 16); /* Swap N in load/store. */ if (!(ins & 0x00100000) && !((ins ^ (dst << 12)) & 0x0000f000)) *as->mcp = ins ^ (swp << 12); /* Swap D in store. */ } } emit_dm(as, ARMI_MOV, dst, src); } /* Generic load of register from stack slot. */ static void emit_spload(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { #if LJ_SOFTFP lua_assert(!irt_isnum(ir->t)); UNUSED(ir); #else if (r >= RID_MAX_GPR) emit_vlso(as, irt_isnum(ir->t) ? ARMI_VLDR_D : ARMI_VLDR_S, r, RID_SP, ofs); else #endif emit_lso(as, ARMI_LDR, r, RID_SP, ofs); } /* Generic store of register to stack slot. */ static void emit_spstore(ASMState *as, IRIns *ir, Reg r, int32_t ofs) { #if LJ_SOFTFP lua_assert(!irt_isnum(ir->t)); UNUSED(ir); #else if (r >= RID_MAX_GPR) emit_vlso(as, irt_isnum(ir->t) ? ARMI_VSTR_D : ARMI_VSTR_S, r, RID_SP, ofs); else #endif emit_lso(as, ARMI_STR, r, RID_SP, ofs); } /* Emit an arithmetic/logic operation with a constant operand. */ static void emit_opk(ASMState *as, ARMIns ai, Reg dest, Reg src, int32_t i, RegSet allow) { uint32_t k = emit_isk12(ai, i); if (k) emit_dn(as, ai^k, dest, src); else emit_dnm(as, ai, dest, src, ra_allock(as, i, allow)); } /* Add offset to pointer. */ static void emit_addptr(ASMState *as, Reg r, int32_t ofs) { if (ofs) emit_opk(as, ARMI_ADD, r, r, ofs, rset_exclude(RSET_GPR, r)); } #define emit_spsub(as, ofs) emit_addptr(as, RID_SP, -(ofs)) wcc-0.0.2/src/wsh/luajit-2.0/src/.gitignore0000644000175000017500000000011213122010155016653 0ustar philphilluajit lj_bcdef.h lj_ffdef.h lj_libdef.h lj_recdef.h lj_folddef.h lj_vm.s wcc-0.0.2/src/wsh/luajit-2.0/src/lj_strscan.h0000644000175000017500000000210013122010155017175 0ustar philphil/* ** String scanning. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_STRSCAN_H #define _LJ_STRSCAN_H #include "lj_obj.h" /* Options for accepted/returned formats. */ #define STRSCAN_OPT_TOINT 0x01 /* Convert to int32_t, if possible. */ #define STRSCAN_OPT_TONUM 0x02 /* Always convert to double. */ #define STRSCAN_OPT_IMAG 0x04 #define STRSCAN_OPT_LL 0x08 #define STRSCAN_OPT_C 0x10 /* Returned format. */ typedef enum { STRSCAN_ERROR, STRSCAN_NUM, STRSCAN_IMAG, STRSCAN_INT, STRSCAN_U32, STRSCAN_I64, STRSCAN_U64, } StrScanFmt; LJ_FUNC StrScanFmt lj_strscan_scan(const uint8_t *p, TValue *o, uint32_t opt); LJ_FUNC int LJ_FASTCALL lj_strscan_num(GCstr *str, TValue *o); #if LJ_DUALNUM LJ_FUNC int LJ_FASTCALL lj_strscan_number(GCstr *str, TValue *o); #else #define lj_strscan_number(s, o) lj_strscan_num((s), (o)) #endif /* Check for number or convert string to number/int in-place (!). */ static LJ_AINLINE int lj_strscan_numberobj(TValue *o) { return tvisnumber(o) || (tvisstr(o) && lj_strscan_number(strV(o), o)); } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lib_aux.c0000644000175000017500000002136513122010155016467 0ustar philphil/* ** Auxiliary library for the Lua/C API. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major parts taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #include #include #include #define lib_aux_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lj_obj.h" #include "lj_err.h" #include "lj_state.h" #include "lj_trace.h" #include "lj_lib.h" #if LJ_TARGET_POSIX #include #endif /* -- I/O error handling -------------------------------------------------- */ LUALIB_API int luaL_fileresult(lua_State *L, int stat, const char *fname) { if (stat) { setboolV(L->top++, 1); return 1; } else { int en = errno; /* Lua API calls may change this value. */ setnilV(L->top++); if (fname) lua_pushfstring(L, "%s: %s", fname, strerror(en)); else lua_pushfstring(L, "%s", strerror(en)); setintV(L->top++, en); lj_trace_abort(G(L)); return 3; } } LUALIB_API int luaL_execresult(lua_State *L, int stat) { if (stat != -1) { #if LJ_TARGET_POSIX if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); setnilV(L->top++); lua_pushliteral(L, "signal"); } else { if (WIFEXITED(stat)) stat = WEXITSTATUS(stat); if (stat == 0) setboolV(L->top++, 1); else setnilV(L->top++); lua_pushliteral(L, "exit"); } #else if (stat == 0) setboolV(L->top++, 1); else setnilV(L->top++); lua_pushliteral(L, "exit"); #endif setintV(L->top++, stat); return 3; } return luaL_fileresult(L, 0, NULL); } /* -- Module registration ------------------------------------------------- */ LUALIB_API const char *luaL_findtable(lua_State *L, int idx, const char *fname, int szhint) { const char *e; lua_pushvalue(L, idx); do { e = strchr(fname, '.'); if (e == NULL) e = fname + strlen(fname); lua_pushlstring(L, fname, (size_t)(e - fname)); lua_rawget(L, -2); if (lua_isnil(L, -1)) { /* no such field? */ lua_pop(L, 1); /* remove this nil */ lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */ lua_pushlstring(L, fname, (size_t)(e - fname)); lua_pushvalue(L, -2); lua_settable(L, -4); /* set new table into field */ } else if (!lua_istable(L, -1)) { /* field has a non-table value? */ lua_pop(L, 2); /* remove table and value */ return fname; /* return problematic part of the name */ } lua_remove(L, -2); /* remove previous table */ fname = e + 1; } while (*e == '.'); return NULL; } static int libsize(const luaL_Reg *l) { int size = 0; for (; l->name; l++) size++; return size; } LUALIB_API void luaL_openlib(lua_State *L, const char *libname, const luaL_Reg *l, int nup) { lj_lib_checkfpu(L); if (libname) { int size = libsize(l); /* check whether lib already exists */ luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 16); lua_getfield(L, -1, libname); /* get _LOADED[libname] */ if (!lua_istable(L, -1)) { /* not found? */ lua_pop(L, 1); /* remove previous result */ /* try global variable (and create one if it does not exist) */ if (luaL_findtable(L, LUA_GLOBALSINDEX, libname, size) != NULL) lj_err_callerv(L, LJ_ERR_BADMODN, libname); lua_pushvalue(L, -1); lua_setfield(L, -3, libname); /* _LOADED[libname] = new table */ } lua_remove(L, -2); /* remove _LOADED table */ lua_insert(L, -(nup+1)); /* move library table to below upvalues */ } for (; l->name; l++) { int i; for (i = 0; i < nup; i++) /* copy upvalues to the top */ lua_pushvalue(L, -nup); lua_pushcclosure(L, l->func, nup); lua_setfield(L, -(nup+2), l->name); } lua_pop(L, nup); /* remove upvalues */ } LUALIB_API void luaL_register(lua_State *L, const char *libname, const luaL_Reg *l) { luaL_openlib(L, libname, l, 0); } LUALIB_API const char *luaL_gsub(lua_State *L, const char *s, const char *p, const char *r) { const char *wild; size_t l = strlen(p); luaL_Buffer b; luaL_buffinit(L, &b); while ((wild = strstr(s, p)) != NULL) { luaL_addlstring(&b, s, (size_t)(wild - s)); /* push prefix */ luaL_addstring(&b, r); /* push replacement in place of pattern */ s = wild + l; /* continue after `p' */ } luaL_addstring(&b, s); /* push last suffix */ luaL_pushresult(&b); return lua_tostring(L, -1); } /* -- Buffer handling ----------------------------------------------------- */ #define bufflen(B) ((size_t)((B)->p - (B)->buffer)) #define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B))) static int emptybuffer(luaL_Buffer *B) { size_t l = bufflen(B); if (l == 0) return 0; /* put nothing on stack */ lua_pushlstring(B->L, B->buffer, l); B->p = B->buffer; B->lvl++; return 1; } static void adjuststack(luaL_Buffer *B) { if (B->lvl > 1) { lua_State *L = B->L; int toget = 1; /* number of levels to concat */ size_t toplen = lua_strlen(L, -1); do { size_t l = lua_strlen(L, -(toget+1)); if (!(B->lvl - toget + 1 >= LUA_MINSTACK/2 || toplen > l)) break; toplen += l; toget++; } while (toget < B->lvl); lua_concat(L, toget); B->lvl = B->lvl - toget + 1; } } LUALIB_API char *luaL_prepbuffer(luaL_Buffer *B) { if (emptybuffer(B)) adjuststack(B); return B->buffer; } LUALIB_API void luaL_addlstring(luaL_Buffer *B, const char *s, size_t l) { while (l--) luaL_addchar(B, *s++); } LUALIB_API void luaL_addstring(luaL_Buffer *B, const char *s) { luaL_addlstring(B, s, strlen(s)); } LUALIB_API void luaL_pushresult(luaL_Buffer *B) { emptybuffer(B); lua_concat(B->L, B->lvl); B->lvl = 1; } LUALIB_API void luaL_addvalue(luaL_Buffer *B) { lua_State *L = B->L; size_t vl; const char *s = lua_tolstring(L, -1, &vl); if (vl <= bufffree(B)) { /* fit into buffer? */ memcpy(B->p, s, vl); /* put it there */ B->p += vl; lua_pop(L, 1); /* remove from stack */ } else { if (emptybuffer(B)) lua_insert(L, -2); /* put buffer before new value */ B->lvl++; /* add new value into B stack */ adjuststack(B); } } LUALIB_API void luaL_buffinit(lua_State *L, luaL_Buffer *B) { B->L = L; B->p = B->buffer; B->lvl = 0; } /* -- Reference management ------------------------------------------------ */ #define FREELIST_REF 0 /* Convert a stack index to an absolute index. */ #define abs_index(L, i) \ ((i) > 0 || (i) <= LUA_REGISTRYINDEX ? (i) : lua_gettop(L) + (i) + 1) LUALIB_API int luaL_ref(lua_State *L, int t) { int ref; t = abs_index(L, t); if (lua_isnil(L, -1)) { lua_pop(L, 1); /* remove from stack */ return LUA_REFNIL; /* `nil' has a unique fixed reference */ } lua_rawgeti(L, t, FREELIST_REF); /* get first free element */ ref = (int)lua_tointeger(L, -1); /* ref = t[FREELIST_REF] */ lua_pop(L, 1); /* remove it from stack */ if (ref != 0) { /* any free element? */ lua_rawgeti(L, t, ref); /* remove it from list */ lua_rawseti(L, t, FREELIST_REF); /* (t[FREELIST_REF] = t[ref]) */ } else { /* no free elements */ ref = (int)lua_objlen(L, t); ref++; /* create new reference */ } lua_rawseti(L, t, ref); return ref; } LUALIB_API void luaL_unref(lua_State *L, int t, int ref) { if (ref >= 0) { t = abs_index(L, t); lua_rawgeti(L, t, FREELIST_REF); lua_rawseti(L, t, ref); /* t[ref] = t[FREELIST_REF] */ lua_pushinteger(L, ref); lua_rawseti(L, t, FREELIST_REF); /* t[FREELIST_REF] = ref */ } } /* -- Default allocator and panic function -------------------------------- */ static int panic(lua_State *L) { const char *s = lua_tostring(L, -1); fputs("PANIC: unprotected error in call to Lua API (", stderr); fputs(s ? s : "?", stderr); fputc(')', stderr); fputc('\n', stderr); fflush(stderr); return 0; } #ifdef LUAJIT_USE_SYSMALLOC #if LJ_64 && !defined(LUAJIT_USE_VALGRIND) #error "Must use builtin allocator for 64 bit target" #endif static void *mem_alloc(void *ud, void *ptr, size_t osize, size_t nsize) { (void)ud; (void)osize; if (nsize == 0) { free(ptr); return NULL; } else { return realloc(ptr, nsize); } } LUALIB_API lua_State *luaL_newstate(void) { lua_State *L = lua_newstate(mem_alloc, NULL); if (L) G(L)->panic = panic; return L; } #else #include "lj_alloc.h" LUALIB_API lua_State *luaL_newstate(void) { lua_State *L; void *ud = lj_alloc_create(); if (ud == NULL) return NULL; #if LJ_64 L = lj_state_newstate(lj_alloc_f, ud); #else L = lua_newstate(lj_alloc_f, ud); #endif if (L) G(L)->panic = panic; return L; } #if LJ_64 LUA_API lua_State *lua_newstate(lua_Alloc f, void *ud) { UNUSED(f); UNUSED(ud); fputs("Must use luaL_newstate() for 64 bit target\n", stderr); return NULL; } #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_cdata.h0000644000175000017500000000403713122010155016607 0ustar philphil/* ** C data management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CDATA_H #define _LJ_CDATA_H #include "lj_obj.h" #include "lj_gc.h" #include "lj_ctype.h" #if LJ_HASFFI /* Get C data pointer. */ static LJ_AINLINE void *cdata_getptr(void *p, CTSize sz) { if (LJ_64 && sz == 4) { /* Support 32 bit pointers on 64 bit targets. */ return ((void *)(uintptr_t)*(uint32_t *)p); } else { lua_assert(sz == CTSIZE_PTR); return *(void **)p; } } /* Set C data pointer. */ static LJ_AINLINE void cdata_setptr(void *p, CTSize sz, const void *v) { if (LJ_64 && sz == 4) { /* Support 32 bit pointers on 64 bit targets. */ *(uint32_t *)p = (uint32_t)(uintptr_t)v; } else { lua_assert(sz == CTSIZE_PTR); *(void **)p = (void *)v; } } /* Allocate fixed-size C data object. */ static LJ_AINLINE GCcdata *lj_cdata_new(CTState *cts, CTypeID id, CTSize sz) { GCcdata *cd; #ifdef LUA_USE_ASSERT CType *ct = ctype_raw(cts, id); lua_assert((ctype_hassize(ct->info) ? ct->size : CTSIZE_PTR) == sz); #endif cd = (GCcdata *)lj_mem_newgco(cts->L, sizeof(GCcdata) + sz); cd->gct = ~LJ_TCDATA; cd->ctypeid = ctype_check(cts, id); return cd; } /* Variant which works without a valid CTState. */ static LJ_AINLINE GCcdata *lj_cdata_new_(lua_State *L, CTypeID id, CTSize sz) { GCcdata *cd = (GCcdata *)lj_mem_newgco(L, sizeof(GCcdata) + sz); cd->gct = ~LJ_TCDATA; cd->ctypeid = id; return cd; } LJ_FUNC GCcdata *lj_cdata_newref(CTState *cts, const void *pp, CTypeID id); LJ_FUNC GCcdata *lj_cdata_newv(CTState *cts, CTypeID id, CTSize sz, CTSize align); LJ_FUNC void LJ_FASTCALL lj_cdata_free(global_State *g, GCcdata *cd); LJ_FUNCA TValue * LJ_FASTCALL lj_cdata_setfin(lua_State *L, GCcdata *cd); LJ_FUNC CType *lj_cdata_index(CTState *cts, GCcdata *cd, cTValue *key, uint8_t **pp, CTInfo *qual); LJ_FUNC int lj_cdata_get(CTState *cts, CType *s, TValue *o, uint8_t *sp); LJ_FUNC void lj_cdata_set(CTState *cts, CType *d, uint8_t *dp, TValue *o, CTInfo qual); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_meta.c0000644000175000017500000003415613122010155016461 0ustar philphil/* ** Metamethod handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_meta_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_meta.h" #include "lj_frame.h" #include "lj_bc.h" #include "lj_vm.h" #include "lj_strscan.h" /* -- Metamethod handling ------------------------------------------------- */ /* String interning of metamethod names for fast indexing. */ void lj_meta_init(lua_State *L) { #define MMNAME(name) "__" #name const char *metanames = MMDEF(MMNAME); #undef MMNAME global_State *g = G(L); const char *p, *q; uint32_t mm; for (mm = 0, p = metanames; *p; mm++, p = q) { GCstr *s; for (q = p+2; *q && *q != '_'; q++) ; s = lj_str_new(L, p, (size_t)(q-p)); /* NOBARRIER: g->gcroot[] is a GC root. */ setgcref(g->gcroot[GCROOT_MMNAME+mm], obj2gco(s)); } } /* Negative caching of a few fast metamethods. See the lj_meta_fast() macro. */ cTValue *lj_meta_cache(GCtab *mt, MMS mm, GCstr *name) { cTValue *mo = lj_tab_getstr(mt, name); lua_assert(mm <= MM_FAST); if (!mo || tvisnil(mo)) { /* No metamethod? */ mt->nomm |= (uint8_t)(1u<metatable); else if (tvisudata(o)) mt = tabref(udataV(o)->metatable); else mt = tabref(basemt_obj(G(L), o)); if (mt) { cTValue *mo = lj_tab_getstr(mt, mmname_str(G(L), mm)); if (mo) return mo; } return niltv(L); } #if LJ_HASFFI /* Tailcall from C function. */ int lj_meta_tailcall(lua_State *L, cTValue *tv) { TValue *base = L->base; TValue *top = L->top; const BCIns *pc = frame_pc(base-1); /* Preserve old PC from frame. */ copyTV(L, base-1, tv); /* Replace frame with new object. */ top->u32.lo = LJ_CONT_TAILCALL; setframe_pc(top, pc); setframe_gc(top+1, obj2gco(L)); /* Dummy frame object. */ setframe_ftsz(top+1, (int)((char *)(top+2) - (char *)base) + FRAME_CONT); L->base = L->top = top+2; /* ** before: [old_mo|PC] [... ...] ** ^base ^top ** after: [new_mo|itype] [... ...] [NULL|PC] [dummy|delta] ** ^base/top ** tailcall: [new_mo|PC] [... ...] ** ^base ^top */ return 0; } #endif /* Setup call to metamethod to be run by Assembler VM. */ static TValue *mmcall(lua_State *L, ASMFunction cont, cTValue *mo, cTValue *a, cTValue *b) { /* ** |-- framesize -> top top+1 top+2 top+3 ** before: [func slots ...] ** mm setup: [func slots ...] [cont|?] [mo|tmtype] [a] [b] ** in asm: [func slots ...] [cont|PC] [mo|delta] [a] [b] ** ^-- func base ^-- mm base ** after mm: [func slots ...] [result] ** ^-- copy to base[PC_RA] --/ for lj_cont_ra ** istruecond + branch for lj_cont_cond* ** ignore for lj_cont_nop ** next PC: [func slots ...] */ TValue *top = L->top; if (curr_funcisL(L)) top = curr_topL(L); setcont(top, cont); /* Assembler VM stores PC in upper word. */ copyTV(L, top+1, mo); /* Store metamethod and two arguments. */ copyTV(L, top+2, a); copyTV(L, top+3, b); return top+2; /* Return new base. */ } /* -- C helpers for some instructions, called from assembler VM ----------- */ /* Helper for TGET*. __index chain and metamethod. */ cTValue *lj_meta_tget(lua_State *L, cTValue *o, cTValue *k) { int loop; for (loop = 0; loop < LJ_MAX_IDXCHAIN; loop++) { cTValue *mo; if (LJ_LIKELY(tvistab(o))) { GCtab *t = tabV(o); cTValue *tv = lj_tab_get(L, t, k); if (!tvisnil(tv) || !(mo = lj_meta_fast(L, tabref(t->metatable), MM_index))) return tv; } else if (tvisnil(mo = lj_meta_lookup(L, o, MM_index))) { lj_err_optype(L, o, LJ_ERR_OPINDEX); return NULL; /* unreachable */ } if (tvisfunc(mo)) { L->top = mmcall(L, lj_cont_ra, mo, o, k); return NULL; /* Trigger metamethod call. */ } o = mo; } lj_err_msg(L, LJ_ERR_GETLOOP); return NULL; /* unreachable */ } /* Helper for TSET*. __newindex chain and metamethod. */ TValue *lj_meta_tset(lua_State *L, cTValue *o, cTValue *k) { TValue tmp; int loop; for (loop = 0; loop < LJ_MAX_IDXCHAIN; loop++) { cTValue *mo; if (LJ_LIKELY(tvistab(o))) { GCtab *t = tabV(o); cTValue *tv = lj_tab_get(L, t, k); if (LJ_LIKELY(!tvisnil(tv))) { t->nomm = 0; /* Invalidate negative metamethod cache. */ lj_gc_anybarriert(L, t); return (TValue *)tv; } else if (!(mo = lj_meta_fast(L, tabref(t->metatable), MM_newindex))) { t->nomm = 0; /* Invalidate negative metamethod cache. */ lj_gc_anybarriert(L, t); if (tv != niltv(L)) return (TValue *)tv; if (tvisnil(k)) lj_err_msg(L, LJ_ERR_NILIDX); else if (tvisint(k)) { setnumV(&tmp, (lua_Number)intV(k)); k = &tmp; } else if (tvisnum(k) && tvisnan(k)) lj_err_msg(L, LJ_ERR_NANIDX); return lj_tab_newkey(L, t, k); } } else if (tvisnil(mo = lj_meta_lookup(L, o, MM_newindex))) { lj_err_optype(L, o, LJ_ERR_OPINDEX); return NULL; /* unreachable */ } if (tvisfunc(mo)) { L->top = mmcall(L, lj_cont_nop, mo, o, k); /* L->top+2 = v filled in by caller. */ return NULL; /* Trigger metamethod call. */ } copyTV(L, &tmp, mo); o = &tmp; } lj_err_msg(L, LJ_ERR_SETLOOP); return NULL; /* unreachable */ } static cTValue *str2num(cTValue *o, TValue *n) { if (tvisnum(o)) return o; else if (tvisint(o)) return (setnumV(n, (lua_Number)intV(o)), n); else if (tvisstr(o) && lj_strscan_num(strV(o), n)) return n; else return NULL; } /* Helper for arithmetic instructions. Coercion, metamethod. */ TValue *lj_meta_arith(lua_State *L, TValue *ra, cTValue *rb, cTValue *rc, BCReg op) { MMS mm = bcmode_mm(op); TValue tempb, tempc; cTValue *b, *c; if ((b = str2num(rb, &tempb)) != NULL && (c = str2num(rc, &tempc)) != NULL) { /* Try coercion first. */ setnumV(ra, lj_vm_foldarith(numV(b), numV(c), (int)mm-MM_add)); return NULL; } else { cTValue *mo = lj_meta_lookup(L, rb, mm); if (tvisnil(mo)) { mo = lj_meta_lookup(L, rc, mm); if (tvisnil(mo)) { if (str2num(rb, &tempb) == NULL) rc = rb; lj_err_optype(L, rc, LJ_ERR_OPARITH); return NULL; /* unreachable */ } } return mmcall(L, lj_cont_ra, mo, rb, rc); } } /* In-place coercion of a number to a string. */ static LJ_AINLINE int tostring(lua_State *L, TValue *o) { if (tvisstr(o)) { return 1; } else if (tvisnumber(o)) { setstrV(L, o, lj_str_fromnumber(L, o)); return 1; } else { return 0; } } /* Helper for CAT. Coercion, iterative concat, __concat metamethod. */ TValue *lj_meta_cat(lua_State *L, TValue *top, int left) { int fromc = 0; if (left < 0) { left = -left; fromc = 1; } do { int n = 1; if (!(tvisstr(top-1) || tvisnumber(top-1)) || !tostring(L, top)) { cTValue *mo = lj_meta_lookup(L, top-1, MM_concat); if (tvisnil(mo)) { mo = lj_meta_lookup(L, top, MM_concat); if (tvisnil(mo)) { if (tvisstr(top-1) || tvisnumber(top-1)) top++; lj_err_optype(L, top-1, LJ_ERR_OPCAT); return NULL; /* unreachable */ } } /* One of the top two elements is not a string, call __cat metamethod: ** ** before: [...][CAT stack .........................] ** top-1 top top+1 top+2 ** pick two: [...][CAT stack ...] [o1] [o2] ** setup mm: [...][CAT stack ...] [cont|?] [mo|tmtype] [o1] [o2] ** in asm: [...][CAT stack ...] [cont|PC] [mo|delta] [o1] [o2] ** ^-- func base ^-- mm base ** after mm: [...][CAT stack ...] <--push-- [result] ** next step: [...][CAT stack .............] */ copyTV(L, top+2, top); /* Careful with the order of stack copies! */ copyTV(L, top+1, top-1); copyTV(L, top, mo); setcont(top-1, lj_cont_cat); return top+1; /* Trigger metamethod call. */ } else if (strV(top)->len == 0) { /* Shortcut. */ (void)tostring(L, top-1); } else { /* Pick as many strings as possible from the top and concatenate them: ** ** before: [...][CAT stack ...........................] ** pick str: [...][CAT stack ...] [...... strings ......] ** concat: [...][CAT stack ...] [result] ** next step: [...][CAT stack ............] */ MSize tlen = strV(top)->len; char *buffer; int i; for (n = 1; n <= left && tostring(L, top-n); n++) { MSize len = strV(top-n)->len; if (len >= LJ_MAX_STR - tlen) lj_err_msg(L, LJ_ERR_STROV); tlen += len; } buffer = lj_str_needbuf(L, &G(L)->tmpbuf, tlen); n--; tlen = 0; for (i = n; i >= 0; i--) { MSize len = strV(top-i)->len; memcpy(buffer + tlen, strVdata(top-i), len); tlen += len; } setstrV(L, top-n, lj_str_new(L, buffer, tlen)); } left -= n; top -= n; } while (left >= 1); if (LJ_UNLIKELY(G(L)->gc.total >= G(L)->gc.threshold)) { if (!fromc) L->top = curr_topL(L); lj_gc_step(L); } return NULL; } /* Helper for LEN. __len metamethod. */ TValue * LJ_FASTCALL lj_meta_len(lua_State *L, cTValue *o) { cTValue *mo = lj_meta_lookup(L, o, MM_len); if (tvisnil(mo)) { if (LJ_52 && tvistab(o)) tabref(tabV(o)->metatable)->nomm |= (uint8_t)(1u<gch.metatable), MM_eq); if (mo) { TValue *top; uint32_t it; if (tabref(o1->gch.metatable) != tabref(o2->gch.metatable)) { cTValue *mo2 = lj_meta_fast(L, tabref(o2->gch.metatable), MM_eq); if (mo2 == NULL || !lj_obj_equal(mo, mo2)) return (TValue *)(intptr_t)ne; } top = curr_top(L); setcont(top, ne ? lj_cont_condf : lj_cont_condt); copyTV(L, top+1, mo); it = ~(uint32_t)o1->gch.gct; setgcV(L, top+2, o1, it); setgcV(L, top+3, o2, it); return top+2; /* Trigger metamethod call. */ } return (TValue *)(intptr_t)ne; } #if LJ_HASFFI TValue * LJ_FASTCALL lj_meta_equal_cd(lua_State *L, BCIns ins) { ASMFunction cont = (bc_op(ins) & 1) ? lj_cont_condf : lj_cont_condt; int op = (int)bc_op(ins) & ~1; TValue tv; cTValue *mo, *o2, *o1 = &L->base[bc_a(ins)]; cTValue *o1mm = o1; if (op == BC_ISEQV) { o2 = &L->base[bc_d(ins)]; if (!tviscdata(o1mm)) o1mm = o2; } else if (op == BC_ISEQS) { setstrV(L, &tv, gco2str(proto_kgc(curr_proto(L), ~(ptrdiff_t)bc_d(ins)))); o2 = &tv; } else if (op == BC_ISEQN) { o2 = &mref(curr_proto(L)->k, cTValue)[bc_d(ins)]; } else { lua_assert(op == BC_ISEQP); setitype(&tv, ~bc_d(ins)); o2 = &tv; } mo = lj_meta_lookup(L, o1mm, MM_eq); if (LJ_LIKELY(!tvisnil(mo))) return mmcall(L, cont, mo, o1, o2); else return (TValue *)(intptr_t)(bc_op(ins) & 1); } #endif /* Helper for ordered comparisons. String compare, __lt/__le metamethods. */ TValue *lj_meta_comp(lua_State *L, cTValue *o1, cTValue *o2, int op) { if (LJ_HASFFI && (tviscdata(o1) || tviscdata(o2))) { ASMFunction cont = (op & 1) ? lj_cont_condf : lj_cont_condt; MMS mm = (op & 2) ? MM_le : MM_lt; cTValue *mo = lj_meta_lookup(L, tviscdata(o1) ? o1 : o2, mm); if (LJ_UNLIKELY(tvisnil(mo))) goto err; return mmcall(L, cont, mo, o1, o2); } else if (LJ_52 || itype(o1) == itype(o2)) { /* Never called with two numbers. */ if (tvisstr(o1) && tvisstr(o2)) { int32_t res = lj_str_cmp(strV(o1), strV(o2)); return (TValue *)(intptr_t)(((op&2) ? res <= 0 : res < 0) ^ (op&1)); } else { trymt: while (1) { ASMFunction cont = (op & 1) ? lj_cont_condf : lj_cont_condt; MMS mm = (op & 2) ? MM_le : MM_lt; cTValue *mo = lj_meta_lookup(L, o1, mm); #if LJ_52 if (tvisnil(mo) && tvisnil((mo = lj_meta_lookup(L, o2, mm)))) #else cTValue *mo2 = lj_meta_lookup(L, o2, mm); if (tvisnil(mo) || !lj_obj_equal(mo, mo2)) #endif { if (op & 2) { /* MM_le not found: retry with MM_lt. */ cTValue *ot = o1; o1 = o2; o2 = ot; /* Swap operands. */ op ^= 3; /* Use LT and flip condition. */ continue; } goto err; } return mmcall(L, cont, mo, o1, o2); } } } else if (tvisbool(o1) && tvisbool(o2)) { goto trymt; } else { err: lj_err_comp(L, o1, o2); return NULL; } } /* Helper for calls. __call metamethod. */ void lj_meta_call(lua_State *L, TValue *func, TValue *top) { cTValue *mo = lj_meta_lookup(L, func, MM_call); TValue *p; if (!tvisfunc(mo)) lj_err_optype_call(L, func); for (p = top; p > func; p--) copyTV(L, p, p-1); copyTV(L, func, mo); } /* Helper for FORI. Coercion. */ void LJ_FASTCALL lj_meta_for(lua_State *L, TValue *o) { if (!lj_strscan_numberobj(o)) lj_err_msg(L, LJ_ERR_FORINIT); if (!lj_strscan_numberobj(o+1)) lj_err_msg(L, LJ_ERR_FORLIM); if (!lj_strscan_numberobj(o+2)) lj_err_msg(L, LJ_ERR_FORSTEP); if (LJ_DUALNUM) { /* Ensure all slots are integers or all slots are numbers. */ int32_t k[3]; int nint = 0; ptrdiff_t i; for (i = 0; i <= 2; i++) { if (tvisint(o+i)) { k[i] = intV(o+i); nint++; } else { k[i] = lj_num2int(numV(o+i)); nint += ((lua_Number)k[i] == numV(o+i)); } } if (nint == 3) { /* Narrow to integers. */ setintV(o, k[0]); setintV(o+1, k[1]); setintV(o+2, k[2]); } else if (nint != 0) { /* Widen to numbers. */ if (tvisint(o)) setnumV(o, (lua_Number)intV(o)); if (tvisint(o+1)) setnumV(o+1, (lua_Number)intV(o+1)); if (tvisint(o+2)) setnumV(o+2, (lua_Number)intV(o+2)); } } } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_asm_x86.h0000644000175000017500000030010613122010155017014 0ustar philphil/* ** x86/x64 IR assembler (SSA IR -> machine code). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* -- Guard handling ------------------------------------------------------ */ /* Generate an exit stub group at the bottom of the reserved MCode memory. */ static MCode *asm_exitstub_gen(ASMState *as, ExitNo group) { ExitNo i, groupofs = (group*EXITSTUBS_PER_GROUP) & 0xff; MCode *mxp = as->mcbot; MCode *mxpstart = mxp; if (mxp + (2+2)*EXITSTUBS_PER_GROUP+8+5 >= as->mctop) asm_mclimit(as); /* Push low byte of exitno for each exit stub. */ *mxp++ = XI_PUSHi8; *mxp++ = (MCode)groupofs; for (i = 1; i < EXITSTUBS_PER_GROUP; i++) { *mxp++ = XI_JMPs; *mxp++ = (MCode)((2+2)*(EXITSTUBS_PER_GROUP - i) - 2); *mxp++ = XI_PUSHi8; *mxp++ = (MCode)(groupofs + i); } /* Push the high byte of the exitno for each exit stub group. */ *mxp++ = XI_PUSHi8; *mxp++ = (MCode)((group*EXITSTUBS_PER_GROUP)>>8); /* Store DISPATCH at original stack slot 0. Account for the two push ops. */ *mxp++ = XI_MOVmi; *mxp++ = MODRM(XM_OFS8, 0, RID_ESP); *mxp++ = MODRM(XM_SCALE1, RID_ESP, RID_ESP); *mxp++ = 2*sizeof(void *); *(int32_t *)mxp = ptr2addr(J2GG(as->J)->dispatch); mxp += 4; /* Jump to exit handler which fills in the ExitState. */ *mxp++ = XI_JMP; mxp += 4; *((int32_t *)(mxp-4)) = jmprel(mxp, (MCode *)(void *)lj_vm_exit_handler); /* Commit the code for this group (even if assembly fails later on). */ lj_mcode_commitbot(as->J, mxp); as->mcbot = mxp; as->mclim = as->mcbot + MCLIM_REDZONE; return mxpstart; } /* Setup all needed exit stubs. */ static void asm_exitstub_setup(ASMState *as, ExitNo nexits) { ExitNo i; if (nexits >= EXITSTUBS_PER_GROUP*LJ_MAX_EXITSTUBGR) lj_trace_err(as->J, LJ_TRERR_SNAPOV); for (i = 0; i < (nexits+EXITSTUBS_PER_GROUP-1)/EXITSTUBS_PER_GROUP; i++) if (as->J->exitstubgroup[i] == NULL) as->J->exitstubgroup[i] = asm_exitstub_gen(as, i); } /* Emit conditional branch to exit for guard. ** It's important to emit this *after* all registers have been allocated, ** because rematerializations may invalidate the flags. */ static void asm_guardcc(ASMState *as, int cc) { MCode *target = exitstub_addr(as->J, as->snapno); MCode *p = as->mcp; if (LJ_UNLIKELY(p == as->invmcp)) { as->loopinv = 1; *(int32_t *)(p+1) = jmprel(p+5, target); target = p; cc ^= 1; if (as->realign) { emit_sjcc(as, cc, target); return; } } emit_jcc(as, cc, target); } /* -- Memory operand fusion ----------------------------------------------- */ /* Limit linear search to this distance. Avoids O(n^2) behavior. */ #define CONFLICT_SEARCH_LIM 31 /* Check if a reference is a signed 32 bit constant. */ static int asm_isk32(ASMState *as, IRRef ref, int32_t *k) { if (irref_isk(ref)) { IRIns *ir = IR(ref); if (ir->o != IR_KINT64) { *k = ir->i; return 1; } else if (checki32((int64_t)ir_kint64(ir)->u64)) { *k = (int32_t)ir_kint64(ir)->u64; return 1; } } return 0; } /* Check if there's no conflicting instruction between curins and ref. ** Also avoid fusing loads if there are multiple references. */ static int noconflict(ASMState *as, IRRef ref, IROp conflict, int noload) { IRIns *ir = as->ir; IRRef i = as->curins; if (i > ref + CONFLICT_SEARCH_LIM) return 0; /* Give up, ref is too far away. */ while (--i > ref) { if (ir[i].o == conflict) return 0; /* Conflict found. */ else if (!noload && (ir[i].op1 == ref || ir[i].op2 == ref)) return 0; } return 1; /* Ok, no conflict. */ } /* Fuse array base into memory operand. */ static IRRef asm_fuseabase(ASMState *as, IRRef ref) { IRIns *irb = IR(ref); as->mrm.ofs = 0; if (irb->o == IR_FLOAD) { IRIns *ira = IR(irb->op1); lua_assert(irb->op2 == IRFL_TAB_ARRAY); /* We can avoid the FLOAD of t->array for colocated arrays. */ if (ira->o == IR_TNEW && ira->op1 <= LJ_MAX_COLOSIZE && !neverfuse(as) && noconflict(as, irb->op1, IR_NEWREF, 1)) { as->mrm.ofs = (int32_t)sizeof(GCtab); /* Ofs to colocated array. */ return irb->op1; /* Table obj. */ } } else if (irb->o == IR_ADD && irref_isk(irb->op2)) { /* Fuse base offset (vararg load). */ as->mrm.ofs = IR(irb->op2)->i; return irb->op1; } return ref; /* Otherwise use the given array base. */ } /* Fuse array reference into memory operand. */ static void asm_fusearef(ASMState *as, IRIns *ir, RegSet allow) { IRIns *irx; lua_assert(ir->o == IR_AREF); as->mrm.base = (uint8_t)ra_alloc1(as, asm_fuseabase(as, ir->op1), allow); irx = IR(ir->op2); if (irref_isk(ir->op2)) { as->mrm.ofs += 8*irx->i; as->mrm.idx = RID_NONE; } else { rset_clear(allow, as->mrm.base); as->mrm.scale = XM_SCALE8; /* Fuse a constant ADD (e.g. t[i+1]) into the offset. ** Doesn't help much without ABCelim, but reduces register pressure. */ if (!LJ_64 && /* Has bad effects with negative index on x64. */ mayfuse(as, ir->op2) && ra_noreg(irx->r) && irx->o == IR_ADD && irref_isk(irx->op2)) { as->mrm.ofs += 8*IR(irx->op2)->i; as->mrm.idx = (uint8_t)ra_alloc1(as, irx->op1, allow); } else { as->mrm.idx = (uint8_t)ra_alloc1(as, ir->op2, allow); } } } /* Fuse array/hash/upvalue reference into memory operand. ** Caveat: this may allocate GPRs for the base/idx registers. Be sure to ** pass the final allow mask, excluding any GPRs used for other inputs. ** In particular: 2-operand GPR instructions need to call ra_dest() first! */ static void asm_fuseahuref(ASMState *as, IRRef ref, RegSet allow) { IRIns *ir = IR(ref); if (ra_noreg(ir->r)) { switch ((IROp)ir->o) { case IR_AREF: if (mayfuse(as, ref)) { asm_fusearef(as, ir, allow); return; } break; case IR_HREFK: if (mayfuse(as, ref)) { as->mrm.base = (uint8_t)ra_alloc1(as, ir->op1, allow); as->mrm.ofs = (int32_t)(IR(ir->op2)->op2 * sizeof(Node)); as->mrm.idx = RID_NONE; return; } break; case IR_UREFC: if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); GCupval *uv = &gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv; as->mrm.ofs = ptr2addr(&uv->tv); as->mrm.base = as->mrm.idx = RID_NONE; return; } break; default: lua_assert(ir->o == IR_HREF || ir->o == IR_NEWREF || ir->o == IR_UREFO || ir->o == IR_KKPTR); break; } } as->mrm.base = (uint8_t)ra_alloc1(as, ref, allow); as->mrm.ofs = 0; as->mrm.idx = RID_NONE; } /* Fuse FLOAD/FREF reference into memory operand. */ static void asm_fusefref(ASMState *as, IRIns *ir, RegSet allow) { lua_assert(ir->o == IR_FLOAD || ir->o == IR_FREF); as->mrm.ofs = field_ofs[ir->op2]; as->mrm.idx = RID_NONE; if (irref_isk(ir->op1)) { as->mrm.ofs += IR(ir->op1)->i; as->mrm.base = RID_NONE; } else { as->mrm.base = (uint8_t)ra_alloc1(as, ir->op1, allow); } } /* Fuse string reference into memory operand. */ static void asm_fusestrref(ASMState *as, IRIns *ir, RegSet allow) { IRIns *irr; lua_assert(ir->o == IR_STRREF); as->mrm.base = as->mrm.idx = RID_NONE; as->mrm.scale = XM_SCALE1; as->mrm.ofs = sizeof(GCstr); if (irref_isk(ir->op1)) { as->mrm.ofs += IR(ir->op1)->i; } else { Reg r = ra_alloc1(as, ir->op1, allow); rset_clear(allow, r); as->mrm.base = (uint8_t)r; } irr = IR(ir->op2); if (irref_isk(ir->op2)) { as->mrm.ofs += irr->i; } else { Reg r; /* Fuse a constant add into the offset, e.g. string.sub(s, i+10). */ if (!LJ_64 && /* Has bad effects with negative index on x64. */ mayfuse(as, ir->op2) && irr->o == IR_ADD && irref_isk(irr->op2)) { as->mrm.ofs += IR(irr->op2)->i; r = ra_alloc1(as, irr->op1, allow); } else { r = ra_alloc1(as, ir->op2, allow); } if (as->mrm.base == RID_NONE) as->mrm.base = (uint8_t)r; else as->mrm.idx = (uint8_t)r; } } static void asm_fusexref(ASMState *as, IRRef ref, RegSet allow) { IRIns *ir = IR(ref); as->mrm.idx = RID_NONE; if (ir->o == IR_KPTR || ir->o == IR_KKPTR) { as->mrm.ofs = ir->i; as->mrm.base = RID_NONE; } else if (ir->o == IR_STRREF) { asm_fusestrref(as, ir, allow); } else { as->mrm.ofs = 0; if (canfuse(as, ir) && ir->o == IR_ADD && ra_noreg(ir->r)) { /* Gather (base+idx*sz)+ofs as emitted by cdata ptr/array indexing. */ IRIns *irx; IRRef idx; Reg r; if (asm_isk32(as, ir->op2, &as->mrm.ofs)) { /* Recognize x+ofs. */ ref = ir->op1; ir = IR(ref); if (!(ir->o == IR_ADD && canfuse(as, ir) && ra_noreg(ir->r))) goto noadd; } as->mrm.scale = XM_SCALE1; idx = ir->op1; ref = ir->op2; irx = IR(idx); if (!(irx->o == IR_BSHL || irx->o == IR_ADD)) { /* Try other operand. */ idx = ir->op2; ref = ir->op1; irx = IR(idx); } if (canfuse(as, irx) && ra_noreg(irx->r)) { if (irx->o == IR_BSHL && irref_isk(irx->op2) && IR(irx->op2)->i <= 3) { /* Recognize idx<op1; as->mrm.scale = (uint8_t)(IR(irx->op2)->i << 6); } else if (irx->o == IR_ADD && irx->op1 == irx->op2) { /* FOLD does idx*2 ==> idx<<1 ==> idx+idx. */ idx = irx->op1; as->mrm.scale = XM_SCALE2; } } r = ra_alloc1(as, idx, allow); rset_clear(allow, r); as->mrm.idx = (uint8_t)r; } noadd: as->mrm.base = (uint8_t)ra_alloc1(as, ref, allow); } } /* Fuse load into memory operand. */ static Reg asm_fuseload(ASMState *as, IRRef ref, RegSet allow) { IRIns *ir = IR(ref); if (ra_hasreg(ir->r)) { if (allow != RSET_EMPTY) { /* Fast path. */ ra_noweak(as, ir->r); return ir->r; } fusespill: /* Force a spill if only memory operands are allowed (asm_x87load). */ as->mrm.base = RID_ESP; as->mrm.ofs = ra_spill(as, ir); as->mrm.idx = RID_NONE; return RID_MRM; } if (ir->o == IR_KNUM) { RegSet avail = as->freeset & ~as->modset & RSET_FPR; lua_assert(allow != RSET_EMPTY); if (!(avail & (avail-1))) { /* Fuse if less than two regs available. */ as->mrm.ofs = ptr2addr(ir_knum(ir)); as->mrm.base = as->mrm.idx = RID_NONE; return RID_MRM; } } else if (ref == REF_BASE || ir->o == IR_KINT64) { RegSet avail = as->freeset & ~as->modset & RSET_GPR; lua_assert(allow != RSET_EMPTY); if (!(avail & (avail-1))) { /* Fuse if less than two regs available. */ as->mrm.ofs = ptr2addr(ref == REF_BASE ? (void *)&J2G(as->J)->jit_base : (void *)ir_kint64(ir)); as->mrm.base = as->mrm.idx = RID_NONE; return RID_MRM; } } else if (mayfuse(as, ref)) { RegSet xallow = (allow & RSET_GPR) ? allow : RSET_GPR; if (ir->o == IR_SLOAD) { if (!(ir->op2 & (IRSLOAD_PARENT|IRSLOAD_CONVERT)) && noconflict(as, ref, IR_RETF, 0)) { as->mrm.base = (uint8_t)ra_alloc1(as, REF_BASE, xallow); as->mrm.ofs = 8*((int32_t)ir->op1-1) + ((ir->op2&IRSLOAD_FRAME)?4:0); as->mrm.idx = RID_NONE; return RID_MRM; } } else if (ir->o == IR_FLOAD) { /* Generic fusion is only ok for 32 bit operand (but see asm_comp). */ if ((irt_isint(ir->t) || irt_isu32(ir->t) || irt_isaddr(ir->t)) && noconflict(as, ref, IR_FSTORE, 0)) { asm_fusefref(as, ir, xallow); return RID_MRM; } } else if (ir->o == IR_ALOAD || ir->o == IR_HLOAD || ir->o == IR_ULOAD) { if (noconflict(as, ref, ir->o + IRDELTA_L2S, 0)) { asm_fuseahuref(as, ir->op1, xallow); return RID_MRM; } } else if (ir->o == IR_XLOAD) { /* Generic fusion is not ok for 8/16 bit operands (but see asm_comp). ** Fusing unaligned memory operands is ok on x86 (except for SIMD types). */ if ((!irt_typerange(ir->t, IRT_I8, IRT_U16)) && noconflict(as, ref, IR_XSTORE, 0)) { asm_fusexref(as, ir->op1, xallow); return RID_MRM; } } else if (ir->o == IR_VLOAD) { asm_fuseahuref(as, ir->op1, xallow); return RID_MRM; } } if (!(as->freeset & allow) && !emit_canremat(ref) && (allow == RSET_EMPTY || ra_hasspill(ir->s) || iscrossref(as, ref))) goto fusespill; return ra_allocref(as, ref, allow); } #if LJ_64 /* Don't fuse a 32 bit load into a 64 bit operation. */ static Reg asm_fuseloadm(ASMState *as, IRRef ref, RegSet allow, int is64) { if (is64 && !irt_is64(IR(ref)->t)) return ra_alloc1(as, ref, allow); return asm_fuseload(as, ref, allow); } #else #define asm_fuseloadm(as, ref, allow, is64) asm_fuseload(as, (ref), (allow)) #endif /* -- Calls --------------------------------------------------------------- */ /* Count the required number of stack slots for a call. */ static int asm_count_call_slots(ASMState *as, const CCallInfo *ci, IRRef *args) { uint32_t i, nargs = CCI_NARGS(ci); int nslots = 0; #if LJ_64 if (LJ_ABI_WIN) { nslots = (int)(nargs*2); /* Only matters for more than four args. */ } else { int ngpr = REGARG_NUMGPR, nfpr = REGARG_NUMFPR; for (i = 0; i < nargs; i++) if (args[i] && irt_isfp(IR(args[i])->t)) { if (nfpr > 0) nfpr--; else nslots += 2; } else { if (ngpr > 0) ngpr--; else nslots += 2; } } #else int ngpr = 0; if ((ci->flags & CCI_CC_MASK) == CCI_CC_FASTCALL) ngpr = 2; else if ((ci->flags & CCI_CC_MASK) == CCI_CC_THISCALL) ngpr = 1; for (i = 0; i < nargs; i++) if (args[i] && irt_isfp(IR(args[i])->t)) { nslots += irt_isnum(IR(args[i])->t) ? 2 : 1; } else { if (ngpr > 0) ngpr--; else nslots++; } #endif return nslots; } /* Generate a call to a C function. */ static void asm_gencall(ASMState *as, const CCallInfo *ci, IRRef *args) { uint32_t n, nargs = CCI_NARGS(ci); int32_t ofs = STACKARG_OFS; #if LJ_64 uint32_t gprs = REGARG_GPRS; Reg fpr = REGARG_FIRSTFPR; #if !LJ_ABI_WIN MCode *patchnfpr = NULL; #endif #else uint32_t gprs = 0; if ((ci->flags & CCI_CC_MASK) != CCI_CC_CDECL) { if ((ci->flags & CCI_CC_MASK) == CCI_CC_THISCALL) gprs = (REGARG_GPRS & 31); else if ((ci->flags & CCI_CC_MASK) == CCI_CC_FASTCALL) gprs = REGARG_GPRS; } #endif if ((void *)ci->func) emit_call(as, ci->func); #if LJ_64 if ((ci->flags & CCI_VARARG)) { /* Special handling for vararg calls. */ #if LJ_ABI_WIN for (n = 0; n < 4 && n < nargs; n++) { IRIns *ir = IR(args[n]); if (irt_isfp(ir->t)) /* Duplicate FPRs in GPRs. */ emit_rr(as, XO_MOVDto, (irt_isnum(ir->t) ? REX_64 : 0) | (fpr+n), ((gprs >> (n*5)) & 31)); /* Either MOVD or MOVQ. */ } #else patchnfpr = --as->mcp; /* Indicate number of used FPRs in register al. */ *--as->mcp = XI_MOVrib | RID_EAX; #endif } #endif for (n = 0; n < nargs; n++) { /* Setup args. */ IRRef ref = args[n]; IRIns *ir = IR(ref); Reg r; #if LJ_64 && LJ_ABI_WIN /* Windows/x64 argument registers are strictly positional. */ r = irt_isfp(ir->t) ? (fpr <= REGARG_LASTFPR ? fpr : 0) : (gprs & 31); fpr++; gprs >>= 5; #elif LJ_64 /* POSIX/x64 argument registers are used in order of appearance. */ if (irt_isfp(ir->t)) { r = fpr <= REGARG_LASTFPR ? fpr++ : 0; } else { r = gprs & 31; gprs >>= 5; } #else if (ref && irt_isfp(ir->t)) { r = 0; } else { r = gprs & 31; gprs >>= 5; if (!ref) continue; } #endif if (r) { /* Argument is in a register. */ if (r < RID_MAX_GPR && ref < ASMREF_TMP1) { #if LJ_64 if (ir->o == IR_KINT64) emit_loadu64(as, r, ir_kint64(ir)->u64); else #endif emit_loadi(as, r, ir->i); } else { lua_assert(rset_test(as->freeset, r)); /* Must have been evicted. */ if (ra_hasreg(ir->r)) { ra_noweak(as, ir->r); emit_movrr(as, ir, r, ir->r); } else { ra_allocref(as, ref, RID2RSET(r)); } } } else if (irt_isfp(ir->t)) { /* FP argument is on stack. */ lua_assert(!(irt_isfloat(ir->t) && irref_isk(ref))); /* No float k. */ if (LJ_32 && (ofs & 4) && irref_isk(ref)) { /* Split stores for unaligned FP consts. */ emit_movmroi(as, RID_ESP, ofs, (int32_t)ir_knum(ir)->u32.lo); emit_movmroi(as, RID_ESP, ofs+4, (int32_t)ir_knum(ir)->u32.hi); } else { r = ra_alloc1(as, ref, RSET_FPR); emit_rmro(as, irt_isnum(ir->t) ? XO_MOVSDto : XO_MOVSSto, r, RID_ESP, ofs); } ofs += (LJ_32 && irt_isfloat(ir->t)) ? 4 : 8; } else { /* Non-FP argument is on stack. */ if (LJ_32 && ref < ASMREF_TMP1) { emit_movmroi(as, RID_ESP, ofs, ir->i); } else { r = ra_alloc1(as, ref, RSET_GPR); emit_movtomro(as, REX_64 + r, RID_ESP, ofs); } ofs += sizeof(intptr_t); } checkmclim(as); } #if LJ_64 && !LJ_ABI_WIN if (patchnfpr) *patchnfpr = fpr - REGARG_FIRSTFPR; #endif } /* Setup result reg/sp for call. Evict scratch regs. */ static void asm_setupresult(ASMState *as, IRIns *ir, const CCallInfo *ci) { RegSet drop = RSET_SCRATCH; int hiop = (LJ_32 && (ir+1)->o == IR_HIOP && !irt_isnil((ir+1)->t)); if ((ci->flags & CCI_NOFPRCLOBBER)) drop &= ~RSET_FPR; if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ if (hiop && ra_hasreg((ir+1)->r)) rset_clear(drop, (ir+1)->r); /* Dest reg handled below. */ ra_evictset(as, drop); /* Evictions must be performed first. */ if (ra_used(ir)) { if (irt_isfp(ir->t)) { int32_t ofs = sps_scale(ir->s); /* Use spill slot or temp slots. */ #if LJ_64 if ((ci->flags & CCI_CASTU64)) { Reg dest = ir->r; if (ra_hasreg(dest)) { ra_free(as, dest); ra_modified(as, dest); emit_rr(as, XO_MOVD, dest|REX_64, RID_RET); /* Really MOVQ. */ } if (ofs) emit_movtomro(as, RID_RET|REX_64, RID_ESP, ofs); } else { ra_destreg(as, ir, RID_FPRET); } #else /* Number result is in x87 st0 for x86 calling convention. */ Reg dest = ir->r; if (ra_hasreg(dest)) { ra_free(as, dest); ra_modified(as, dest); emit_rmro(as, irt_isnum(ir->t) ? XMM_MOVRM(as) : XO_MOVSS, dest, RID_ESP, ofs); } if ((ci->flags & CCI_CASTU64)) { emit_movtomro(as, RID_RETLO, RID_ESP, ofs); emit_movtomro(as, RID_RETHI, RID_ESP, ofs+4); } else { emit_rmro(as, irt_isnum(ir->t) ? XO_FSTPq : XO_FSTPd, irt_isnum(ir->t) ? XOg_FSTPq : XOg_FSTPd, RID_ESP, ofs); } #endif #if LJ_32 } else if (hiop) { ra_destpair(as, ir); #endif } else { lua_assert(!irt_ispri(ir->t)); ra_destreg(as, ir, RID_RET); } } else if (LJ_32 && irt_isfp(ir->t) && !(ci->flags & CCI_CASTU64)) { emit_x87op(as, XI_FPOP); /* Pop unused result from x87 st0. */ } } static void asm_call(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX]; const CCallInfo *ci = &lj_ir_callinfo[ir->op2]; asm_collectargs(as, ir, ci, args); asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } /* Return a constant function pointer or NULL for indirect calls. */ static void *asm_callx_func(ASMState *as, IRIns *irf, IRRef func) { #if LJ_32 UNUSED(as); if (irref_isk(func)) return (void *)irf->i; #else if (irref_isk(func)) { MCode *p; if (irf->o == IR_KINT64) p = (MCode *)(void *)ir_k64(irf)->u64; else p = (MCode *)(void *)(uintptr_t)(uint32_t)irf->i; if (p - as->mcp == (int32_t)(p - as->mcp)) return p; /* Call target is still in +-2GB range. */ /* Avoid the indirect case of emit_call(). Try to hoist func addr. */ } #endif return NULL; } static void asm_callx(ASMState *as, IRIns *ir) { IRRef args[CCI_NARGS_MAX*2]; CCallInfo ci; IRRef func; IRIns *irf; int32_t spadj = 0; ci.flags = asm_callx_flags(as, ir); asm_collectargs(as, ir, &ci, args); asm_setupresult(as, ir, &ci); #if LJ_32 /* Have to readjust stack after non-cdecl calls due to callee cleanup. */ if ((ci.flags & CCI_CC_MASK) != CCI_CC_CDECL) spadj = 4 * asm_count_call_slots(as, &ci, args); #endif func = ir->op2; irf = IR(func); if (irf->o == IR_CARG) { func = irf->op1; irf = IR(func); } ci.func = (ASMFunction)asm_callx_func(as, irf, func); if (!(void *)ci.func) { /* Use a (hoistable) non-scratch register for indirect calls. */ RegSet allow = (RSET_GPR & ~RSET_SCRATCH); Reg r = ra_alloc1(as, func, allow); if (LJ_32) emit_spsub(as, spadj); /* Above code may cause restores! */ emit_rr(as, XO_GROUP5, XOg_CALL, r); } else if (LJ_32) { emit_spsub(as, spadj); } asm_gencall(as, &ci, args); } /* -- Returns ------------------------------------------------------------- */ /* Return to lower frame. Guard that it goes to the right spot. */ static void asm_retf(ASMState *as, IRIns *ir) { Reg base = ra_alloc1(as, REF_BASE, RSET_GPR); void *pc = ir_kptr(IR(ir->op2)); int32_t delta = 1+bc_a(*((const BCIns *)pc - 1)); as->topslot -= (BCReg)delta; if ((int32_t)as->topslot < 0) as->topslot = 0; irt_setmark(IR(REF_BASE)->t); /* Children must not coalesce with BASE reg. */ emit_setgl(as, base, jit_base); emit_addptr(as, base, -8*delta); asm_guardcc(as, CC_NE); emit_gmroi(as, XG_ARITHi(XOg_CMP), base, -4, ptr2addr(pc)); } /* -- Type conversions ---------------------------------------------------- */ static void asm_tointg(ASMState *as, IRIns *ir, Reg left) { Reg tmp = ra_scratch(as, rset_exclude(RSET_FPR, left)); Reg dest = ra_dest(as, ir, RSET_GPR); asm_guardcc(as, CC_P); asm_guardcc(as, CC_NE); emit_rr(as, XO_UCOMISD, left, tmp); emit_rr(as, XO_CVTSI2SD, tmp, dest); if (!(as->flags & JIT_F_SPLIT_XMM)) emit_rr(as, XO_XORPS, tmp, tmp); /* Avoid partial register stall. */ emit_rr(as, XO_CVTTSD2SI, dest, left); /* Can't fuse since left is needed twice. */ } static void asm_tobit(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); Reg tmp = ra_noreg(IR(ir->op1)->r) ? ra_alloc1(as, ir->op1, RSET_FPR) : ra_scratch(as, RSET_FPR); Reg right = asm_fuseload(as, ir->op2, rset_exclude(RSET_FPR, tmp)); emit_rr(as, XO_MOVDto, tmp, dest); emit_mrm(as, XO_ADDSD, tmp, right); ra_left(as, tmp, ir->op1); } static void asm_conv(ASMState *as, IRIns *ir) { IRType st = (IRType)(ir->op2 & IRCONV_SRCMASK); int st64 = (st == IRT_I64 || st == IRT_U64 || (LJ_64 && st == IRT_P64)); int stfp = (st == IRT_NUM || st == IRT_FLOAT); IRRef lref = ir->op1; lua_assert(irt_type(ir->t) != st); lua_assert(!(LJ_32 && (irt_isint64(ir->t) || st64))); /* Handled by SPLIT. */ if (irt_isfp(ir->t)) { Reg dest = ra_dest(as, ir, RSET_FPR); if (stfp) { /* FP to FP conversion. */ Reg left = asm_fuseload(as, lref, RSET_FPR); emit_mrm(as, st == IRT_NUM ? XO_CVTSD2SS : XO_CVTSS2SD, dest, left); if (left == dest) return; /* Avoid the XO_XORPS. */ } else if (LJ_32 && st == IRT_U32) { /* U32 to FP conversion on x86. */ /* number = (2^52+2^51 .. u32) - (2^52+2^51) */ cTValue *k = lj_ir_k64_find(as->J, U64x(43380000,00000000)); Reg bias = ra_scratch(as, rset_exclude(RSET_FPR, dest)); if (irt_isfloat(ir->t)) emit_rr(as, XO_CVTSD2SS, dest, dest); emit_rr(as, XO_SUBSD, dest, bias); /* Subtract 2^52+2^51 bias. */ emit_rr(as, XO_XORPS, dest, bias); /* Merge bias and integer. */ emit_loadn(as, bias, k); emit_mrm(as, XO_MOVD, dest, asm_fuseload(as, lref, RSET_GPR)); return; } else { /* Integer to FP conversion. */ Reg left = (LJ_64 && (st == IRT_U32 || st == IRT_U64)) ? ra_alloc1(as, lref, RSET_GPR) : asm_fuseloadm(as, lref, RSET_GPR, st64); if (LJ_64 && st == IRT_U64) { MCLabel l_end = emit_label(as); const void *k = lj_ir_k64_find(as->J, U64x(43f00000,00000000)); emit_rma(as, XO_ADDSD, dest, k); /* Add 2^64 to compensate. */ emit_sjcc(as, CC_NS, l_end); emit_rr(as, XO_TEST, left|REX_64, left); /* Check if u64 >= 2^63. */ } emit_mrm(as, irt_isnum(ir->t) ? XO_CVTSI2SD : XO_CVTSI2SS, dest|((LJ_64 && (st64 || st == IRT_U32)) ? REX_64 : 0), left); } if (!(as->flags & JIT_F_SPLIT_XMM)) emit_rr(as, XO_XORPS, dest, dest); /* Avoid partial register stall. */ } else if (stfp) { /* FP to integer conversion. */ if (irt_isguard(ir->t)) { /* Checked conversions are only supported from number to int. */ lua_assert(irt_isint(ir->t) && st == IRT_NUM); asm_tointg(as, ir, ra_alloc1(as, lref, RSET_FPR)); } else { Reg dest = ra_dest(as, ir, RSET_GPR); x86Op op = st == IRT_NUM ? ((ir->op2 & IRCONV_TRUNC) ? XO_CVTTSD2SI : XO_CVTSD2SI) : ((ir->op2 & IRCONV_TRUNC) ? XO_CVTTSS2SI : XO_CVTSS2SI); if (LJ_64 ? irt_isu64(ir->t) : irt_isu32(ir->t)) { /* LJ_64: For inputs >= 2^63 add -2^64, convert again. */ /* LJ_32: For inputs >= 2^31 add -2^31, convert again and add 2^31. */ Reg tmp = ra_noreg(IR(lref)->r) ? ra_alloc1(as, lref, RSET_FPR) : ra_scratch(as, RSET_FPR); MCLabel l_end = emit_label(as); if (LJ_32) emit_gri(as, XG_ARITHi(XOg_ADD), dest, (int32_t)0x80000000); emit_rr(as, op, dest|REX_64, tmp); if (st == IRT_NUM) emit_rma(as, XO_ADDSD, tmp, lj_ir_k64_find(as->J, LJ_64 ? U64x(c3f00000,00000000) : U64x(c1e00000,00000000))); else emit_rma(as, XO_ADDSS, tmp, lj_ir_k64_find(as->J, LJ_64 ? U64x(00000000,df800000) : U64x(00000000,cf000000))); emit_sjcc(as, CC_NS, l_end); emit_rr(as, XO_TEST, dest|REX_64, dest); /* Check if dest negative. */ emit_rr(as, op, dest|REX_64, tmp); ra_left(as, tmp, lref); } else { Reg left = asm_fuseload(as, lref, RSET_FPR); if (LJ_64 && irt_isu32(ir->t)) emit_rr(as, XO_MOV, dest, dest); /* Zero hiword. */ emit_mrm(as, op, dest|((LJ_64 && (irt_is64(ir->t) || irt_isu32(ir->t))) ? REX_64 : 0), left); } } } else if (st >= IRT_I8 && st <= IRT_U16) { /* Extend to 32 bit integer. */ Reg left, dest = ra_dest(as, ir, RSET_GPR); RegSet allow = RSET_GPR; x86Op op; lua_assert(irt_isint(ir->t) || irt_isu32(ir->t)); if (st == IRT_I8) { op = XO_MOVSXb; allow = RSET_GPR8; dest |= FORCE_REX; } else if (st == IRT_U8) { op = XO_MOVZXb; allow = RSET_GPR8; dest |= FORCE_REX; } else if (st == IRT_I16) { op = XO_MOVSXw; } else { op = XO_MOVZXw; } left = asm_fuseload(as, lref, allow); /* Add extra MOV if source is already in wrong register. */ if (!LJ_64 && left != RID_MRM && !rset_test(allow, left)) { Reg tmp = ra_scratch(as, allow); emit_rr(as, op, dest, tmp); emit_rr(as, XO_MOV, tmp, left); } else { emit_mrm(as, op, dest, left); } } else { /* 32/64 bit integer conversions. */ if (LJ_32) { /* Only need to handle 32/32 bit no-op (cast) on x86. */ Reg dest = ra_dest(as, ir, RSET_GPR); ra_left(as, dest, lref); /* Do nothing, but may need to move regs. */ } else if (irt_is64(ir->t)) { Reg dest = ra_dest(as, ir, RSET_GPR); if (st64 || !(ir->op2 & IRCONV_SEXT)) { /* 64/64 bit no-op (cast) or 32 to 64 bit zero extension. */ ra_left(as, dest, lref); /* Do nothing, but may need to move regs. */ } else { /* 32 to 64 bit sign extension. */ Reg left = asm_fuseload(as, lref, RSET_GPR); emit_mrm(as, XO_MOVSXd, dest|REX_64, left); } } else { Reg dest = ra_dest(as, ir, RSET_GPR); if (st64) { Reg left = asm_fuseload(as, lref, RSET_GPR); /* This is either a 32 bit reg/reg mov which zeroes the hiword ** or a load of the loword from a 64 bit address. */ emit_mrm(as, XO_MOV, dest, left); } else { /* 32/32 bit no-op (cast). */ ra_left(as, dest, lref); /* Do nothing, but may need to move regs. */ } } } } #if LJ_32 && LJ_HASFFI /* No SSE conversions to/from 64 bit on x86, so resort to ugly x87 code. */ /* 64 bit integer to FP conversion in 32 bit mode. */ static void asm_conv_fp_int64(ASMState *as, IRIns *ir) { Reg hi = ra_alloc1(as, ir->op1, RSET_GPR); Reg lo = ra_alloc1(as, (ir-1)->op1, rset_exclude(RSET_GPR, hi)); int32_t ofs = sps_scale(ir->s); /* Use spill slot or temp slots. */ Reg dest = ir->r; if (ra_hasreg(dest)) { ra_free(as, dest); ra_modified(as, dest); emit_rmro(as, irt_isnum(ir->t) ? XMM_MOVRM(as) : XO_MOVSS, dest, RID_ESP, ofs); } emit_rmro(as, irt_isnum(ir->t) ? XO_FSTPq : XO_FSTPd, irt_isnum(ir->t) ? XOg_FSTPq : XOg_FSTPd, RID_ESP, ofs); if (((ir-1)->op2 & IRCONV_SRCMASK) == IRT_U64) { /* For inputs in [2^63,2^64-1] add 2^64 to compensate. */ MCLabel l_end = emit_label(as); emit_rma(as, XO_FADDq, XOg_FADDq, lj_ir_k64_find(as->J, U64x(43f00000,00000000))); emit_sjcc(as, CC_NS, l_end); emit_rr(as, XO_TEST, hi, hi); /* Check if u64 >= 2^63. */ } else { lua_assert(((ir-1)->op2 & IRCONV_SRCMASK) == IRT_I64); } emit_rmro(as, XO_FILDq, XOg_FILDq, RID_ESP, 0); /* NYI: Avoid narrow-to-wide store-to-load forwarding stall. */ emit_rmro(as, XO_MOVto, hi, RID_ESP, 4); emit_rmro(as, XO_MOVto, lo, RID_ESP, 0); } /* FP to 64 bit integer conversion in 32 bit mode. */ static void asm_conv_int64_fp(ASMState *as, IRIns *ir) { IRType st = (IRType)((ir-1)->op2 & IRCONV_SRCMASK); IRType dt = (((ir-1)->op2 & IRCONV_DSTMASK) >> IRCONV_DSH); Reg lo, hi; lua_assert(st == IRT_NUM || st == IRT_FLOAT); lua_assert(dt == IRT_I64 || dt == IRT_U64); lua_assert(((ir-1)->op2 & IRCONV_TRUNC)); hi = ra_dest(as, ir, RSET_GPR); lo = ra_dest(as, ir-1, rset_exclude(RSET_GPR, hi)); if (ra_used(ir-1)) emit_rmro(as, XO_MOV, lo, RID_ESP, 0); /* NYI: Avoid wide-to-narrow store-to-load forwarding stall. */ if (!(as->flags & JIT_F_SSE3)) { /* Set FPU rounding mode to default. */ emit_rmro(as, XO_FLDCW, XOg_FLDCW, RID_ESP, 4); emit_rmro(as, XO_MOVto, lo, RID_ESP, 4); emit_gri(as, XG_ARITHi(XOg_AND), lo, 0xf3ff); } if (dt == IRT_U64) { /* For inputs in [2^63,2^64-1] add -2^64 and convert again. */ MCLabel l_pop, l_end = emit_label(as); emit_x87op(as, XI_FPOP); l_pop = emit_label(as); emit_sjmp(as, l_end); emit_rmro(as, XO_MOV, hi, RID_ESP, 4); if ((as->flags & JIT_F_SSE3)) emit_rmro(as, XO_FISTTPq, XOg_FISTTPq, RID_ESP, 0); else emit_rmro(as, XO_FISTPq, XOg_FISTPq, RID_ESP, 0); emit_rma(as, XO_FADDq, XOg_FADDq, lj_ir_k64_find(as->J, U64x(c3f00000,00000000))); emit_sjcc(as, CC_NS, l_pop); emit_rr(as, XO_TEST, hi, hi); /* Check if out-of-range (2^63). */ } emit_rmro(as, XO_MOV, hi, RID_ESP, 4); if ((as->flags & JIT_F_SSE3)) { /* Truncation is easy with SSE3. */ emit_rmro(as, XO_FISTTPq, XOg_FISTTPq, RID_ESP, 0); } else { /* Otherwise set FPU rounding mode to truncate before the store. */ emit_rmro(as, XO_FISTPq, XOg_FISTPq, RID_ESP, 0); emit_rmro(as, XO_FLDCW, XOg_FLDCW, RID_ESP, 0); emit_rmro(as, XO_MOVtow, lo, RID_ESP, 0); emit_rmro(as, XO_ARITHw(XOg_OR), lo, RID_ESP, 0); emit_loadi(as, lo, 0xc00); emit_rmro(as, XO_FNSTCW, XOg_FNSTCW, RID_ESP, 0); } if (dt == IRT_U64) emit_x87op(as, XI_FDUP); emit_mrm(as, st == IRT_NUM ? XO_FLDq : XO_FLDd, st == IRT_NUM ? XOg_FLDq: XOg_FLDd, asm_fuseload(as, ir->op1, RSET_EMPTY)); } #endif static void asm_strto(ASMState *as, IRIns *ir) { /* Force a spill slot for the destination register (if any). */ const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_strscan_num]; IRRef args[2]; RegSet drop = RSET_SCRATCH; if ((drop & RSET_FPR) != RSET_FPR && ra_hasreg(ir->r)) rset_set(drop, ir->r); /* WIN64 doesn't spill all FPRs. */ ra_evictset(as, drop); asm_guardcc(as, CC_E); emit_rr(as, XO_TEST, RID_RET, RID_RET); /* Test return status. */ args[0] = ir->op1; /* GCstr *str */ args[1] = ASMREF_TMP1; /* TValue *n */ asm_gencall(as, ci, args); /* Store the result to the spill slot or temp slots. */ emit_rmro(as, XO_LEA, ra_releasetmp(as, ASMREF_TMP1)|REX_64, RID_ESP, sps_scale(ir->s)); } static void asm_tostr(ASMState *as, IRIns *ir) { IRIns *irl = IR(ir->op1); IRRef args[2]; args[0] = ASMREF_L; as->gcsteps++; if (irt_isnum(irl->t)) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromnum]; args[1] = ASMREF_TMP1; /* const lua_Number * */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); emit_rmro(as, XO_LEA, ra_releasetmp(as, ASMREF_TMP1)|REX_64, RID_ESP, ra_spill(as, irl)); } else { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_str_fromint]; args[1] = ir->op1; /* int32_t k */ asm_setupresult(as, ir, ci); /* GCstr * */ asm_gencall(as, ci, args); } } /* -- Memory references --------------------------------------------------- */ static void asm_aref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); asm_fusearef(as, ir, RSET_GPR); if (!(as->mrm.idx == RID_NONE && as->mrm.ofs == 0)) emit_mrm(as, XO_LEA, dest, RID_MRM); else if (as->mrm.base != dest) emit_rr(as, XO_MOV, dest, as->mrm.base); } /* Merge NE(HREF, niltv) check. */ static MCode *merge_href_niltv(ASMState *as, IRIns *ir) { /* Assumes nothing else generates NE of HREF. */ if ((ir[1].o == IR_NE || ir[1].o == IR_EQ) && ir[1].op1 == as->curins && ra_hasreg(ir->r)) { MCode *p = as->mcp; p += (LJ_64 && *p != XI_ARITHi) ? 7+6 : 6+6; /* Ensure no loop branch inversion happened. */ if (p[-6] == 0x0f && p[-5] == XI_JCCn+(CC_NE^(ir[1].o & 1))) { as->mcp = p; /* Kill cmp reg, imm32 + jz exit. */ return p + *(int32_t *)(p-4); /* Return exit address. */ } } return NULL; } /* Inlined hash lookup. Specialized for key type and for const keys. ** The equivalent C code is: ** Node *n = hashkey(t, key); ** do { ** if (lj_obj_equal(&n->key, key)) return &n->val; ** } while ((n = nextnode(n))); ** return niltv(L); */ static void asm_href(ASMState *as, IRIns *ir) { MCode *nilexit = merge_href_niltv(as, ir); /* Do this before any restores. */ RegSet allow = RSET_GPR; Reg dest = ra_dest(as, ir, allow); Reg tab = ra_alloc1(as, ir->op1, rset_clear(allow, dest)); Reg key = RID_NONE, tmp = RID_NONE; IRIns *irkey = IR(ir->op2); int isk = irref_isk(ir->op2); IRType1 kt = irkey->t; uint32_t khash; MCLabel l_end, l_loop, l_next; if (!isk) { rset_clear(allow, tab); key = ra_alloc1(as, ir->op2, irt_isnum(kt) ? RSET_FPR : allow); if (!irt_isstr(kt)) tmp = ra_scratch(as, rset_exclude(allow, key)); } /* Key not found in chain: jump to exit (if merged with NE) or load niltv. */ l_end = emit_label(as); if (nilexit && ir[1].o == IR_NE) { emit_jcc(as, CC_E, nilexit); /* XI_JMP is not found by lj_asm_patchexit. */ nilexit = NULL; } else { emit_loada(as, dest, niltvg(J2G(as->J))); } /* Follow hash chain until the end. */ l_loop = emit_sjcc_label(as, CC_NZ); emit_rr(as, XO_TEST, dest, dest); emit_rmro(as, XO_MOV, dest, dest, offsetof(Node, next)); l_next = emit_label(as); /* Type and value comparison. */ if (nilexit) emit_jcc(as, CC_E, nilexit); else emit_sjcc(as, CC_E, l_end); if (irt_isnum(kt)) { if (isk) { /* Assumes -0.0 is already canonicalized to +0.0. */ emit_gmroi(as, XG_ARITHi(XOg_CMP), dest, offsetof(Node, key.u32.lo), (int32_t)ir_knum(irkey)->u32.lo); emit_sjcc(as, CC_NE, l_next); emit_gmroi(as, XG_ARITHi(XOg_CMP), dest, offsetof(Node, key.u32.hi), (int32_t)ir_knum(irkey)->u32.hi); } else { emit_sjcc(as, CC_P, l_next); emit_rmro(as, XO_UCOMISD, key, dest, offsetof(Node, key.n)); emit_sjcc(as, CC_AE, l_next); /* The type check avoids NaN penalties and complaints from Valgrind. */ #if LJ_64 emit_u32(as, LJ_TISNUM); emit_rmro(as, XO_ARITHi, XOg_CMP, dest, offsetof(Node, key.it)); #else emit_i8(as, LJ_TISNUM); emit_rmro(as, XO_ARITHi8, XOg_CMP, dest, offsetof(Node, key.it)); #endif } #if LJ_64 } else if (irt_islightud(kt)) { emit_rmro(as, XO_CMP, key|REX_64, dest, offsetof(Node, key.u64)); #endif } else { if (!irt_ispri(kt)) { lua_assert(irt_isaddr(kt)); if (isk) emit_gmroi(as, XG_ARITHi(XOg_CMP), dest, offsetof(Node, key.gcr), ptr2addr(ir_kgc(irkey))); else emit_rmro(as, XO_CMP, key, dest, offsetof(Node, key.gcr)); emit_sjcc(as, CC_NE, l_next); } lua_assert(!irt_isnil(kt)); emit_i8(as, irt_toitype(kt)); emit_rmro(as, XO_ARITHi8, XOg_CMP, dest, offsetof(Node, key.it)); } emit_sfixup(as, l_loop); checkmclim(as); /* Load main position relative to tab->node into dest. */ khash = isk ? ir_khash(irkey) : 1; if (khash == 0) { emit_rmro(as, XO_MOV, dest, tab, offsetof(GCtab, node)); } else { emit_rmro(as, XO_ARITH(XOg_ADD), dest, tab, offsetof(GCtab, node)); if ((as->flags & JIT_F_PREFER_IMUL)) { emit_i8(as, sizeof(Node)); emit_rr(as, XO_IMULi8, dest, dest); } else { emit_shifti(as, XOg_SHL, dest, 3); emit_rmrxo(as, XO_LEA, dest, dest, dest, XM_SCALE2, 0); } if (isk) { emit_gri(as, XG_ARITHi(XOg_AND), dest, (int32_t)khash); emit_rmro(as, XO_MOV, dest, tab, offsetof(GCtab, hmask)); } else if (irt_isstr(kt)) { emit_rmro(as, XO_ARITH(XOg_AND), dest, key, offsetof(GCstr, hash)); emit_rmro(as, XO_MOV, dest, tab, offsetof(GCtab, hmask)); } else { /* Must match with hashrot() in lj_tab.c. */ emit_rmro(as, XO_ARITH(XOg_AND), dest, tab, offsetof(GCtab, hmask)); emit_rr(as, XO_ARITH(XOg_SUB), dest, tmp); emit_shifti(as, XOg_ROL, tmp, HASH_ROT3); emit_rr(as, XO_ARITH(XOg_XOR), dest, tmp); emit_shifti(as, XOg_ROL, dest, HASH_ROT2); emit_rr(as, XO_ARITH(XOg_SUB), tmp, dest); emit_shifti(as, XOg_ROL, dest, HASH_ROT1); emit_rr(as, XO_ARITH(XOg_XOR), tmp, dest); if (irt_isnum(kt)) { emit_rr(as, XO_ARITH(XOg_ADD), dest, dest); #if LJ_64 emit_shifti(as, XOg_SHR|REX_64, dest, 32); emit_rr(as, XO_MOV, tmp, dest); emit_rr(as, XO_MOVDto, key|REX_64, dest); #else emit_rmro(as, XO_MOV, dest, RID_ESP, ra_spill(as, irkey)+4); emit_rr(as, XO_MOVDto, key, tmp); #endif } else { emit_rr(as, XO_MOV, tmp, key); emit_rmro(as, XO_LEA, dest, key, HASH_BIAS); } } } } static void asm_hrefk(ASMState *as, IRIns *ir) { IRIns *kslot = IR(ir->op2); IRIns *irkey = IR(kslot->op1); int32_t ofs = (int32_t)(kslot->op2 * sizeof(Node)); Reg dest = ra_used(ir) ? ra_dest(as, ir, RSET_GPR) : RID_NONE; Reg node = ra_alloc1(as, ir->op1, RSET_GPR); #if !LJ_64 MCLabel l_exit; #endif lua_assert(ofs % sizeof(Node) == 0); if (ra_hasreg(dest)) { if (ofs != 0) { if (dest == node && !(as->flags & JIT_F_LEA_AGU)) emit_gri(as, XG_ARITHi(XOg_ADD), dest, ofs); else emit_rmro(as, XO_LEA, dest, node, ofs); } else if (dest != node) { emit_rr(as, XO_MOV, dest, node); } } asm_guardcc(as, CC_NE); #if LJ_64 if (!irt_ispri(irkey->t)) { Reg key = ra_scratch(as, rset_exclude(RSET_GPR, node)); emit_rmro(as, XO_CMP, key|REX_64, node, ofs + (int32_t)offsetof(Node, key.u64)); lua_assert(irt_isnum(irkey->t) || irt_isgcv(irkey->t)); /* Assumes -0.0 is already canonicalized to +0.0. */ emit_loadu64(as, key, irt_isnum(irkey->t) ? ir_knum(irkey)->u64 : ((uint64_t)irt_toitype(irkey->t) << 32) | (uint64_t)(uint32_t)ptr2addr(ir_kgc(irkey))); } else { lua_assert(!irt_isnil(irkey->t)); emit_i8(as, irt_toitype(irkey->t)); emit_rmro(as, XO_ARITHi8, XOg_CMP, node, ofs + (int32_t)offsetof(Node, key.it)); } #else l_exit = emit_label(as); if (irt_isnum(irkey->t)) { /* Assumes -0.0 is already canonicalized to +0.0. */ emit_gmroi(as, XG_ARITHi(XOg_CMP), node, ofs + (int32_t)offsetof(Node, key.u32.lo), (int32_t)ir_knum(irkey)->u32.lo); emit_sjcc(as, CC_NE, l_exit); emit_gmroi(as, XG_ARITHi(XOg_CMP), node, ofs + (int32_t)offsetof(Node, key.u32.hi), (int32_t)ir_knum(irkey)->u32.hi); } else { if (!irt_ispri(irkey->t)) { lua_assert(irt_isgcv(irkey->t)); emit_gmroi(as, XG_ARITHi(XOg_CMP), node, ofs + (int32_t)offsetof(Node, key.gcr), ptr2addr(ir_kgc(irkey))); emit_sjcc(as, CC_NE, l_exit); } lua_assert(!irt_isnil(irkey->t)); emit_i8(as, irt_toitype(irkey->t)); emit_rmro(as, XO_ARITHi8, XOg_CMP, node, ofs + (int32_t)offsetof(Node, key.it)); } #endif } static void asm_newref(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_tab_newkey]; IRRef args[3]; IRIns *irkey; Reg tmp; if (ir->r == RID_SINK) return; args[0] = ASMREF_L; /* lua_State *L */ args[1] = ir->op1; /* GCtab *t */ args[2] = ASMREF_TMP1; /* cTValue *key */ asm_setupresult(as, ir, ci); /* TValue * */ asm_gencall(as, ci, args); tmp = ra_releasetmp(as, ASMREF_TMP1); irkey = IR(ir->op2); if (irt_isnum(irkey->t)) { /* For numbers use the constant itself or a spill slot as a TValue. */ if (irref_isk(ir->op2)) emit_loada(as, tmp, ir_knum(irkey)); else emit_rmro(as, XO_LEA, tmp|REX_64, RID_ESP, ra_spill(as, irkey)); } else { /* Otherwise use g->tmptv to hold the TValue. */ if (!irref_isk(ir->op2)) { Reg src = ra_alloc1(as, ir->op2, rset_exclude(RSET_GPR, tmp)); emit_movtomro(as, REX_64IR(irkey, src), tmp, 0); } else if (!irt_ispri(irkey->t)) { emit_movmroi(as, tmp, 0, irkey->i); } if (!(LJ_64 && irt_islightud(irkey->t))) emit_movmroi(as, tmp, 4, irt_toitype(irkey->t)); emit_loada(as, tmp, &J2G(as->J)->tmptv); } } static void asm_uref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); if (irref_isk(ir->op1)) { GCfunc *fn = ir_kfunc(IR(ir->op1)); MRef *v = &gcref(fn->l.uvptr[(ir->op2 >> 8)])->uv.v; emit_rma(as, XO_MOV, dest, v); } else { Reg uv = ra_scratch(as, RSET_GPR); Reg func = ra_alloc1(as, ir->op1, RSET_GPR); if (ir->o == IR_UREFC) { emit_rmro(as, XO_LEA, dest, uv, offsetof(GCupval, tv)); asm_guardcc(as, CC_NE); emit_i8(as, 1); emit_rmro(as, XO_ARITHib, XOg_CMP, uv, offsetof(GCupval, closed)); } else { emit_rmro(as, XO_MOV, dest, uv, offsetof(GCupval, v)); } emit_rmro(as, XO_MOV, uv, func, (int32_t)offsetof(GCfuncL, uvptr) + 4*(int32_t)(ir->op2 >> 8)); } } static void asm_fref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); asm_fusefref(as, ir, RSET_GPR); emit_mrm(as, XO_LEA, dest, RID_MRM); } static void asm_strref(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); asm_fusestrref(as, ir, RSET_GPR); if (as->mrm.base == RID_NONE) emit_loadi(as, dest, as->mrm.ofs); else if (as->mrm.base == dest && as->mrm.idx == RID_NONE) emit_gri(as, XG_ARITHi(XOg_ADD), dest, as->mrm.ofs); else emit_mrm(as, XO_LEA, dest, RID_MRM); } /* -- Loads and stores ---------------------------------------------------- */ static void asm_fxload(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); x86Op xo; if (ir->o == IR_FLOAD) asm_fusefref(as, ir, RSET_GPR); else asm_fusexref(as, ir->op1, RSET_GPR); /* ir->op2 is ignored -- unaligned loads are ok on x86. */ switch (irt_type(ir->t)) { case IRT_I8: xo = XO_MOVSXb; break; case IRT_U8: xo = XO_MOVZXb; break; case IRT_I16: xo = XO_MOVSXw; break; case IRT_U16: xo = XO_MOVZXw; break; case IRT_NUM: xo = XMM_MOVRM(as); break; case IRT_FLOAT: xo = XO_MOVSS; break; default: if (LJ_64 && irt_is64(ir->t)) dest |= REX_64; else lua_assert(irt_isint(ir->t) || irt_isu32(ir->t) || irt_isaddr(ir->t)); xo = XO_MOV; break; } emit_mrm(as, xo, dest, RID_MRM); } static void asm_fxstore(ASMState *as, IRIns *ir) { RegSet allow = RSET_GPR; Reg src = RID_NONE, osrc = RID_NONE; int32_t k = 0; if (ir->r == RID_SINK) return; /* The IRT_I16/IRT_U16 stores should never be simplified for constant ** values since mov word [mem], imm16 has a length-changing prefix. */ if (irt_isi16(ir->t) || irt_isu16(ir->t) || irt_isfp(ir->t) || !asm_isk32(as, ir->op2, &k)) { RegSet allow8 = irt_isfp(ir->t) ? RSET_FPR : (irt_isi8(ir->t) || irt_isu8(ir->t)) ? RSET_GPR8 : RSET_GPR; src = osrc = ra_alloc1(as, ir->op2, allow8); if (!LJ_64 && !rset_test(allow8, src)) { /* Already in wrong register. */ rset_clear(allow, osrc); src = ra_scratch(as, allow8); } rset_clear(allow, src); } if (ir->o == IR_FSTORE) { asm_fusefref(as, IR(ir->op1), allow); } else { asm_fusexref(as, ir->op1, allow); if (LJ_32 && ir->o == IR_HIOP) as->mrm.ofs += 4; } if (ra_hasreg(src)) { x86Op xo; switch (irt_type(ir->t)) { case IRT_I8: case IRT_U8: xo = XO_MOVtob; src |= FORCE_REX; break; case IRT_I16: case IRT_U16: xo = XO_MOVtow; break; case IRT_NUM: xo = XO_MOVSDto; break; case IRT_FLOAT: xo = XO_MOVSSto; break; #if LJ_64 case IRT_LIGHTUD: lua_assert(0); /* NYI: mask 64 bit lightuserdata. */ #endif default: if (LJ_64 && irt_is64(ir->t)) src |= REX_64; else lua_assert(irt_isint(ir->t) || irt_isu32(ir->t) || irt_isaddr(ir->t)); xo = XO_MOVto; break; } emit_mrm(as, xo, src, RID_MRM); if (!LJ_64 && src != osrc) { ra_noweak(as, osrc); emit_rr(as, XO_MOV, src, osrc); } } else { if (irt_isi8(ir->t) || irt_isu8(ir->t)) { emit_i8(as, k); emit_mrm(as, XO_MOVmib, 0, RID_MRM); } else { lua_assert(irt_is64(ir->t) || irt_isint(ir->t) || irt_isu32(ir->t) || irt_isaddr(ir->t)); emit_i32(as, k); emit_mrm(as, XO_MOVmi, REX_64IR(ir, 0), RID_MRM); } } } #if LJ_64 static Reg asm_load_lightud64(ASMState *as, IRIns *ir, int typecheck) { if (ra_used(ir) || typecheck) { Reg dest = ra_dest(as, ir, RSET_GPR); if (typecheck) { Reg tmp = ra_scratch(as, rset_exclude(RSET_GPR, dest)); asm_guardcc(as, CC_NE); emit_i8(as, -2); emit_rr(as, XO_ARITHi8, XOg_CMP, tmp); emit_shifti(as, XOg_SAR|REX_64, tmp, 47); emit_rr(as, XO_MOV, tmp|REX_64, dest); } return dest; } else { return RID_NONE; } } #endif static void asm_ahuvload(ASMState *as, IRIns *ir) { lua_assert(irt_isnum(ir->t) || irt_ispri(ir->t) || irt_isaddr(ir->t) || (LJ_DUALNUM && irt_isint(ir->t))); #if LJ_64 if (irt_islightud(ir->t)) { Reg dest = asm_load_lightud64(as, ir, 1); if (ra_hasreg(dest)) { asm_fuseahuref(as, ir->op1, RSET_GPR); emit_mrm(as, XO_MOV, dest|REX_64, RID_MRM); } return; } else #endif if (ra_used(ir)) { RegSet allow = irt_isnum(ir->t) ? RSET_FPR : RSET_GPR; Reg dest = ra_dest(as, ir, allow); asm_fuseahuref(as, ir->op1, RSET_GPR); emit_mrm(as, dest < RID_MAX_GPR ? XO_MOV : XMM_MOVRM(as), dest, RID_MRM); } else { asm_fuseahuref(as, ir->op1, RSET_GPR); } /* Always do the type check, even if the load result is unused. */ as->mrm.ofs += 4; asm_guardcc(as, irt_isnum(ir->t) ? CC_AE : CC_NE); if (LJ_64 && irt_type(ir->t) >= IRT_NUM) { lua_assert(irt_isinteger(ir->t) || irt_isnum(ir->t)); emit_u32(as, LJ_TISNUM); emit_mrm(as, XO_ARITHi, XOg_CMP, RID_MRM); } else { emit_i8(as, irt_toitype(ir->t)); emit_mrm(as, XO_ARITHi8, XOg_CMP, RID_MRM); } } static void asm_ahustore(ASMState *as, IRIns *ir) { if (ir->r == RID_SINK) return; if (irt_isnum(ir->t)) { Reg src = ra_alloc1(as, ir->op2, RSET_FPR); asm_fuseahuref(as, ir->op1, RSET_GPR); emit_mrm(as, XO_MOVSDto, src, RID_MRM); #if LJ_64 } else if (irt_islightud(ir->t)) { Reg src = ra_alloc1(as, ir->op2, RSET_GPR); asm_fuseahuref(as, ir->op1, rset_exclude(RSET_GPR, src)); emit_mrm(as, XO_MOVto, src|REX_64, RID_MRM); #endif } else { IRIns *irr = IR(ir->op2); RegSet allow = RSET_GPR; Reg src = RID_NONE; if (!irref_isk(ir->op2)) { src = ra_alloc1(as, ir->op2, allow); rset_clear(allow, src); } asm_fuseahuref(as, ir->op1, allow); if (ra_hasreg(src)) { emit_mrm(as, XO_MOVto, src, RID_MRM); } else if (!irt_ispri(irr->t)) { lua_assert(irt_isaddr(ir->t) || (LJ_DUALNUM && irt_isinteger(ir->t))); emit_i32(as, irr->i); emit_mrm(as, XO_MOVmi, 0, RID_MRM); } as->mrm.ofs += 4; emit_i32(as, (int32_t)irt_toitype(ir->t)); emit_mrm(as, XO_MOVmi, 0, RID_MRM); } } static void asm_sload(ASMState *as, IRIns *ir) { int32_t ofs = 8*((int32_t)ir->op1-1) + ((ir->op2 & IRSLOAD_FRAME) ? 4 : 0); IRType1 t = ir->t; Reg base; lua_assert(!(ir->op2 & IRSLOAD_PARENT)); /* Handled by asm_head_side(). */ lua_assert(irt_isguard(t) || !(ir->op2 & IRSLOAD_TYPECHECK)); lua_assert(LJ_DUALNUM || !irt_isint(t) || (ir->op2 & (IRSLOAD_CONVERT|IRSLOAD_FRAME))); if ((ir->op2 & IRSLOAD_CONVERT) && irt_isguard(t) && irt_isint(t)) { Reg left = ra_scratch(as, RSET_FPR); asm_tointg(as, ir, left); /* Frees dest reg. Do this before base alloc. */ base = ra_alloc1(as, REF_BASE, RSET_GPR); emit_rmro(as, XMM_MOVRM(as), left, base, ofs); t.irt = IRT_NUM; /* Continue with a regular number type check. */ #if LJ_64 } else if (irt_islightud(t)) { Reg dest = asm_load_lightud64(as, ir, (ir->op2 & IRSLOAD_TYPECHECK)); if (ra_hasreg(dest)) { base = ra_alloc1(as, REF_BASE, RSET_GPR); emit_rmro(as, XO_MOV, dest|REX_64, base, ofs); } return; #endif } else if (ra_used(ir)) { RegSet allow = irt_isnum(t) ? RSET_FPR : RSET_GPR; Reg dest = ra_dest(as, ir, allow); base = ra_alloc1(as, REF_BASE, RSET_GPR); lua_assert(irt_isnum(t) || irt_isint(t) || irt_isaddr(t)); if ((ir->op2 & IRSLOAD_CONVERT)) { t.irt = irt_isint(t) ? IRT_NUM : IRT_INT; /* Check for original type. */ emit_rmro(as, irt_isint(t) ? XO_CVTSI2SD : XO_CVTSD2SI, dest, base, ofs); } else if (irt_isnum(t)) { emit_rmro(as, XMM_MOVRM(as), dest, base, ofs); } else { emit_rmro(as, XO_MOV, dest, base, ofs); } } else { if (!(ir->op2 & IRSLOAD_TYPECHECK)) return; /* No type check: avoid base alloc. */ base = ra_alloc1(as, REF_BASE, RSET_GPR); } if ((ir->op2 & IRSLOAD_TYPECHECK)) { /* Need type check, even if the load result is unused. */ asm_guardcc(as, irt_isnum(t) ? CC_AE : CC_NE); if (LJ_64 && irt_type(t) >= IRT_NUM) { lua_assert(irt_isinteger(t) || irt_isnum(t)); emit_u32(as, LJ_TISNUM); emit_rmro(as, XO_ARITHi, XOg_CMP, base, ofs+4); } else { emit_i8(as, irt_toitype(t)); emit_rmro(as, XO_ARITHi8, XOg_CMP, base, ofs+4); } } } /* -- Allocations --------------------------------------------------------- */ #if LJ_HASFFI static void asm_cnew(ASMState *as, IRIns *ir) { CTState *cts = ctype_ctsG(J2G(as->J)); CTypeID ctypeid = (CTypeID)IR(ir->op1)->i; CTSize sz = (ir->o == IR_CNEWI || ir->op2 == REF_NIL) ? lj_ctype_size(cts, ctypeid) : (CTSize)IR(ir->op2)->i; const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_mem_newgco]; IRRef args[2]; lua_assert(sz != CTSIZE_INVALID); args[0] = ASMREF_L; /* lua_State *L */ args[1] = ASMREF_TMP1; /* MSize size */ as->gcsteps++; asm_setupresult(as, ir, ci); /* GCcdata * */ /* Initialize immutable cdata object. */ if (ir->o == IR_CNEWI) { RegSet allow = (RSET_GPR & ~RSET_SCRATCH); #if LJ_64 Reg r64 = sz == 8 ? REX_64 : 0; if (irref_isk(ir->op2)) { IRIns *irk = IR(ir->op2); uint64_t k = irk->o == IR_KINT64 ? ir_k64(irk)->u64 : (uint64_t)(uint32_t)irk->i; if (sz == 4 || checki32((int64_t)k)) { emit_i32(as, (int32_t)k); emit_rmro(as, XO_MOVmi, r64, RID_RET, sizeof(GCcdata)); } else { emit_movtomro(as, RID_ECX + r64, RID_RET, sizeof(GCcdata)); emit_loadu64(as, RID_ECX, k); } } else { Reg r = ra_alloc1(as, ir->op2, allow); emit_movtomro(as, r + r64, RID_RET, sizeof(GCcdata)); } #else int32_t ofs = sizeof(GCcdata); if (sz == 8) { ofs += 4; ir++; lua_assert(ir->o == IR_HIOP); } do { if (irref_isk(ir->op2)) { emit_movmroi(as, RID_RET, ofs, IR(ir->op2)->i); } else { Reg r = ra_alloc1(as, ir->op2, allow); emit_movtomro(as, r, RID_RET, ofs); rset_clear(allow, r); } if (ofs == sizeof(GCcdata)) break; ofs -= 4; ir--; } while (1); #endif lua_assert(sz == 4 || sz == 8); } /* Combine initialization of marked, gct and ctypeid. */ emit_movtomro(as, RID_ECX, RID_RET, offsetof(GCcdata, marked)); emit_gri(as, XG_ARITHi(XOg_OR), RID_ECX, (int32_t)((~LJ_TCDATA<<8)+(ctypeid<<16))); emit_gri(as, XG_ARITHi(XOg_AND), RID_ECX, LJ_GC_WHITES); emit_opgl(as, XO_MOVZXb, RID_ECX, gc.currentwhite); asm_gencall(as, ci, args); emit_loadi(as, ra_releasetmp(as, ASMREF_TMP1), (int32_t)(sz+sizeof(GCcdata))); } #else #define asm_cnew(as, ir) ((void)0) #endif /* -- Write barriers ------------------------------------------------------ */ static void asm_tbar(ASMState *as, IRIns *ir) { Reg tab = ra_alloc1(as, ir->op1, RSET_GPR); Reg tmp = ra_scratch(as, rset_exclude(RSET_GPR, tab)); MCLabel l_end = emit_label(as); emit_movtomro(as, tmp, tab, offsetof(GCtab, gclist)); emit_setgl(as, tab, gc.grayagain); emit_getgl(as, tmp, gc.grayagain); emit_i8(as, ~LJ_GC_BLACK); emit_rmro(as, XO_ARITHib, XOg_AND, tab, offsetof(GCtab, marked)); emit_sjcc(as, CC_Z, l_end); emit_i8(as, LJ_GC_BLACK); emit_rmro(as, XO_GROUP3b, XOg_TEST, tab, offsetof(GCtab, marked)); } static void asm_obar(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_barrieruv]; IRRef args[2]; MCLabel l_end; Reg obj; /* No need for other object barriers (yet). */ lua_assert(IR(ir->op1)->o == IR_UREFC); ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ir->op1; /* TValue *tv */ asm_gencall(as, ci, args); emit_loada(as, ra_releasetmp(as, ASMREF_TMP1), J2G(as->J)); obj = IR(ir->op1)->r; emit_sjcc(as, CC_Z, l_end); emit_i8(as, LJ_GC_WHITES); if (irref_isk(ir->op2)) { GCobj *vp = ir_kgc(IR(ir->op2)); emit_rma(as, XO_GROUP3b, XOg_TEST, &vp->gch.marked); } else { Reg val = ra_alloc1(as, ir->op2, rset_exclude(RSET_SCRATCH&RSET_GPR, obj)); emit_rmro(as, XO_GROUP3b, XOg_TEST, val, (int32_t)offsetof(GChead, marked)); } emit_sjcc(as, CC_Z, l_end); emit_i8(as, LJ_GC_BLACK); emit_rmro(as, XO_GROUP3b, XOg_TEST, obj, (int32_t)offsetof(GCupval, marked)-(int32_t)offsetof(GCupval, tv)); } /* -- FP/int arithmetic and logic operations ------------------------------ */ /* Load reference onto x87 stack. Force a spill to memory if needed. */ static void asm_x87load(ASMState *as, IRRef ref) { IRIns *ir = IR(ref); if (ir->o == IR_KNUM) { cTValue *tv = ir_knum(ir); if (tvispzero(tv)) /* Use fldz only for +0. */ emit_x87op(as, XI_FLDZ); else if (tvispone(tv)) emit_x87op(as, XI_FLD1); else emit_rma(as, XO_FLDq, XOg_FLDq, tv); } else if (ir->o == IR_CONV && ir->op2 == IRCONV_NUM_INT && !ra_used(ir) && !irref_isk(ir->op1) && mayfuse(as, ir->op1)) { IRIns *iri = IR(ir->op1); emit_rmro(as, XO_FILDd, XOg_FILDd, RID_ESP, ra_spill(as, iri)); } else { emit_mrm(as, XO_FLDq, XOg_FLDq, asm_fuseload(as, ref, RSET_EMPTY)); } } /* Try to rejoin pow from EXP2, MUL and LOG2 (if still unsplit). */ static int fpmjoin_pow(ASMState *as, IRIns *ir) { IRIns *irp = IR(ir->op1); if (irp == ir-1 && irp->o == IR_MUL && !ra_used(irp)) { IRIns *irpp = IR(irp->op1); if (irpp == ir-2 && irpp->o == IR_FPMATH && irpp->op2 == IRFPM_LOG2 && !ra_used(irpp)) { /* The modified regs must match with the *.dasc implementation. */ RegSet drop = RSET_RANGE(RID_XMM0, RID_XMM2+1)|RID2RSET(RID_EAX); IRIns *irx; if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ ra_evictset(as, drop); ra_destreg(as, ir, RID_XMM0); emit_call(as, lj_vm_pow_sse); irx = IR(irpp->op1); if (ra_noreg(irx->r) && ra_gethint(irx->r) == RID_XMM1) irx->r = RID_INIT; /* Avoid allocating xmm1 for x. */ ra_left(as, RID_XMM0, irpp->op1); ra_left(as, RID_XMM1, irp->op2); return 1; } } return 0; } static void asm_fpmath(ASMState *as, IRIns *ir) { IRFPMathOp fpm = ir->o == IR_FPMATH ? (IRFPMathOp)ir->op2 : IRFPM_OTHER; if (fpm == IRFPM_SQRT) { Reg dest = ra_dest(as, ir, RSET_FPR); Reg left = asm_fuseload(as, ir->op1, RSET_FPR); emit_mrm(as, XO_SQRTSD, dest, left); } else if (fpm <= IRFPM_TRUNC) { if (as->flags & JIT_F_SSE4_1) { /* SSE4.1 has a rounding instruction. */ Reg dest = ra_dest(as, ir, RSET_FPR); Reg left = asm_fuseload(as, ir->op1, RSET_FPR); /* ROUNDSD has a 4-byte opcode which doesn't fit in x86Op. ** Let's pretend it's a 3-byte opcode, and compensate afterwards. ** This is atrocious, but the alternatives are much worse. */ /* Round down/up/trunc == 1001/1010/1011. */ emit_i8(as, 0x09 + fpm); emit_mrm(as, XO_ROUNDSD, dest, left); if (LJ_64 && as->mcp[1] != (MCode)(XO_ROUNDSD >> 16)) { as->mcp[0] = as->mcp[1]; as->mcp[1] = 0x0f; /* Swap 0F and REX. */ } *--as->mcp = 0x66; /* 1st byte of ROUNDSD opcode. */ } else { /* Call helper functions for SSE2 variant. */ /* The modified regs must match with the *.dasc implementation. */ RegSet drop = RSET_RANGE(RID_XMM0, RID_XMM3+1)|RID2RSET(RID_EAX); if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ ra_evictset(as, drop); ra_destreg(as, ir, RID_XMM0); emit_call(as, fpm == IRFPM_FLOOR ? lj_vm_floor_sse : fpm == IRFPM_CEIL ? lj_vm_ceil_sse : lj_vm_trunc_sse); ra_left(as, RID_XMM0, ir->op1); } } else if (fpm == IRFPM_EXP2 && fpmjoin_pow(as, ir)) { /* Rejoined to pow(). */ } else { /* Handle x87 ops. */ int32_t ofs = sps_scale(ir->s); /* Use spill slot or temp slots. */ Reg dest = ir->r; if (ra_hasreg(dest)) { ra_free(as, dest); ra_modified(as, dest); emit_rmro(as, XMM_MOVRM(as), dest, RID_ESP, ofs); } emit_rmro(as, XO_FSTPq, XOg_FSTPq, RID_ESP, ofs); switch (fpm) { /* st0 = lj_vm_*(st0) */ case IRFPM_EXP: emit_call(as, lj_vm_exp_x87); break; case IRFPM_EXP2: emit_call(as, lj_vm_exp2_x87); break; case IRFPM_SIN: emit_x87op(as, XI_FSIN); break; case IRFPM_COS: emit_x87op(as, XI_FCOS); break; case IRFPM_TAN: emit_x87op(as, XI_FPOP); emit_x87op(as, XI_FPTAN); break; case IRFPM_LOG: case IRFPM_LOG2: case IRFPM_LOG10: /* Note: the use of fyl2xp1 would be pointless here. When computing ** log(1.0+eps) the precision is already lost after 1.0 is added. ** Subtracting 1.0 won't recover it. OTOH math.log1p would make sense. */ emit_x87op(as, XI_FYL2X); break; case IRFPM_OTHER: switch (ir->o) { case IR_ATAN2: emit_x87op(as, XI_FPATAN); asm_x87load(as, ir->op2); break; case IR_LDEXP: emit_x87op(as, XI_FPOP1); emit_x87op(as, XI_FSCALE); break; default: lua_assert(0); break; } break; default: lua_assert(0); break; } asm_x87load(as, ir->op1); switch (fpm) { case IRFPM_LOG: emit_x87op(as, XI_FLDLN2); break; case IRFPM_LOG2: emit_x87op(as, XI_FLD1); break; case IRFPM_LOG10: emit_x87op(as, XI_FLDLG2); break; case IRFPM_OTHER: if (ir->o == IR_LDEXP) asm_x87load(as, ir->op2); break; default: break; } } } static void asm_fppowi(ASMState *as, IRIns *ir) { /* The modified regs must match with the *.dasc implementation. */ RegSet drop = RSET_RANGE(RID_XMM0, RID_XMM1+1)|RID2RSET(RID_EAX); if (ra_hasreg(ir->r)) rset_clear(drop, ir->r); /* Dest reg handled below. */ ra_evictset(as, drop); ra_destreg(as, ir, RID_XMM0); emit_call(as, lj_vm_powi_sse); ra_left(as, RID_XMM0, ir->op1); ra_left(as, RID_EAX, ir->op2); } #if LJ_64 && LJ_HASFFI static void asm_arith64(ASMState *as, IRIns *ir, IRCallID id) { const CCallInfo *ci = &lj_ir_callinfo[id]; IRRef args[2]; args[0] = ir->op1; args[1] = ir->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } #endif static void asm_intmod(ASMState *as, IRIns *ir) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_vm_modi]; IRRef args[2]; args[0] = ir->op1; args[1] = ir->op2; asm_setupresult(as, ir, ci); asm_gencall(as, ci, args); } static int asm_swapops(ASMState *as, IRIns *ir) { IRIns *irl = IR(ir->op1); IRIns *irr = IR(ir->op2); lua_assert(ra_noreg(irr->r)); if (!irm_iscomm(lj_ir_mode[ir->o])) return 0; /* Can't swap non-commutative operations. */ if (irref_isk(ir->op2)) return 0; /* Don't swap constants to the left. */ if (ra_hasreg(irl->r)) return 1; /* Swap if left already has a register. */ if (ra_samehint(ir->r, irr->r)) return 1; /* Swap if dest and right have matching hints. */ if (as->curins > as->loopref) { /* In variant part? */ if (ir->op2 < as->loopref && !irt_isphi(irr->t)) return 0; /* Keep invariants on the right. */ if (ir->op1 < as->loopref && !irt_isphi(irl->t)) return 1; /* Swap invariants to the right. */ } if (opisfusableload(irl->o)) return 1; /* Swap fusable loads to the right. */ return 0; /* Otherwise don't swap. */ } static void asm_fparith(ASMState *as, IRIns *ir, x86Op xo) { IRRef lref = ir->op1; IRRef rref = ir->op2; RegSet allow = RSET_FPR; Reg dest; Reg right = IR(rref)->r; if (ra_hasreg(right)) { rset_clear(allow, right); ra_noweak(as, right); } dest = ra_dest(as, ir, allow); if (lref == rref) { right = dest; } else if (ra_noreg(right)) { if (asm_swapops(as, ir)) { IRRef tmp = lref; lref = rref; rref = tmp; } right = asm_fuseload(as, rref, rset_clear(allow, dest)); } emit_mrm(as, xo, dest, right); ra_left(as, dest, lref); } static void asm_intarith(ASMState *as, IRIns *ir, x86Arith xa) { IRRef lref = ir->op1; IRRef rref = ir->op2; RegSet allow = RSET_GPR; Reg dest, right; int32_t k = 0; if (as->flagmcp == as->mcp) { /* Drop test r,r instruction. */ MCode *p = as->mcp + ((LJ_64 && *as->mcp < XI_TESTb) ? 3 : 2); if ((p[1] & 15) < 14) { if ((p[1] & 15) >= 12) p[1] -= 4; /* L <->S, NL <-> NS */ as->flagmcp = NULL; as->mcp = p; } /* else: cannot transform LE/NLE to cc without use of OF. */ } right = IR(rref)->r; if (ra_hasreg(right)) { rset_clear(allow, right); ra_noweak(as, right); } dest = ra_dest(as, ir, allow); if (lref == rref) { right = dest; } else if (ra_noreg(right) && !asm_isk32(as, rref, &k)) { if (asm_swapops(as, ir)) { IRRef tmp = lref; lref = rref; rref = tmp; } right = asm_fuseloadm(as, rref, rset_clear(allow, dest), irt_is64(ir->t)); } if (irt_isguard(ir->t)) /* For IR_ADDOV etc. */ asm_guardcc(as, CC_O); if (xa != XOg_X_IMUL) { if (ra_hasreg(right)) emit_mrm(as, XO_ARITH(xa), REX_64IR(ir, dest), right); else emit_gri(as, XG_ARITHi(xa), REX_64IR(ir, dest), k); } else if (ra_hasreg(right)) { /* IMUL r, mrm. */ emit_mrm(as, XO_IMUL, REX_64IR(ir, dest), right); } else { /* IMUL r, r, k. */ /* NYI: use lea/shl/add/sub (FOLD only does 2^k) depending on CPU. */ Reg left = asm_fuseloadm(as, lref, RSET_GPR, irt_is64(ir->t)); x86Op xo; if (checki8(k)) { emit_i8(as, k); xo = XO_IMULi8; } else { emit_i32(as, k); xo = XO_IMULi; } emit_mrm(as, xo, REX_64IR(ir, dest), left); return; } ra_left(as, dest, lref); } /* LEA is really a 4-operand ADD with an independent destination register, ** up to two source registers and an immediate. One register can be scaled ** by 1, 2, 4 or 8. This can be used to avoid moves or to fuse several ** instructions. ** ** Currently only a few common cases are supported: ** - 3-operand ADD: y = a+b; y = a+k with a and b already allocated ** - Left ADD fusion: y = (a+b)+k; y = (a+k)+b ** - Right ADD fusion: y = a+(b+k) ** The ommited variants have already been reduced by FOLD. ** ** There are more fusion opportunities, like gathering shifts or joining ** common references. But these are probably not worth the trouble, since ** array indexing is not decomposed and already makes use of all fields ** of the ModRM operand. */ static int asm_lea(ASMState *as, IRIns *ir) { IRIns *irl = IR(ir->op1); IRIns *irr = IR(ir->op2); RegSet allow = RSET_GPR; Reg dest; as->mrm.base = as->mrm.idx = RID_NONE; as->mrm.scale = XM_SCALE1; as->mrm.ofs = 0; if (ra_hasreg(irl->r)) { rset_clear(allow, irl->r); ra_noweak(as, irl->r); as->mrm.base = irl->r; if (irref_isk(ir->op2) || ra_hasreg(irr->r)) { /* The PHI renaming logic does a better job in some cases. */ if (ra_hasreg(ir->r) && ((irt_isphi(irl->t) && as->phireg[ir->r] == ir->op1) || (irt_isphi(irr->t) && as->phireg[ir->r] == ir->op2))) return 0; if (irref_isk(ir->op2)) { as->mrm.ofs = irr->i; } else { rset_clear(allow, irr->r); ra_noweak(as, irr->r); as->mrm.idx = irr->r; } } else if (irr->o == IR_ADD && mayfuse(as, ir->op2) && irref_isk(irr->op2)) { Reg idx = ra_alloc1(as, irr->op1, allow); rset_clear(allow, idx); as->mrm.idx = (uint8_t)idx; as->mrm.ofs = IR(irr->op2)->i; } else { return 0; } } else if (ir->op1 != ir->op2 && irl->o == IR_ADD && mayfuse(as, ir->op1) && (irref_isk(ir->op2) || irref_isk(irl->op2))) { Reg idx, base = ra_alloc1(as, irl->op1, allow); rset_clear(allow, base); as->mrm.base = (uint8_t)base; if (irref_isk(ir->op2)) { as->mrm.ofs = irr->i; idx = ra_alloc1(as, irl->op2, allow); } else { as->mrm.ofs = IR(irl->op2)->i; idx = ra_alloc1(as, ir->op2, allow); } rset_clear(allow, idx); as->mrm.idx = (uint8_t)idx; } else { return 0; } dest = ra_dest(as, ir, allow); emit_mrm(as, XO_LEA, dest, RID_MRM); return 1; /* Success. */ } static void asm_add(ASMState *as, IRIns *ir) { if (irt_isnum(ir->t)) asm_fparith(as, ir, XO_ADDSD); else if ((as->flags & JIT_F_LEA_AGU) || as->flagmcp == as->mcp || irt_is64(ir->t) || !asm_lea(as, ir)) asm_intarith(as, ir, XOg_ADD); } static void asm_neg_not(ASMState *as, IRIns *ir, x86Group3 xg) { Reg dest = ra_dest(as, ir, RSET_GPR); emit_rr(as, XO_GROUP3, REX_64IR(ir, xg), dest); ra_left(as, dest, ir->op1); } static void asm_min_max(ASMState *as, IRIns *ir, int cc) { Reg right, dest = ra_dest(as, ir, RSET_GPR); IRRef lref = ir->op1, rref = ir->op2; if (irref_isk(rref)) { lref = rref; rref = ir->op1; } right = ra_alloc1(as, rref, rset_exclude(RSET_GPR, dest)); emit_rr(as, XO_CMOV + (cc<<24), REX_64IR(ir, dest), right); emit_rr(as, XO_CMP, REX_64IR(ir, dest), right); ra_left(as, dest, lref); } static void asm_bitswap(ASMState *as, IRIns *ir) { Reg dest = ra_dest(as, ir, RSET_GPR); as->mcp = emit_op(XO_BSWAP + ((dest&7) << 24), REX_64IR(ir, 0), dest, 0, as->mcp, 1); ra_left(as, dest, ir->op1); } static void asm_bitshift(ASMState *as, IRIns *ir, x86Shift xs) { IRRef rref = ir->op2; IRIns *irr = IR(rref); Reg dest; if (irref_isk(rref)) { /* Constant shifts. */ int shift; dest = ra_dest(as, ir, RSET_GPR); shift = irr->i & (irt_is64(ir->t) ? 63 : 31); switch (shift) { case 0: break; case 1: emit_rr(as, XO_SHIFT1, REX_64IR(ir, xs), dest); break; default: emit_shifti(as, REX_64IR(ir, xs), dest, shift); break; } } else { /* Variable shifts implicitly use register cl (i.e. ecx). */ Reg right; dest = ra_dest(as, ir, rset_exclude(RSET_GPR, RID_ECX)); if (dest == RID_ECX) { dest = ra_scratch(as, rset_exclude(RSET_GPR, RID_ECX)); emit_rr(as, XO_MOV, RID_ECX, dest); } right = irr->r; if (ra_noreg(right)) right = ra_allocref(as, rref, RID2RSET(RID_ECX)); else if (right != RID_ECX) ra_scratch(as, RID2RSET(RID_ECX)); emit_rr(as, XO_SHIFTcl, REX_64IR(ir, xs), dest); ra_noweak(as, right); if (right != RID_ECX) emit_rr(as, XO_MOV, RID_ECX, right); } ra_left(as, dest, ir->op1); /* ** Note: avoid using the flags resulting from a shift or rotate! ** All of them cause a partial flag stall, except for r,1 shifts ** (but not rotates). And a shift count of 0 leaves the flags unmodified. */ } /* -- Comparisons --------------------------------------------------------- */ /* Virtual flags for unordered FP comparisons. */ #define VCC_U 0x1000 /* Unordered. */ #define VCC_P 0x2000 /* Needs extra CC_P branch. */ #define VCC_S 0x4000 /* Swap avoids CC_P branch. */ #define VCC_PS (VCC_P|VCC_S) /* Map of comparisons to flags. ORDER IR. */ #define COMPFLAGS(ci, cin, cu, cf) ((ci)+((cu)<<4)+((cin)<<8)+(cf)) static const uint16_t asm_compmap[IR_ABC+1] = { /* signed non-eq unsigned flags */ /* LT */ COMPFLAGS(CC_GE, CC_G, CC_AE, VCC_PS), /* GE */ COMPFLAGS(CC_L, CC_L, CC_B, 0), /* LE */ COMPFLAGS(CC_G, CC_G, CC_A, VCC_PS), /* GT */ COMPFLAGS(CC_LE, CC_L, CC_BE, 0), /* ULT */ COMPFLAGS(CC_AE, CC_A, CC_AE, VCC_U), /* UGE */ COMPFLAGS(CC_B, CC_B, CC_B, VCC_U|VCC_PS), /* ULE */ COMPFLAGS(CC_A, CC_A, CC_A, VCC_U), /* UGT */ COMPFLAGS(CC_BE, CC_B, CC_BE, VCC_U|VCC_PS), /* EQ */ COMPFLAGS(CC_NE, CC_NE, CC_NE, VCC_P), /* NE */ COMPFLAGS(CC_E, CC_E, CC_E, VCC_U|VCC_P), /* ABC */ COMPFLAGS(CC_BE, CC_B, CC_BE, VCC_U|VCC_PS) /* Same as UGT. */ }; /* FP and integer comparisons. */ static void asm_comp(ASMState *as, IRIns *ir, uint32_t cc) { if (irt_isnum(ir->t)) { IRRef lref = ir->op1; IRRef rref = ir->op2; Reg left, right; MCLabel l_around; /* ** An extra CC_P branch is required to preserve ordered/unordered ** semantics for FP comparisons. This can be avoided by swapping ** the operands and inverting the condition (except for EQ and UNE). ** So always try to swap if possible. ** ** Another option would be to swap operands to achieve better memory ** operand fusion. But it's unlikely that this outweighs the cost ** of the extra branches. */ if (cc & VCC_S) { /* Swap? */ IRRef tmp = lref; lref = rref; rref = tmp; cc ^= (VCC_PS|(5<<4)); /* A <-> B, AE <-> BE, PS <-> none */ } left = ra_alloc1(as, lref, RSET_FPR); right = asm_fuseload(as, rref, rset_exclude(RSET_FPR, left)); l_around = emit_label(as); asm_guardcc(as, cc >> 4); if (cc & VCC_P) { /* Extra CC_P branch required? */ if (!(cc & VCC_U)) { asm_guardcc(as, CC_P); /* Branch to exit for ordered comparisons. */ } else if (l_around != as->invmcp) { emit_sjcc(as, CC_P, l_around); /* Branch around for unordered. */ } else { /* Patched to mcloop by asm_loop_fixup. */ as->loopinv = 2; if (as->realign) emit_sjcc(as, CC_P, as->mcp); else emit_jcc(as, CC_P, as->mcp); } } emit_mrm(as, XO_UCOMISD, left, right); } else { IRRef lref = ir->op1, rref = ir->op2; IROp leftop = (IROp)(IR(lref)->o); Reg r64 = REX_64IR(ir, 0); int32_t imm = 0; lua_assert(irt_is64(ir->t) || irt_isint(ir->t) || irt_isu32(ir->t) || irt_isaddr(ir->t) || irt_isu8(ir->t)); /* Swap constants (only for ABC) and fusable loads to the right. */ if (irref_isk(lref) || (!irref_isk(rref) && opisfusableload(leftop))) { if ((cc & 0xc) == 0xc) cc ^= 0x53; /* L <-> G, LE <-> GE */ else if ((cc & 0xa) == 0x2) cc ^= 0x55; /* A <-> B, AE <-> BE */ lref = ir->op2; rref = ir->op1; } if (asm_isk32(as, rref, &imm)) { IRIns *irl = IR(lref); /* Check wether we can use test ins. Not for unsigned, since CF=0. */ int usetest = (imm == 0 && (cc & 0xa) != 0x2); if (usetest && irl->o == IR_BAND && irl+1 == ir && !ra_used(irl)) { /* Combine comp(BAND(ref, r/imm), 0) into test mrm, r/imm. */ Reg right, left = RID_NONE; RegSet allow = RSET_GPR; if (!asm_isk32(as, irl->op2, &imm)) { left = ra_alloc1(as, irl->op2, allow); rset_clear(allow, left); } else { /* Try to Fuse IRT_I8/IRT_U8 loads, too. See below. */ IRIns *irll = IR(irl->op1); if (opisfusableload((IROp)irll->o) && (irt_isi8(irll->t) || irt_isu8(irll->t))) { IRType1 origt = irll->t; /* Temporarily flip types. */ irll->t.irt = (irll->t.irt & ~IRT_TYPE) | IRT_INT; as->curins--; /* Skip to BAND to avoid failing in noconflict(). */ right = asm_fuseload(as, irl->op1, RSET_GPR); as->curins++; irll->t = origt; if (right != RID_MRM) goto test_nofuse; /* Fusion succeeded, emit test byte mrm, imm8. */ asm_guardcc(as, cc); emit_i8(as, (imm & 0xff)); emit_mrm(as, XO_GROUP3b, XOg_TEST, RID_MRM); return; } } as->curins--; /* Skip to BAND to avoid failing in noconflict(). */ right = asm_fuseloadm(as, irl->op1, allow, r64); as->curins++; /* Undo the above. */ test_nofuse: asm_guardcc(as, cc); if (ra_noreg(left)) { emit_i32(as, imm); emit_mrm(as, XO_GROUP3, r64 + XOg_TEST, right); } else { emit_mrm(as, XO_TEST, r64 + left, right); } } else { Reg left; if (opisfusableload((IROp)irl->o) && ((irt_isu8(irl->t) && checku8(imm)) || ((irt_isi8(irl->t) || irt_isi16(irl->t)) && checki8(imm)) || (irt_isu16(irl->t) && checku16(imm) && checki8((int16_t)imm)))) { /* Only the IRT_INT case is fused by asm_fuseload. ** The IRT_I8/IRT_U8 loads and some IRT_I16/IRT_U16 loads ** are handled here. ** Note that cmp word [mem], imm16 should not be generated, ** since it has a length-changing prefix. Compares of a word ** against a sign-extended imm8 are ok, however. */ IRType1 origt = irl->t; /* Temporarily flip types. */ irl->t.irt = (irl->t.irt & ~IRT_TYPE) | IRT_INT; left = asm_fuseload(as, lref, RSET_GPR); irl->t = origt; if (left == RID_MRM) { /* Fusion succeeded? */ if (irt_isu8(irl->t) || irt_isu16(irl->t)) cc >>= 4; /* Need unsigned compare. */ asm_guardcc(as, cc); emit_i8(as, imm); emit_mrm(as, (irt_isi8(origt) || irt_isu8(origt)) ? XO_ARITHib : XO_ARITHiw8, r64 + XOg_CMP, RID_MRM); return; } /* Otherwise handle register case as usual. */ } else { left = asm_fuseloadm(as, lref, irt_isu8(ir->t) ? RSET_GPR8 : RSET_GPR, r64); } asm_guardcc(as, cc); if (usetest && left != RID_MRM) { /* Use test r,r instead of cmp r,0. */ x86Op xo = XO_TEST; if (irt_isu8(ir->t)) { lua_assert(ir->o == IR_EQ || ir->o == IR_NE); xo = XO_TESTb; if (!rset_test(RSET_RANGE(RID_EAX, RID_EBX+1), left)) { if (LJ_64) { left |= FORCE_REX; } else { emit_i32(as, 0xff); emit_mrm(as, XO_GROUP3, XOg_TEST, left); return; } } } emit_rr(as, xo, r64 + left, left); if (irl+1 == ir) /* Referencing previous ins? */ as->flagmcp = as->mcp; /* Set flag to drop test r,r if possible. */ } else { emit_gmrmi(as, XG_ARITHi(XOg_CMP), r64 + left, imm); } } } else { Reg left = ra_alloc1(as, lref, RSET_GPR); Reg right = asm_fuseloadm(as, rref, rset_exclude(RSET_GPR, left), r64); asm_guardcc(as, cc); emit_mrm(as, XO_CMP, r64 + left, right); } } } #if LJ_32 && LJ_HASFFI /* 64 bit integer comparisons in 32 bit mode. */ static void asm_comp_int64(ASMState *as, IRIns *ir) { uint32_t cc = asm_compmap[(ir-1)->o]; RegSet allow = RSET_GPR; Reg lefthi = RID_NONE, leftlo = RID_NONE; Reg righthi = RID_NONE, rightlo = RID_NONE; MCLabel l_around; x86ModRM mrm; as->curins--; /* Skip loword ins. Avoids failing in noconflict(), too. */ /* Allocate/fuse hiword operands. */ if (irref_isk(ir->op2)) { lefthi = asm_fuseload(as, ir->op1, allow); } else { lefthi = ra_alloc1(as, ir->op1, allow); rset_clear(allow, lefthi); righthi = asm_fuseload(as, ir->op2, allow); if (righthi == RID_MRM) { if (as->mrm.base != RID_NONE) rset_clear(allow, as->mrm.base); if (as->mrm.idx != RID_NONE) rset_clear(allow, as->mrm.idx); } else { rset_clear(allow, righthi); } } mrm = as->mrm; /* Save state for hiword instruction. */ /* Allocate/fuse loword operands. */ if (irref_isk((ir-1)->op2)) { leftlo = asm_fuseload(as, (ir-1)->op1, allow); } else { leftlo = ra_alloc1(as, (ir-1)->op1, allow); rset_clear(allow, leftlo); rightlo = asm_fuseload(as, (ir-1)->op2, allow); } /* All register allocations must be performed _before_ this point. */ l_around = emit_label(as); as->invmcp = as->flagmcp = NULL; /* Cannot use these optimizations. */ /* Loword comparison and branch. */ asm_guardcc(as, cc >> 4); /* Always use unsigned compare for loword. */ if (ra_noreg(rightlo)) { int32_t imm = IR((ir-1)->op2)->i; if (imm == 0 && ((cc >> 4) & 0xa) != 0x2 && leftlo != RID_MRM) emit_rr(as, XO_TEST, leftlo, leftlo); else emit_gmrmi(as, XG_ARITHi(XOg_CMP), leftlo, imm); } else { emit_mrm(as, XO_CMP, leftlo, rightlo); } /* Hiword comparison and branches. */ if ((cc & 15) != CC_NE) emit_sjcc(as, CC_NE, l_around); /* Hiword unequal: skip loword compare. */ if ((cc & 15) != CC_E) asm_guardcc(as, cc >> 8); /* Hiword compare without equality check. */ as->mrm = mrm; /* Restore state. */ if (ra_noreg(righthi)) { int32_t imm = IR(ir->op2)->i; if (imm == 0 && (cc & 0xa) != 0x2 && lefthi != RID_MRM) emit_rr(as, XO_TEST, lefthi, lefthi); else emit_gmrmi(as, XG_ARITHi(XOg_CMP), lefthi, imm); } else { emit_mrm(as, XO_CMP, lefthi, righthi); } } #endif /* -- Support for 64 bit ops in 32 bit mode ------------------------------- */ /* Hiword op of a split 64 bit op. Previous op must be the loword op. */ static void asm_hiop(ASMState *as, IRIns *ir) { #if LJ_32 && LJ_HASFFI /* HIOP is marked as a store because it needs its own DCE logic. */ int uselo = ra_used(ir-1), usehi = ra_used(ir); /* Loword/hiword used? */ if (LJ_UNLIKELY(!(as->flags & JIT_F_OPT_DCE))) uselo = usehi = 1; if ((ir-1)->o == IR_CONV) { /* Conversions to/from 64 bit. */ if (usehi || uselo) { if (irt_isfp(ir->t)) asm_conv_fp_int64(as, ir); else asm_conv_int64_fp(as, ir); } as->curins--; /* Always skip the CONV. */ return; } else if ((ir-1)->o <= IR_NE) { /* 64 bit integer comparisons. ORDER IR. */ asm_comp_int64(as, ir); return; } else if ((ir-1)->o == IR_XSTORE) { if ((ir-1)->r != RID_SINK) asm_fxstore(as, ir); return; } if (!usehi) return; /* Skip unused hiword op for all remaining ops. */ switch ((ir-1)->o) { case IR_ADD: as->flagmcp = NULL; as->curins--; asm_intarith(as, ir, XOg_ADC); asm_intarith(as, ir-1, XOg_ADD); break; case IR_SUB: as->flagmcp = NULL; as->curins--; asm_intarith(as, ir, XOg_SBB); asm_intarith(as, ir-1, XOg_SUB); break; case IR_NEG: { Reg dest = ra_dest(as, ir, RSET_GPR); emit_rr(as, XO_GROUP3, XOg_NEG, dest); emit_i8(as, 0); emit_rr(as, XO_ARITHi8, XOg_ADC, dest); ra_left(as, dest, ir->op1); as->curins--; asm_neg_not(as, ir-1, XOg_NEG); break; } case IR_CALLN: case IR_CALLXS: if (!uselo) ra_allocref(as, ir->op1, RID2RSET(RID_RETLO)); /* Mark lo op as used. */ break; case IR_CNEWI: /* Nothing to do here. Handled by CNEWI itself. */ break; default: lua_assert(0); break; } #else UNUSED(as); UNUSED(ir); lua_assert(0); /* Unused on x64 or without FFI. */ #endif } /* -- Stack handling ------------------------------------------------------ */ /* Check Lua stack size for overflow. Use exit handler as fallback. */ static void asm_stack_check(ASMState *as, BCReg topslot, IRIns *irp, RegSet allow, ExitNo exitno) { /* Try to get an unused temp. register, otherwise spill/restore eax. */ Reg pbase = irp ? irp->r : RID_BASE; Reg r = allow ? rset_pickbot(allow) : RID_EAX; emit_jcc(as, CC_B, exitstub_addr(as->J, exitno)); if (allow == RSET_EMPTY) /* Restore temp. register. */ emit_rmro(as, XO_MOV, r|REX_64, RID_ESP, 0); else ra_modified(as, r); emit_gri(as, XG_ARITHi(XOg_CMP), r, (int32_t)(8*topslot)); if (ra_hasreg(pbase) && pbase != r) emit_rr(as, XO_ARITH(XOg_SUB), r, pbase); else emit_rmro(as, XO_ARITH(XOg_SUB), r, RID_NONE, ptr2addr(&J2G(as->J)->jit_base)); emit_rmro(as, XO_MOV, r, r, offsetof(lua_State, maxstack)); emit_getgl(as, r, jit_L); if (allow == RSET_EMPTY) /* Spill temp. register. */ emit_rmro(as, XO_MOVto, r|REX_64, RID_ESP, 0); } /* Restore Lua stack from on-trace state. */ static void asm_stack_restore(ASMState *as, SnapShot *snap) { SnapEntry *map = &as->T->snapmap[snap->mapofs]; SnapEntry *flinks = &as->T->snapmap[snap_nextofs(as->T, snap)-1]; MSize n, nent = snap->nent; /* Store the value of all modified slots to the Lua stack. */ for (n = 0; n < nent; n++) { SnapEntry sn = map[n]; BCReg s = snap_slot(sn); int32_t ofs = 8*((int32_t)s-1); IRRef ref = snap_ref(sn); IRIns *ir = IR(ref); if ((sn & SNAP_NORESTORE)) continue; if (irt_isnum(ir->t)) { Reg src = ra_alloc1(as, ref, RSET_FPR); emit_rmro(as, XO_MOVSDto, src, RID_BASE, ofs); } else { lua_assert(irt_ispri(ir->t) || irt_isaddr(ir->t) || (LJ_DUALNUM && irt_isinteger(ir->t))); if (!irref_isk(ref)) { Reg src = ra_alloc1(as, ref, rset_exclude(RSET_GPR, RID_BASE)); emit_movtomro(as, REX_64IR(ir, src), RID_BASE, ofs); } else if (!irt_ispri(ir->t)) { emit_movmroi(as, RID_BASE, ofs, ir->i); } if ((sn & (SNAP_CONT|SNAP_FRAME))) { if (s != 0) /* Do not overwrite link to previous frame. */ emit_movmroi(as, RID_BASE, ofs+4, (int32_t)(*flinks--)); } else { if (!(LJ_64 && irt_islightud(ir->t))) emit_movmroi(as, RID_BASE, ofs+4, irt_toitype(ir->t)); } } checkmclim(as); } lua_assert(map + nent == flinks); } /* -- GC handling --------------------------------------------------------- */ /* Check GC threshold and do one or more GC steps. */ static void asm_gc_check(ASMState *as) { const CCallInfo *ci = &lj_ir_callinfo[IRCALL_lj_gc_step_jit]; IRRef args[2]; MCLabel l_end; Reg tmp; ra_evictset(as, RSET_SCRATCH); l_end = emit_label(as); /* Exit trace if in GCSatomic or GCSfinalize. Avoids syncing GC objects. */ asm_guardcc(as, CC_NE); /* Assumes asm_snap_prep() already done. */ emit_rr(as, XO_TEST, RID_RET, RID_RET); args[0] = ASMREF_TMP1; /* global_State *g */ args[1] = ASMREF_TMP2; /* MSize steps */ asm_gencall(as, ci, args); tmp = ra_releasetmp(as, ASMREF_TMP1); emit_loada(as, tmp, J2G(as->J)); emit_loadi(as, ra_releasetmp(as, ASMREF_TMP2), as->gcsteps); /* Jump around GC step if GC total < GC threshold. */ emit_sjcc(as, CC_B, l_end); emit_opgl(as, XO_ARITH(XOg_CMP), tmp, gc.threshold); emit_getgl(as, tmp, gc.total); as->gcsteps = 0; checkmclim(as); } /* -- Loop handling ------------------------------------------------------- */ /* Fixup the loop branch. */ static void asm_loop_fixup(ASMState *as) { MCode *p = as->mctop; MCode *target = as->mcp; if (as->realign) { /* Realigned loops use short jumps. */ as->realign = NULL; /* Stop another retry. */ lua_assert(((intptr_t)target & 15) == 0); if (as->loopinv) { /* Inverted loop branch? */ p -= 5; p[0] = XI_JMP; lua_assert(target - p >= -128); p[-1] = (MCode)(target - p); /* Patch sjcc. */ if (as->loopinv == 2) p[-3] = (MCode)(target - p + 2); /* Patch opt. short jp. */ } else { lua_assert(target - p >= -128); p[-1] = (MCode)(int8_t)(target - p); /* Patch short jmp. */ p[-2] = XI_JMPs; } } else { MCode *newloop; p[-5] = XI_JMP; if (as->loopinv) { /* Inverted loop branch? */ /* asm_guardcc already inverted the jcc and patched the jmp. */ p -= 5; newloop = target+4; *(int32_t *)(p-4) = (int32_t)(target - p); /* Patch jcc. */ if (as->loopinv == 2) { *(int32_t *)(p-10) = (int32_t)(target - p + 6); /* Patch opt. jp. */ newloop = target+8; } } else { /* Otherwise just patch jmp. */ *(int32_t *)(p-4) = (int32_t)(target - p); newloop = target+3; } /* Realign small loops and shorten the loop branch. */ if (newloop >= p - 128) { as->realign = newloop; /* Force a retry and remember alignment. */ as->curins = as->stopins; /* Abort asm_trace now. */ as->T->nins = as->orignins; /* Remove any added renames. */ } } } /* -- Head of trace ------------------------------------------------------- */ /* Coalesce BASE register for a root trace. */ static void asm_head_root_base(ASMState *as) { IRIns *ir = IR(REF_BASE); Reg r = ir->r; if (ra_hasreg(r)) { ra_free(as, r); if (rset_test(as->modset, r) || irt_ismarked(ir->t)) ir->r = RID_INIT; /* No inheritance for modified BASE register. */ if (r != RID_BASE) emit_rr(as, XO_MOV, r, RID_BASE); } } /* Coalesce or reload BASE register for a side trace. */ static RegSet asm_head_side_base(ASMState *as, IRIns *irp, RegSet allow) { IRIns *ir = IR(REF_BASE); Reg r = ir->r; if (ra_hasreg(r)) { ra_free(as, r); if (rset_test(as->modset, r) || irt_ismarked(ir->t)) ir->r = RID_INIT; /* No inheritance for modified BASE register. */ if (irp->r == r) { rset_clear(allow, r); /* Mark same BASE register as coalesced. */ } else if (ra_hasreg(irp->r) && rset_test(as->freeset, irp->r)) { rset_clear(allow, irp->r); emit_rr(as, XO_MOV, r, irp->r); /* Move from coalesced parent reg. */ } else { emit_getgl(as, r, jit_base); /* Otherwise reload BASE. */ } } return allow; } /* -- Tail of trace ------------------------------------------------------- */ /* Fixup the tail code. */ static void asm_tail_fixup(ASMState *as, TraceNo lnk) { /* Note: don't use as->mcp swap + emit_*: emit_op overwrites more bytes. */ MCode *p = as->mctop; MCode *target, *q; int32_t spadj = as->T->spadjust; if (spadj == 0) { p -= ((as->flags & JIT_F_LEA_AGU) ? 7 : 6) + (LJ_64 ? 1 : 0); } else { MCode *p1; /* Patch stack adjustment. */ if (checki8(spadj)) { p -= 3; p1 = p-6; *p1 = (MCode)spadj; } else { p1 = p-9; *(int32_t *)p1 = spadj; } if ((as->flags & JIT_F_LEA_AGU)) { #if LJ_64 p1[-4] = 0x48; #endif p1[-3] = (MCode)XI_LEA; p1[-2] = MODRM(checki8(spadj) ? XM_OFS8 : XM_OFS32, RID_ESP, RID_ESP); p1[-1] = MODRM(XM_SCALE1, RID_ESP, RID_ESP); } else { #if LJ_64 p1[-3] = 0x48; #endif p1[-2] = (MCode)(checki8(spadj) ? XI_ARITHi8 : XI_ARITHi); p1[-1] = MODRM(XM_REG, XOg_ADD, RID_ESP); } } /* Patch exit branch. */ target = lnk ? traceref(as->J, lnk)->mcode : (MCode *)lj_vm_exit_interp; *(int32_t *)(p-4) = jmprel(p, target); p[-5] = XI_JMP; /* Drop unused mcode tail. Fill with NOPs to make the prefetcher happy. */ for (q = as->mctop-1; q >= p; q--) *q = XI_NOP; as->mctop = p; } /* Prepare tail of code. */ static void asm_tail_prep(ASMState *as) { MCode *p = as->mctop; /* Realign and leave room for backwards loop branch or exit branch. */ if (as->realign) { int i = ((int)(intptr_t)as->realign) & 15; /* Fill unused mcode tail with NOPs to make the prefetcher happy. */ while (i-- > 0) *--p = XI_NOP; as->mctop = p; p -= (as->loopinv ? 5 : 2); /* Space for short/near jmp. */ } else { p -= 5; /* Space for exit branch (near jmp). */ } if (as->loopref) { as->invmcp = as->mcp = p; } else { /* Leave room for ESP adjustment: add esp, imm or lea esp, [esp+imm] */ as->mcp = p - (((as->flags & JIT_F_LEA_AGU) ? 7 : 6) + (LJ_64 ? 1 : 0)); as->invmcp = NULL; } } /* -- Instruction dispatch ------------------------------------------------ */ /* Assemble a single instruction. */ static void asm_ir(ASMState *as, IRIns *ir) { switch ((IROp)ir->o) { /* Miscellaneous ops. */ case IR_LOOP: asm_loop(as); break; case IR_NOP: case IR_XBAR: lua_assert(!ra_used(ir)); break; case IR_USE: ra_alloc1(as, ir->op1, irt_isfp(ir->t) ? RSET_FPR : RSET_GPR); break; case IR_PHI: asm_phi(as, ir); break; case IR_HIOP: asm_hiop(as, ir); break; case IR_GCSTEP: asm_gcstep(as, ir); break; /* Guarded assertions. */ case IR_LT: case IR_GE: case IR_LE: case IR_GT: case IR_ULT: case IR_UGE: case IR_ULE: case IR_UGT: case IR_EQ: case IR_NE: case IR_ABC: asm_comp(as, ir, asm_compmap[ir->o]); break; case IR_RETF: asm_retf(as, ir); break; /* Bit ops. */ case IR_BNOT: asm_neg_not(as, ir, XOg_NOT); break; case IR_BSWAP: asm_bitswap(as, ir); break; case IR_BAND: asm_intarith(as, ir, XOg_AND); break; case IR_BOR: asm_intarith(as, ir, XOg_OR); break; case IR_BXOR: asm_intarith(as, ir, XOg_XOR); break; case IR_BSHL: asm_bitshift(as, ir, XOg_SHL); break; case IR_BSHR: asm_bitshift(as, ir, XOg_SHR); break; case IR_BSAR: asm_bitshift(as, ir, XOg_SAR); break; case IR_BROL: asm_bitshift(as, ir, XOg_ROL); break; case IR_BROR: asm_bitshift(as, ir, XOg_ROR); break; /* Arithmetic ops. */ case IR_ADD: asm_add(as, ir); break; case IR_SUB: if (irt_isnum(ir->t)) asm_fparith(as, ir, XO_SUBSD); else /* Note: no need for LEA trick here. i-k is encoded as i+(-k). */ asm_intarith(as, ir, XOg_SUB); break; case IR_MUL: if (irt_isnum(ir->t)) asm_fparith(as, ir, XO_MULSD); else asm_intarith(as, ir, XOg_X_IMUL); break; case IR_DIV: #if LJ_64 && LJ_HASFFI if (!irt_isnum(ir->t)) asm_arith64(as, ir, irt_isi64(ir->t) ? IRCALL_lj_carith_divi64 : IRCALL_lj_carith_divu64); else #endif asm_fparith(as, ir, XO_DIVSD); break; case IR_MOD: #if LJ_64 && LJ_HASFFI if (!irt_isint(ir->t)) asm_arith64(as, ir, irt_isi64(ir->t) ? IRCALL_lj_carith_modi64 : IRCALL_lj_carith_modu64); else #endif asm_intmod(as, ir); break; case IR_NEG: if (irt_isnum(ir->t)) asm_fparith(as, ir, XO_XORPS); else asm_neg_not(as, ir, XOg_NEG); break; case IR_ABS: asm_fparith(as, ir, XO_ANDPS); break; case IR_MIN: if (irt_isnum(ir->t)) asm_fparith(as, ir, XO_MINSD); else asm_min_max(as, ir, CC_G); break; case IR_MAX: if (irt_isnum(ir->t)) asm_fparith(as, ir, XO_MAXSD); else asm_min_max(as, ir, CC_L); break; case IR_FPMATH: case IR_ATAN2: case IR_LDEXP: asm_fpmath(as, ir); break; case IR_POW: #if LJ_64 && LJ_HASFFI if (!irt_isnum(ir->t)) asm_arith64(as, ir, irt_isi64(ir->t) ? IRCALL_lj_carith_powi64 : IRCALL_lj_carith_powu64); else #endif asm_fppowi(as, ir); break; /* Overflow-checking arithmetic ops. Note: don't use LEA here! */ case IR_ADDOV: asm_intarith(as, ir, XOg_ADD); break; case IR_SUBOV: asm_intarith(as, ir, XOg_SUB); break; case IR_MULOV: asm_intarith(as, ir, XOg_X_IMUL); break; /* Memory references. */ case IR_AREF: asm_aref(as, ir); break; case IR_HREF: asm_href(as, ir); break; case IR_HREFK: asm_hrefk(as, ir); break; case IR_NEWREF: asm_newref(as, ir); break; case IR_UREFO: case IR_UREFC: asm_uref(as, ir); break; case IR_FREF: asm_fref(as, ir); break; case IR_STRREF: asm_strref(as, ir); break; /* Loads and stores. */ case IR_ALOAD: case IR_HLOAD: case IR_ULOAD: case IR_VLOAD: asm_ahuvload(as, ir); break; case IR_FLOAD: case IR_XLOAD: asm_fxload(as, ir); break; case IR_SLOAD: asm_sload(as, ir); break; case IR_ASTORE: case IR_HSTORE: case IR_USTORE: asm_ahustore(as, ir); break; case IR_FSTORE: case IR_XSTORE: asm_fxstore(as, ir); break; /* Allocations. */ case IR_SNEW: case IR_XSNEW: asm_snew(as, ir); break; case IR_TNEW: asm_tnew(as, ir); break; case IR_TDUP: asm_tdup(as, ir); break; case IR_CNEW: case IR_CNEWI: asm_cnew(as, ir); break; /* Write barriers. */ case IR_TBAR: asm_tbar(as, ir); break; case IR_OBAR: asm_obar(as, ir); break; /* Type conversions. */ case IR_TOBIT: asm_tobit(as, ir); break; case IR_CONV: asm_conv(as, ir); break; case IR_TOSTR: asm_tostr(as, ir); break; case IR_STRTO: asm_strto(as, ir); break; /* Calls. */ case IR_CALLN: case IR_CALLL: case IR_CALLS: asm_call(as, ir); break; case IR_CALLXS: asm_callx(as, ir); break; case IR_CARG: break; default: setintV(&as->J->errinfo, ir->o); lj_trace_err_info(as->J, LJ_TRERR_NYIIR); break; } } /* -- Trace setup --------------------------------------------------------- */ /* Ensure there are enough stack slots for call arguments. */ static Reg asm_setup_call_slots(ASMState *as, IRIns *ir, const CCallInfo *ci) { IRRef args[CCI_NARGS_MAX*2]; int nslots; asm_collectargs(as, ir, ci, args); nslots = asm_count_call_slots(as, ci, args); if (nslots > as->evenspill) /* Leave room for args in stack slots. */ as->evenspill = nslots; #if LJ_64 return irt_isfp(ir->t) ? REGSP_HINT(RID_FPRET) : REGSP_HINT(RID_RET); #else return irt_isfp(ir->t) ? REGSP_INIT : REGSP_HINT(RID_RET); #endif } /* Target-specific setup. */ static void asm_setup_target(ASMState *as) { asm_exitstub_setup(as, as->T->nsnap); } /* -- Trace patching ------------------------------------------------------ */ static const uint8_t map_op1[256] = { 0x92,0x92,0x92,0x92,0x52,0x45,0x51,0x51,0x92,0x92,0x92,0x92,0x52,0x45,0x51,0x20, 0x92,0x92,0x92,0x92,0x52,0x45,0x51,0x51,0x92,0x92,0x92,0x92,0x52,0x45,0x51,0x51, 0x92,0x92,0x92,0x92,0x52,0x45,0x10,0x51,0x92,0x92,0x92,0x92,0x52,0x45,0x10,0x51, 0x92,0x92,0x92,0x92,0x52,0x45,0x10,0x51,0x92,0x92,0x92,0x92,0x52,0x45,0x10,0x51, #if LJ_64 0x10,0x10,0x10,0x10,0x10,0x10,0x10,0x10,0x14,0x14,0x14,0x14,0x14,0x14,0x14,0x14, #else 0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51, #endif 0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51, 0x51,0x51,0x92,0x92,0x10,0x10,0x12,0x11,0x45,0x86,0x52,0x93,0x51,0x51,0x51,0x51, 0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52, 0x93,0x86,0x93,0x93,0x92,0x92,0x92,0x92,0x92,0x92,0x92,0x92,0x92,0x92,0x92,0x92, 0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x51,0x47,0x51,0x51,0x51,0x51,0x51, #if LJ_64 0x59,0x59,0x59,0x59,0x51,0x51,0x51,0x51,0x52,0x45,0x51,0x51,0x51,0x51,0x51,0x51, #else 0x55,0x55,0x55,0x55,0x51,0x51,0x51,0x51,0x52,0x45,0x51,0x51,0x51,0x51,0x51,0x51, #endif 0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x05,0x05,0x05,0x05,0x05,0x05,0x05,0x05, 0x93,0x93,0x53,0x51,0x70,0x71,0x93,0x86,0x54,0x51,0x53,0x51,0x51,0x52,0x51,0x51, 0x92,0x92,0x92,0x92,0x52,0x52,0x51,0x51,0x92,0x92,0x92,0x92,0x92,0x92,0x92,0x92, 0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x45,0x45,0x47,0x52,0x51,0x51,0x51,0x51, 0x10,0x51,0x10,0x10,0x51,0x51,0x63,0x66,0x51,0x51,0x51,0x51,0x51,0x51,0x92,0x92 }; static const uint8_t map_op2[256] = { 0x93,0x93,0x93,0x93,0x52,0x52,0x52,0x52,0x52,0x52,0x51,0x52,0x51,0x93,0x52,0x94, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x53,0x53,0x53,0x53,0x53,0x53,0x53,0x53,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x34,0x51,0x35,0x51,0x51,0x51,0x51,0x51, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x53,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x94,0x54,0x54,0x54,0x93,0x93,0x93,0x52,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46,0x46, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x52,0x52,0x52,0x93,0x94,0x93,0x51,0x51,0x52,0x52,0x52,0x93,0x94,0x93,0x93,0x93, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x94,0x93,0x93,0x93,0x93,0x93, 0x93,0x93,0x94,0x93,0x94,0x94,0x94,0x93,0x52,0x52,0x52,0x52,0x52,0x52,0x52,0x52, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93, 0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x93,0x52 }; static uint32_t asm_x86_inslen(const uint8_t* p) { uint32_t result = 0; uint32_t prefixes = 0; uint32_t x = map_op1[*p]; for (;;) { switch (x >> 4) { case 0: return result + x + (prefixes & 4); case 1: prefixes |= x; x = map_op1[*++p]; result++; break; case 2: x = map_op2[*++p]; break; case 3: p++; goto mrm; case 4: result -= (prefixes & 2); /* fallthrough */ case 5: return result + (x & 15); case 6: /* Group 3. */ if (p[1] & 0x38) x = 2; else if ((prefixes & 2) && (x == 0x66)) x = 4; goto mrm; case 7: /* VEX c4/c5. */ if (LJ_32 && p[1] < 0xc0) { x = 2; goto mrm; } if (x == 0x70) { x = *++p & 0x1f; result++; if (x >= 2) { p += 2; result += 2; goto mrm; } } p++; result++; x = map_op2[*++p]; break; case 8: result -= (prefixes & 2); /* fallthrough */ case 9: mrm: /* ModR/M and possibly SIB. */ result += (x & 15); x = *++p; switch (x >> 6) { case 0: if ((x & 7) == 5) return result + 4; break; case 1: result++; break; case 2: result += 4; break; case 3: return result; } if ((x & 7) == 4) { result++; if (x < 0x40 && (p[1] & 7) == 5) result += 4; } return result; } } } /* Patch exit jumps of existing machine code to a new target. */ void lj_asm_patchexit(jit_State *J, GCtrace *T, ExitNo exitno, MCode *target) { MCode *p = T->mcode; MCode *mcarea = lj_mcode_patch(J, p, 0); MSize len = T->szmcode; MCode *px = exitstub_addr(J, exitno) - 6; MCode *pe = p+len-6; uint32_t stateaddr = u32ptr(&J2G(J)->vmstate); if (len > 5 && p[len-5] == XI_JMP && p+len-6 + *(int32_t *)(p+len-4) == px) *(int32_t *)(p+len-4) = jmprel(p+len, target); /* Do not patch parent exit for a stack check. Skip beyond vmstate update. */ for (; p < pe; p += asm_x86_inslen(p)) if (*(uint32_t *)(p+(LJ_64 ? 3 : 2)) == stateaddr && p[0] == XI_MOVmi) break; lua_assert(p < pe); for (; p < pe; p += asm_x86_inslen(p)) if ((*(uint16_t *)p & 0xf0ff) == 0x800f && p + *(int32_t *)(p+2) == px) *(int32_t *)(p+2) = jmprel(p+6, target); lj_mcode_sync(T->mcode, T->mcode + T->szmcode); lj_mcode_patch(J, mcarea, 1); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_opt_loop.c0000644000175000017500000003555013122010155017365 0ustar philphil/* ** LOOP: Loop Optimizations. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_opt_loop_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_err.h" #include "lj_str.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" #include "lj_trace.h" #include "lj_snap.h" #include "lj_vm.h" /* Loop optimization: ** ** Traditional Loop-Invariant Code Motion (LICM) splits the instructions ** of a loop into invariant and variant instructions. The invariant ** instructions are hoisted out of the loop and only the variant ** instructions remain inside the loop body. ** ** Unfortunately LICM is mostly useless for compiling dynamic languages. ** The IR has many guards and most of the subsequent instructions are ** control-dependent on them. The first non-hoistable guard would ** effectively prevent hoisting of all subsequent instructions. ** ** That's why we use a special form of unrolling using copy-substitution, ** combined with redundancy elimination: ** ** The recorded instruction stream is re-emitted to the compiler pipeline ** with substituted operands. The substitution table is filled with the ** refs returned by re-emitting each instruction. This can be done ** on-the-fly, because the IR is in strict SSA form, where every ref is ** defined before its use. ** ** This aproach generates two code sections, separated by the LOOP ** instruction: ** ** 1. The recorded instructions form a kind of pre-roll for the loop. It ** contains a mix of invariant and variant instructions and performs ** exactly one loop iteration (but not necessarily the 1st iteration). ** ** 2. The loop body contains only the variant instructions and performs ** all remaining loop iterations. ** ** On first sight that looks like a waste of space, because the variant ** instructions are present twice. But the key insight is that the ** pre-roll honors the control-dependencies for *both* the pre-roll itself ** *and* the loop body! ** ** It also means one doesn't have to explicitly model control-dependencies ** (which, BTW, wouldn't help LICM much). And it's much easier to ** integrate sparse snapshotting with this approach. ** ** One of the nicest aspects of this approach is that all of the ** optimizations of the compiler pipeline (FOLD, CSE, FWD, etc.) can be ** reused with only minor restrictions (e.g. one should not fold ** instructions across loop-carried dependencies). ** ** But in general all optimizations can be applied which only need to look ** backwards into the generated instruction stream. At any point in time ** during the copy-substitution process this contains both a static loop ** iteration (the pre-roll) and a dynamic one (from the to-be-copied ** instruction up to the end of the partial loop body). ** ** Since control-dependencies are implicitly kept, CSE also applies to all ** kinds of guards. The major advantage is that all invariant guards can ** be hoisted, too. ** ** Load/store forwarding works across loop iterations, too. This is ** important if loop-carried dependencies are kept in upvalues or tables. ** E.g. 'self.idx = self.idx + 1' deep down in some OO-style method may ** become a forwarded loop-recurrence after inlining. ** ** Since the IR is in SSA form, loop-carried dependencies have to be ** modeled with PHI instructions. The potential candidates for PHIs are ** collected on-the-fly during copy-substitution. After eliminating the ** redundant ones, PHI instructions are emitted *below* the loop body. ** ** Note that this departure from traditional SSA form doesn't change the ** semantics of the PHI instructions themselves. But it greatly simplifies ** on-the-fly generation of the IR and the machine code. */ /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) /* Emit raw IR without passing through optimizations. */ #define emitir_raw(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_ir_emit(J)) /* -- PHI elimination ----------------------------------------------------- */ /* Emit or eliminate collected PHIs. */ static void loop_emit_phi(jit_State *J, IRRef1 *subst, IRRef1 *phi, IRRef nphi, SnapNo onsnap) { int passx = 0; IRRef i, j, nslots; IRRef invar = J->chain[IR_LOOP]; /* Pass #1: mark redundant and potentially redundant PHIs. */ for (i = 0, j = 0; i < nphi; i++) { IRRef lref = phi[i]; IRRef rref = subst[lref]; if (lref == rref || rref == REF_DROP) { /* Invariants are redundant. */ irt_clearphi(IR(lref)->t); } else { phi[j++] = (IRRef1)lref; if (!(IR(rref)->op1 == lref || IR(rref)->op2 == lref)) { /* Quick check for simple recurrences failed, need pass2. */ irt_setmark(IR(lref)->t); passx = 1; } } } nphi = j; /* Pass #2: traverse variant part and clear marks of non-redundant PHIs. */ if (passx) { SnapNo s; for (i = J->cur.nins-1; i > invar; i--) { IRIns *ir = IR(i); if (!irref_isk(ir->op2)) irt_clearmark(IR(ir->op2)->t); if (!irref_isk(ir->op1)) { irt_clearmark(IR(ir->op1)->t); if (ir->op1 < invar && ir->o >= IR_CALLN && ir->o <= IR_CARG) { /* ORDER IR */ ir = IR(ir->op1); while (ir->o == IR_CARG) { if (!irref_isk(ir->op2)) irt_clearmark(IR(ir->op2)->t); if (irref_isk(ir->op1)) break; ir = IR(ir->op1); irt_clearmark(ir->t); } } } } for (s = J->cur.nsnap-1; s >= onsnap; s--) { SnapShot *snap = &J->cur.snap[s]; SnapEntry *map = &J->cur.snapmap[snap->mapofs]; MSize n, nent = snap->nent; for (n = 0; n < nent; n++) { IRRef ref = snap_ref(map[n]); if (!irref_isk(ref)) irt_clearmark(IR(ref)->t); } } } /* Pass #3: add PHIs for variant slots without a corresponding SLOAD. */ nslots = J->baseslot+J->maxslot; for (i = 1; i < nslots; i++) { IRRef ref = tref_ref(J->slot[i]); while (!irref_isk(ref) && ref != subst[ref]) { IRIns *ir = IR(ref); irt_clearmark(ir->t); /* Unmark potential uses, too. */ if (irt_isphi(ir->t) || irt_ispri(ir->t)) break; irt_setphi(ir->t); if (nphi >= LJ_MAX_PHI) lj_trace_err(J, LJ_TRERR_PHIOV); phi[nphi++] = (IRRef1)ref; ref = subst[ref]; if (ref > invar) break; } } /* Pass #4: propagate non-redundant PHIs. */ while (passx) { passx = 0; for (i = 0; i < nphi; i++) { IRRef lref = phi[i]; IRIns *ir = IR(lref); if (!irt_ismarked(ir->t)) { /* Propagate only from unmarked PHIs. */ IRIns *irr = IR(subst[lref]); if (irt_ismarked(irr->t)) { /* Right ref points to other PHI? */ irt_clearmark(irr->t); /* Mark that PHI as non-redundant. */ passx = 1; /* Retry. */ } } } } /* Pass #5: emit PHI instructions or eliminate PHIs. */ for (i = 0; i < nphi; i++) { IRRef lref = phi[i]; IRIns *ir = IR(lref); if (!irt_ismarked(ir->t)) { /* Emit PHI if not marked. */ IRRef rref = subst[lref]; if (rref > invar) irt_setphi(IR(rref)->t); emitir_raw(IRT(IR_PHI, irt_type(ir->t)), lref, rref); } else { /* Otherwise eliminate PHI. */ irt_clearmark(ir->t); irt_clearphi(ir->t); } } } /* -- Loop unrolling using copy-substitution ------------------------------ */ /* Copy-substitute snapshot. */ static void loop_subst_snap(jit_State *J, SnapShot *osnap, SnapEntry *loopmap, IRRef1 *subst) { SnapEntry *nmap, *omap = &J->cur.snapmap[osnap->mapofs]; SnapEntry *nextmap = &J->cur.snapmap[snap_nextofs(&J->cur, osnap)]; MSize nmapofs; MSize on, ln, nn, onent = osnap->nent; BCReg nslots = osnap->nslots; SnapShot *snap = &J->cur.snap[J->cur.nsnap]; if (irt_isguard(J->guardemit)) { /* Guard inbetween? */ nmapofs = J->cur.nsnapmap; J->cur.nsnap++; /* Add new snapshot. */ } else { /* Otherwise overwrite previous snapshot. */ snap--; nmapofs = snap->mapofs; } J->guardemit.irt = 0; /* Setup new snapshot. */ snap->mapofs = (uint16_t)nmapofs; snap->ref = (IRRef1)J->cur.nins; snap->nslots = nslots; snap->topslot = osnap->topslot; snap->count = 0; nmap = &J->cur.snapmap[nmapofs]; /* Substitute snapshot slots. */ on = ln = nn = 0; while (on < onent) { SnapEntry osn = omap[on], lsn = loopmap[ln]; if (snap_slot(lsn) < snap_slot(osn)) { /* Copy slot from loop map. */ nmap[nn++] = lsn; ln++; } else { /* Copy substituted slot from snapshot map. */ if (snap_slot(lsn) == snap_slot(osn)) ln++; /* Shadowed loop slot. */ if (!irref_isk(snap_ref(osn))) osn = snap_setref(osn, subst[snap_ref(osn)]); nmap[nn++] = osn; on++; } } while (snap_slot(loopmap[ln]) < nslots) /* Copy remaining loop slots. */ nmap[nn++] = loopmap[ln++]; snap->nent = (uint8_t)nn; omap += onent; nmap += nn; while (omap < nextmap) /* Copy PC + frame links. */ *nmap++ = *omap++; J->cur.nsnapmap = (uint16_t)(nmap - J->cur.snapmap); } /* Unroll loop. */ static void loop_unroll(jit_State *J) { IRRef1 phi[LJ_MAX_PHI]; uint32_t nphi = 0; IRRef1 *subst; SnapNo onsnap; SnapShot *osnap, *loopsnap; SnapEntry *loopmap, *psentinel; IRRef ins, invar; /* Use temp buffer for substitution table. ** Only non-constant refs in [REF_BIAS,invar) are valid indexes. ** Caveat: don't call into the VM or run the GC or the buffer may be gone. */ invar = J->cur.nins; subst = (IRRef1 *)lj_str_needbuf(J->L, &G(J->L)->tmpbuf, (invar-REF_BIAS)*sizeof(IRRef1)) - REF_BIAS; subst[REF_BASE] = REF_BASE; /* LOOP separates the pre-roll from the loop body. */ emitir_raw(IRTG(IR_LOOP, IRT_NIL), 0, 0); /* Grow snapshot buffer and map for copy-substituted snapshots. ** Need up to twice the number of snapshots minus #0 and loop snapshot. ** Need up to twice the number of entries plus fallback substitutions ** from the loop snapshot entries for each new snapshot. ** Caveat: both calls may reallocate J->cur.snap and J->cur.snapmap! */ onsnap = J->cur.nsnap; lj_snap_grow_buf(J, 2*onsnap-2); lj_snap_grow_map(J, J->cur.nsnapmap*2+(onsnap-2)*J->cur.snap[onsnap-1].nent); /* The loop snapshot is used for fallback substitutions. */ loopsnap = &J->cur.snap[onsnap-1]; loopmap = &J->cur.snapmap[loopsnap->mapofs]; /* The PC of snapshot #0 and the loop snapshot must match. */ psentinel = &loopmap[loopsnap->nent]; lua_assert(*psentinel == J->cur.snapmap[J->cur.snap[0].nent]); *psentinel = SNAP(255, 0, 0); /* Replace PC with temporary sentinel. */ /* Start substitution with snapshot #1 (#0 is empty for root traces). */ osnap = &J->cur.snap[1]; /* Copy and substitute all recorded instructions and snapshots. */ for (ins = REF_FIRST; ins < invar; ins++) { IRIns *ir; IRRef op1, op2; if (ins >= osnap->ref) /* Instruction belongs to next snapshot? */ loop_subst_snap(J, osnap++, loopmap, subst); /* Copy-substitute it. */ /* Substitute instruction operands. */ ir = IR(ins); op1 = ir->op1; if (!irref_isk(op1)) op1 = subst[op1]; op2 = ir->op2; if (!irref_isk(op2)) op2 = subst[op2]; if (irm_kind(lj_ir_mode[ir->o]) == IRM_N && op1 == ir->op1 && op2 == ir->op2) { /* Regular invariant ins? */ subst[ins] = (IRRef1)ins; /* Shortcut. */ } else { /* Re-emit substituted instruction to the FOLD/CSE/etc. pipeline. */ IRType1 t = ir->t; /* Get this first, since emitir may invalidate ir. */ IRRef ref = tref_ref(emitir(ir->ot & ~IRT_ISPHI, op1, op2)); subst[ins] = (IRRef1)ref; if (ref != ins) { IRIns *irr = IR(ref); if (ref < invar) { /* Loop-carried dependency? */ /* Potential PHI? */ if (!irref_isk(ref) && !irt_isphi(irr->t) && !irt_ispri(irr->t)) { irt_setphi(irr->t); if (nphi >= LJ_MAX_PHI) lj_trace_err(J, LJ_TRERR_PHIOV); phi[nphi++] = (IRRef1)ref; } /* Check all loop-carried dependencies for type instability. */ if (!irt_sametype(t, irr->t)) { if (irt_isinteger(t) && irt_isinteger(irr->t)) continue; else if (irt_isnum(t) && irt_isinteger(irr->t)) /* Fix int->num. */ ref = tref_ref(emitir(IRTN(IR_CONV), ref, IRCONV_NUM_INT)); else if (irt_isnum(irr->t) && irt_isinteger(t)) /* Fix num->int. */ ref = tref_ref(emitir(IRTGI(IR_CONV), ref, IRCONV_INT_NUM|IRCONV_CHECK)); else lj_trace_err(J, LJ_TRERR_TYPEINS); subst[ins] = (IRRef1)ref; irr = IR(ref); goto phiconv; } } else if (ref != REF_DROP && irr->o == IR_CONV && ref > invar && irr->op1 < invar) { /* May need an extra PHI for a CONV. */ ref = irr->op1; irr = IR(ref); phiconv: if (ref < invar && !irref_isk(ref) && !irt_isphi(irr->t)) { irt_setphi(irr->t); if (nphi >= LJ_MAX_PHI) lj_trace_err(J, LJ_TRERR_PHIOV); phi[nphi++] = (IRRef1)ref; } } } } } if (!irt_isguard(J->guardemit)) /* Drop redundant snapshot. */ J->cur.nsnapmap = (uint16_t)J->cur.snap[--J->cur.nsnap].mapofs; lua_assert(J->cur.nsnapmap <= J->sizesnapmap); *psentinel = J->cur.snapmap[J->cur.snap[0].nent]; /* Restore PC. */ loop_emit_phi(J, subst, phi, nphi, onsnap); } /* Undo any partial changes made by the loop optimization. */ static void loop_undo(jit_State *J, IRRef ins, SnapNo nsnap, MSize nsnapmap) { ptrdiff_t i; SnapShot *snap = &J->cur.snap[nsnap-1]; SnapEntry *map = J->cur.snapmap; map[snap->mapofs + snap->nent] = map[J->cur.snap[0].nent]; /* Restore PC. */ J->cur.nsnapmap = (uint16_t)nsnapmap; J->cur.nsnap = nsnap; J->guardemit.irt = 0; lj_ir_rollback(J, ins); for (i = 0; i < BPROP_SLOTS; i++) { /* Remove backprop. cache entries. */ BPropEntry *bp = &J->bpropcache[i]; if (bp->val >= ins) bp->key = 0; } for (ins--; ins >= REF_FIRST; ins--) { /* Remove flags. */ IRIns *ir = IR(ins); irt_clearphi(ir->t); irt_clearmark(ir->t); } } /* Protected callback for loop optimization. */ static TValue *cploop_opt(lua_State *L, lua_CFunction dummy, void *ud) { UNUSED(L); UNUSED(dummy); loop_unroll((jit_State *)ud); return NULL; } /* Loop optimization. */ int lj_opt_loop(jit_State *J) { IRRef nins = J->cur.nins; SnapNo nsnap = J->cur.nsnap; MSize nsnapmap = J->cur.nsnapmap; int errcode = lj_vm_cpcall(J->L, NULL, J, cploop_opt); if (LJ_UNLIKELY(errcode)) { lua_State *L = J->L; if (errcode == LUA_ERRRUN && tvisnumber(L->top-1)) { /* Trace error? */ int32_t e = numberVint(L->top-1); switch ((TraceError)e) { case LJ_TRERR_TYPEINS: /* Type instability. */ case LJ_TRERR_GFAIL: /* Guard would always fail. */ /* Unrolling via recording fixes many cases, e.g. a flipped boolean. */ if (--J->instunroll < 0) /* But do not unroll forever. */ break; L->top--; /* Remove error object. */ loop_undo(J, nins, nsnap, nsnapmap); return 1; /* Loop optimization failed, continue recording. */ default: break; } } lj_err_throw(L, errcode); /* Propagate all other errors. */ } return 0; /* Loop optimization is ok. */ } #undef IR #undef emitir #undef emitir_raw #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_snap.h0000644000175000017500000000163113122010155016471 0ustar philphil/* ** Snapshot handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_SNAP_H #define _LJ_SNAP_H #include "lj_obj.h" #include "lj_jit.h" #if LJ_HASJIT LJ_FUNC void lj_snap_add(jit_State *J); LJ_FUNC void lj_snap_purge(jit_State *J); LJ_FUNC void lj_snap_shrink(jit_State *J); LJ_FUNC IRIns *lj_snap_regspmap(GCtrace *T, SnapNo snapno, IRIns *ir); LJ_FUNC void lj_snap_replay(jit_State *J, GCtrace *T); LJ_FUNC const BCIns *lj_snap_restore(jit_State *J, void *exptr); LJ_FUNC void lj_snap_grow_buf_(jit_State *J, MSize need); LJ_FUNC void lj_snap_grow_map_(jit_State *J, MSize need); static LJ_AINLINE void lj_snap_grow_buf(jit_State *J, MSize need) { if (LJ_UNLIKELY(need > J->sizesnap)) lj_snap_grow_buf_(J, need); } static LJ_AINLINE void lj_snap_grow_map(jit_State *J, MSize need) { if (LJ_UNLIKELY(need > J->sizesnapmap)) lj_snap_grow_map_(J, need); } #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_bc.h0000644000175000017500000002003713122010155016115 0ustar philphil/* ** Bytecode instruction format. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_BC_H #define _LJ_BC_H #include "lj_def.h" #include "lj_arch.h" /* Bytecode instruction format, 32 bit wide, fields of 8 or 16 bit: ** ** +----+----+----+----+ ** | B | C | A | OP | Format ABC ** +----+----+----+----+ ** | D | A | OP | Format AD ** +-------------------- ** MSB LSB ** ** In-memory instructions are always stored in host byte order. */ /* Operand ranges and related constants. */ #define BCMAX_A 0xff #define BCMAX_B 0xff #define BCMAX_C 0xff #define BCMAX_D 0xffff #define BCBIAS_J 0x8000 #define NO_REG BCMAX_A #define NO_JMP (~(BCPos)0) /* Macros to get instruction fields. */ #define bc_op(i) ((BCOp)((i)&0xff)) #define bc_a(i) ((BCReg)(((i)>>8)&0xff)) #define bc_b(i) ((BCReg)((i)>>24)) #define bc_c(i) ((BCReg)(((i)>>16)&0xff)) #define bc_d(i) ((BCReg)((i)>>16)) #define bc_j(i) ((ptrdiff_t)bc_d(i)-BCBIAS_J) /* Macros to set instruction fields. */ #define setbc_byte(p, x, ofs) \ ((uint8_t *)(p))[LJ_ENDIAN_SELECT(ofs, 3-ofs)] = (uint8_t)(x) #define setbc_op(p, x) setbc_byte(p, (x), 0) #define setbc_a(p, x) setbc_byte(p, (x), 1) #define setbc_b(p, x) setbc_byte(p, (x), 3) #define setbc_c(p, x) setbc_byte(p, (x), 2) #define setbc_d(p, x) \ ((uint16_t *)(p))[LJ_ENDIAN_SELECT(1, 0)] = (uint16_t)(x) #define setbc_j(p, x) setbc_d(p, (BCPos)((int32_t)(x)+BCBIAS_J)) /* Macros to compose instructions. */ #define BCINS_ABC(o, a, b, c) \ (((BCIns)(o))|((BCIns)(a)<<8)|((BCIns)(b)<<24)|((BCIns)(c)<<16)) #define BCINS_AD(o, a, d) \ (((BCIns)(o))|((BCIns)(a)<<8)|((BCIns)(d)<<16)) #define BCINS_AJ(o, a, j) BCINS_AD(o, a, (BCPos)((int32_t)(j)+BCBIAS_J)) /* Bytecode instruction definition. Order matters, see below. ** ** (name, filler, Amode, Bmode, Cmode or Dmode, metamethod) ** ** The opcode name suffixes specify the type for RB/RC or RD: ** V = variable slot ** S = string const ** N = number const ** P = primitive type (~itype) ** B = unsigned byte literal ** M = multiple args/results */ #define BCDEF(_) \ /* Comparison ops. ORDER OPR. */ \ _(ISLT, var, ___, var, lt) \ _(ISGE, var, ___, var, lt) \ _(ISLE, var, ___, var, le) \ _(ISGT, var, ___, var, le) \ \ _(ISEQV, var, ___, var, eq) \ _(ISNEV, var, ___, var, eq) \ _(ISEQS, var, ___, str, eq) \ _(ISNES, var, ___, str, eq) \ _(ISEQN, var, ___, num, eq) \ _(ISNEN, var, ___, num, eq) \ _(ISEQP, var, ___, pri, eq) \ _(ISNEP, var, ___, pri, eq) \ \ /* Unary test and copy ops. */ \ _(ISTC, dst, ___, var, ___) \ _(ISFC, dst, ___, var, ___) \ _(IST, ___, ___, var, ___) \ _(ISF, ___, ___, var, ___) \ \ /* Unary ops. */ \ _(MOV, dst, ___, var, ___) \ _(NOT, dst, ___, var, ___) \ _(UNM, dst, ___, var, unm) \ _(LEN, dst, ___, var, len) \ \ /* Binary ops. ORDER OPR. VV last, POW must be next. */ \ _(ADDVN, dst, var, num, add) \ _(SUBVN, dst, var, num, sub) \ _(MULVN, dst, var, num, mul) \ _(DIVVN, dst, var, num, div) \ _(MODVN, dst, var, num, mod) \ \ _(ADDNV, dst, var, num, add) \ _(SUBNV, dst, var, num, sub) \ _(MULNV, dst, var, num, mul) \ _(DIVNV, dst, var, num, div) \ _(MODNV, dst, var, num, mod) \ \ _(ADDVV, dst, var, var, add) \ _(SUBVV, dst, var, var, sub) \ _(MULVV, dst, var, var, mul) \ _(DIVVV, dst, var, var, div) \ _(MODVV, dst, var, var, mod) \ \ _(POW, dst, var, var, pow) \ _(CAT, dst, rbase, rbase, concat) \ \ /* Constant ops. */ \ _(KSTR, dst, ___, str, ___) \ _(KCDATA, dst, ___, cdata, ___) \ _(KSHORT, dst, ___, lits, ___) \ _(KNUM, dst, ___, num, ___) \ _(KPRI, dst, ___, pri, ___) \ _(KNIL, base, ___, base, ___) \ \ /* Upvalue and function ops. */ \ _(UGET, dst, ___, uv, ___) \ _(USETV, uv, ___, var, ___) \ _(USETS, uv, ___, str, ___) \ _(USETN, uv, ___, num, ___) \ _(USETP, uv, ___, pri, ___) \ _(UCLO, rbase, ___, jump, ___) \ _(FNEW, dst, ___, func, gc) \ \ /* Table ops. */ \ _(TNEW, dst, ___, lit, gc) \ _(TDUP, dst, ___, tab, gc) \ _(GGET, dst, ___, str, index) \ _(GSET, var, ___, str, newindex) \ _(TGETV, dst, var, var, index) \ _(TGETS, dst, var, str, index) \ _(TGETB, dst, var, lit, index) \ _(TSETV, var, var, var, newindex) \ _(TSETS, var, var, str, newindex) \ _(TSETB, var, var, lit, newindex) \ _(TSETM, base, ___, num, newindex) \ \ /* Calls and vararg handling. T = tail call. */ \ _(CALLM, base, lit, lit, call) \ _(CALL, base, lit, lit, call) \ _(CALLMT, base, ___, lit, call) \ _(CALLT, base, ___, lit, call) \ _(ITERC, base, lit, lit, call) \ _(ITERN, base, lit, lit, call) \ _(VARG, base, lit, lit, ___) \ _(ISNEXT, base, ___, jump, ___) \ \ /* Returns. */ \ _(RETM, base, ___, lit, ___) \ _(RET, rbase, ___, lit, ___) \ _(RET0, rbase, ___, lit, ___) \ _(RET1, rbase, ___, lit, ___) \ \ /* Loops and branches. I/J = interp/JIT, I/C/L = init/call/loop. */ \ _(FORI, base, ___, jump, ___) \ _(JFORI, base, ___, jump, ___) \ \ _(FORL, base, ___, jump, ___) \ _(IFORL, base, ___, jump, ___) \ _(JFORL, base, ___, lit, ___) \ \ _(ITERL, base, ___, jump, ___) \ _(IITERL, base, ___, jump, ___) \ _(JITERL, base, ___, lit, ___) \ \ _(LOOP, rbase, ___, jump, ___) \ _(ILOOP, rbase, ___, jump, ___) \ _(JLOOP, rbase, ___, lit, ___) \ \ _(JMP, rbase, ___, jump, ___) \ \ /* Function headers. I/J = interp/JIT, F/V/C = fixarg/vararg/C func. */ \ _(FUNCF, rbase, ___, ___, ___) \ _(IFUNCF, rbase, ___, ___, ___) \ _(JFUNCF, rbase, ___, lit, ___) \ _(FUNCV, rbase, ___, ___, ___) \ _(IFUNCV, rbase, ___, ___, ___) \ _(JFUNCV, rbase, ___, lit, ___) \ _(FUNCC, rbase, ___, ___, ___) \ _(FUNCCW, rbase, ___, ___, ___) /* Bytecode opcode numbers. */ typedef enum { #define BCENUM(name, ma, mb, mc, mt) BC_##name, BCDEF(BCENUM) #undef BCENUM BC__MAX } BCOp; LJ_STATIC_ASSERT((int)BC_ISEQV+1 == (int)BC_ISNEV); LJ_STATIC_ASSERT(((int)BC_ISEQV^1) == (int)BC_ISNEV); LJ_STATIC_ASSERT(((int)BC_ISEQS^1) == (int)BC_ISNES); LJ_STATIC_ASSERT(((int)BC_ISEQN^1) == (int)BC_ISNEN); LJ_STATIC_ASSERT(((int)BC_ISEQP^1) == (int)BC_ISNEP); LJ_STATIC_ASSERT(((int)BC_ISLT^1) == (int)BC_ISGE); LJ_STATIC_ASSERT(((int)BC_ISLE^1) == (int)BC_ISGT); LJ_STATIC_ASSERT(((int)BC_ISLT^3) == (int)BC_ISGT); LJ_STATIC_ASSERT((int)BC_IST-(int)BC_ISTC == (int)BC_ISF-(int)BC_ISFC); LJ_STATIC_ASSERT((int)BC_CALLT-(int)BC_CALL == (int)BC_CALLMT-(int)BC_CALLM); LJ_STATIC_ASSERT((int)BC_CALLMT + 1 == (int)BC_CALLT); LJ_STATIC_ASSERT((int)BC_RETM + 1 == (int)BC_RET); LJ_STATIC_ASSERT((int)BC_FORL + 1 == (int)BC_IFORL); LJ_STATIC_ASSERT((int)BC_FORL + 2 == (int)BC_JFORL); LJ_STATIC_ASSERT((int)BC_ITERL + 1 == (int)BC_IITERL); LJ_STATIC_ASSERT((int)BC_ITERL + 2 == (int)BC_JITERL); LJ_STATIC_ASSERT((int)BC_LOOP + 1 == (int)BC_ILOOP); LJ_STATIC_ASSERT((int)BC_LOOP + 2 == (int)BC_JLOOP); LJ_STATIC_ASSERT((int)BC_FUNCF + 1 == (int)BC_IFUNCF); LJ_STATIC_ASSERT((int)BC_FUNCF + 2 == (int)BC_JFUNCF); LJ_STATIC_ASSERT((int)BC_FUNCV + 1 == (int)BC_IFUNCV); LJ_STATIC_ASSERT((int)BC_FUNCV + 2 == (int)BC_JFUNCV); /* This solves a circular dependency problem, change as needed. */ #define FF_next_N 4 /* Stack slots used by FORI/FORL, relative to operand A. */ enum { FORL_IDX, FORL_STOP, FORL_STEP, FORL_EXT }; /* Bytecode operand modes. ORDER BCMode */ typedef enum { BCMnone, BCMdst, BCMbase, BCMvar, BCMrbase, BCMuv, /* Mode A must be <= 7 */ BCMlit, BCMlits, BCMpri, BCMnum, BCMstr, BCMtab, BCMfunc, BCMjump, BCMcdata, BCM_max } BCMode; #define BCM___ BCMnone #define bcmode_a(op) ((BCMode)(lj_bc_mode[op] & 7)) #define bcmode_b(op) ((BCMode)((lj_bc_mode[op]>>3) & 15)) #define bcmode_c(op) ((BCMode)((lj_bc_mode[op]>>7) & 15)) #define bcmode_d(op) bcmode_c(op) #define bcmode_hasd(op) ((lj_bc_mode[op] & (15<<3)) == (BCMnone<<3)) #define bcmode_mm(op) ((MMS)(lj_bc_mode[op]>>11)) #define BCMODE(name, ma, mb, mc, mm) \ (BCM##ma|(BCM##mb<<3)|(BCM##mc<<7)|(MM_##mm<<11)), #define BCMODE_FF 0 static LJ_AINLINE int bc_isret(BCOp op) { return (op == BC_RETM || op == BC_RET || op == BC_RET0 || op == BC_RET1); } LJ_DATA const uint16_t lj_bc_mode[]; LJ_DATA const uint16_t lj_bc_ofs[]; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_state.c0000644000175000017500000002127013122010155016644 0ustar philphil/* ** State and stack handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_state_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_func.h" #include "lj_meta.h" #include "lj_state.h" #include "lj_frame.h" #if LJ_HASFFI #include "lj_ctype.h" #endif #include "lj_trace.h" #include "lj_dispatch.h" #include "lj_vm.h" #include "lj_lex.h" #include "lj_alloc.h" /* -- Stack handling ------------------------------------------------------ */ /* Stack sizes. */ #define LJ_STACK_MIN LUA_MINSTACK /* Min. stack size. */ #define LJ_STACK_MAX LUAI_MAXSTACK /* Max. stack size. */ #define LJ_STACK_START (2*LJ_STACK_MIN) /* Starting stack size. */ #define LJ_STACK_MAXEX (LJ_STACK_MAX + 1 + LJ_STACK_EXTRA) /* Explanation of LJ_STACK_EXTRA: ** ** Calls to metamethods store their arguments beyond the current top ** without checking for the stack limit. This avoids stack resizes which ** would invalidate passed TValue pointers. The stack check is performed ** later by the function header. This can safely resize the stack or raise ** an error. Thus we need some extra slots beyond the current stack limit. ** ** Most metamethods need 4 slots above top (cont, mobj, arg1, arg2) plus ** one extra slot if mobj is not a function. Only lj_meta_tset needs 5 ** slots above top, but then mobj is always a function. So we can get by ** with 5 extra slots. */ /* Resize stack slots and adjust pointers in state. */ static void resizestack(lua_State *L, MSize n) { TValue *st, *oldst = tvref(L->stack); ptrdiff_t delta; MSize oldsize = L->stacksize; MSize realsize = n + 1 + LJ_STACK_EXTRA; GCobj *up; lua_assert((MSize)(tvref(L->maxstack)-oldst)==L->stacksize-LJ_STACK_EXTRA-1); st = (TValue *)lj_mem_realloc(L, tvref(L->stack), (MSize)(L->stacksize*sizeof(TValue)), (MSize)(realsize*sizeof(TValue))); setmref(L->stack, st); delta = (char *)st - (char *)oldst; setmref(L->maxstack, st + n); while (oldsize < realsize) /* Clear new slots. */ setnilV(st + oldsize++); L->stacksize = realsize; L->base = (TValue *)((char *)L->base + delta); L->top = (TValue *)((char *)L->top + delta); for (up = gcref(L->openupval); up != NULL; up = gcnext(up)) setmref(gco2uv(up)->v, (TValue *)((char *)uvval(gco2uv(up)) + delta)); if (obj2gco(L) == gcref(G(L)->jit_L)) setmref(G(L)->jit_base, mref(G(L)->jit_base, char) + delta); } /* Relimit stack after error, in case the limit was overdrawn. */ void lj_state_relimitstack(lua_State *L) { if (L->stacksize > LJ_STACK_MAXEX && L->top-tvref(L->stack) < LJ_STACK_MAX-1) resizestack(L, LJ_STACK_MAX); } /* Try to shrink the stack (called from GC). */ void lj_state_shrinkstack(lua_State *L, MSize used) { if (L->stacksize > LJ_STACK_MAXEX) return; /* Avoid stack shrinking while handling stack overflow. */ if (4*used < L->stacksize && 2*(LJ_STACK_START+LJ_STACK_EXTRA) < L->stacksize && obj2gco(L) != gcref(G(L)->jit_L)) /* Don't shrink stack of live trace. */ resizestack(L, L->stacksize >> 1); } /* Try to grow stack. */ void LJ_FASTCALL lj_state_growstack(lua_State *L, MSize need) { MSize n; if (L->stacksize > LJ_STACK_MAXEX) /* Overflow while handling overflow? */ lj_err_throw(L, LUA_ERRERR); n = L->stacksize + need; if (n > LJ_STACK_MAX) { n += 2*LUA_MINSTACK; } else if (n < 2*L->stacksize) { n = 2*L->stacksize; if (n >= LJ_STACK_MAX) n = LJ_STACK_MAX; } resizestack(L, n); if (L->stacksize > LJ_STACK_MAXEX) lj_err_msg(L, LJ_ERR_STKOV); } void LJ_FASTCALL lj_state_growstack1(lua_State *L) { lj_state_growstack(L, 1); } /* Allocate basic stack for new state. */ static void stack_init(lua_State *L1, lua_State *L) { TValue *stend, *st = lj_mem_newvec(L, LJ_STACK_START+LJ_STACK_EXTRA, TValue); setmref(L1->stack, st); L1->stacksize = LJ_STACK_START + LJ_STACK_EXTRA; stend = st + L1->stacksize; setmref(L1->maxstack, stend - LJ_STACK_EXTRA - 1); L1->base = L1->top = st+1; setthreadV(L1, st, L1); /* Needed for curr_funcisL() on empty stack. */ while (st < stend) /* Clear new slots. */ setnilV(st++); } /* -- State handling ------------------------------------------------------ */ /* Open parts that may cause memory-allocation errors. */ static TValue *cpluaopen(lua_State *L, lua_CFunction dummy, void *ud) { global_State *g = G(L); UNUSED(dummy); UNUSED(ud); stack_init(L, L); /* NOBARRIER: State initialization, all objects are white. */ setgcref(L->env, obj2gco(lj_tab_new(L, 0, LJ_MIN_GLOBAL))); settabV(L, registry(L), lj_tab_new(L, 0, LJ_MIN_REGISTRY)); lj_str_resize(L, LJ_MIN_STRTAB-1); lj_meta_init(L); lj_lex_init(L); fixstring(lj_err_str(L, LJ_ERR_ERRMEM)); /* Preallocate memory error msg. */ g->gc.threshold = 4*g->gc.total; lj_trace_initstate(g); return NULL; } static void close_state(lua_State *L) { global_State *g = G(L); lj_func_closeuv(L, tvref(L->stack)); lj_gc_freeall(g); lua_assert(gcref(g->gc.root) == obj2gco(L)); lua_assert(g->strnum == 0); lj_trace_freestate(g); #if LJ_HASFFI lj_ctype_freestate(g); #endif lj_mem_freevec(g, g->strhash, g->strmask+1, GCRef); lj_str_freebuf(g, &g->tmpbuf); lj_mem_freevec(g, tvref(L->stack), L->stacksize, TValue); lua_assert(g->gc.total == sizeof(GG_State)); #ifndef LUAJIT_USE_SYSMALLOC if (g->allocf == lj_alloc_f) lj_alloc_destroy(g->allocd); else #endif g->allocf(g->allocd, G2GG(g), sizeof(GG_State), 0); } #if LJ_64 && !(defined(LUAJIT_USE_VALGRIND) && defined(LUAJIT_USE_SYSMALLOC)) lua_State *lj_state_newstate(lua_Alloc f, void *ud) #else LUA_API lua_State *lua_newstate(lua_Alloc f, void *ud) #endif { GG_State *GG = (GG_State *)f(ud, NULL, 0, sizeof(GG_State)); lua_State *L = &GG->L; global_State *g = &GG->g; if (GG == NULL || !checkptr32(GG)) return NULL; memset(GG, 0, sizeof(GG_State)); L->gct = ~LJ_TTHREAD; L->marked = LJ_GC_WHITE0 | LJ_GC_FIXED | LJ_GC_SFIXED; /* Prevent free. */ L->dummy_ffid = FF_C; setmref(L->glref, g); g->gc.currentwhite = LJ_GC_WHITE0 | LJ_GC_FIXED; g->strempty.marked = LJ_GC_WHITE0; g->strempty.gct = ~LJ_TSTR; g->allocf = f; g->allocd = ud; setgcref(g->mainthref, obj2gco(L)); setgcref(g->uvhead.prev, obj2gco(&g->uvhead)); setgcref(g->uvhead.next, obj2gco(&g->uvhead)); g->strmask = ~(MSize)0; setnilV(registry(L)); setnilV(&g->nilnode.val); setnilV(&g->nilnode.key); setmref(g->nilnode.freetop, &g->nilnode); lj_str_initbuf(&g->tmpbuf); g->gc.state = GCSpause; setgcref(g->gc.root, obj2gco(L)); setmref(g->gc.sweep, &g->gc.root); g->gc.total = sizeof(GG_State); g->gc.pause = LUAI_GCPAUSE; g->gc.stepmul = LUAI_GCMUL; lj_dispatch_init((GG_State *)L); L->status = LUA_ERRERR+1; /* Avoid touching the stack upon memory error. */ if (lj_vm_cpcall(L, NULL, NULL, cpluaopen) != 0) { /* Memory allocation error: free partial state. */ close_state(L); return NULL; } L->status = 0; return L; } static TValue *cpfinalize(lua_State *L, lua_CFunction dummy, void *ud) { UNUSED(dummy); UNUSED(ud); lj_gc_finalize_cdata(L); lj_gc_finalize_udata(L); /* Frame pop omitted. */ return NULL; } LUA_API void lua_close(lua_State *L) { global_State *g = G(L); int i; L = mainthread(g); /* Only the main thread can be closed. */ lj_func_closeuv(L, tvref(L->stack)); lj_gc_separateudata(g, 1); /* Separate udata which have GC metamethods. */ #if LJ_HASJIT G2J(g)->flags &= ~JIT_F_ON; G2J(g)->state = LJ_TRACE_IDLE; lj_dispatch_update(g); #endif for (i = 0;;) { hook_enter(g); L->status = 0; L->cframe = NULL; L->base = L->top = tvref(L->stack) + 1; if (lj_vm_cpcall(L, NULL, NULL, cpfinalize) == 0) { if (++i >= 10) break; lj_gc_separateudata(g, 1); /* Separate udata again. */ if (gcref(g->gc.mmudata) == NULL) /* Until nothing is left to do. */ break; } } close_state(L); } lua_State *lj_state_new(lua_State *L) { lua_State *L1 = lj_mem_newobj(L, lua_State); L1->gct = ~LJ_TTHREAD; L1->dummy_ffid = FF_C; L1->status = 0; L1->stacksize = 0; setmref(L1->stack, NULL); L1->cframe = NULL; /* NOBARRIER: The lua_State is new (marked white). */ setgcrefnull(L1->openupval); setmrefr(L1->glref, L->glref); setgcrefr(L1->env, L->env); stack_init(L1, L); /* init stack */ lua_assert(iswhite(obj2gco(L1))); return L1; } void LJ_FASTCALL lj_state_free(global_State *g, lua_State *L) { lua_assert(L != mainthread(g)); lj_func_closeuv(L, tvref(L->stack)); lua_assert(gcref(L->openupval) == NULL); lj_mem_freevec(g, tvref(L->stack), L->stacksize, TValue); lj_mem_freet(g, L); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_udata.c0000644000175000017500000000152013122010155016616 0ustar philphil/* ** Userdata handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_udata_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_udata.h" GCudata *lj_udata_new(lua_State *L, MSize sz, GCtab *env) { GCudata *ud = lj_mem_newt(L, sizeof(GCudata) + sz, GCudata); global_State *g = G(L); newwhite(g, ud); /* Not finalized. */ ud->gct = ~LJ_TUDATA; ud->udtype = UDTYPE_USERDATA; ud->len = sz; /* NOBARRIER: The GCudata is new (marked white). */ setgcrefnull(ud->metatable); setgcref(ud->env, obj2gco(env)); /* Chain to userdata list (after main thread). */ setgcrefr(ud->nextgc, mainthread(g)->nextgc); setgcref(mainthread(g)->nextgc, obj2gco(ud)); return ud; } void LJ_FASTCALL lj_udata_free(global_State *g, GCudata *ud) { lj_mem_free(g, ud, sizeudata(ud)); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ir.h0000644000175000017500000004232513122010155016147 0ustar philphil/* ** SSA IR (Intermediate Representation) format. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_IR_H #define _LJ_IR_H #include "lj_obj.h" /* -- IR instructions ----------------------------------------------------- */ /* IR instruction definition. Order matters, see below. ORDER IR */ #define IRDEF(_) \ /* Guarded assertions. */ \ /* Must be properly aligned to flip opposites (^1) and (un)ordered (^4). */ \ _(LT, N , ref, ref) \ _(GE, N , ref, ref) \ _(LE, N , ref, ref) \ _(GT, N , ref, ref) \ \ _(ULT, N , ref, ref) \ _(UGE, N , ref, ref) \ _(ULE, N , ref, ref) \ _(UGT, N , ref, ref) \ \ _(EQ, C , ref, ref) \ _(NE, C , ref, ref) \ \ _(ABC, N , ref, ref) \ _(RETF, S , ref, ref) \ \ /* Miscellaneous ops. */ \ _(NOP, N , ___, ___) \ _(BASE, N , lit, lit) \ _(PVAL, N , lit, ___) \ _(GCSTEP, S , ___, ___) \ _(HIOP, S , ref, ref) \ _(LOOP, S , ___, ___) \ _(USE, S , ref, ___) \ _(PHI, S , ref, ref) \ _(RENAME, S , ref, lit) \ \ /* Constants. */ \ _(KPRI, N , ___, ___) \ _(KINT, N , cst, ___) \ _(KGC, N , cst, ___) \ _(KPTR, N , cst, ___) \ _(KKPTR, N , cst, ___) \ _(KNULL, N , cst, ___) \ _(KNUM, N , cst, ___) \ _(KINT64, N , cst, ___) \ _(KSLOT, N , ref, lit) \ \ /* Bit ops. */ \ _(BNOT, N , ref, ___) \ _(BSWAP, N , ref, ___) \ _(BAND, C , ref, ref) \ _(BOR, C , ref, ref) \ _(BXOR, C , ref, ref) \ _(BSHL, N , ref, ref) \ _(BSHR, N , ref, ref) \ _(BSAR, N , ref, ref) \ _(BROL, N , ref, ref) \ _(BROR, N , ref, ref) \ \ /* Arithmetic ops. ORDER ARITH */ \ _(ADD, C , ref, ref) \ _(SUB, N , ref, ref) \ _(MUL, C , ref, ref) \ _(DIV, N , ref, ref) \ _(MOD, N , ref, ref) \ _(POW, N , ref, ref) \ _(NEG, N , ref, ref) \ \ _(ABS, N , ref, ref) \ _(ATAN2, N , ref, ref) \ _(LDEXP, N , ref, ref) \ _(MIN, C , ref, ref) \ _(MAX, C , ref, ref) \ _(FPMATH, N , ref, lit) \ \ /* Overflow-checking arithmetic ops. */ \ _(ADDOV, CW, ref, ref) \ _(SUBOV, NW, ref, ref) \ _(MULOV, CW, ref, ref) \ \ /* Memory ops. A = array, H = hash, U = upvalue, F = field, S = stack. */ \ \ /* Memory references. */ \ _(AREF, R , ref, ref) \ _(HREFK, R , ref, ref) \ _(HREF, L , ref, ref) \ _(NEWREF, S , ref, ref) \ _(UREFO, LW, ref, lit) \ _(UREFC, LW, ref, lit) \ _(FREF, R , ref, lit) \ _(STRREF, N , ref, ref) \ \ /* Loads and Stores. These must be in the same order. */ \ _(ALOAD, L , ref, ___) \ _(HLOAD, L , ref, ___) \ _(ULOAD, L , ref, ___) \ _(FLOAD, L , ref, lit) \ _(XLOAD, L , ref, lit) \ _(SLOAD, L , lit, lit) \ _(VLOAD, L , ref, ___) \ \ _(ASTORE, S , ref, ref) \ _(HSTORE, S , ref, ref) \ _(USTORE, S , ref, ref) \ _(FSTORE, S , ref, ref) \ _(XSTORE, S , ref, ref) \ \ /* Allocations. */ \ _(SNEW, N , ref, ref) /* CSE is ok, not marked as A. */ \ _(XSNEW, A , ref, ref) \ _(TNEW, AW, lit, lit) \ _(TDUP, AW, ref, ___) \ _(CNEW, AW, ref, ref) \ _(CNEWI, NW, ref, ref) /* CSE is ok, not marked as A. */ \ \ /* Barriers. */ \ _(TBAR, S , ref, ___) \ _(OBAR, S , ref, ref) \ _(XBAR, S , ___, ___) \ \ /* Type conversions. */ \ _(CONV, NW, ref, lit) \ _(TOBIT, N , ref, ref) \ _(TOSTR, N , ref, ___) \ _(STRTO, N , ref, ___) \ \ /* Calls. */ \ _(CALLN, N , ref, lit) \ _(CALLL, L , ref, lit) \ _(CALLS, S , ref, lit) \ _(CALLXS, S , ref, ref) \ _(CARG, N , ref, ref) \ \ /* End of list. */ /* IR opcodes (max. 256). */ typedef enum { #define IRENUM(name, m, m1, m2) IR_##name, IRDEF(IRENUM) #undef IRENUM IR__MAX } IROp; /* Stored opcode. */ typedef uint8_t IROp1; LJ_STATIC_ASSERT(((int)IR_EQ^1) == (int)IR_NE); LJ_STATIC_ASSERT(((int)IR_LT^1) == (int)IR_GE); LJ_STATIC_ASSERT(((int)IR_LE^1) == (int)IR_GT); LJ_STATIC_ASSERT(((int)IR_LT^3) == (int)IR_GT); LJ_STATIC_ASSERT(((int)IR_LT^4) == (int)IR_ULT); /* Delta between xLOAD and xSTORE. */ #define IRDELTA_L2S ((int)IR_ASTORE - (int)IR_ALOAD) LJ_STATIC_ASSERT((int)IR_HLOAD + IRDELTA_L2S == (int)IR_HSTORE); LJ_STATIC_ASSERT((int)IR_ULOAD + IRDELTA_L2S == (int)IR_USTORE); LJ_STATIC_ASSERT((int)IR_FLOAD + IRDELTA_L2S == (int)IR_FSTORE); LJ_STATIC_ASSERT((int)IR_XLOAD + IRDELTA_L2S == (int)IR_XSTORE); /* -- Named IR literals --------------------------------------------------- */ /* FPMATH sub-functions. ORDER FPM. */ #define IRFPMDEF(_) \ _(FLOOR) _(CEIL) _(TRUNC) /* Must be first and in this order. */ \ _(SQRT) _(EXP) _(EXP2) _(LOG) _(LOG2) _(LOG10) \ _(SIN) _(COS) _(TAN) \ _(OTHER) typedef enum { #define FPMENUM(name) IRFPM_##name, IRFPMDEF(FPMENUM) #undef FPMENUM IRFPM__MAX } IRFPMathOp; /* FLOAD fields. */ #define IRFLDEF(_) \ _(STR_LEN, offsetof(GCstr, len)) \ _(FUNC_ENV, offsetof(GCfunc, l.env)) \ _(FUNC_PC, offsetof(GCfunc, l.pc)) \ _(TAB_META, offsetof(GCtab, metatable)) \ _(TAB_ARRAY, offsetof(GCtab, array)) \ _(TAB_NODE, offsetof(GCtab, node)) \ _(TAB_ASIZE, offsetof(GCtab, asize)) \ _(TAB_HMASK, offsetof(GCtab, hmask)) \ _(TAB_NOMM, offsetof(GCtab, nomm)) \ _(UDATA_META, offsetof(GCudata, metatable)) \ _(UDATA_UDTYPE, offsetof(GCudata, udtype)) \ _(UDATA_FILE, sizeof(GCudata)) \ _(CDATA_CTYPEID, offsetof(GCcdata, ctypeid)) \ _(CDATA_PTR, sizeof(GCcdata)) \ _(CDATA_INT, sizeof(GCcdata)) \ _(CDATA_INT64, sizeof(GCcdata)) \ _(CDATA_INT64_4, sizeof(GCcdata) + 4) typedef enum { #define FLENUM(name, ofs) IRFL_##name, IRFLDEF(FLENUM) #undef FLENUM IRFL__MAX } IRFieldID; /* SLOAD mode bits, stored in op2. */ #define IRSLOAD_PARENT 0x01 /* Coalesce with parent trace. */ #define IRSLOAD_FRAME 0x02 /* Load hiword of frame. */ #define IRSLOAD_TYPECHECK 0x04 /* Needs type check. */ #define IRSLOAD_CONVERT 0x08 /* Number to integer conversion. */ #define IRSLOAD_READONLY 0x10 /* Read-only, omit slot store. */ #define IRSLOAD_INHERIT 0x20 /* Inherited by exits/side traces. */ /* XLOAD mode, stored in op2. */ #define IRXLOAD_READONLY 1 /* Load from read-only data. */ #define IRXLOAD_VOLATILE 2 /* Load from volatile data. */ #define IRXLOAD_UNALIGNED 4 /* Unaligned load. */ /* CONV mode, stored in op2. */ #define IRCONV_SRCMASK 0x001f /* Source IRType. */ #define IRCONV_DSTMASK 0x03e0 /* Dest. IRType (also in ir->t). */ #define IRCONV_DSH 5 #define IRCONV_NUM_INT ((IRT_NUM<>2)&3)) #define irm_iscomm(m) ((m) & IRM_C) #define irm_kind(m) ((m) & IRM_S) #define IRMODE(name, m, m1, m2) (((IRM##m1)|((IRM##m2)<<2)|(IRM_##m))^IRM_W), LJ_DATA const uint8_t lj_ir_mode[IR__MAX+1]; /* -- IR instruction types ------------------------------------------------ */ /* Map of itypes to non-negative numbers. ORDER LJ_T. ** LJ_TUPVAL/LJ_TTRACE never appear in a TValue. Use these itypes for ** IRT_P32 and IRT_P64, which never escape the IR. ** The various integers are only used in the IR and can only escape to ** a TValue after implicit or explicit conversion. Their types must be ** contiguous and next to IRT_NUM (see the typerange macros below). */ #define IRTDEF(_) \ _(NIL, 4) _(FALSE, 4) _(TRUE, 4) _(LIGHTUD, LJ_64 ? 8 : 4) _(STR, 4) \ _(P32, 4) _(THREAD, 4) _(PROTO, 4) _(FUNC, 4) _(P64, 8) _(CDATA, 4) \ _(TAB, 4) _(UDATA, 4) \ _(FLOAT, 4) _(NUM, 8) _(I8, 1) _(U8, 1) _(I16, 2) _(U16, 2) \ _(INT, 4) _(U32, 4) _(I64, 8) _(U64, 8) \ _(SOFTFP, 4) /* There is room for 9 more types. */ /* IR result type and flags (8 bit). */ typedef enum { #define IRTENUM(name, size) IRT_##name, IRTDEF(IRTENUM) #undef IRTENUM IRT__MAX, /* Native pointer type and the corresponding integer type. */ IRT_PTR = LJ_64 ? IRT_P64 : IRT_P32, IRT_INTP = LJ_64 ? IRT_I64 : IRT_INT, IRT_UINTP = LJ_64 ? IRT_U64 : IRT_U32, /* Additional flags. */ IRT_MARK = 0x20, /* Marker for misc. purposes. */ IRT_ISPHI = 0x40, /* Instruction is left or right PHI operand. */ IRT_GUARD = 0x80, /* Instruction is a guard. */ /* Masks. */ IRT_TYPE = 0x1f, IRT_T = 0xff } IRType; #define irtype_ispri(irt) ((uint32_t)(irt) <= IRT_TRUE) /* Stored IRType. */ typedef struct IRType1 { uint8_t irt; } IRType1; #define IRT(o, t) ((uint32_t)(((o)<<8) | (t))) #define IRTI(o) (IRT((o), IRT_INT)) #define IRTN(o) (IRT((o), IRT_NUM)) #define IRTG(o, t) (IRT((o), IRT_GUARD|(t))) #define IRTGI(o) (IRT((o), IRT_GUARD|IRT_INT)) #define irt_t(t) ((IRType)(t).irt) #define irt_type(t) ((IRType)((t).irt & IRT_TYPE)) #define irt_sametype(t1, t2) ((((t1).irt ^ (t2).irt) & IRT_TYPE) == 0) #define irt_typerange(t, first, last) \ ((uint32_t)((t).irt & IRT_TYPE) - (uint32_t)(first) <= (uint32_t)(last-first)) #define irt_isnil(t) (irt_type(t) == IRT_NIL) #define irt_ispri(t) ((uint32_t)irt_type(t) <= IRT_TRUE) #define irt_islightud(t) (irt_type(t) == IRT_LIGHTUD) #define irt_isstr(t) (irt_type(t) == IRT_STR) #define irt_istab(t) (irt_type(t) == IRT_TAB) #define irt_iscdata(t) (irt_type(t) == IRT_CDATA) #define irt_isfloat(t) (irt_type(t) == IRT_FLOAT) #define irt_isnum(t) (irt_type(t) == IRT_NUM) #define irt_isint(t) (irt_type(t) == IRT_INT) #define irt_isi8(t) (irt_type(t) == IRT_I8) #define irt_isu8(t) (irt_type(t) == IRT_U8) #define irt_isi16(t) (irt_type(t) == IRT_I16) #define irt_isu16(t) (irt_type(t) == IRT_U16) #define irt_isu32(t) (irt_type(t) == IRT_U32) #define irt_isi64(t) (irt_type(t) == IRT_I64) #define irt_isu64(t) (irt_type(t) == IRT_U64) #define irt_isfp(t) (irt_isnum(t) || irt_isfloat(t)) #define irt_isinteger(t) (irt_typerange((t), IRT_I8, IRT_INT)) #define irt_isgcv(t) (irt_typerange((t), IRT_STR, IRT_UDATA)) #define irt_isaddr(t) (irt_typerange((t), IRT_LIGHTUD, IRT_UDATA)) #define irt_isint64(t) (irt_typerange((t), IRT_I64, IRT_U64)) #if LJ_64 #define IRT_IS64 \ ((1u<> irt_type(t)) & 1) #define irt_is64orfp(t) (((IRT_IS64|(1u<>irt_type(t)) & 1) #define irt_size(t) (lj_ir_type_size[irt_t((t))]) LJ_DATA const uint8_t lj_ir_type_size[]; static LJ_AINLINE IRType itype2irt(const TValue *tv) { if (tvisint(tv)) return IRT_INT; else if (tvisnum(tv)) return IRT_NUM; #if LJ_64 else if (tvislightud(tv)) return IRT_LIGHTUD; #endif else return (IRType)~itype(tv); } static LJ_AINLINE uint32_t irt_toitype_(IRType t) { lua_assert(!LJ_64 || t != IRT_LIGHTUD); if (LJ_DUALNUM && t > IRT_NUM) { return LJ_TISNUM; } else { lua_assert(t <= IRT_NUM); return ~(uint32_t)t; } } #define irt_toitype(t) irt_toitype_(irt_type((t))) #define irt_isguard(t) ((t).irt & IRT_GUARD) #define irt_ismarked(t) ((t).irt & IRT_MARK) #define irt_setmark(t) ((t).irt |= IRT_MARK) #define irt_clearmark(t) ((t).irt &= ~IRT_MARK) #define irt_isphi(t) ((t).irt & IRT_ISPHI) #define irt_setphi(t) ((t).irt |= IRT_ISPHI) #define irt_clearphi(t) ((t).irt &= ~IRT_ISPHI) /* Stored combined IR opcode and type. */ typedef uint16_t IROpT; /* -- IR references ------------------------------------------------------- */ /* IR references. */ typedef uint16_t IRRef1; /* One stored reference. */ typedef uint32_t IRRef2; /* Two stored references. */ typedef uint32_t IRRef; /* Used to pass around references. */ /* Fixed references. */ enum { REF_BIAS = 0x8000, REF_TRUE = REF_BIAS-3, REF_FALSE = REF_BIAS-2, REF_NIL = REF_BIAS-1, /* \--- Constants grow downwards. */ REF_BASE = REF_BIAS, /* /--- IR grows upwards. */ REF_FIRST = REF_BIAS+1, REF_DROP = 0xffff }; /* Note: IRMlit operands must be < REF_BIAS, too! ** This allows for fast and uniform manipulation of all operands ** without looking up the operand mode in lj_ir_mode: ** - CSE calculates the maximum reference of two operands. ** This must work with mixed reference/literal operands, too. ** - DCE marking only checks for operand >= REF_BIAS. ** - LOOP needs to substitute reference operands. ** Constant references and literals must not be modified. */ #define IRREF2(lo, hi) ((IRRef2)(lo) | ((IRRef2)(hi) << 16)) #define irref_isk(ref) ((ref) < REF_BIAS) /* Tagged IR references (32 bit). ** ** +-------+-------+---------------+ ** | irt | flags | ref | ** +-------+-------+---------------+ ** ** The tag holds a copy of the IRType and speeds up IR type checks. */ typedef uint32_t TRef; #define TREF_REFMASK 0x0000ffff #define TREF_FRAME 0x00010000 #define TREF_CONT 0x00020000 #define TREF(ref, t) ((TRef)((ref) + ((t)<<24))) #define tref_ref(tr) ((IRRef1)(tr)) #define tref_t(tr) ((IRType)((tr)>>24)) #define tref_type(tr) ((IRType)(((tr)>>24) & IRT_TYPE)) #define tref_typerange(tr, first, last) \ ((((tr)>>24) & IRT_TYPE) - (TRef)(first) <= (TRef)(last-first)) #define tref_istype(tr, t) (((tr) & (IRT_TYPE<<24)) == ((t)<<24)) #define tref_isnil(tr) (tref_istype((tr), IRT_NIL)) #define tref_isfalse(tr) (tref_istype((tr), IRT_FALSE)) #define tref_istrue(tr) (tref_istype((tr), IRT_TRUE)) #define tref_isstr(tr) (tref_istype((tr), IRT_STR)) #define tref_isfunc(tr) (tref_istype((tr), IRT_FUNC)) #define tref_iscdata(tr) (tref_istype((tr), IRT_CDATA)) #define tref_istab(tr) (tref_istype((tr), IRT_TAB)) #define tref_isudata(tr) (tref_istype((tr), IRT_UDATA)) #define tref_isnum(tr) (tref_istype((tr), IRT_NUM)) #define tref_isint(tr) (tref_istype((tr), IRT_INT)) #define tref_isbool(tr) (tref_typerange((tr), IRT_FALSE, IRT_TRUE)) #define tref_ispri(tr) (tref_typerange((tr), IRT_NIL, IRT_TRUE)) #define tref_istruecond(tr) (!tref_typerange((tr), IRT_NIL, IRT_FALSE)) #define tref_isinteger(tr) (tref_typerange((tr), IRT_I8, IRT_INT)) #define tref_isnumber(tr) (tref_typerange((tr), IRT_NUM, IRT_INT)) #define tref_isnumber_str(tr) (tref_isnumber((tr)) || tref_isstr((tr))) #define tref_isgcv(tr) (tref_typerange((tr), IRT_STR, IRT_UDATA)) #define tref_isk(tr) (irref_isk(tref_ref((tr)))) #define tref_isk2(tr1, tr2) (irref_isk(tref_ref((tr1) | (tr2)))) #define TREF_PRI(t) (TREF(REF_NIL-(t), (t))) #define TREF_NIL (TREF_PRI(IRT_NIL)) #define TREF_FALSE (TREF_PRI(IRT_FALSE)) #define TREF_TRUE (TREF_PRI(IRT_TRUE)) /* -- IR format ----------------------------------------------------------- */ /* IR instruction format (64 bit). ** ** 16 16 8 8 8 8 ** +-------+-------+---+---+---+---+ ** | op1 | op2 | t | o | r | s | ** +-------+-------+---+---+---+---+ ** | op12/i/gco | ot | prev | (alternative fields in union) ** +---------------+-------+-------+ ** 32 16 16 ** ** prev is only valid prior to register allocation and then reused for r + s. */ typedef union IRIns { struct { LJ_ENDIAN_LOHI( IRRef1 op1; /* IR operand 1. */ , IRRef1 op2; /* IR operand 2. */ ) IROpT ot; /* IR opcode and type (overlaps t and o). */ IRRef1 prev; /* Previous ins in same chain (overlaps r and s). */ }; struct { IRRef2 op12; /* IR operand 1 and 2 (overlaps op1 and op2). */ LJ_ENDIAN_LOHI( IRType1 t; /* IR type. */ , IROp1 o; /* IR opcode. */ ) LJ_ENDIAN_LOHI( uint8_t r; /* Register allocation (overlaps prev). */ , uint8_t s; /* Spill slot allocation (overlaps prev). */ ) }; int32_t i; /* 32 bit signed integer literal (overlaps op12). */ GCRef gcr; /* GCobj constant (overlaps op12). */ MRef ptr; /* Pointer constant (overlaps op12). */ } IRIns; #define ir_kgc(ir) check_exp((ir)->o == IR_KGC, gcref((ir)->gcr)) #define ir_kstr(ir) (gco2str(ir_kgc((ir)))) #define ir_ktab(ir) (gco2tab(ir_kgc((ir)))) #define ir_kfunc(ir) (gco2func(ir_kgc((ir)))) #define ir_kcdata(ir) (gco2cd(ir_kgc((ir)))) #define ir_knum(ir) check_exp((ir)->o == IR_KNUM, mref((ir)->ptr, cTValue)) #define ir_kint64(ir) check_exp((ir)->o == IR_KINT64, mref((ir)->ptr,cTValue)) #define ir_k64(ir) \ check_exp((ir)->o == IR_KNUM || (ir)->o == IR_KINT64, mref((ir)->ptr,cTValue)) #define ir_kptr(ir) \ check_exp((ir)->o == IR_KPTR || (ir)->o == IR_KKPTR, mref((ir)->ptr, void)) /* A store or any other op with a non-weak guard has a side-effect. */ static LJ_AINLINE int ir_sideeff(IRIns *ir) { return (((ir->t.irt | ~IRT_GUARD) & lj_ir_mode[ir->o]) >= IRM_S); } LJ_STATIC_ASSERT((int)IRT_GUARD == (int)IRM_W); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/msvcbuild.bat0000644000175000017500000000714213122010155017355 0ustar philphil@rem Script to build LuaJIT with MSVC. @rem Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h @rem @rem Either open a "Visual Studio .NET Command Prompt" @rem (Note that the Express Edition does not contain an x64 compiler) @rem -or- @rem Open a "Windows SDK Command Shell" and set the compiler environment: @rem setenv /release /x86 @rem -or- @rem setenv /release /x64 @rem @rem Then cd to this directory and run this script. @if not defined INCLUDE goto :FAIL @setlocal @set LJCOMPILE=cl /nologo /c /O2 /W3 /D_CRT_SECURE_NO_DEPRECATE @set LJLINK=link /nologo @set LJMT=mt /nologo @set LJLIB=lib /nologo /nodefaultlib @set DASMDIR=..\dynasm @set DASM=%DASMDIR%\dynasm.lua @set LJDLLNAME=lua51.dll @set LJLIBNAME=lua51.lib @set ALL_LIB=lib_base.c lib_math.c lib_bit.c lib_string.c lib_table.c lib_io.c lib_os.c lib_package.c lib_debug.c lib_jit.c lib_ffi.c %LJCOMPILE% host\minilua.c @if errorlevel 1 goto :BAD %LJLINK% /out:minilua.exe minilua.obj @if errorlevel 1 goto :BAD if exist minilua.exe.manifest^ %LJMT% -manifest minilua.exe.manifest -outputresource:minilua.exe @set DASMFLAGS=-D WIN -D JIT -D FFI -D P64 @set LJARCH=x64 @minilua @if errorlevel 8 goto :X64 @set DASMFLAGS=-D WIN -D JIT -D FFI @set LJARCH=x86 :X64 minilua %DASM% -LN %DASMFLAGS% -o host\buildvm_arch.h vm_x86.dasc @if errorlevel 1 goto :BAD %LJCOMPILE% /I "." /I %DASMDIR% host\buildvm*.c @if errorlevel 1 goto :BAD %LJLINK% /out:buildvm.exe buildvm*.obj @if errorlevel 1 goto :BAD if exist buildvm.exe.manifest^ %LJMT% -manifest buildvm.exe.manifest -outputresource:buildvm.exe buildvm -m peobj -o lj_vm.obj @if errorlevel 1 goto :BAD buildvm -m bcdef -o lj_bcdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m ffdef -o lj_ffdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m libdef -o lj_libdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m recdef -o lj_recdef.h %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m vmdef -o jit\vmdef.lua %ALL_LIB% @if errorlevel 1 goto :BAD buildvm -m folddef -o lj_folddef.h lj_opt_fold.c @if errorlevel 1 goto :BAD @if "%1" neq "debug" goto :NODEBUG @shift @set LJCOMPILE=%LJCOMPILE% /Zi @set LJLINK=%LJLINK% /debug :NODEBUG @if "%1"=="amalg" goto :AMALGDLL @if "%1"=="static" goto :STATIC %LJCOMPILE% /MD /DLUA_BUILD_AS_DLL lj_*.c lib_*.c @if errorlevel 1 goto :BAD %LJLINK% /DLL /out:%LJDLLNAME% lj_*.obj lib_*.obj @if errorlevel 1 goto :BAD @goto :MTDLL :STATIC %LJCOMPILE% lj_*.c lib_*.c @if errorlevel 1 goto :BAD %LJLIB% /OUT:%LJLIBNAME% lj_*.obj lib_*.obj @if errorlevel 1 goto :BAD @goto :MTDLL :AMALGDLL %LJCOMPILE% /MD /DLUA_BUILD_AS_DLL ljamalg.c @if errorlevel 1 goto :BAD %LJLINK% /DLL /out:%LJDLLNAME% ljamalg.obj lj_vm.obj @if errorlevel 1 goto :BAD :MTDLL if exist %LJDLLNAME%.manifest^ %LJMT% -manifest %LJDLLNAME%.manifest -outputresource:%LJDLLNAME%;2 %LJCOMPILE% luajit.c @if errorlevel 1 goto :BAD %LJLINK% /out:luajit.exe luajit.obj %LJLIBNAME% @if errorlevel 1 goto :BAD if exist luajit.exe.manifest^ %LJMT% -manifest luajit.exe.manifest -outputresource:luajit.exe @del *.obj *.manifest minilua.exe buildvm.exe @del host\buildvm_arch.h @del lj_bcdef.h lj_ffdef.h lj_libdef.h lj_recdef.h lj_folddef.h @echo. @echo === Successfully built LuaJIT for Windows/%LJARCH% === @goto :END :BAD @echo. @echo ******************************************************* @echo *** Build FAILED -- Please check the error messages *** @echo ******************************************************* @goto :END :FAIL @echo You must open a "Visual Studio .NET Command Prompt" to run this script :END wcc-0.0.2/src/wsh/luajit-2.0/src/lj_meta.h0000644000175000017500000000265713122010155016467 0ustar philphil/* ** Metamethod handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_META_H #define _LJ_META_H #include "lj_obj.h" /* Metamethod handling */ LJ_FUNC void lj_meta_init(lua_State *L); LJ_FUNC cTValue *lj_meta_cache(GCtab *mt, MMS mm, GCstr *name); LJ_FUNC cTValue *lj_meta_lookup(lua_State *L, cTValue *o, MMS mm); #if LJ_HASFFI LJ_FUNC int lj_meta_tailcall(lua_State *L, cTValue *tv); #endif #define lj_meta_fastg(g, mt, mm) \ ((mt) == NULL ? NULL : ((mt)->nomm & (1u<<(mm))) ? NULL : \ lj_meta_cache(mt, mm, mmname_str(g, mm))) #define lj_meta_fast(L, mt, mm) lj_meta_fastg(G(L), mt, mm) /* C helpers for some instructions, called from assembler VM. */ LJ_FUNCA cTValue *lj_meta_tget(lua_State *L, cTValue *o, cTValue *k); LJ_FUNCA TValue *lj_meta_tset(lua_State *L, cTValue *o, cTValue *k); LJ_FUNCA TValue *lj_meta_arith(lua_State *L, TValue *ra, cTValue *rb, cTValue *rc, BCReg op); LJ_FUNCA TValue *lj_meta_cat(lua_State *L, TValue *top, int left); LJ_FUNCA TValue * LJ_FASTCALL lj_meta_len(lua_State *L, cTValue *o); LJ_FUNCA TValue *lj_meta_equal(lua_State *L, GCobj *o1, GCobj *o2, int ne); LJ_FUNCA TValue * LJ_FASTCALL lj_meta_equal_cd(lua_State *L, BCIns ins); LJ_FUNCA TValue *lj_meta_comp(lua_State *L, cTValue *o1, cTValue *o2, int op); LJ_FUNCA void lj_meta_call(lua_State *L, TValue *func, TValue *top); LJ_FUNCA void LJ_FASTCALL lj_meta_for(lua_State *L, TValue *o); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_mcode.c0000644000175000017500000002365313122010155016622 0ustar philphil/* ** Machine code management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_mcode_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_gc.h" #include "lj_err.h" #include "lj_jit.h" #include "lj_mcode.h" #include "lj_trace.h" #include "lj_dispatch.h" #endif #if LJ_HASJIT || LJ_HASFFI #include "lj_vm.h" #endif /* -- OS-specific functions ----------------------------------------------- */ #if LJ_HASJIT || LJ_HASFFI /* Define this if you want to run LuaJIT with Valgrind. */ #ifdef LUAJIT_USE_VALGRIND #include #endif #if LJ_TARGET_IOS void sys_icache_invalidate(void *start, size_t len); #endif /* Synchronize data/instruction cache. */ void lj_mcode_sync(void *start, void *end) { #ifdef LUAJIT_USE_VALGRIND VALGRIND_DISCARD_TRANSLATIONS(start, (char *)end-(char *)start); #endif #if LJ_TARGET_X86ORX64 UNUSED(start); UNUSED(end); #elif LJ_TARGET_IOS sys_icache_invalidate(start, (char *)end-(char *)start); #elif LJ_TARGET_PPC lj_vm_cachesync(start, end); #elif defined(__GNUC__) __clear_cache(start, end); #else #error "Missing builtin to flush instruction cache" #endif } #endif #if LJ_HASJIT #if LJ_TARGET_WINDOWS #define WIN32_LEAN_AND_MEAN #include #define MCPROT_RW PAGE_READWRITE #define MCPROT_RX PAGE_EXECUTE_READ #define MCPROT_RWX PAGE_EXECUTE_READWRITE static void *mcode_alloc_at(jit_State *J, uintptr_t hint, size_t sz, DWORD prot) { void *p = VirtualAlloc((void *)hint, sz, MEM_RESERVE|MEM_COMMIT|MEM_TOP_DOWN, prot); if (!p && !hint) lj_trace_err(J, LJ_TRERR_MCODEAL); return p; } static void mcode_free(jit_State *J, void *p, size_t sz) { UNUSED(J); UNUSED(sz); VirtualFree(p, 0, MEM_RELEASE); } static int mcode_setprot(void *p, size_t sz, DWORD prot) { DWORD oprot; return !VirtualProtect(p, sz, prot, &oprot); } #elif LJ_TARGET_POSIX #include #ifndef MAP_ANONYMOUS #define MAP_ANONYMOUS MAP_ANON #endif #define MCPROT_RW (PROT_READ|PROT_WRITE) #define MCPROT_RX (PROT_READ|PROT_EXEC) #define MCPROT_RWX (PROT_READ|PROT_WRITE|PROT_EXEC) static void *mcode_alloc_at(jit_State *J, uintptr_t hint, size_t sz, int prot) { void *p = mmap((void *)hint, sz, prot, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0); if (p == MAP_FAILED) { if (!hint) lj_trace_err(J, LJ_TRERR_MCODEAL); p = NULL; } return p; } static void mcode_free(jit_State *J, void *p, size_t sz) { UNUSED(J); munmap(p, sz); } static int mcode_setprot(void *p, size_t sz, int prot) { return mprotect(p, sz, prot); } #elif LJ_64 #error "Missing OS support for explicit placement of executable memory" #else /* Fallback allocator. This will fail if memory is not executable by default. */ #define LUAJIT_UNPROTECT_MCODE #define MCPROT_RW 0 #define MCPROT_RX 0 #define MCPROT_RWX 0 static void *mcode_alloc_at(jit_State *J, uintptr_t hint, size_t sz, int prot) { UNUSED(hint); UNUSED(prot); return lj_mem_new(J->L, sz); } static void mcode_free(jit_State *J, void *p, size_t sz) { lj_mem_free(J2G(J), p, sz); } #endif /* -- MCode area protection ----------------------------------------------- */ /* Define this ONLY if page protection twiddling becomes a bottleneck. */ #ifdef LUAJIT_UNPROTECT_MCODE /* It's generally considered to be a potential security risk to have ** pages with simultaneous write *and* execute access in a process. ** ** Do not even think about using this mode for server processes or ** apps handling untrusted external data (such as a browser). ** ** The security risk is not in LuaJIT itself -- but if an adversary finds ** any *other* flaw in your C application logic, then any RWX memory page ** simplifies writing an exploit considerably. */ #define MCPROT_GEN MCPROT_RWX #define MCPROT_RUN MCPROT_RWX static void mcode_protect(jit_State *J, int prot) { UNUSED(J); UNUSED(prot); } #else /* This is the default behaviour and much safer: ** ** Most of the time the memory pages holding machine code are executable, ** but NONE of them is writable. ** ** The current memory area is marked read-write (but NOT executable) only ** during the short time window while the assembler generates machine code. */ #define MCPROT_GEN MCPROT_RW #define MCPROT_RUN MCPROT_RX /* Protection twiddling failed. Probably due to kernel security. */ static LJ_NOINLINE void mcode_protfail(jit_State *J) { lua_CFunction panic = J2G(J)->panic; if (panic) { lua_State *L = J->L; setstrV(L, L->top++, lj_err_str(L, LJ_ERR_JITPROT)); panic(L); } } /* Change protection of MCode area. */ static void mcode_protect(jit_State *J, int prot) { if (J->mcprot != prot) { if (LJ_UNLIKELY(mcode_setprot(J->mcarea, J->szmcarea, prot))) mcode_protfail(J); J->mcprot = prot; } } #endif /* -- MCode area allocation ----------------------------------------------- */ #if LJ_TARGET_X64 #define mcode_validptr(p) ((p) && (uintptr_t)(p) < (uintptr_t)1<<47) #else #define mcode_validptr(p) ((p) && (uintptr_t)(p) < 0xffff0000) #endif #ifdef LJ_TARGET_JUMPRANGE /* Get memory within relative jump distance of our code in 64 bit mode. */ static void *mcode_alloc(jit_State *J, size_t sz) { /* Target an address in the static assembler code (64K aligned). ** Try addresses within a distance of target-range/2+1MB..target+range/2-1MB. ** Use half the jump range so every address in the range can reach any other. */ #if LJ_TARGET_MIPS /* Use the middle of the 256MB-aligned region. */ uintptr_t target = ((uintptr_t)(void *)lj_vm_exit_handler & 0xf0000000u) + 0x08000000u; #else uintptr_t target = (uintptr_t)(void *)lj_vm_exit_handler & ~(uintptr_t)0xffff; #endif const uintptr_t range = (1u << (LJ_TARGET_JUMPRANGE-1)) - (1u << 21); /* First try a contiguous area below the last one. */ uintptr_t hint = J->mcarea ? (uintptr_t)J->mcarea - sz : 0; int i; for (i = 0; i < 32; i++) { /* 32 attempts ought to be enough ... */ if (mcode_validptr(hint)) { void *p = mcode_alloc_at(J, hint, sz, MCPROT_GEN); if (mcode_validptr(p) && ((uintptr_t)p + sz - target < range || target - (uintptr_t)p < range)) return p; if (p) mcode_free(J, p, sz); /* Free badly placed area. */ } /* Next try probing pseudo-random addresses. */ do { hint = (0x78fb ^ LJ_PRNG_BITS(J, 15)) << 16; /* 64K aligned. */ } while (!(hint + sz < range)); hint = target + hint - (range>>1); } lj_trace_err(J, LJ_TRERR_MCODEAL); /* Give up. OS probably ignores hints? */ return NULL; } #else /* All memory addresses are reachable by relative jumps. */ static void *mcode_alloc(jit_State *J, size_t sz) { #ifdef __OpenBSD__ /* Allow better executable memory allocation for OpenBSD W^X mode. */ void *p = mcode_alloc_at(J, 0, sz, MCPROT_RUN); if (p && mcode_setprot(p, sz, MCPROT_GEN)) { mcode_free(J, p, sz); return NULL; } return p; #else return mcode_alloc_at(J, 0, sz, MCPROT_GEN); #endif } #endif /* -- MCode area management ----------------------------------------------- */ /* Linked list of MCode areas. */ typedef struct MCLink { MCode *next; /* Next area. */ size_t size; /* Size of current area. */ } MCLink; /* Allocate a new MCode area. */ static void mcode_allocarea(jit_State *J) { MCode *oldarea = J->mcarea; size_t sz = (size_t)J->param[JIT_P_sizemcode] << 10; sz = (sz + LJ_PAGESIZE-1) & ~(size_t)(LJ_PAGESIZE - 1); J->mcarea = (MCode *)mcode_alloc(J, sz); J->szmcarea = sz; J->mcprot = MCPROT_GEN; J->mctop = (MCode *)((char *)J->mcarea + J->szmcarea); J->mcbot = (MCode *)((char *)J->mcarea + sizeof(MCLink)); ((MCLink *)J->mcarea)->next = oldarea; ((MCLink *)J->mcarea)->size = sz; J->szallmcarea += sz; } /* Free all MCode areas. */ void lj_mcode_free(jit_State *J) { MCode *mc = J->mcarea; J->mcarea = NULL; J->szallmcarea = 0; while (mc) { MCode *next = ((MCLink *)mc)->next; mcode_free(J, mc, ((MCLink *)mc)->size); mc = next; } } /* -- MCode transactions -------------------------------------------------- */ /* Reserve the remainder of the current MCode area. */ MCode *lj_mcode_reserve(jit_State *J, MCode **lim) { if (!J->mcarea) mcode_allocarea(J); else mcode_protect(J, MCPROT_GEN); *lim = J->mcbot; return J->mctop; } /* Commit the top part of the current MCode area. */ void lj_mcode_commit(jit_State *J, MCode *top) { J->mctop = top; mcode_protect(J, MCPROT_RUN); } /* Abort the reservation. */ void lj_mcode_abort(jit_State *J) { if (J->mcarea) mcode_protect(J, MCPROT_RUN); } /* Set/reset protection to allow patching of MCode areas. */ MCode *lj_mcode_patch(jit_State *J, MCode *ptr, int finish) { #ifdef LUAJIT_UNPROTECT_MCODE UNUSED(J); UNUSED(ptr); UNUSED(finish); return NULL; #else if (finish) { if (J->mcarea == ptr) mcode_protect(J, MCPROT_RUN); else if (LJ_UNLIKELY(mcode_setprot(ptr, ((MCLink *)ptr)->size, MCPROT_RUN))) mcode_protfail(J); return NULL; } else { MCode *mc = J->mcarea; /* Try current area first to use the protection cache. */ if (ptr >= mc && ptr < (MCode *)((char *)mc + J->szmcarea)) { mcode_protect(J, MCPROT_GEN); return mc; } /* Otherwise search through the list of MCode areas. */ for (;;) { mc = ((MCLink *)mc)->next; lua_assert(mc != NULL); if (ptr >= mc && ptr < (MCode *)((char *)mc + ((MCLink *)mc)->size)) { if (LJ_UNLIKELY(mcode_setprot(mc, ((MCLink *)mc)->size, MCPROT_GEN))) mcode_protfail(J); return mc; } } } #endif } /* Limit of MCode reservation reached. */ void lj_mcode_limiterr(jit_State *J, size_t need) { size_t sizemcode, maxmcode; lj_mcode_abort(J); sizemcode = (size_t)J->param[JIT_P_sizemcode] << 10; sizemcode = (sizemcode + LJ_PAGESIZE-1) & ~(size_t)(LJ_PAGESIZE - 1); maxmcode = (size_t)J->param[JIT_P_maxmcode] << 10; if ((size_t)need > sizemcode) lj_trace_err(J, LJ_TRERR_MCODEOV); /* Too long for any area. */ if (J->szallmcarea + sizemcode > maxmcode) lj_trace_err(J, LJ_TRERR_MCODEAL); mcode_allocarea(J); lj_trace_err(J, LJ_TRERR_MCODELM); /* Retry with new area. */ } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_cparse.c0000644000175000017500000015666413122010155017021 0ustar philphil/* ** C declaration parser. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_ctype.h" #include "lj_cparse.h" #include "lj_frame.h" #include "lj_vm.h" #include "lj_char.h" #include "lj_strscan.h" /* ** Important note: this is NOT a validating C parser! This is a minimal ** C declaration parser, solely for use by the LuaJIT FFI. ** ** It ought to return correct results for properly formed C declarations, ** but it may accept some invalid declarations, too (and return nonsense). ** Also, it shows rather generic error messages to avoid unnecessary bloat. ** If in doubt, please check the input against your favorite C compiler. */ /* -- C lexer ------------------------------------------------------------- */ /* C lexer token names. */ static const char *const ctoknames[] = { #define CTOKSTR(name, str) str, CTOKDEF(CTOKSTR) #undef CTOKSTR NULL }; /* Forward declaration. */ LJ_NORET static void cp_err(CPState *cp, ErrMsg em); static const char *cp_tok2str(CPState *cp, CPToken tok) { lua_assert(tok < CTOK_FIRSTDECL); if (tok > CTOK_OFS) return ctoknames[tok-CTOK_OFS-1]; else if (!lj_char_iscntrl(tok)) return lj_str_pushf(cp->L, "%c", tok); else return lj_str_pushf(cp->L, "char(%d)", tok); } /* End-of-line? */ static LJ_AINLINE int cp_iseol(CPChar c) { return (c == '\n' || c == '\r'); } /* Peek next raw character. */ static LJ_AINLINE CPChar cp_rawpeek(CPState *cp) { return (CPChar)(uint8_t)(*cp->p); } static LJ_NOINLINE CPChar cp_get_bs(CPState *cp); /* Get next character. */ static LJ_AINLINE CPChar cp_get(CPState *cp) { cp->c = (CPChar)(uint8_t)(*cp->p++); if (LJ_LIKELY(cp->c != '\\')) return cp->c; return cp_get_bs(cp); } /* Transparently skip backslash-escaped line breaks. */ static LJ_NOINLINE CPChar cp_get_bs(CPState *cp) { CPChar c2, c = cp_rawpeek(cp); if (!cp_iseol(c)) return cp->c; cp->p++; c2 = cp_rawpeek(cp); if (cp_iseol(c2) && c2 != c) cp->p++; cp->linenumber++; return cp_get(cp); } /* Grow save buffer. */ static LJ_NOINLINE void cp_save_grow(CPState *cp, CPChar c) { MSize newsize; if (cp->sb.sz >= CPARSE_MAX_BUF/2) cp_err(cp, LJ_ERR_XELEM); newsize = cp->sb.sz * 2; lj_str_resizebuf(cp->L, &cp->sb, newsize); cp->sb.buf[cp->sb.n++] = (char)c; } /* Save character in buffer. */ static LJ_AINLINE void cp_save(CPState *cp, CPChar c) { if (LJ_UNLIKELY(cp->sb.n + 1 > cp->sb.sz)) cp_save_grow(cp, c); else cp->sb.buf[cp->sb.n++] = (char)c; } /* Skip line break. Handles "\n", "\r", "\r\n" or "\n\r". */ static void cp_newline(CPState *cp) { CPChar c = cp_rawpeek(cp); if (cp_iseol(c) && c != cp->c) cp->p++; cp->linenumber++; } LJ_NORET static void cp_errmsg(CPState *cp, CPToken tok, ErrMsg em, ...) { const char *msg, *tokstr; lua_State *L; va_list argp; if (tok == 0) { tokstr = NULL; } else if (tok == CTOK_IDENT || tok == CTOK_INTEGER || tok == CTOK_STRING || tok >= CTOK_FIRSTDECL) { if (cp->sb.n == 0) cp_save(cp, '$'); cp_save(cp, '\0'); tokstr = cp->sb.buf; } else { tokstr = cp_tok2str(cp, tok); } L = cp->L; va_start(argp, em); msg = lj_str_pushvf(L, err2msg(em), argp); va_end(argp); if (tokstr) msg = lj_str_pushf(L, err2msg(LJ_ERR_XNEAR), msg, tokstr); if (cp->linenumber > 1) msg = lj_str_pushf(L, "%s at line %d", msg, cp->linenumber); lj_err_callermsg(L, msg); } LJ_NORET LJ_NOINLINE static void cp_err_token(CPState *cp, CPToken tok) { cp_errmsg(cp, cp->tok, LJ_ERR_XTOKEN, cp_tok2str(cp, tok)); } LJ_NORET LJ_NOINLINE static void cp_err_badidx(CPState *cp, CType *ct) { GCstr *s = lj_ctype_repr(cp->cts->L, ctype_typeid(cp->cts, ct), NULL); cp_errmsg(cp, 0, LJ_ERR_FFI_BADIDX, strdata(s)); } LJ_NORET LJ_NOINLINE static void cp_err(CPState *cp, ErrMsg em) { cp_errmsg(cp, 0, em); } /* -- Main lexical scanner ------------------------------------------------ */ /* Parse number literal. Only handles int32_t/uint32_t right now. */ static CPToken cp_number(CPState *cp) { StrScanFmt fmt; TValue o; do { cp_save(cp, cp->c); } while (lj_char_isident(cp_get(cp))); cp_save(cp, '\0'); fmt = lj_strscan_scan((const uint8_t *)cp->sb.buf, &o, STRSCAN_OPT_C); if (fmt == STRSCAN_INT) cp->val.id = CTID_INT32; else if (fmt == STRSCAN_U32) cp->val.id = CTID_UINT32; else if (!(cp->mode & CPARSE_MODE_SKIP)) cp_errmsg(cp, CTOK_INTEGER, LJ_ERR_XNUMBER); cp->val.u32 = (uint32_t)o.i; return CTOK_INTEGER; } /* Parse identifier or keyword. */ static CPToken cp_ident(CPState *cp) { do { cp_save(cp, cp->c); } while (lj_char_isident(cp_get(cp))); cp->str = lj_str_new(cp->L, cp->sb.buf, cp->sb.n); cp->val.id = lj_ctype_getname(cp->cts, &cp->ct, cp->str, cp->tmask); if (ctype_type(cp->ct->info) == CT_KW) return ctype_cid(cp->ct->info); return CTOK_IDENT; } /* Parse parameter. */ static CPToken cp_param(CPState *cp) { CPChar c = cp_get(cp); TValue *o = cp->param; if (lj_char_isident(c) || c == '$') /* Reserve $xyz for future extensions. */ cp_errmsg(cp, c, LJ_ERR_XSYNTAX); if (!o || o >= cp->L->top) cp_err(cp, LJ_ERR_FFI_NUMPARAM); cp->param = o+1; if (tvisstr(o)) { cp->str = strV(o); cp->val.id = 0; cp->ct = &cp->cts->tab[0]; return CTOK_IDENT; } else if (tvisnumber(o)) { cp->val.i32 = numberVint(o); cp->val.id = CTID_INT32; return CTOK_INTEGER; } else { GCcdata *cd; if (!tviscdata(o)) lj_err_argtype(cp->L, (int)(o-cp->L->base)+1, "type parameter"); cd = cdataV(o); if (cd->ctypeid == CTID_CTYPEID) cp->val.id = *(CTypeID *)cdataptr(cd); else cp->val.id = cd->ctypeid; return '$'; } } /* Parse string or character constant. */ static CPToken cp_string(CPState *cp) { CPChar delim = cp->c; cp_get(cp); while (cp->c != delim) { CPChar c = cp->c; if (c == '\0') cp_errmsg(cp, CTOK_EOF, LJ_ERR_XSTR); if (c == '\\') { c = cp_get(cp); switch (c) { case '\0': cp_errmsg(cp, CTOK_EOF, LJ_ERR_XSTR); break; case 'a': c = '\a'; break; case 'b': c = '\b'; break; case 'f': c = '\f'; break; case 'n': c = '\n'; break; case 'r': c = '\r'; break; case 't': c = '\t'; break; case 'v': c = '\v'; break; case 'e': c = 27; break; case 'x': c = 0; while (lj_char_isxdigit(cp_get(cp))) c = (c<<4) + (lj_char_isdigit(cp->c) ? cp->c-'0' : (cp->c&15)+9); cp_save(cp, (c & 0xff)); continue; default: if (lj_char_isdigit(c)) { c -= '0'; if (lj_char_isdigit(cp_get(cp))) { c = c*8 + (cp->c - '0'); if (lj_char_isdigit(cp_get(cp))) { c = c*8 + (cp->c - '0'); cp_get(cp); } } cp_save(cp, (c & 0xff)); continue; } break; } } cp_save(cp, c); cp_get(cp); } cp_get(cp); if (delim == '"') { cp->str = lj_str_new(cp->L, cp->sb.buf, cp->sb.n); return CTOK_STRING; } else { if (cp->sb.n != 1) cp_err_token(cp, '\''); cp->val.i32 = (int32_t)(char)cp->sb.buf[0]; cp->val.id = CTID_INT32; return CTOK_INTEGER; } } /* Skip C comment. */ static void cp_comment_c(CPState *cp) { do { if (cp_get(cp) == '*') { do { if (cp_get(cp) == '/') { cp_get(cp); return; } } while (cp->c == '*'); } if (cp_iseol(cp->c)) cp_newline(cp); } while (cp->c != '\0'); } /* Skip C++ comment. */ static void cp_comment_cpp(CPState *cp) { while (!cp_iseol(cp_get(cp)) && cp->c != '\0') ; } /* Lexical scanner for C. Only a minimal subset is implemented. */ static CPToken cp_next_(CPState *cp) { lj_str_resetbuf(&cp->sb); for (;;) { if (lj_char_isident(cp->c)) return lj_char_isdigit(cp->c) ? cp_number(cp) : cp_ident(cp); switch (cp->c) { case '\n': case '\r': cp_newline(cp); /* fallthrough. */ case ' ': case '\t': case '\v': case '\f': cp_get(cp); break; case '"': case '\'': return cp_string(cp); case '/': if (cp_get(cp) == '*') cp_comment_c(cp); else if (cp->c == '/') cp_comment_cpp(cp); else return '/'; break; case '|': if (cp_get(cp) != '|') return '|'; cp_get(cp); return CTOK_OROR; case '&': if (cp_get(cp) != '&') return '&'; cp_get(cp); return CTOK_ANDAND; case '=': if (cp_get(cp) != '=') return '='; cp_get(cp); return CTOK_EQ; case '!': if (cp_get(cp) != '=') return '!'; cp_get(cp); return CTOK_NE; case '<': if (cp_get(cp) == '=') { cp_get(cp); return CTOK_LE; } else if (cp->c == '<') { cp_get(cp); return CTOK_SHL; } return '<'; case '>': if (cp_get(cp) == '=') { cp_get(cp); return CTOK_GE; } else if (cp->c == '>') { cp_get(cp); return CTOK_SHR; } return '>'; case '-': if (cp_get(cp) != '>') return '-'; cp_get(cp); return CTOK_DEREF; case '$': return cp_param(cp); case '\0': return CTOK_EOF; default: { CPToken c = cp->c; cp_get(cp); return c; } } } } static LJ_NOINLINE CPToken cp_next(CPState *cp) { return (cp->tok = cp_next_(cp)); } /* -- C parser ------------------------------------------------------------ */ /* Namespaces for resolving identifiers. */ #define CPNS_DEFAULT \ ((1u<linenumber = 1; cp->depth = 0; cp->curpack = 0; cp->packstack[0] = 255; lj_str_initbuf(&cp->sb); lj_str_resizebuf(cp->L, &cp->sb, LJ_MIN_SBUF); lua_assert(cp->p != NULL); cp_get(cp); /* Read-ahead first char. */ cp->tok = 0; cp->tmask = CPNS_DEFAULT; cp_next(cp); /* Read-ahead first token. */ } /* Cleanup C parser state. */ static void cp_cleanup(CPState *cp) { global_State *g = G(cp->L); lj_str_freebuf(g, &cp->sb); } /* Check and consume optional token. */ static int cp_opt(CPState *cp, CPToken tok) { if (cp->tok == tok) { cp_next(cp); return 1; } return 0; } /* Check and consume token. */ static void cp_check(CPState *cp, CPToken tok) { if (cp->tok != tok) cp_err_token(cp, tok); cp_next(cp); } /* Check if the next token may start a type declaration. */ static int cp_istypedecl(CPState *cp) { if (cp->tok >= CTOK_FIRSTDECL && cp->tok <= CTOK_LASTDECL) return 1; if (cp->tok == CTOK_IDENT && ctype_istypedef(cp->ct->info)) return 1; if (cp->tok == '$') return 1; return 0; } /* -- Constant expression evaluator --------------------------------------- */ /* Forward declarations. */ static void cp_expr_unary(CPState *cp, CPValue *k); static void cp_expr_sub(CPState *cp, CPValue *k, int pri); /* Please note that type handling is very weak here. Most ops simply ** assume integer operands. Accessors are only needed to compute types and ** return synthetic values. The only purpose of the expression evaluator ** is to compute the values of constant expressions one would typically ** find in C header files. And again: this is NOT a validating C parser! */ /* Parse comma separated expression and return last result. */ static void cp_expr_comma(CPState *cp, CPValue *k) { do { cp_expr_sub(cp, k, 0); } while (cp_opt(cp, ',')); } /* Parse sizeof/alignof operator. */ static void cp_expr_sizeof(CPState *cp, CPValue *k, int wantsz) { CTSize sz; CTInfo info; if (cp_opt(cp, '(')) { if (cp_istypedecl(cp)) k->id = cp_decl_abstract(cp); else cp_expr_comma(cp, k); cp_check(cp, ')'); } else { cp_expr_unary(cp, k); } info = lj_ctype_info(cp->cts, k->id, &sz); if (wantsz) { if (sz != CTSIZE_INVALID) k->u32 = sz; else if (k->id != CTID_A_CCHAR) /* Special case for sizeof("string"). */ cp_err(cp, LJ_ERR_FFI_INVSIZE); } else { k->u32 = 1u << ctype_align(info); } k->id = CTID_UINT32; /* Really size_t. */ } /* Parse prefix operators. */ static void cp_expr_prefix(CPState *cp, CPValue *k) { if (cp->tok == CTOK_INTEGER) { *k = cp->val; cp_next(cp); } else if (cp_opt(cp, '+')) { cp_expr_unary(cp, k); /* Nothing to do (well, integer promotion). */ } else if (cp_opt(cp, '-')) { cp_expr_unary(cp, k); k->i32 = -k->i32; } else if (cp_opt(cp, '~')) { cp_expr_unary(cp, k); k->i32 = ~k->i32; } else if (cp_opt(cp, '!')) { cp_expr_unary(cp, k); k->i32 = !k->i32; k->id = CTID_INT32; } else if (cp_opt(cp, '(')) { if (cp_istypedecl(cp)) { /* Cast operator. */ CTypeID id = cp_decl_abstract(cp); cp_check(cp, ')'); cp_expr_unary(cp, k); k->id = id; /* No conversion performed. */ } else { /* Sub-expression. */ cp_expr_comma(cp, k); cp_check(cp, ')'); } } else if (cp_opt(cp, '*')) { /* Indirection. */ CType *ct; cp_expr_unary(cp, k); ct = lj_ctype_rawref(cp->cts, k->id); if (!ctype_ispointer(ct->info)) cp_err_badidx(cp, ct); k->u32 = 0; k->id = ctype_cid(ct->info); } else if (cp_opt(cp, '&')) { /* Address operator. */ cp_expr_unary(cp, k); k->id = lj_ctype_intern(cp->cts, CTINFO(CT_PTR, CTALIGN_PTR+k->id), CTSIZE_PTR); } else if (cp_opt(cp, CTOK_SIZEOF)) { cp_expr_sizeof(cp, k, 1); } else if (cp_opt(cp, CTOK_ALIGNOF)) { cp_expr_sizeof(cp, k, 0); } else if (cp->tok == CTOK_IDENT) { if (ctype_type(cp->ct->info) == CT_CONSTVAL) { k->u32 = cp->ct->size; k->id = ctype_cid(cp->ct->info); } else if (ctype_type(cp->ct->info) == CT_EXTERN) { k->u32 = cp->val.id; k->id = ctype_cid(cp->ct->info); } else if (ctype_type(cp->ct->info) == CT_FUNC) { k->u32 = cp->val.id; k->id = cp->val.id; } else { goto err_expr; } cp_next(cp); } else if (cp->tok == CTOK_STRING) { CTSize sz = cp->str->len; while (cp_next(cp) == CTOK_STRING) sz += cp->str->len; k->u32 = sz + 1; k->id = CTID_A_CCHAR; } else { err_expr: cp_errmsg(cp, cp->tok, LJ_ERR_XSYMBOL); } } /* Parse postfix operators. */ static void cp_expr_postfix(CPState *cp, CPValue *k) { for (;;) { CType *ct; if (cp_opt(cp, '[')) { /* Array/pointer index. */ CPValue k2; cp_expr_comma(cp, &k2); ct = lj_ctype_rawref(cp->cts, k->id); if (!ctype_ispointer(ct->info)) { ct = lj_ctype_rawref(cp->cts, k2.id); if (!ctype_ispointer(ct->info)) cp_err_badidx(cp, ct); } cp_check(cp, ']'); k->u32 = 0; } else if (cp->tok == '.' || cp->tok == CTOK_DEREF) { /* Struct deref. */ CTSize ofs; CType *fct; ct = lj_ctype_rawref(cp->cts, k->id); if (cp->tok == CTOK_DEREF) { if (!ctype_ispointer(ct->info)) cp_err_badidx(cp, ct); ct = lj_ctype_rawref(cp->cts, ctype_cid(ct->info)); } cp_next(cp); if (cp->tok != CTOK_IDENT) cp_err_token(cp, CTOK_IDENT); if (!ctype_isstruct(ct->info) || ct->size == CTSIZE_INVALID || !(fct = lj_ctype_getfield(cp->cts, ct, cp->str, &ofs)) || ctype_isbitfield(fct->info)) { GCstr *s = lj_ctype_repr(cp->cts->L, ctype_typeid(cp->cts, ct), NULL); cp_errmsg(cp, 0, LJ_ERR_FFI_BADMEMBER, strdata(s), strdata(cp->str)); } ct = fct; k->u32 = ctype_isconstval(ct->info) ? ct->size : 0; cp_next(cp); } else { return; } k->id = ctype_cid(ct->info); } } /* Parse infix operators. */ static void cp_expr_infix(CPState *cp, CPValue *k, int pri) { CPValue k2; k2.u32 = 0; k2.id = 0; /* Silence the compiler. */ for (;;) { switch (pri) { case 0: if (cp_opt(cp, '?')) { CPValue k3; cp_expr_comma(cp, &k2); /* Right-associative. */ cp_check(cp, ':'); cp_expr_sub(cp, &k3, 0); k->u32 = k->u32 ? k2.u32 : k3.u32; k->id = k2.id > k3.id ? k2.id : k3.id; continue; } case 1: if (cp_opt(cp, CTOK_OROR)) { cp_expr_sub(cp, &k2, 2); k->i32 = k->u32 || k2.u32; k->id = CTID_INT32; continue; } case 2: if (cp_opt(cp, CTOK_ANDAND)) { cp_expr_sub(cp, &k2, 3); k->i32 = k->u32 && k2.u32; k->id = CTID_INT32; continue; } case 3: if (cp_opt(cp, '|')) { cp_expr_sub(cp, &k2, 4); k->u32 = k->u32 | k2.u32; goto arith_result; } case 4: if (cp_opt(cp, '^')) { cp_expr_sub(cp, &k2, 5); k->u32 = k->u32 ^ k2.u32; goto arith_result; } case 5: if (cp_opt(cp, '&')) { cp_expr_sub(cp, &k2, 6); k->u32 = k->u32 & k2.u32; goto arith_result; } case 6: if (cp_opt(cp, CTOK_EQ)) { cp_expr_sub(cp, &k2, 7); k->i32 = k->u32 == k2.u32; k->id = CTID_INT32; continue; } else if (cp_opt(cp, CTOK_NE)) { cp_expr_sub(cp, &k2, 7); k->i32 = k->u32 != k2.u32; k->id = CTID_INT32; continue; } case 7: if (cp_opt(cp, '<')) { cp_expr_sub(cp, &k2, 8); if (k->id == CTID_INT32 && k2.id == CTID_INT32) k->i32 = k->i32 < k2.i32; else k->i32 = k->u32 < k2.u32; k->id = CTID_INT32; continue; } else if (cp_opt(cp, '>')) { cp_expr_sub(cp, &k2, 8); if (k->id == CTID_INT32 && k2.id == CTID_INT32) k->i32 = k->i32 > k2.i32; else k->i32 = k->u32 > k2.u32; k->id = CTID_INT32; continue; } else if (cp_opt(cp, CTOK_LE)) { cp_expr_sub(cp, &k2, 8); if (k->id == CTID_INT32 && k2.id == CTID_INT32) k->i32 = k->i32 <= k2.i32; else k->i32 = k->u32 <= k2.u32; k->id = CTID_INT32; continue; } else if (cp_opt(cp, CTOK_GE)) { cp_expr_sub(cp, &k2, 8); if (k->id == CTID_INT32 && k2.id == CTID_INT32) k->i32 = k->i32 >= k2.i32; else k->i32 = k->u32 >= k2.u32; k->id = CTID_INT32; continue; } case 8: if (cp_opt(cp, CTOK_SHL)) { cp_expr_sub(cp, &k2, 9); k->u32 = k->u32 << k2.u32; continue; } else if (cp_opt(cp, CTOK_SHR)) { cp_expr_sub(cp, &k2, 9); if (k->id == CTID_INT32) k->i32 = k->i32 >> k2.i32; else k->u32 = k->u32 >> k2.u32; continue; } case 9: if (cp_opt(cp, '+')) { cp_expr_sub(cp, &k2, 10); k->u32 = k->u32 + k2.u32; arith_result: if (k2.id > k->id) k->id = k2.id; /* Trivial promotion to unsigned. */ continue; } else if (cp_opt(cp, '-')) { cp_expr_sub(cp, &k2, 10); k->u32 = k->u32 - k2.u32; goto arith_result; } case 10: if (cp_opt(cp, '*')) { cp_expr_unary(cp, &k2); k->u32 = k->u32 * k2.u32; goto arith_result; } else if (cp_opt(cp, '/')) { cp_expr_unary(cp, &k2); if (k2.id > k->id) k->id = k2.id; /* Trivial promotion to unsigned. */ if (k2.u32 == 0 || (k->id == CTID_INT32 && k->u32 == 0x80000000u && k2.i32 == -1)) cp_err(cp, LJ_ERR_BADVAL); if (k->id == CTID_INT32) k->i32 = k->i32 / k2.i32; else k->u32 = k->u32 / k2.u32; continue; } else if (cp_opt(cp, '%')) { cp_expr_unary(cp, &k2); if (k2.id > k->id) k->id = k2.id; /* Trivial promotion to unsigned. */ if (k2.u32 == 0 || (k->id == CTID_INT32 && k->u32 == 0x80000000u && k2.i32 == -1)) cp_err(cp, LJ_ERR_BADVAL); if (k->id == CTID_INT32) k->i32 = k->i32 % k2.i32; else k->u32 = k->u32 % k2.u32; continue; } default: return; } } } /* Parse and evaluate unary expression. */ static void cp_expr_unary(CPState *cp, CPValue *k) { if (++cp->depth > CPARSE_MAX_DECLDEPTH) cp_err(cp, LJ_ERR_XLEVELS); cp_expr_prefix(cp, k); cp_expr_postfix(cp, k); cp->depth--; } /* Parse and evaluate sub-expression. */ static void cp_expr_sub(CPState *cp, CPValue *k, int pri) { cp_expr_unary(cp, k); cp_expr_infix(cp, k, pri); } /* Parse constant integer expression. */ static void cp_expr_kint(CPState *cp, CPValue *k) { CType *ct; cp_expr_sub(cp, k, 0); ct = ctype_raw(cp->cts, k->id); if (!ctype_isinteger(ct->info)) cp_err(cp, LJ_ERR_BADVAL); } /* Parse (non-negative) size expression. */ static CTSize cp_expr_ksize(CPState *cp) { CPValue k; cp_expr_kint(cp, &k); if (k.u32 >= 0x80000000u) cp_err(cp, LJ_ERR_FFI_INVSIZE); return k.u32; } /* -- Type declaration stack management ----------------------------------- */ /* Add declaration element behind the insertion position. */ static CPDeclIdx cp_add(CPDecl *decl, CTInfo info, CTSize size) { CPDeclIdx top = decl->top; if (top >= CPARSE_MAX_DECLSTACK) cp_err(decl->cp, LJ_ERR_XLEVELS); decl->stack[top].info = info; decl->stack[top].size = size; decl->stack[top].sib = 0; setgcrefnull(decl->stack[top].name); decl->stack[top].next = decl->stack[decl->pos].next; decl->stack[decl->pos].next = (CTypeID1)top; decl->top = top+1; return top; } /* Push declaration element before the insertion position. */ static CPDeclIdx cp_push(CPDecl *decl, CTInfo info, CTSize size) { return (decl->pos = cp_add(decl, info, size)); } /* Push or merge attributes. */ static void cp_push_attributes(CPDecl *decl) { CType *ct = &decl->stack[decl->pos]; if (ctype_isfunc(ct->info)) { /* Ok to modify in-place. */ #if LJ_TARGET_X86 if ((decl->fattr & CTFP_CCONV)) ct->info = (ct->info & (CTMASK_NUM|CTF_VARARG|CTMASK_CID)) + (decl->fattr & ~CTMASK_CID); #endif } else { if ((decl->attr & CTFP_ALIGNED) && !(decl->mode & CPARSE_MODE_FIELD)) cp_push(decl, CTINFO(CT_ATTRIB, CTATTRIB(CTA_ALIGN)), ctype_align(decl->attr)); } } /* Push unrolled type to declaration stack and merge qualifiers. */ static void cp_push_type(CPDecl *decl, CTypeID id) { CType *ct = ctype_get(decl->cp->cts, id); CTInfo info = ct->info; CTSize size = ct->size; switch (ctype_type(info)) { case CT_STRUCT: case CT_ENUM: cp_push(decl, CTINFO(CT_TYPEDEF, id), 0); /* Don't copy unique types. */ if ((decl->attr & CTF_QUAL)) { /* Push unmerged qualifiers. */ cp_push(decl, CTINFO(CT_ATTRIB, CTATTRIB(CTA_QUAL)), (decl->attr & CTF_QUAL)); decl->attr &= ~CTF_QUAL; } break; case CT_ATTRIB: if (ctype_isxattrib(info, CTA_QUAL)) decl->attr &= ~size; /* Remove redundant qualifiers. */ cp_push_type(decl, ctype_cid(info)); /* Unroll. */ cp_push(decl, info & ~CTMASK_CID, size); /* Copy type. */ break; case CT_ARRAY: if ((ct->info & (CTF_VECTOR|CTF_COMPLEX))) { info |= (decl->attr & CTF_QUAL); decl->attr &= ~CTF_QUAL; } cp_push_type(decl, ctype_cid(info)); /* Unroll. */ cp_push(decl, info & ~CTMASK_CID, size); /* Copy type. */ decl->stack[decl->pos].sib = 1; /* Mark as already checked and sized. */ /* Note: this is not copied to the ct->sib in the C type table. */ break; case CT_FUNC: /* Copy type, link parameters (shared). */ decl->stack[cp_push(decl, info, size)].sib = ct->sib; break; default: /* Copy type, merge common qualifiers. */ cp_push(decl, info|(decl->attr & CTF_QUAL), size); decl->attr &= ~CTF_QUAL; break; } } /* Consume the declaration element chain and intern the C type. */ static CTypeID cp_decl_intern(CPState *cp, CPDecl *decl) { CTypeID id = 0; CPDeclIdx idx = 0; CTSize csize = CTSIZE_INVALID; CTSize cinfo = 0; do { CType *ct = &decl->stack[idx]; CTInfo info = ct->info; CTInfo size = ct->size; /* The cid is already part of info for copies of pointers/functions. */ idx = ct->next; if (ctype_istypedef(info)) { lua_assert(id == 0); id = ctype_cid(info); /* Always refetch info/size, since struct/enum may have been completed. */ cinfo = ctype_get(cp->cts, id)->info; csize = ctype_get(cp->cts, id)->size; lua_assert(ctype_isstruct(cinfo) || ctype_isenum(cinfo)); } else if (ctype_isfunc(info)) { /* Intern function. */ CType *fct; CTypeID fid; CTypeID sib; if (id) { CType *refct = ctype_raw(cp->cts, id); /* Reject function or refarray return types. */ if (ctype_isfunc(refct->info) || ctype_isrefarray(refct->info)) cp_err(cp, LJ_ERR_FFI_INVTYPE); } /* No intervening attributes allowed, skip forward. */ while (idx) { CType *ctn = &decl->stack[idx]; if (!ctype_isattrib(ctn->info)) break; idx = ctn->next; /* Skip attribute. */ } sib = ct->sib; /* Next line may reallocate the C type table. */ fid = lj_ctype_new(cp->cts, &fct); csize = CTSIZE_INVALID; fct->info = cinfo = info + id; fct->size = size; fct->sib = sib; id = fid; } else if (ctype_isattrib(info)) { if (ctype_isxattrib(info, CTA_QUAL)) cinfo |= size; else if (ctype_isxattrib(info, CTA_ALIGN)) CTF_INSERT(cinfo, ALIGN, size); id = lj_ctype_intern(cp->cts, info+id, size); /* Inherit csize/cinfo from original type. */ } else { if (ctype_isnum(info)) { /* Handle mode/vector-size attributes. */ lua_assert(id == 0); if (!(info & CTF_BOOL)) { CTSize msize = ctype_msizeP(decl->attr); CTSize vsize = ctype_vsizeP(decl->attr); if (msize && (!(info & CTF_FP) || (msize == 4 || msize == 8))) { CTSize malign = lj_fls(msize); if (malign > 4) malign = 4; /* Limit alignment. */ CTF_INSERT(info, ALIGN, malign); size = msize; /* Override size via mode. */ } if (vsize) { /* Vector size set? */ CTSize esize = lj_fls(size); if (vsize >= esize) { /* Intern the element type first. */ id = lj_ctype_intern(cp->cts, info, size); /* Then create a vector (array) with vsize alignment. */ size = (1u << vsize); if (vsize > 4) vsize = 4; /* Limit alignment. */ if (ctype_align(info) > vsize) vsize = ctype_align(info); info = CTINFO(CT_ARRAY, (info & CTF_QUAL) + CTF_VECTOR + CTALIGN(vsize)); } } } } else if (ctype_isptr(info)) { /* Reject pointer/ref to ref. */ if (id && ctype_isref(ctype_raw(cp->cts, id)->info)) cp_err(cp, LJ_ERR_FFI_INVTYPE); if (ctype_isref(info)) { info &= ~CTF_VOLATILE; /* Refs are always const, never volatile. */ /* No intervening attributes allowed, skip forward. */ while (idx) { CType *ctn = &decl->stack[idx]; if (!ctype_isattrib(ctn->info)) break; idx = ctn->next; /* Skip attribute. */ } } } else if (ctype_isarray(info)) { /* Check for valid array size etc. */ if (ct->sib == 0) { /* Only check/size arrays not copied by unroll. */ if (ctype_isref(cinfo)) /* Reject arrays of refs. */ cp_err(cp, LJ_ERR_FFI_INVTYPE); /* Reject VLS or unknown-sized types. */ if (ctype_isvltype(cinfo) || csize == CTSIZE_INVALID) cp_err(cp, LJ_ERR_FFI_INVSIZE); /* a[] and a[?] keep their invalid size. */ if (size != CTSIZE_INVALID) { uint64_t xsz = (uint64_t)size * csize; if (xsz >= 0x80000000u) cp_err(cp, LJ_ERR_FFI_INVSIZE); size = (CTSize)xsz; } } if ((cinfo & CTF_ALIGN) > (info & CTF_ALIGN)) /* Find max. align. */ info = (info & ~CTF_ALIGN) | (cinfo & CTF_ALIGN); info |= (cinfo & CTF_QUAL); /* Inherit qual. */ } else { lua_assert(ctype_isvoid(info)); } csize = size; cinfo = info+id; id = lj_ctype_intern(cp->cts, info+id, size); } } while (idx); return id; } /* -- C declaration parser ------------------------------------------------ */ #define H_(le, be) LJ_ENDIAN_SELECT(0x##le, 0x##be) /* Reset declaration state to declaration specifier. */ static void cp_decl_reset(CPDecl *decl) { decl->pos = decl->specpos; decl->top = decl->specpos+1; decl->stack[decl->specpos].next = 0; decl->attr = decl->specattr; decl->fattr = decl->specfattr; decl->name = NULL; decl->redir = NULL; } /* Parse constant initializer. */ /* NYI: FP constants and strings as initializers. */ static CTypeID cp_decl_constinit(CPState *cp, CType **ctp, CTypeID ctypeid) { CType *ctt = ctype_get(cp->cts, ctypeid); CTInfo info; CTSize size; CPValue k; CTypeID constid; while (ctype_isattrib(ctt->info)) { /* Skip attributes. */ ctypeid = ctype_cid(ctt->info); /* Update ID, too. */ ctt = ctype_get(cp->cts, ctypeid); } info = ctt->info; size = ctt->size; if (!ctype_isinteger(info) || !(info & CTF_CONST) || size > 4) cp_err(cp, LJ_ERR_FFI_INVTYPE); cp_check(cp, '='); cp_expr_sub(cp, &k, 0); constid = lj_ctype_new(cp->cts, ctp); (*ctp)->info = CTINFO(CT_CONSTVAL, CTF_CONST|ctypeid); k.u32 <<= 8*(4-size); if ((info & CTF_UNSIGNED)) k.u32 >>= 8*(4-size); else k.u32 = (uint32_t)((int32_t)k.u32 >> 8*(4-size)); (*ctp)->size = k.u32; return constid; } /* Parse size in parentheses as part of attribute. */ static CTSize cp_decl_sizeattr(CPState *cp) { CTSize sz; uint32_t oldtmask = cp->tmask; cp->tmask = CPNS_DEFAULT; /* Required for expression evaluator. */ cp_check(cp, '('); sz = cp_expr_ksize(cp); cp->tmask = oldtmask; cp_check(cp, ')'); return sz; } /* Parse alignment attribute. */ static void cp_decl_align(CPState *cp, CPDecl *decl) { CTSize al = 4; /* Unspecified alignment is 16 bytes. */ if (cp->tok == '(') { al = cp_decl_sizeattr(cp); al = al ? lj_fls(al) : 0; } CTF_INSERT(decl->attr, ALIGN, al); decl->attr |= CTFP_ALIGNED; } /* Parse GCC asm("name") redirect. */ static void cp_decl_asm(CPState *cp, CPDecl *decl) { UNUSED(decl); cp_next(cp); cp_check(cp, '('); if (cp->tok == CTOK_STRING) { GCstr *str = cp->str; while (cp_next(cp) == CTOK_STRING) { lj_str_pushf(cp->L, "%s%s", strdata(str), strdata(cp->str)); cp->L->top--; str = strV(cp->L->top); } decl->redir = str; } cp_check(cp, ')'); } /* Parse GCC __attribute__((mode(...))). */ static void cp_decl_mode(CPState *cp, CPDecl *decl) { cp_check(cp, '('); if (cp->tok == CTOK_IDENT) { const char *s = strdata(cp->str); CTSize sz = 0, vlen = 0; if (s[0] == '_' && s[1] == '_') s += 2; if (*s == 'V') { s++; vlen = *s++ - '0'; if (*s >= '0' && *s <= '9') vlen = vlen*10 + (*s++ - '0'); } switch (*s++) { case 'Q': sz = 1; break; case 'H': sz = 2; break; case 'S': sz = 4; break; case 'D': sz = 8; break; case 'T': sz = 16; break; case 'O': sz = 32; break; default: goto bad_size; } if (*s == 'I' || *s == 'F') { CTF_INSERT(decl->attr, MSIZEP, sz); if (vlen) CTF_INSERT(decl->attr, VSIZEP, lj_fls(vlen*sz)); } bad_size: cp_next(cp); } cp_check(cp, ')'); } /* Parse GCC __attribute__((...)). */ static void cp_decl_gccattribute(CPState *cp, CPDecl *decl) { cp_next(cp); cp_check(cp, '('); cp_check(cp, '('); while (cp->tok != ')') { if (cp->tok == CTOK_IDENT) { GCstr *attrstr = cp->str; cp_next(cp); switch (attrstr->hash) { case H_(64a9208e,8ce14319): case H_(8e6331b2,95a282af): /* aligned */ cp_decl_align(cp, decl); break; case H_(42eb47de,f0ede26c): case H_(29f48a09,cf383e0c): /* packed */ decl->attr |= CTFP_PACKED; break; case H_(0a84eef6,8dfab04c): case H_(995cf92c,d5696591): /* mode */ cp_decl_mode(cp, decl); break; case H_(0ab31997,2d5213fa): case H_(bf875611,200e9990): /* vector_size */ { CTSize vsize = cp_decl_sizeattr(cp); if (vsize) CTF_INSERT(decl->attr, VSIZEP, lj_fls(vsize)); } break; #if LJ_TARGET_X86 case H_(5ad22db8,c689b848): case H_(439150fa,65ea78cb): /* regparm */ CTF_INSERT(decl->fattr, REGPARM, cp_decl_sizeattr(cp)); decl->fattr |= CTFP_CCONV; break; case H_(18fc0b98,7ff4c074): case H_(4e62abed,0a747424): /* cdecl */ CTF_INSERT(decl->fattr, CCONV, CTCC_CDECL); decl->fattr |= CTFP_CCONV; break; case H_(72b2e41b,494c5a44): case H_(f2356d59,f25fc9bd): /* thiscall */ CTF_INSERT(decl->fattr, CCONV, CTCC_THISCALL); decl->fattr |= CTFP_CCONV; break; case H_(0d0ffc42,ab746f88): case H_(21c54ba1,7f0ca7e3): /* fastcall */ CTF_INSERT(decl->fattr, CCONV, CTCC_FASTCALL); decl->fattr |= CTFP_CCONV; break; case H_(ef76b040,9412e06a): case H_(de56697b,c750e6e1): /* stdcall */ CTF_INSERT(decl->fattr, CCONV, CTCC_STDCALL); decl->fattr |= CTFP_CCONV; break; case H_(ea78b622,f234bd8e): case H_(252ffb06,8d50f34b): /* sseregparm */ decl->fattr |= CTF_SSEREGPARM; decl->fattr |= CTFP_CCONV; break; #endif default: /* Skip all other attributes. */ goto skip_attr; } } else if (cp->tok >= CTOK_FIRSTDECL) { /* For __attribute((const)) etc. */ cp_next(cp); skip_attr: if (cp_opt(cp, '(')) { while (cp->tok != ')' && cp->tok != CTOK_EOF) cp_next(cp); cp_check(cp, ')'); } } else { break; } if (!cp_opt(cp, ',')) break; } cp_check(cp, ')'); cp_check(cp, ')'); } /* Parse MSVC __declspec(...). */ static void cp_decl_msvcattribute(CPState *cp, CPDecl *decl) { cp_next(cp); cp_check(cp, '('); while (cp->tok == CTOK_IDENT) { GCstr *attrstr = cp->str; cp_next(cp); switch (attrstr->hash) { case H_(bc2395fa,98f267f8): /* align */ cp_decl_align(cp, decl); break; default: /* Ignore all other attributes. */ if (cp_opt(cp, '(')) { while (cp->tok != ')' && cp->tok != CTOK_EOF) cp_next(cp); cp_check(cp, ')'); } break; } } cp_check(cp, ')'); } /* Parse declaration attributes (and common qualifiers). */ static void cp_decl_attributes(CPState *cp, CPDecl *decl) { for (;;) { switch (cp->tok) { case CTOK_CONST: decl->attr |= CTF_CONST; break; case CTOK_VOLATILE: decl->attr |= CTF_VOLATILE; break; case CTOK_RESTRICT: break; /* Ignore. */ case CTOK_EXTENSION: break; /* Ignore. */ case CTOK_ATTRIBUTE: cp_decl_gccattribute(cp, decl); continue; case CTOK_ASM: cp_decl_asm(cp, decl); continue; case CTOK_DECLSPEC: cp_decl_msvcattribute(cp, decl); continue; case CTOK_CCDECL: #if LJ_TARGET_X86 CTF_INSERT(decl->fattr, CCONV, cp->ct->size); decl->fattr |= CTFP_CCONV; #endif break; case CTOK_PTRSZ: #if LJ_64 CTF_INSERT(decl->attr, MSIZEP, cp->ct->size); #endif break; default: return; } cp_next(cp); } } /* Parse struct/union/enum name. */ static CTypeID cp_struct_name(CPState *cp, CPDecl *sdecl, CTInfo info) { CTypeID sid; CType *ct; cp->tmask = CPNS_STRUCT; cp_next(cp); cp_decl_attributes(cp, sdecl); cp->tmask = CPNS_DEFAULT; if (cp->tok != '{') { if (cp->tok != CTOK_IDENT) cp_err_token(cp, CTOK_IDENT); if (cp->val.id) { /* Name of existing struct/union/enum. */ sid = cp->val.id; ct = cp->ct; if ((ct->info ^ info) & (CTMASK_NUM|CTF_UNION)) /* Wrong type. */ cp_errmsg(cp, 0, LJ_ERR_FFI_REDEF, strdata(gco2str(gcref(ct->name)))); } else { /* Create named, incomplete struct/union/enum. */ if ((cp->mode & CPARSE_MODE_NOIMPLICIT)) cp_errmsg(cp, 0, LJ_ERR_FFI_BADTAG, strdata(cp->str)); sid = lj_ctype_new(cp->cts, &ct); ct->info = info; ct->size = CTSIZE_INVALID; ctype_setname(ct, cp->str); lj_ctype_addname(cp->cts, ct, sid); } cp_next(cp); } else { /* Create anonymous, incomplete struct/union/enum. */ sid = lj_ctype_new(cp->cts, &ct); ct->info = info; ct->size = CTSIZE_INVALID; } if (cp->tok == '{') { if (ct->size != CTSIZE_INVALID || ct->sib) cp_errmsg(cp, 0, LJ_ERR_FFI_REDEF, strdata(gco2str(gcref(ct->name)))); ct->sib = 1; /* Indicate the type is currently being defined. */ } return sid; } /* Determine field alignment. */ static CTSize cp_field_align(CPState *cp, CType *ct, CTInfo info) { CTSize align = ctype_align(info); UNUSED(cp); UNUSED(ct); #if (LJ_TARGET_X86 && !LJ_ABI_WIN) || (LJ_TARGET_ARM && __APPLE__) /* The SYSV i386 and iOS ABIs limit alignment of non-vector fields to 2^2. */ if (align > 2 && !(info & CTFP_ALIGNED)) { if (ctype_isarray(info) && !(info & CTF_VECTOR)) { do { ct = ctype_rawchild(cp->cts, ct); info = ct->info; } while (ctype_isarray(info) && !(info & CTF_VECTOR)); } if (ctype_isnum(info) || ctype_isenum(info)) align = 2; } #endif return align; } /* Layout struct/union fields. */ static void cp_struct_layout(CPState *cp, CTypeID sid, CTInfo sattr) { CTSize bofs = 0, bmaxofs = 0; /* Bit offset and max. bit offset. */ CTSize maxalign = ctype_align(sattr); CType *sct = ctype_get(cp->cts, sid); CTInfo sinfo = sct->info; CTypeID fieldid = sct->sib; while (fieldid) { CType *ct = ctype_get(cp->cts, fieldid); CTInfo attr = ct->size; /* Field declaration attributes (temp.). */ if (ctype_isfield(ct->info) || (ctype_isxattrib(ct->info, CTA_SUBTYPE) && attr)) { CTSize align, amask; /* Alignment (pow2) and alignment mask (bits). */ CTSize sz; CTInfo info = lj_ctype_info(cp->cts, ctype_cid(ct->info), &sz); CTSize bsz, csz = 8*sz; /* Field size and container size (in bits). */ sinfo |= (info & (CTF_QUAL|CTF_VLA)); /* Merge pseudo-qualifiers. */ /* Check for size overflow and determine alignment. */ if (sz >= 0x20000000u || bofs + csz < bofs || (info & CTF_VLA)) { if (!(sz == CTSIZE_INVALID && ctype_isarray(info) && !(sinfo & CTF_UNION))) cp_err(cp, LJ_ERR_FFI_INVSIZE); csz = sz = 0; /* Treat a[] and a[?] as zero-sized. */ } align = cp_field_align(cp, ct, info); if (((attr|sattr) & CTFP_PACKED) || ((attr & CTFP_ALIGNED) && ctype_align(attr) > align)) align = ctype_align(attr); if (cp->packstack[cp->curpack] < align) align = cp->packstack[cp->curpack]; if (align > maxalign) maxalign = align; amask = (8u << align) - 1; bsz = ctype_bitcsz(ct->info); /* Bitfield size (temp.). */ if (bsz == CTBSZ_FIELD || !ctype_isfield(ct->info)) { bsz = csz; /* Regular fields or subtypes always fill the container. */ bofs = (bofs + amask) & ~amask; /* Start new aligned field. */ ct->size = (bofs >> 3); /* Store field offset. */ } else { /* Bitfield. */ if (bsz == 0 || (attr & CTFP_ALIGNED) || (!((attr|sattr) & CTFP_PACKED) && (bofs & amask) + bsz > csz)) bofs = (bofs + amask) & ~amask; /* Start new aligned field. */ /* Prefer regular field over bitfield. */ if (bsz == csz && (bofs & amask) == 0) { ct->info = CTINFO(CT_FIELD, ctype_cid(ct->info)); ct->size = (bofs >> 3); /* Store field offset. */ } else { ct->info = CTINFO(CT_BITFIELD, (info & (CTF_QUAL|CTF_UNSIGNED|CTF_BOOL)) + (csz << (CTSHIFT_BITCSZ-3)) + (bsz << CTSHIFT_BITBSZ)); #if LJ_BE ct->info += ((csz - (bofs & (csz-1)) - bsz) << CTSHIFT_BITPOS); #else ct->info += ((bofs & (csz-1)) << CTSHIFT_BITPOS); #endif ct->size = ((bofs & ~(csz-1)) >> 3); /* Store container offset. */ } } /* Determine next offset or max. offset. */ if ((sinfo & CTF_UNION)) { if (bsz > bmaxofs) bmaxofs = bsz; } else { bofs += bsz; } } /* All other fields in the chain are already set up. */ fieldid = ct->sib; } /* Complete struct/union. */ sct->info = sinfo + CTALIGN(maxalign); bofs = (sinfo & CTF_UNION) ? bmaxofs : bofs; maxalign = (8u << maxalign) - 1; sct->size = (((bofs + maxalign) & ~maxalign) >> 3); } /* Parse struct/union declaration. */ static CTypeID cp_decl_struct(CPState *cp, CPDecl *sdecl, CTInfo sinfo) { CTypeID sid = cp_struct_name(cp, sdecl, sinfo); if (cp_opt(cp, '{')) { /* Struct/union definition. */ CTypeID lastid = sid; int lastdecl = 0; while (cp->tok != '}') { CPDecl decl; CPscl scl = cp_decl_spec(cp, &decl, CDF_STATIC); decl.mode = scl ? CPARSE_MODE_DIRECT : CPARSE_MODE_DIRECT|CPARSE_MODE_ABSTRACT|CPARSE_MODE_FIELD; for (;;) { CTypeID ctypeid; if (lastdecl) cp_err_token(cp, '}'); /* Parse field declarator. */ decl.bits = CTSIZE_INVALID; cp_declarator(cp, &decl); ctypeid = cp_decl_intern(cp, &decl); if ((scl & CDF_STATIC)) { /* Static constant in struct namespace. */ CType *ct; CTypeID fieldid = cp_decl_constinit(cp, &ct, ctypeid); ctype_get(cp->cts, lastid)->sib = fieldid; lastid = fieldid; ctype_setname(ct, decl.name); } else { CTSize bsz = CTBSZ_FIELD; /* Temp. for layout phase. */ CType *ct; CTypeID fieldid = lj_ctype_new(cp->cts, &ct); /* Do this first. */ CType *tct = ctype_raw(cp->cts, ctypeid); if (decl.bits == CTSIZE_INVALID) { /* Regular field. */ if (ctype_isarray(tct->info) && tct->size == CTSIZE_INVALID) lastdecl = 1; /* a[] or a[?] must be the last declared field. */ /* Accept transparent struct/union/enum. */ if (!decl.name) { if (!((ctype_isstruct(tct->info) && !(tct->info & CTF_VLA)) || ctype_isenum(tct->info))) cp_err_token(cp, CTOK_IDENT); ct->info = CTINFO(CT_ATTRIB, CTATTRIB(CTA_SUBTYPE) + ctypeid); ct->size = ctype_isstruct(tct->info) ? (decl.attr|0x80000000u) : 0; /* For layout phase. */ goto add_field; } } else { /* Bitfield. */ bsz = decl.bits; if (!ctype_isinteger_or_bool(tct->info) || (bsz == 0 && decl.name) || 8*tct->size > CTBSZ_MAX || bsz > ((tct->info & CTF_BOOL) ? 1 : 8*tct->size)) cp_errmsg(cp, ':', LJ_ERR_BADVAL); } /* Create temporary field for layout phase. */ ct->info = CTINFO(CT_FIELD, ctypeid + (bsz << CTSHIFT_BITCSZ)); ct->size = decl.attr; if (decl.name) ctype_setname(ct, decl.name); add_field: ctype_get(cp->cts, lastid)->sib = fieldid; lastid = fieldid; } if (!cp_opt(cp, ',')) break; cp_decl_reset(&decl); } cp_check(cp, ';'); } cp_check(cp, '}'); ctype_get(cp->cts, lastid)->sib = 0; /* Drop sib = 1 for empty structs. */ cp_decl_attributes(cp, sdecl); /* Layout phase needs postfix attributes. */ cp_struct_layout(cp, sid, sdecl->attr); } return sid; } /* Parse enum declaration. */ static CTypeID cp_decl_enum(CPState *cp, CPDecl *sdecl) { CTypeID eid = cp_struct_name(cp, sdecl, CTINFO(CT_ENUM, CTID_VOID)); CTInfo einfo = CTINFO(CT_ENUM, CTALIGN(2) + CTID_UINT32); CTSize esize = 4; /* Only 32 bit enums are supported. */ if (cp_opt(cp, '{')) { /* Enum definition. */ CPValue k; CTypeID lastid = eid; k.u32 = 0; k.id = CTID_INT32; do { GCstr *name = cp->str; if (cp->tok != CTOK_IDENT) cp_err_token(cp, CTOK_IDENT); if (cp->val.id) cp_errmsg(cp, 0, LJ_ERR_FFI_REDEF, strdata(name)); cp_next(cp); if (cp_opt(cp, '=')) { cp_expr_kint(cp, &k); if (k.id == CTID_UINT32) { /* C99 says that enum constants are always (signed) integers. ** But since unsigned constants like 0x80000000 are quite common, ** those are left as uint32_t. */ if (k.i32 >= 0) k.id = CTID_INT32; } else { /* OTOH it's common practice and even mandated by some ABIs ** that the enum type itself is unsigned, unless there are any ** negative constants. */ k.id = CTID_INT32; if (k.i32 < 0) einfo = CTINFO(CT_ENUM, CTALIGN(2) + CTID_INT32); } } /* Add named enum constant. */ { CType *ct; CTypeID constid = lj_ctype_new(cp->cts, &ct); ctype_get(cp->cts, lastid)->sib = constid; lastid = constid; ctype_setname(ct, name); ct->info = CTINFO(CT_CONSTVAL, CTF_CONST|k.id); ct->size = k.u32++; if (k.u32 == 0x80000000u) k.id = CTID_UINT32; lj_ctype_addname(cp->cts, ct, constid); } if (!cp_opt(cp, ',')) break; } while (cp->tok != '}'); /* Trailing ',' is ok. */ cp_check(cp, '}'); /* Complete enum. */ ctype_get(cp->cts, eid)->info = einfo; ctype_get(cp->cts, eid)->size = esize; } return eid; } /* Parse declaration specifiers. */ static CPscl cp_decl_spec(CPState *cp, CPDecl *decl, CPscl scl) { uint32_t cds = 0, sz = 0; CTypeID tdef = 0; decl->cp = cp; decl->mode = cp->mode; decl->name = NULL; decl->redir = NULL; decl->attr = 0; decl->fattr = 0; decl->pos = decl->top = 0; decl->stack[0].next = 0; for (;;) { /* Parse basic types. */ cp_decl_attributes(cp, decl); if (cp->tok >= CTOK_FIRSTDECL && cp->tok <= CTOK_LASTDECLFLAG) { uint32_t cbit; if (cp->ct->size) { if (sz) goto end_decl; sz = cp->ct->size; } cbit = (1u << (cp->tok - CTOK_FIRSTDECL)); cds = cds | cbit | ((cbit & cds & CDF_LONG) << 1); if (cp->tok >= CTOK_FIRSTSCL) { if (!(scl & cbit)) cp_errmsg(cp, cp->tok, LJ_ERR_FFI_BADSCL); } else if (tdef) { goto end_decl; } cp_next(cp); continue; } if (sz || tdef || (cds & (CDF_SHORT|CDF_LONG|CDF_SIGNED|CDF_UNSIGNED|CDF_COMPLEX))) break; switch (cp->tok) { case CTOK_STRUCT: tdef = cp_decl_struct(cp, decl, CTINFO(CT_STRUCT, 0)); continue; case CTOK_UNION: tdef = cp_decl_struct(cp, decl, CTINFO(CT_STRUCT, CTF_UNION)); continue; case CTOK_ENUM: tdef = cp_decl_enum(cp, decl); continue; case CTOK_IDENT: if (ctype_istypedef(cp->ct->info)) { tdef = ctype_cid(cp->ct->info); /* Get typedef. */ cp_next(cp); continue; } break; case '$': tdef = cp->val.id; cp_next(cp); continue; default: break; } break; } end_decl: if ((cds & CDF_COMPLEX)) /* Use predefined complex types. */ tdef = sz == 4 ? CTID_COMPLEX_FLOAT : CTID_COMPLEX_DOUBLE; if (tdef) { cp_push_type(decl, tdef); } else if ((cds & CDF_VOID)) { cp_push(decl, CTINFO(CT_VOID, (decl->attr & CTF_QUAL)), CTSIZE_INVALID); decl->attr &= ~CTF_QUAL; } else { /* Determine type info and size. */ CTInfo info = CTINFO(CT_NUM, (cds & CDF_UNSIGNED) ? CTF_UNSIGNED : 0); if ((cds & CDF_BOOL)) { if ((cds & ~(CDF_SCL|CDF_BOOL|CDF_INT|CDF_SIGNED|CDF_UNSIGNED))) cp_errmsg(cp, 0, LJ_ERR_FFI_INVTYPE); info |= CTF_BOOL; if (!(cds & CDF_SIGNED)) info |= CTF_UNSIGNED; if (!sz) { sz = 1; } } else if ((cds & CDF_FP)) { info = CTINFO(CT_NUM, CTF_FP); if ((cds & CDF_LONG)) sz = sizeof(long double); } else if ((cds & CDF_CHAR)) { if ((cds & (CDF_CHAR|CDF_SIGNED|CDF_UNSIGNED)) == CDF_CHAR) info |= CTF_UCHAR; /* Handle platforms where char is unsigned. */ } else if ((cds & CDF_SHORT)) { sz = sizeof(short); } else if ((cds & CDF_LONGLONG)) { sz = 8; } else if ((cds & CDF_LONG)) { info |= CTF_LONG; sz = sizeof(long); } else if (!sz) { if (!(cds & (CDF_SIGNED|CDF_UNSIGNED))) cp_errmsg(cp, cp->tok, LJ_ERR_FFI_DECLSPEC); sz = sizeof(int); } lua_assert(sz != 0); info += CTALIGN(lj_fls(sz)); /* Use natural alignment. */ info += (decl->attr & CTF_QUAL); /* Merge qualifiers. */ cp_push(decl, info, sz); decl->attr &= ~CTF_QUAL; } decl->specpos = decl->pos; decl->specattr = decl->attr; decl->specfattr = decl->fattr; return (cds & CDF_SCL); /* Return storage class. */ } /* Parse array declaration. */ static void cp_decl_array(CPState *cp, CPDecl *decl) { CTInfo info = CTINFO(CT_ARRAY, 0); CTSize nelem = CTSIZE_INVALID; /* Default size for a[] or a[?]. */ cp_decl_attributes(cp, decl); if (cp_opt(cp, '?')) info |= CTF_VLA; /* Create variable-length array a[?]. */ else if (cp->tok != ']') nelem = cp_expr_ksize(cp); cp_check(cp, ']'); cp_add(decl, info, nelem); } /* Parse function declaration. */ static void cp_decl_func(CPState *cp, CPDecl *fdecl) { CTSize nargs = 0; CTInfo info = CTINFO(CT_FUNC, 0); CTypeID lastid = 0, anchor = 0; if (cp->tok != ')') { do { CPDecl decl; CTypeID ctypeid, fieldid; CType *ct; if (cp_opt(cp, '.')) { /* Vararg function. */ cp_check(cp, '.'); /* Workaround for the minimalistic lexer. */ cp_check(cp, '.'); info |= CTF_VARARG; break; } cp_decl_spec(cp, &decl, CDF_REGISTER); decl.mode = CPARSE_MODE_DIRECT|CPARSE_MODE_ABSTRACT; cp_declarator(cp, &decl); ctypeid = cp_decl_intern(cp, &decl); ct = ctype_raw(cp->cts, ctypeid); if (ctype_isvoid(ct->info)) break; else if (ctype_isrefarray(ct->info)) ctypeid = lj_ctype_intern(cp->cts, CTINFO(CT_PTR, CTALIGN_PTR|ctype_cid(ct->info)), CTSIZE_PTR); else if (ctype_isfunc(ct->info)) ctypeid = lj_ctype_intern(cp->cts, CTINFO(CT_PTR, CTALIGN_PTR|ctypeid), CTSIZE_PTR); /* Add new parameter. */ fieldid = lj_ctype_new(cp->cts, &ct); if (anchor) ctype_get(cp->cts, lastid)->sib = fieldid; else anchor = fieldid; lastid = fieldid; if (decl.name) ctype_setname(ct, decl.name); ct->info = CTINFO(CT_FIELD, ctypeid); ct->size = nargs++; } while (cp_opt(cp, ',')); } cp_check(cp, ')'); if (cp_opt(cp, '{')) { /* Skip function definition. */ int level = 1; cp->mode |= CPARSE_MODE_SKIP; for (;;) { if (cp->tok == '{') level++; else if (cp->tok == '}' && --level == 0) break; else if (cp->tok == CTOK_EOF) cp_err_token(cp, '}'); cp_next(cp); } cp->mode &= ~CPARSE_MODE_SKIP; cp->tok = ';'; /* Ok for cp_decl_multi(), error in cp_decl_single(). */ } info |= (fdecl->fattr & ~CTMASK_CID); fdecl->fattr = 0; fdecl->stack[cp_add(fdecl, info, nargs)].sib = anchor; } /* Parse declarator. */ static void cp_declarator(CPState *cp, CPDecl *decl) { if (++cp->depth > CPARSE_MAX_DECLDEPTH) cp_err(cp, LJ_ERR_XLEVELS); for (;;) { /* Head of declarator. */ if (cp_opt(cp, '*')) { /* Pointer. */ CTSize sz; CTInfo info; cp_decl_attributes(cp, decl); sz = CTSIZE_PTR; info = CTINFO(CT_PTR, CTALIGN_PTR); #if LJ_64 if (ctype_msizeP(decl->attr) == 4) { sz = 4; info = CTINFO(CT_PTR, CTALIGN(2)); } #endif info += (decl->attr & (CTF_QUAL|CTF_REF)); decl->attr &= ~(CTF_QUAL|(CTMASK_MSIZEP<attr &= ~(CTF_QUAL|(CTMASK_MSIZEP<mode & CPARSE_MODE_ABSTRACT) && (cp->tok == ')' || cp_istypedecl(cp))) goto func_decl; pos = decl->pos; cp_declarator(cp, decl); cp_check(cp, ')'); decl->pos = pos; } else if (cp->tok == CTOK_IDENT) { /* Direct declarator. */ if (!(decl->mode & CPARSE_MODE_DIRECT)) cp_err_token(cp, CTOK_EOF); decl->name = cp->str; decl->nameid = cp->val.id; cp_next(cp); } else { /* Abstract declarator. */ if (!(decl->mode & CPARSE_MODE_ABSTRACT)) cp_err_token(cp, CTOK_IDENT); } for (;;) { /* Tail of declarator. */ if (cp_opt(cp, '[')) { /* Array. */ cp_decl_array(cp, decl); } else if (cp_opt(cp, '(')) { /* Function. */ func_decl: cp_decl_func(cp, decl); } else { break; } } if ((decl->mode & CPARSE_MODE_FIELD) && cp_opt(cp, ':')) /* Field width. */ decl->bits = cp_expr_ksize(cp); /* Process postfix attributes. */ cp_decl_attributes(cp, decl); cp_push_attributes(decl); cp->depth--; } /* Parse an abstract type declaration and return it's C type ID. */ static CTypeID cp_decl_abstract(CPState *cp) { CPDecl decl; cp_decl_spec(cp, &decl, 0); decl.mode = CPARSE_MODE_ABSTRACT; cp_declarator(cp, &decl); return cp_decl_intern(cp, &decl); } /* Handle pragmas. */ static void cp_pragma(CPState *cp, BCLine pragmaline) { cp_next(cp); if (cp->tok == CTOK_IDENT && cp->str->hash == H_(e79b999f,42ca3e85)) { /* pack */ cp_next(cp); cp_check(cp, '('); if (cp->tok == CTOK_IDENT) { if (cp->str->hash == H_(738e923c,a1b65954)) { /* push */ if (cp->curpack < CPARSE_MAX_PACKSTACK) { cp->packstack[cp->curpack+1] = cp->packstack[cp->curpack]; cp->curpack++; } } else if (cp->str->hash == H_(6c71cf27,6c71cf27)) { /* pop */ if (cp->curpack > 0) cp->curpack--; } else { cp_errmsg(cp, cp->tok, LJ_ERR_XSYMBOL); } cp_next(cp); if (!cp_opt(cp, ',')) goto end_pack; } if (cp->tok == CTOK_INTEGER) { cp->packstack[cp->curpack] = cp->val.u32 ? lj_fls(cp->val.u32) : 0; cp_next(cp); } else { cp->packstack[cp->curpack] = 255; } end_pack: cp_check(cp, ')'); } else { /* Ignore all other pragmas. */ while (cp->tok != CTOK_EOF && cp->linenumber == pragmaline) cp_next(cp); } } /* Parse multiple C declarations of types or extern identifiers. */ static void cp_decl_multi(CPState *cp) { int first = 1; while (cp->tok != CTOK_EOF) { CPDecl decl; CPscl scl; if (cp_opt(cp, ';')) { /* Skip empty statements. */ first = 0; continue; } if (cp->tok == '#') { /* Workaround, since we have no preprocessor, yet. */ BCLine pragmaline = cp->linenumber; if (!(cp_next(cp) == CTOK_IDENT && cp->str->hash == H_(f5e6b4f8,1d509107))) /* pragma */ cp_errmsg(cp, cp->tok, LJ_ERR_XSYMBOL); cp_pragma(cp, pragmaline); continue; } scl = cp_decl_spec(cp, &decl, CDF_TYPEDEF|CDF_EXTERN|CDF_STATIC); if ((cp->tok == ';' || cp->tok == CTOK_EOF) && ctype_istypedef(decl.stack[0].info)) { CTInfo info = ctype_rawchild(cp->cts, &decl.stack[0])->info; if (ctype_isstruct(info) || ctype_isenum(info)) goto decl_end; /* Accept empty declaration of struct/union/enum. */ } for (;;) { CTypeID ctypeid; cp_declarator(cp, &decl); ctypeid = cp_decl_intern(cp, &decl); if (decl.name && !decl.nameid) { /* NYI: redeclarations are ignored. */ CType *ct; CTypeID id; if ((scl & CDF_TYPEDEF)) { /* Create new typedef. */ id = lj_ctype_new(cp->cts, &ct); ct->info = CTINFO(CT_TYPEDEF, ctypeid); goto noredir; } else if (ctype_isfunc(ctype_get(cp->cts, ctypeid)->info)) { /* Treat both static and extern function declarations as extern. */ ct = ctype_get(cp->cts, ctypeid); /* We always get new anonymous functions (typedefs are copied). */ lua_assert(gcref(ct->name) == NULL); id = ctypeid; /* Just name it. */ } else if ((scl & CDF_STATIC)) { /* Accept static constants. */ id = cp_decl_constinit(cp, &ct, ctypeid); goto noredir; } else { /* External references have extern or no storage class. */ id = lj_ctype_new(cp->cts, &ct); ct->info = CTINFO(CT_EXTERN, ctypeid); } if (decl.redir) { /* Add attribute for redirected symbol name. */ CType *cta; CTypeID aid = lj_ctype_new(cp->cts, &cta); ct = ctype_get(cp->cts, id); /* Table may have been reallocated. */ cta->info = CTINFO(CT_ATTRIB, CTATTRIB(CTA_REDIR)); cta->sib = ct->sib; ct->sib = aid; ctype_setname(cta, decl.redir); } noredir: ctype_setname(ct, decl.name); lj_ctype_addname(cp->cts, ct, id); } if (!cp_opt(cp, ',')) break; cp_decl_reset(&decl); } decl_end: if (cp->tok == CTOK_EOF && first) break; /* May omit ';' for 1 decl. */ first = 0; cp_check(cp, ';'); } } /* Parse a single C type declaration. */ static void cp_decl_single(CPState *cp) { CPDecl decl; cp_decl_spec(cp, &decl, 0); cp_declarator(cp, &decl); cp->val.id = cp_decl_intern(cp, &decl); if (cp->tok != CTOK_EOF) cp_err_token(cp, CTOK_EOF); } #undef H_ /* ------------------------------------------------------------------------ */ /* Protected callback for C parser. */ static TValue *cpcparser(lua_State *L, lua_CFunction dummy, void *ud) { CPState *cp = (CPState *)ud; UNUSED(dummy); cframe_errfunc(L->cframe) = -1; /* Inherit error function. */ cp_init(cp); if ((cp->mode & CPARSE_MODE_MULTI)) cp_decl_multi(cp); else cp_decl_single(cp); if (cp->param && cp->param != cp->L->top) cp_err(cp, LJ_ERR_FFI_NUMPARAM); lua_assert(cp->depth == 0); return NULL; } /* C parser. */ int lj_cparse(CPState *cp) { LJ_CTYPE_SAVE(cp->cts); int errcode = lj_vm_cpcall(cp->L, NULL, cp, cpcparser); if (errcode) LJ_CTYPE_RESTORE(cp->cts); cp_cleanup(cp); return errcode; } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_udata.h0000644000175000017500000000046313122010155016630 0ustar philphil/* ** Userdata handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_UDATA_H #define _LJ_UDATA_H #include "lj_obj.h" LJ_FUNC GCudata *lj_udata_new(lua_State *L, MSize sz, GCtab *env); LJ_FUNC void LJ_FASTCALL lj_udata_free(global_State *g, GCudata *ud); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_gc.c0000644000175000017500000006332613122010155016125 0ustar philphil/* ** Garbage collector. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_gc_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_func.h" #include "lj_udata.h" #include "lj_meta.h" #include "lj_state.h" #include "lj_frame.h" #if LJ_HASFFI #include "lj_ctype.h" #include "lj_cdata.h" #endif #include "lj_trace.h" #include "lj_vm.h" #define GCSTEPSIZE 1024u #define GCSWEEPMAX 40 #define GCSWEEPCOST 10 #define GCFINALIZECOST 100 /* Macros to set GCobj colors and flags. */ #define white2gray(x) ((x)->gch.marked &= (uint8_t)~LJ_GC_WHITES) #define gray2black(x) ((x)->gch.marked |= LJ_GC_BLACK) #define isfinalized(u) ((u)->marked & LJ_GC_FINALIZED) /* -- Mark phase ---------------------------------------------------------- */ /* Mark a TValue (if needed). */ #define gc_marktv(g, tv) \ { lua_assert(!tvisgcv(tv) || (~itype(tv) == gcval(tv)->gch.gct)); \ if (tviswhite(tv)) gc_mark(g, gcV(tv)); } /* Mark a GCobj (if needed). */ #define gc_markobj(g, o) \ { if (iswhite(obj2gco(o))) gc_mark(g, obj2gco(o)); } /* Mark a string object. */ #define gc_mark_str(s) ((s)->marked &= (uint8_t)~LJ_GC_WHITES) /* Mark a white GCobj. */ static void gc_mark(global_State *g, GCobj *o) { int gct = o->gch.gct; lua_assert(iswhite(o) && !isdead(g, o)); white2gray(o); if (LJ_UNLIKELY(gct == ~LJ_TUDATA)) { GCtab *mt = tabref(gco2ud(o)->metatable); gray2black(o); /* Userdata are never gray. */ if (mt) gc_markobj(g, mt); gc_markobj(g, tabref(gco2ud(o)->env)); } else if (LJ_UNLIKELY(gct == ~LJ_TUPVAL)) { GCupval *uv = gco2uv(o); gc_marktv(g, uvval(uv)); if (uv->closed) gray2black(o); /* Closed upvalues are never gray. */ } else if (gct != ~LJ_TSTR && gct != ~LJ_TCDATA) { lua_assert(gct == ~LJ_TFUNC || gct == ~LJ_TTAB || gct == ~LJ_TTHREAD || gct == ~LJ_TPROTO); setgcrefr(o->gch.gclist, g->gc.gray); setgcref(g->gc.gray, o); } } /* Mark GC roots. */ static void gc_mark_gcroot(global_State *g) { ptrdiff_t i; for (i = 0; i < GCROOT_MAX; i++) if (gcref(g->gcroot[i]) != NULL) gc_markobj(g, gcref(g->gcroot[i])); } /* Start a GC cycle and mark the root set. */ static void gc_mark_start(global_State *g) { setgcrefnull(g->gc.gray); setgcrefnull(g->gc.grayagain); setgcrefnull(g->gc.weak); gc_markobj(g, mainthread(g)); gc_markobj(g, tabref(mainthread(g)->env)); gc_marktv(g, &g->registrytv); gc_mark_gcroot(g); g->gc.state = GCSpropagate; } /* Mark open upvalues. */ static void gc_mark_uv(global_State *g) { GCupval *uv; for (uv = uvnext(&g->uvhead); uv != &g->uvhead; uv = uvnext(uv)) { lua_assert(uvprev(uvnext(uv)) == uv && uvnext(uvprev(uv)) == uv); if (isgray(obj2gco(uv))) gc_marktv(g, uvval(uv)); } } /* Mark userdata in mmudata list. */ static void gc_mark_mmudata(global_State *g) { GCobj *root = gcref(g->gc.mmudata); GCobj *u = root; if (u) { do { u = gcnext(u); makewhite(g, u); /* Could be from previous GC. */ gc_mark(g, u); } while (u != root); } } /* Separate userdata objects to be finalized to mmudata list. */ size_t lj_gc_separateudata(global_State *g, int all) { size_t m = 0; GCRef *p = &mainthread(g)->nextgc; GCobj *o; while ((o = gcref(*p)) != NULL) { if (!(iswhite(o) || all) || isfinalized(gco2ud(o))) { p = &o->gch.nextgc; /* Nothing to do. */ } else if (!lj_meta_fastg(g, tabref(gco2ud(o)->metatable), MM_gc)) { markfinalized(o); /* Done, as there's no __gc metamethod. */ p = &o->gch.nextgc; } else { /* Otherwise move userdata to be finalized to mmudata list. */ m += sizeudata(gco2ud(o)); markfinalized(o); *p = o->gch.nextgc; if (gcref(g->gc.mmudata)) { /* Link to end of mmudata list. */ GCobj *root = gcref(g->gc.mmudata); setgcrefr(o->gch.nextgc, root->gch.nextgc); setgcref(root->gch.nextgc, o); setgcref(g->gc.mmudata, o); } else { /* Create circular list. */ setgcref(o->gch.nextgc, o); setgcref(g->gc.mmudata, o); } } } return m; } /* -- Propagation phase --------------------------------------------------- */ /* Traverse a table. */ static int gc_traverse_tab(global_State *g, GCtab *t) { int weak = 0; cTValue *mode; GCtab *mt = tabref(t->metatable); if (mt) gc_markobj(g, mt); mode = lj_meta_fastg(g, mt, MM_mode); if (mode && tvisstr(mode)) { /* Valid __mode field? */ const char *modestr = strVdata(mode); int c; while ((c = *modestr++)) { if (c == 'k') weak |= LJ_GC_WEAKKEY; else if (c == 'v') weak |= LJ_GC_WEAKVAL; else if (c == 'K') weak = (int)(~0u & ~LJ_GC_WEAKVAL); } if (weak > 0) { /* Weak tables are cleared in the atomic phase. */ t->marked = (uint8_t)((t->marked & ~LJ_GC_WEAK) | weak); setgcrefr(t->gclist, g->gc.weak); setgcref(g->gc.weak, obj2gco(t)); } } if (weak == LJ_GC_WEAK) /* Nothing to mark if both keys/values are weak. */ return 1; if (!(weak & LJ_GC_WEAKVAL)) { /* Mark array part. */ MSize i, asize = t->asize; for (i = 0; i < asize; i++) gc_marktv(g, arrayslot(t, i)); } if (t->hmask > 0) { /* Mark hash part. */ Node *node = noderef(t->node); MSize i, hmask = t->hmask; for (i = 0; i <= hmask; i++) { Node *n = &node[i]; if (!tvisnil(&n->val)) { /* Mark non-empty slot. */ lua_assert(!tvisnil(&n->key)); if (!(weak & LJ_GC_WEAKKEY)) gc_marktv(g, &n->key); if (!(weak & LJ_GC_WEAKVAL)) gc_marktv(g, &n->val); } } } return weak; } /* Traverse a function. */ static void gc_traverse_func(global_State *g, GCfunc *fn) { gc_markobj(g, tabref(fn->c.env)); if (isluafunc(fn)) { uint32_t i; lua_assert(fn->l.nupvalues <= funcproto(fn)->sizeuv); gc_markobj(g, funcproto(fn)); for (i = 0; i < fn->l.nupvalues; i++) /* Mark Lua function upvalues. */ gc_markobj(g, &gcref(fn->l.uvptr[i])->uv); } else { uint32_t i; for (i = 0; i < fn->c.nupvalues; i++) /* Mark C function upvalues. */ gc_marktv(g, &fn->c.upvalue[i]); } } #if LJ_HASJIT /* Mark a trace. */ static void gc_marktrace(global_State *g, TraceNo traceno) { GCobj *o = obj2gco(traceref(G2J(g), traceno)); lua_assert(traceno != G2J(g)->cur.traceno); if (iswhite(o)) { white2gray(o); setgcrefr(o->gch.gclist, g->gc.gray); setgcref(g->gc.gray, o); } } /* Traverse a trace. */ static void gc_traverse_trace(global_State *g, GCtrace *T) { IRRef ref; if (T->traceno == 0) return; for (ref = T->nk; ref < REF_TRUE; ref++) { IRIns *ir = &T->ir[ref]; if (ir->o == IR_KGC) gc_markobj(g, ir_kgc(ir)); } if (T->link) gc_marktrace(g, T->link); if (T->nextroot) gc_marktrace(g, T->nextroot); if (T->nextside) gc_marktrace(g, T->nextside); gc_markobj(g, gcref(T->startpt)); } /* The current trace is a GC root while not anchored in the prototype (yet). */ #define gc_traverse_curtrace(g) gc_traverse_trace(g, &G2J(g)->cur) #else #define gc_traverse_curtrace(g) UNUSED(g) #endif /* Traverse a prototype. */ static void gc_traverse_proto(global_State *g, GCproto *pt) { ptrdiff_t i; gc_mark_str(proto_chunkname(pt)); for (i = -(ptrdiff_t)pt->sizekgc; i < 0; i++) /* Mark collectable consts. */ gc_markobj(g, proto_kgc(pt, i)); #if LJ_HASJIT if (pt->trace) gc_marktrace(g, pt->trace); #endif } /* Traverse the frame structure of a stack. */ static MSize gc_traverse_frames(global_State *g, lua_State *th) { TValue *frame, *top = th->top-1, *bot = tvref(th->stack); /* Note: extra vararg frame not skipped, marks function twice (harmless). */ for (frame = th->base-1; frame > bot; frame = frame_prev(frame)) { GCfunc *fn = frame_func(frame); TValue *ftop = frame; if (isluafunc(fn)) ftop += funcproto(fn)->framesize; if (ftop > top) top = ftop; gc_markobj(g, fn); /* Need to mark hidden function (or L). */ } top++; /* Correct bias of -1 (frame == base-1). */ if (top > tvref(th->maxstack)) top = tvref(th->maxstack); return (MSize)(top - bot); /* Return minimum needed stack size. */ } /* Traverse a thread object. */ static void gc_traverse_thread(global_State *g, lua_State *th) { TValue *o, *top = th->top; for (o = tvref(th->stack)+1; o < top; o++) gc_marktv(g, o); if (g->gc.state == GCSatomic) { top = tvref(th->stack) + th->stacksize; for (; o < top; o++) /* Clear unmarked slots. */ setnilV(o); } gc_markobj(g, tabref(th->env)); lj_state_shrinkstack(th, gc_traverse_frames(g, th)); } /* Propagate one gray object. Traverse it and turn it black. */ static size_t propagatemark(global_State *g) { GCobj *o = gcref(g->gc.gray); int gct = o->gch.gct; lua_assert(isgray(o)); gray2black(o); setgcrefr(g->gc.gray, o->gch.gclist); /* Remove from gray list. */ if (LJ_LIKELY(gct == ~LJ_TTAB)) { GCtab *t = gco2tab(o); if (gc_traverse_tab(g, t) > 0) black2gray(o); /* Keep weak tables gray. */ return sizeof(GCtab) + sizeof(TValue) * t->asize + sizeof(Node) * (t->hmask + 1); } else if (LJ_LIKELY(gct == ~LJ_TFUNC)) { GCfunc *fn = gco2func(o); gc_traverse_func(g, fn); return isluafunc(fn) ? sizeLfunc((MSize)fn->l.nupvalues) : sizeCfunc((MSize)fn->c.nupvalues); } else if (LJ_LIKELY(gct == ~LJ_TPROTO)) { GCproto *pt = gco2pt(o); gc_traverse_proto(g, pt); return pt->sizept; } else if (LJ_LIKELY(gct == ~LJ_TTHREAD)) { lua_State *th = gco2th(o); setgcrefr(th->gclist, g->gc.grayagain); setgcref(g->gc.grayagain, o); black2gray(o); /* Threads are never black. */ gc_traverse_thread(g, th); return sizeof(lua_State) + sizeof(TValue) * th->stacksize; } else { #if LJ_HASJIT GCtrace *T = gco2trace(o); gc_traverse_trace(g, T); return ((sizeof(GCtrace)+7)&~7) + (T->nins-T->nk)*sizeof(IRIns) + T->nsnap*sizeof(SnapShot) + T->nsnapmap*sizeof(SnapEntry); #else lua_assert(0); return 0; #endif } } /* Propagate all gray objects. */ static size_t gc_propagate_gray(global_State *g) { size_t m = 0; while (gcref(g->gc.gray) != NULL) m += propagatemark(g); return m; } /* -- Sweep phase --------------------------------------------------------- */ /* Try to shrink some common data structures. */ static void gc_shrink(global_State *g, lua_State *L) { if (g->strnum <= (g->strmask >> 2) && g->strmask > LJ_MIN_STRTAB*2-1) lj_str_resize(L, g->strmask >> 1); /* Shrink string table. */ if (g->tmpbuf.sz > LJ_MIN_SBUF*2) lj_str_resizebuf(L, &g->tmpbuf, g->tmpbuf.sz >> 1); /* Shrink temp buf. */ } /* Type of GC free functions. */ typedef void (LJ_FASTCALL *GCFreeFunc)(global_State *g, GCobj *o); /* GC free functions for LJ_TSTR .. LJ_TUDATA. ORDER LJ_T */ static const GCFreeFunc gc_freefunc[] = { (GCFreeFunc)lj_str_free, (GCFreeFunc)lj_func_freeuv, (GCFreeFunc)lj_state_free, (GCFreeFunc)lj_func_freeproto, (GCFreeFunc)lj_func_free, #if LJ_HASJIT (GCFreeFunc)lj_trace_free, #else (GCFreeFunc)0, #endif #if LJ_HASFFI (GCFreeFunc)lj_cdata_free, #else (GCFreeFunc)0, #endif (GCFreeFunc)lj_tab_free, (GCFreeFunc)lj_udata_free }; /* Full sweep of a GC list. */ #define gc_fullsweep(g, p) gc_sweep(g, (p), LJ_MAX_MEM) /* Partial sweep of a GC list. */ static GCRef *gc_sweep(global_State *g, GCRef *p, uint32_t lim) { /* Mask with other white and LJ_GC_FIXED. Or LJ_GC_SFIXED on shutdown. */ int ow = otherwhite(g); GCobj *o; while ((o = gcref(*p)) != NULL && lim-- > 0) { if (o->gch.gct == ~LJ_TTHREAD) /* Need to sweep open upvalues, too. */ gc_fullsweep(g, &gco2th(o)->openupval); if (((o->gch.marked ^ LJ_GC_WHITES) & ow)) { /* Black or current white? */ lua_assert(!isdead(g, o) || (o->gch.marked & LJ_GC_FIXED)); makewhite(g, o); /* Value is alive, change to the current white. */ p = &o->gch.nextgc; } else { /* Otherwise value is dead, free it. */ lua_assert(isdead(g, o) || ow == LJ_GC_SFIXED); setgcrefr(*p, o->gch.nextgc); if (o == gcref(g->gc.root)) setgcrefr(g->gc.root, o->gch.nextgc); /* Adjust list anchor. */ gc_freefunc[o->gch.gct - ~LJ_TSTR](g, o); } } return p; } /* Check whether we can clear a key or a value slot from a table. */ static int gc_mayclear(cTValue *o, int val) { if (tvisgcv(o)) { /* Only collectable objects can be weak references. */ if (tvisstr(o)) { /* But strings cannot be used as weak references. */ gc_mark_str(strV(o)); /* And need to be marked. */ return 0; } if (iswhite(gcV(o))) return 1; /* Object is about to be collected. */ if (tvisudata(o) && val && isfinalized(udataV(o))) return 1; /* Finalized userdata is dropped only from values. */ } return 0; /* Cannot clear. */ } /* Clear collected entries from weak tables. */ static void gc_clearweak(GCobj *o) { while (o) { GCtab *t = gco2tab(o); lua_assert((t->marked & LJ_GC_WEAK)); if ((t->marked & LJ_GC_WEAKVAL)) { MSize i, asize = t->asize; for (i = 0; i < asize; i++) { /* Clear array slot when value is about to be collected. */ TValue *tv = arrayslot(t, i); if (gc_mayclear(tv, 1)) setnilV(tv); } } if (t->hmask > 0) { Node *node = noderef(t->node); MSize i, hmask = t->hmask; for (i = 0; i <= hmask; i++) { Node *n = &node[i]; /* Clear hash slot when key or value is about to be collected. */ if (!tvisnil(&n->val) && (gc_mayclear(&n->key, 0) || gc_mayclear(&n->val, 1))) setnilV(&n->val); } } o = gcref(t->gclist); } } /* Call a userdata or cdata finalizer. */ static void gc_call_finalizer(global_State *g, lua_State *L, cTValue *mo, GCobj *o) { /* Save and restore lots of state around the __gc callback. */ uint8_t oldh = hook_save(g); MSize oldt = g->gc.threshold; int errcode; TValue *top; lj_trace_abort(g); top = L->top; L->top = top+2; hook_entergc(g); /* Disable hooks and new traces during __gc. */ g->gc.threshold = LJ_MAX_MEM; /* Prevent GC steps. */ copyTV(L, top, mo); setgcV(L, top+1, o, ~o->gch.gct); errcode = lj_vm_pcall(L, top+1, 1+0, -1); /* Stack: |mo|o| -> | */ hook_restore(g, oldh); g->gc.threshold = oldt; /* Restore GC threshold. */ if (errcode) lj_err_throw(L, errcode); /* Propagate errors. */ } /* Finalize one userdata or cdata object from the mmudata list. */ static void gc_finalize(lua_State *L) { global_State *g = G(L); GCobj *o = gcnext(gcref(g->gc.mmudata)); cTValue *mo; lua_assert(gcref(g->jit_L) == NULL); /* Must not be called on trace. */ /* Unchain from list of userdata to be finalized. */ if (o == gcref(g->gc.mmudata)) setgcrefnull(g->gc.mmudata); else setgcrefr(gcref(g->gc.mmudata)->gch.nextgc, o->gch.nextgc); #if LJ_HASFFI if (o->gch.gct == ~LJ_TCDATA) { TValue tmp, *tv; /* Add cdata back to the GC list and make it white. */ setgcrefr(o->gch.nextgc, g->gc.root); setgcref(g->gc.root, o); makewhite(g, o); o->gch.marked &= (uint8_t)~LJ_GC_CDATA_FIN; /* Resolve finalizer. */ setcdataV(L, &tmp, gco2cd(o)); tv = lj_tab_set(L, ctype_ctsG(g)->finalizer, &tmp); if (!tvisnil(tv)) { g->gc.nocdatafin = 0; copyTV(L, &tmp, tv); setnilV(tv); /* Clear entry in finalizer table. */ gc_call_finalizer(g, L, &tmp, o); } return; } #endif /* Add userdata back to the main userdata list and make it white. */ setgcrefr(o->gch.nextgc, mainthread(g)->nextgc); setgcref(mainthread(g)->nextgc, o); makewhite(g, o); /* Resolve the __gc metamethod. */ mo = lj_meta_fastg(g, tabref(gco2ud(o)->metatable), MM_gc); if (mo) gc_call_finalizer(g, L, mo, o); } /* Finalize all userdata objects from mmudata list. */ void lj_gc_finalize_udata(lua_State *L) { while (gcref(G(L)->gc.mmudata) != NULL) gc_finalize(L); } #if LJ_HASFFI /* Finalize all cdata objects from finalizer table. */ void lj_gc_finalize_cdata(lua_State *L) { global_State *g = G(L); CTState *cts = ctype_ctsG(g); if (cts) { GCtab *t = cts->finalizer; Node *node = noderef(t->node); ptrdiff_t i; setgcrefnull(t->metatable); /* Mark finalizer table as disabled. */ for (i = (ptrdiff_t)t->hmask; i >= 0; i--) if (!tvisnil(&node[i].val) && tviscdata(&node[i].key)) { GCobj *o = gcV(&node[i].key); TValue tmp; makewhite(g, o); o->gch.marked &= (uint8_t)~LJ_GC_CDATA_FIN; copyTV(L, &tmp, &node[i].val); setnilV(&node[i].val); gc_call_finalizer(g, L, &tmp, o); } } } #endif /* Free all remaining GC objects. */ void lj_gc_freeall(global_State *g) { MSize i, strmask; /* Free everything, except super-fixed objects (the main thread). */ g->gc.currentwhite = LJ_GC_WHITES | LJ_GC_SFIXED; gc_fullsweep(g, &g->gc.root); strmask = g->strmask; for (i = 0; i <= strmask; i++) /* Free all string hash chains. */ gc_fullsweep(g, &g->strhash[i]); } /* -- Collector ----------------------------------------------------------- */ /* Atomic part of the GC cycle, transitioning from mark to sweep phase. */ static void atomic(global_State *g, lua_State *L) { size_t udsize; gc_mark_uv(g); /* Need to remark open upvalues (the thread may be dead). */ gc_propagate_gray(g); /* Propagate any left-overs. */ setgcrefr(g->gc.gray, g->gc.weak); /* Empty the list of weak tables. */ setgcrefnull(g->gc.weak); lua_assert(!iswhite(obj2gco(mainthread(g)))); gc_markobj(g, L); /* Mark running thread. */ gc_traverse_curtrace(g); /* Traverse current trace. */ gc_mark_gcroot(g); /* Mark GC roots (again). */ gc_propagate_gray(g); /* Propagate all of the above. */ setgcrefr(g->gc.gray, g->gc.grayagain); /* Empty the 2nd chance list. */ setgcrefnull(g->gc.grayagain); gc_propagate_gray(g); /* Propagate it. */ udsize = lj_gc_separateudata(g, 0); /* Separate userdata to be finalized. */ gc_mark_mmudata(g); /* Mark them. */ udsize += gc_propagate_gray(g); /* And propagate the marks. */ /* All marking done, clear weak tables. */ gc_clearweak(gcref(g->gc.weak)); /* Prepare for sweep phase. */ g->gc.currentwhite = (uint8_t)otherwhite(g); /* Flip current white. */ g->strempty.marked = g->gc.currentwhite; setmref(g->gc.sweep, &g->gc.root); g->gc.estimate = g->gc.total - (MSize)udsize; /* Initial estimate. */ } /* GC state machine. Returns a cost estimate for each step performed. */ static size_t gc_onestep(lua_State *L) { global_State *g = G(L); switch (g->gc.state) { case GCSpause: gc_mark_start(g); /* Start a new GC cycle by marking all GC roots. */ return 0; case GCSpropagate: if (gcref(g->gc.gray) != NULL) return propagatemark(g); /* Propagate one gray object. */ g->gc.state = GCSatomic; /* End of mark phase. */ return 0; case GCSatomic: if (gcref(g->jit_L)) /* Don't run atomic phase on trace. */ return LJ_MAX_MEM; atomic(g, L); g->gc.state = GCSsweepstring; /* Start of sweep phase. */ g->gc.sweepstr = 0; return 0; case GCSsweepstring: { MSize old = g->gc.total; gc_fullsweep(g, &g->strhash[g->gc.sweepstr++]); /* Sweep one chain. */ if (g->gc.sweepstr > g->strmask) g->gc.state = GCSsweep; /* All string hash chains sweeped. */ lua_assert(old >= g->gc.total); g->gc.estimate -= old - g->gc.total; return GCSWEEPCOST; } case GCSsweep: { MSize old = g->gc.total; setmref(g->gc.sweep, gc_sweep(g, mref(g->gc.sweep, GCRef), GCSWEEPMAX)); lua_assert(old >= g->gc.total); g->gc.estimate -= old - g->gc.total; if (gcref(*mref(g->gc.sweep, GCRef)) == NULL) { gc_shrink(g, L); if (gcref(g->gc.mmudata)) { /* Need any finalizations? */ g->gc.state = GCSfinalize; #if LJ_HASFFI g->gc.nocdatafin = 1; #endif } else { /* Otherwise skip this phase to help the JIT. */ g->gc.state = GCSpause; /* End of GC cycle. */ g->gc.debt = 0; } } return GCSWEEPMAX*GCSWEEPCOST; } case GCSfinalize: if (gcref(g->gc.mmudata) != NULL) { if (gcref(g->jit_L)) /* Don't call finalizers on trace. */ return LJ_MAX_MEM; gc_finalize(L); /* Finalize one userdata object. */ if (g->gc.estimate > GCFINALIZECOST) g->gc.estimate -= GCFINALIZECOST; return GCFINALIZECOST; } #if LJ_HASFFI if (!g->gc.nocdatafin) lj_tab_rehash(L, ctype_ctsG(g)->finalizer); #endif g->gc.state = GCSpause; /* End of GC cycle. */ g->gc.debt = 0; return 0; default: lua_assert(0); return 0; } } /* Perform a limited amount of incremental GC steps. */ int LJ_FASTCALL lj_gc_step(lua_State *L) { global_State *g = G(L); MSize lim; int32_t ostate = g->vmstate; setvmstate(g, GC); lim = (GCSTEPSIZE/100) * g->gc.stepmul; if (lim == 0) lim = LJ_MAX_MEM; if (g->gc.total > g->gc.threshold) g->gc.debt += g->gc.total - g->gc.threshold; do { lim -= (MSize)gc_onestep(L); if (g->gc.state == GCSpause) { g->gc.threshold = (g->gc.estimate/100) * g->gc.pause; g->vmstate = ostate; return 1; /* Finished a GC cycle. */ } } while ((int32_t)lim > 0); if (g->gc.debt < GCSTEPSIZE) { g->gc.threshold = g->gc.total + GCSTEPSIZE; g->vmstate = ostate; return -1; } else { g->gc.debt -= GCSTEPSIZE; g->gc.threshold = g->gc.total; g->vmstate = ostate; return 0; } } /* Ditto, but fix the stack top first. */ void LJ_FASTCALL lj_gc_step_fixtop(lua_State *L) { if (curr_funcisL(L)) L->top = curr_topL(L); lj_gc_step(L); } #if LJ_HASJIT /* Perform multiple GC steps. Called from JIT-compiled code. */ int LJ_FASTCALL lj_gc_step_jit(global_State *g, MSize steps) { lua_State *L = gco2th(gcref(g->jit_L)); L->base = mref(G(L)->jit_base, TValue); L->top = curr_topL(L); while (steps-- > 0 && lj_gc_step(L) == 0) ; /* Return 1 to force a trace exit. */ return (G(L)->gc.state == GCSatomic || G(L)->gc.state == GCSfinalize); } #endif /* Perform a full GC cycle. */ void lj_gc_fullgc(lua_State *L) { global_State *g = G(L); int32_t ostate = g->vmstate; setvmstate(g, GC); if (g->gc.state <= GCSatomic) { /* Caught somewhere in the middle. */ setmref(g->gc.sweep, &g->gc.root); /* Sweep everything (preserving it). */ setgcrefnull(g->gc.gray); /* Reset lists from partial propagation. */ setgcrefnull(g->gc.grayagain); setgcrefnull(g->gc.weak); g->gc.state = GCSsweepstring; /* Fast forward to the sweep phase. */ g->gc.sweepstr = 0; } while (g->gc.state == GCSsweepstring || g->gc.state == GCSsweep) gc_onestep(L); /* Finish sweep. */ lua_assert(g->gc.state == GCSfinalize || g->gc.state == GCSpause); /* Now perform a full GC. */ g->gc.state = GCSpause; do { gc_onestep(L); } while (g->gc.state != GCSpause); g->gc.threshold = (g->gc.estimate/100) * g->gc.pause; g->vmstate = ostate; } /* -- Write barriers ------------------------------------------------------ */ /* Move the GC propagation frontier forward. */ void lj_gc_barrierf(global_State *g, GCobj *o, GCobj *v) { lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o)); lua_assert(g->gc.state != GCSfinalize && g->gc.state != GCSpause); lua_assert(o->gch.gct != ~LJ_TTAB); /* Preserve invariant during propagation. Otherwise it doesn't matter. */ if (g->gc.state == GCSpropagate || g->gc.state == GCSatomic) gc_mark(g, v); /* Move frontier forward. */ else makewhite(g, o); /* Make it white to avoid the following barrier. */ } /* Specialized barrier for closed upvalue. Pass &uv->tv. */ void LJ_FASTCALL lj_gc_barrieruv(global_State *g, TValue *tv) { #define TV2MARKED(x) \ (*((uint8_t *)(x) - offsetof(GCupval, tv) + offsetof(GCupval, marked))) if (g->gc.state == GCSpropagate || g->gc.state == GCSatomic) gc_mark(g, gcV(tv)); else TV2MARKED(tv) = (TV2MARKED(tv) & (uint8_t)~LJ_GC_COLORS) | curwhite(g); #undef TV2MARKED } /* Close upvalue. Also needs a write barrier. */ void lj_gc_closeuv(global_State *g, GCupval *uv) { GCobj *o = obj2gco(uv); /* Copy stack slot to upvalue itself and point to the copy. */ copyTV(mainthread(g), &uv->tv, uvval(uv)); setmref(uv->v, &uv->tv); uv->closed = 1; setgcrefr(o->gch.nextgc, g->gc.root); setgcref(g->gc.root, o); if (isgray(o)) { /* A closed upvalue is never gray, so fix this. */ if (g->gc.state == GCSpropagate || g->gc.state == GCSatomic) { gray2black(o); /* Make it black and preserve invariant. */ if (tviswhite(&uv->tv)) lj_gc_barrierf(g, o, gcV(&uv->tv)); } else { makewhite(g, o); /* Make it white, i.e. sweep the upvalue. */ lua_assert(g->gc.state != GCSfinalize && g->gc.state != GCSpause); } } } #if LJ_HASJIT /* Mark a trace if it's saved during the propagation phase. */ void lj_gc_barriertrace(global_State *g, uint32_t traceno) { if (g->gc.state == GCSpropagate || g->gc.state == GCSatomic) gc_marktrace(g, traceno); } #endif /* -- Allocator ----------------------------------------------------------- */ /* Call pluggable memory allocator to allocate or resize a fragment. */ void *lj_mem_realloc(lua_State *L, void *p, MSize osz, MSize nsz) { global_State *g = G(L); lua_assert((osz == 0) == (p == NULL)); p = g->allocf(g->allocd, p, osz, nsz); if (p == NULL && nsz > 0) lj_err_mem(L); lua_assert((nsz == 0) == (p == NULL)); lua_assert(checkptr32(p)); g->gc.total = (g->gc.total - osz) + nsz; return p; } /* Allocate new GC object and link it to the root set. */ void * LJ_FASTCALL lj_mem_newgco(lua_State *L, MSize size) { global_State *g = G(L); GCobj *o = (GCobj *)g->allocf(g->allocd, NULL, 0, size); if (o == NULL) lj_err_mem(L); lua_assert(checkptr32(o)); g->gc.total += size; setgcrefr(o->gch.nextgc, g->gc.root); setgcref(g->gc.root, o); newwhite(g, o); return o; } /* Resize growable vector. */ void *lj_mem_grow(lua_State *L, void *p, MSize *szp, MSize lim, MSize esz) { MSize sz = (*szp) << 1; if (sz < LJ_MIN_VECSZ) sz = LJ_MIN_VECSZ; if (sz > lim) sz = lim; p = lj_mem_realloc(L, p, (*szp)*esz, sz*esz); *szp = sz; return p; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_traceerr.h0000644000175000017500000000406713122010155017345 0ustar philphil/* ** Trace compiler error messages. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* This file may be included multiple times with different TREDEF macros. */ /* Recording. */ TREDEF(RECERR, "error thrown or hook called during recording") TREDEF(TRACEOV, "trace too long") TREDEF(STACKOV, "trace too deep") TREDEF(SNAPOV, "too many snapshots") TREDEF(BLACKL, "blacklisted") TREDEF(NYIBC, "NYI: bytecode %d") /* Recording loop ops. */ TREDEF(LLEAVE, "leaving loop in root trace") TREDEF(LINNER, "inner loop in root trace") TREDEF(LUNROLL, "loop unroll limit reached") /* Recording calls/returns. */ TREDEF(BADTYPE, "bad argument type") TREDEF(CJITOFF, "JIT compilation disabled for function") TREDEF(CUNROLL, "call unroll limit reached") TREDEF(DOWNREC, "down-recursion, restarting") TREDEF(NYICF, "NYI: C function %s") TREDEF(NYIFF, "NYI: FastFunc %s") TREDEF(NYIFFU, "NYI: unsupported variant of FastFunc %s") TREDEF(NYIRETL, "NYI: return to lower frame") /* Recording indexed load/store. */ TREDEF(STORENN, "store with nil or NaN key") TREDEF(NOMM, "missing metamethod") TREDEF(IDXLOOP, "looping index lookup") TREDEF(NYITMIX, "NYI: mixed sparse/dense table") /* Recording C data operations. */ TREDEF(NOCACHE, "symbol not in cache") TREDEF(NYICONV, "NYI: unsupported C type conversion") TREDEF(NYICALL, "NYI: unsupported C function type") /* Optimizations. */ TREDEF(GFAIL, "guard would always fail") TREDEF(PHIOV, "too many PHIs") TREDEF(TYPEINS, "persistent type instability") /* Assembler. */ TREDEF(MCODEAL, "failed to allocate mcode memory") TREDEF(MCODEOV, "machine code too long") TREDEF(MCODELM, "hit mcode limit (retrying)") TREDEF(SPILLOV, "too many spill slots") TREDEF(BADRA, "inconsistent register allocation") TREDEF(NYIIR, "NYI: cannot assemble IR instruction %d") TREDEF(NYIPHI, "NYI: PHI shuffling too complex") TREDEF(NYICOAL, "NYI: register coalescing too complex") #undef TREDEF /* Detecting unused error messages: awk -F, '/^TREDEF/ { gsub(/TREDEF./, ""); printf "grep -q LJ_TRERR_%s *.[ch] || echo %s\n", $1, $1}' lj_traceerr.h | sh */ wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ccallback.c0000644000175000017500000004460013122010155017425 0ustar philphil/* ** FFI C callback handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_tab.h" #include "lj_state.h" #include "lj_frame.h" #include "lj_ctype.h" #include "lj_cconv.h" #include "lj_ccall.h" #include "lj_ccallback.h" #include "lj_target.h" #include "lj_mcode.h" #include "lj_trace.h" #include "lj_vm.h" /* -- Target-specific handling of callback slots -------------------------- */ #define CALLBACK_MCODE_SIZE (LJ_PAGESIZE * LJ_NUM_CBPAGE) #if LJ_OS_NOJIT /* Disabled callback support. */ #define CALLBACK_SLOT2OFS(slot) (0*(slot)) #define CALLBACK_OFS2SLOT(ofs) (0*(ofs)) #define CALLBACK_MAX_SLOT 0 #elif LJ_TARGET_X86ORX64 #define CALLBACK_MCODE_HEAD (LJ_64 ? 8 : 0) #define CALLBACK_MCODE_GROUP (-2+1+2+5+(LJ_64 ? 6 : 5)) #define CALLBACK_SLOT2OFS(slot) \ (CALLBACK_MCODE_HEAD + CALLBACK_MCODE_GROUP*((slot)/32) + 4*(slot)) static MSize CALLBACK_OFS2SLOT(MSize ofs) { MSize group; ofs -= CALLBACK_MCODE_HEAD; group = ofs / (32*4 + CALLBACK_MCODE_GROUP); return (ofs % (32*4 + CALLBACK_MCODE_GROUP))/4 + group*32; } #define CALLBACK_MAX_SLOT \ (((CALLBACK_MCODE_SIZE-CALLBACK_MCODE_HEAD)/(CALLBACK_MCODE_GROUP+4*32))*32) #elif LJ_TARGET_ARM #define CALLBACK_MCODE_HEAD 32 #define CALLBACK_SLOT2OFS(slot) (CALLBACK_MCODE_HEAD + 8*(slot)) #define CALLBACK_OFS2SLOT(ofs) (((ofs)-CALLBACK_MCODE_HEAD)/8) #define CALLBACK_MAX_SLOT (CALLBACK_OFS2SLOT(CALLBACK_MCODE_SIZE)) #elif LJ_TARGET_PPC #define CALLBACK_MCODE_HEAD 24 #define CALLBACK_SLOT2OFS(slot) (CALLBACK_MCODE_HEAD + 8*(slot)) #define CALLBACK_OFS2SLOT(ofs) (((ofs)-CALLBACK_MCODE_HEAD)/8) #define CALLBACK_MAX_SLOT (CALLBACK_OFS2SLOT(CALLBACK_MCODE_SIZE)) #elif LJ_TARGET_MIPS #define CALLBACK_MCODE_HEAD 24 #define CALLBACK_SLOT2OFS(slot) (CALLBACK_MCODE_HEAD + 8*(slot)) #define CALLBACK_OFS2SLOT(ofs) (((ofs)-CALLBACK_MCODE_HEAD)/8) #define CALLBACK_MAX_SLOT (CALLBACK_OFS2SLOT(CALLBACK_MCODE_SIZE)) #else /* Missing support for this architecture. */ #define CALLBACK_SLOT2OFS(slot) (0*(slot)) #define CALLBACK_OFS2SLOT(ofs) (0*(ofs)) #define CALLBACK_MAX_SLOT 0 #endif /* Convert callback slot number to callback function pointer. */ static void *callback_slot2ptr(CTState *cts, MSize slot) { return (uint8_t *)cts->cb.mcode + CALLBACK_SLOT2OFS(slot); } /* Convert callback function pointer to slot number. */ MSize lj_ccallback_ptr2slot(CTState *cts, void *p) { uintptr_t ofs = (uintptr_t)((uint8_t *)p -(uint8_t *)cts->cb.mcode); if (ofs < CALLBACK_MCODE_SIZE) { MSize slot = CALLBACK_OFS2SLOT((MSize)ofs); if (CALLBACK_SLOT2OFS(slot) == (MSize)ofs) return slot; } return ~0u; /* Not a known callback function pointer. */ } /* Initialize machine code for callback function pointers. */ #if LJ_OS_NOJIT /* Disabled callback support. */ #define callback_mcode_init(g, p) UNUSED(p) #elif LJ_TARGET_X86ORX64 static void callback_mcode_init(global_State *g, uint8_t *page) { uint8_t *p = page; uint8_t *target = (uint8_t *)(void *)lj_vm_ffi_callback; MSize slot; #if LJ_64 *(void **)p = target; p += 8; #endif for (slot = 0; slot < CALLBACK_MAX_SLOT; slot++) { /* mov al, slot; jmp group */ *p++ = XI_MOVrib | RID_EAX; *p++ = (uint8_t)slot; if ((slot & 31) == 31 || slot == CALLBACK_MAX_SLOT-1) { /* push ebp/rbp; mov ah, slot>>8; mov ebp, &g. */ *p++ = XI_PUSH + RID_EBP; *p++ = XI_MOVrib | (RID_EAX+4); *p++ = (uint8_t)(slot >> 8); *p++ = XI_MOVri | RID_EBP; *(int32_t *)p = i32ptr(g); p += 4; #if LJ_64 /* jmp [rip-pageofs] where lj_vm_ffi_callback is stored. */ *p++ = XI_GROUP5; *p++ = XM_OFS0 + (XOg_JMP<<3) + RID_EBP; *(int32_t *)p = (int32_t)(page-(p+4)); p += 4; #else /* jmp lj_vm_ffi_callback. */ *p++ = XI_JMP; *(int32_t *)p = target-(p+4); p += 4; #endif } else { *p++ = XI_JMPs; *p++ = (uint8_t)((2+2)*(31-(slot&31)) - 2); } } lua_assert(p - page <= CALLBACK_MCODE_SIZE); } #elif LJ_TARGET_ARM static void callback_mcode_init(global_State *g, uint32_t *page) { uint32_t *p = page; void *target = (void *)lj_vm_ffi_callback; MSize slot; /* This must match with the saveregs macro in buildvm_arm.dasc. */ *p++ = ARMI_SUB|ARMF_D(RID_R12)|ARMF_N(RID_R12)|ARMF_M(RID_PC); *p++ = ARMI_PUSH|ARMF_N(RID_SP)|RSET_RANGE(RID_R4,RID_R11+1)|RID2RSET(RID_LR); *p++ = ARMI_SUB|ARMI_K12|ARMF_D(RID_R12)|ARMF_N(RID_R12)|CALLBACK_MCODE_HEAD; *p++ = ARMI_STR|ARMI_LS_P|ARMI_LS_W|ARMF_D(RID_R12)|ARMF_N(RID_SP)|(CFRAME_SIZE-4*9); *p++ = ARMI_LDR|ARMI_LS_P|ARMI_LS_U|ARMF_D(RID_R12)|ARMF_N(RID_PC); *p++ = ARMI_LDR|ARMI_LS_P|ARMI_LS_U|ARMF_D(RID_PC)|ARMF_N(RID_PC); *p++ = u32ptr(g); *p++ = u32ptr(target); for (slot = 0; slot < CALLBACK_MAX_SLOT; slot++) { *p++ = ARMI_MOV|ARMF_D(RID_R12)|ARMF_M(RID_PC); *p = ARMI_B | ((page-p-2) & 0x00ffffffu); p++; } lua_assert(p - page <= CALLBACK_MCODE_SIZE); } #elif LJ_TARGET_PPC static void callback_mcode_init(global_State *g, uint32_t *page) { uint32_t *p = page; void *target = (void *)lj_vm_ffi_callback; MSize slot; *p++ = PPCI_LIS | PPCF_T(RID_TMP) | (u32ptr(target) >> 16); *p++ = PPCI_LIS | PPCF_T(RID_R12) | (u32ptr(g) >> 16); *p++ = PPCI_ORI | PPCF_A(RID_TMP)|PPCF_T(RID_TMP) | (u32ptr(target) & 0xffff); *p++ = PPCI_ORI | PPCF_A(RID_R12)|PPCF_T(RID_R12) | (u32ptr(g) & 0xffff); *p++ = PPCI_MTCTR | PPCF_T(RID_TMP); *p++ = PPCI_BCTR; for (slot = 0; slot < CALLBACK_MAX_SLOT; slot++) { *p++ = PPCI_LI | PPCF_T(RID_R11) | slot; *p = PPCI_B | (((page-p) & 0x00ffffffu) << 2); p++; } lua_assert(p - page <= CALLBACK_MCODE_SIZE); } #elif LJ_TARGET_MIPS static void callback_mcode_init(global_State *g, uint32_t *page) { uint32_t *p = page; void *target = (void *)lj_vm_ffi_callback; MSize slot; *p++ = MIPSI_SW | MIPSF_T(RID_R1)|MIPSF_S(RID_SP) | 0; *p++ = MIPSI_LUI | MIPSF_T(RID_R3) | (u32ptr(target) >> 16); *p++ = MIPSI_LUI | MIPSF_T(RID_R2) | (u32ptr(g) >> 16); *p++ = MIPSI_ORI | MIPSF_T(RID_R3)|MIPSF_S(RID_R3) |(u32ptr(target)&0xffff); *p++ = MIPSI_JR | MIPSF_S(RID_R3); *p++ = MIPSI_ORI | MIPSF_T(RID_R2)|MIPSF_S(RID_R2) | (u32ptr(g)&0xffff); for (slot = 0; slot < CALLBACK_MAX_SLOT; slot++) { *p = MIPSI_B | ((page-p-1) & 0x0000ffffu); p++; *p++ = MIPSI_LI | MIPSF_T(RID_R1) | slot; } lua_assert(p - page <= CALLBACK_MCODE_SIZE); } #else /* Missing support for this architecture. */ #define callback_mcode_init(g, p) UNUSED(p) #endif /* -- Machine code management --------------------------------------------- */ #if LJ_TARGET_WINDOWS #define WIN32_LEAN_AND_MEAN #include #elif LJ_TARGET_POSIX #include #ifndef MAP_ANONYMOUS #define MAP_ANONYMOUS MAP_ANON #endif #endif /* Allocate and initialize area for callback function pointers. */ static void callback_mcode_new(CTState *cts) { size_t sz = (size_t)CALLBACK_MCODE_SIZE; void *p; if (CALLBACK_MAX_SLOT == 0) lj_err_caller(cts->L, LJ_ERR_FFI_CBACKOV); #if LJ_TARGET_WINDOWS p = VirtualAlloc(NULL, sz, MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE); if (!p) lj_err_caller(cts->L, LJ_ERR_FFI_CBACKOV); #elif LJ_TARGET_POSIX p = mmap(NULL, sz, (PROT_READ|PROT_WRITE), MAP_PRIVATE|MAP_ANONYMOUS, -1, 0); if (p == MAP_FAILED) lj_err_caller(cts->L, LJ_ERR_FFI_CBACKOV); #else /* Fallback allocator. Fails if memory is not executable by default. */ p = lj_mem_new(cts->L, sz); #endif cts->cb.mcode = p; callback_mcode_init(cts->g, p); lj_mcode_sync(p, (char *)p + sz); #if LJ_TARGET_WINDOWS { DWORD oprot; VirtualProtect(p, sz, PAGE_EXECUTE_READ, &oprot); } #elif LJ_TARGET_POSIX mprotect(p, sz, (PROT_READ|PROT_EXEC)); #endif } /* Free area for callback function pointers. */ void lj_ccallback_mcode_free(CTState *cts) { size_t sz = (size_t)CALLBACK_MCODE_SIZE; void *p = cts->cb.mcode; if (p == NULL) return; #if LJ_TARGET_WINDOWS VirtualFree(p, 0, MEM_RELEASE); UNUSED(sz); #elif LJ_TARGET_POSIX munmap(p, sz); #else lj_mem_free(cts->g, p, sz); #endif } /* -- C callback entry ---------------------------------------------------- */ /* Target-specific handling of register arguments. Similar to lj_ccall.c. */ #if LJ_TARGET_X86 #define CALLBACK_HANDLE_REGARG \ if (!isfp) { /* Only non-FP values may be passed in registers. */ \ if (n > 1) { /* Anything > 32 bit is passed on the stack. */ \ if (!LJ_ABI_WIN) ngpr = maxgpr; /* Prevent reordering. */ \ } else if (ngpr + 1 <= maxgpr) { \ sp = &cts->cb.gpr[ngpr]; \ ngpr += n; \ goto done; \ } \ } #elif LJ_TARGET_X64 && LJ_ABI_WIN /* Windows/x64 argument registers are strictly positional (use ngpr). */ #define CALLBACK_HANDLE_REGARG \ if (isfp) { \ if (ngpr < maxgpr) { sp = &cts->cb.fpr[ngpr++]; UNUSED(nfpr); goto done; } \ } else { \ if (ngpr < maxgpr) { sp = &cts->cb.gpr[ngpr++]; goto done; } \ } #elif LJ_TARGET_X64 #define CALLBACK_HANDLE_REGARG \ if (isfp) { \ if (nfpr + n <= CCALL_NARG_FPR) { \ sp = &cts->cb.fpr[nfpr]; \ nfpr += n; \ goto done; \ } \ } else { \ if (ngpr + n <= maxgpr) { \ sp = &cts->cb.gpr[ngpr]; \ ngpr += n; \ goto done; \ } \ } #elif LJ_TARGET_ARM #if LJ_ABI_SOFTFP #define CALLBACK_HANDLE_REGARG_FP1 UNUSED(isfp); #define CALLBACK_HANDLE_REGARG_FP2 #else #define CALLBACK_HANDLE_REGARG_FP1 \ if (isfp) { \ if (n == 1) { \ if (fprodd) { \ sp = &cts->cb.fpr[fprodd-1]; \ fprodd = 0; \ goto done; \ } else if (nfpr + 1 <= CCALL_NARG_FPR) { \ sp = &cts->cb.fpr[nfpr++]; \ fprodd = nfpr; \ goto done; \ } \ } else { \ if (nfpr + 1 <= CCALL_NARG_FPR) { \ sp = &cts->cb.fpr[nfpr++]; \ goto done; \ } \ } \ fprodd = 0; /* No reordering after the first FP value is on stack. */ \ } else { #define CALLBACK_HANDLE_REGARG_FP2 } #endif #define CALLBACK_HANDLE_REGARG \ CALLBACK_HANDLE_REGARG_FP1 \ if (n > 1) ngpr = (ngpr + 1u) & ~1u; /* Align to regpair. */ \ if (ngpr + n <= maxgpr) { \ sp = &cts->cb.gpr[ngpr]; \ ngpr += n; \ goto done; \ } CALLBACK_HANDLE_REGARG_FP2 #elif LJ_TARGET_PPC #define CALLBACK_HANDLE_REGARG \ if (isfp) { \ if (nfpr + 1 <= CCALL_NARG_FPR) { \ sp = &cts->cb.fpr[nfpr++]; \ cta = ctype_get(cts, CTID_DOUBLE); /* FPRs always hold doubles. */ \ goto done; \ } \ } else { /* Try to pass argument in GPRs. */ \ if (n > 1) { \ lua_assert(ctype_isinteger(cta->info) && n == 2); /* int64_t. */ \ ngpr = (ngpr + 1u) & ~1u; /* Align int64_t to regpair. */ \ } \ if (ngpr + n <= maxgpr) { \ sp = &cts->cb.gpr[ngpr]; \ ngpr += n; \ goto done; \ } \ } #define CALLBACK_HANDLE_RET \ if (ctype_isfp(ctr->info) && ctr->size == sizeof(float)) \ *(double *)dp = *(float *)dp; /* FPRs always hold doubles. */ #elif LJ_TARGET_MIPS #define CALLBACK_HANDLE_REGARG \ if (isfp && nfpr < CCALL_NARG_FPR) { /* Try to pass argument in FPRs. */ \ sp = (void *)((uint8_t *)&cts->cb.fpr[nfpr] + ((LJ_BE && n==1) ? 4 : 0)); \ nfpr++; ngpr += n; \ goto done; \ } else { /* Try to pass argument in GPRs. */ \ nfpr = CCALL_NARG_FPR; \ if (n > 1) ngpr = (ngpr + 1u) & ~1u; /* Align to regpair. */ \ if (ngpr + n <= maxgpr) { \ sp = &cts->cb.gpr[ngpr]; \ ngpr += n; \ goto done; \ } \ } #define CALLBACK_HANDLE_RET \ if (ctype_isfp(ctr->info) && ctr->size == sizeof(float)) \ ((float *)dp)[1] = *(float *)dp; #else #error "Missing calling convention definitions for this architecture" #endif /* Convert and push callback arguments to Lua stack. */ static void callback_conv_args(CTState *cts, lua_State *L) { TValue *o = L->top; intptr_t *stack = cts->cb.stack; MSize slot = cts->cb.slot; CTypeID id = 0, rid, fid; int gcsteps = 0; CType *ct; GCfunc *fn; MSize ngpr = 0, nsp = 0, maxgpr = CCALL_NARG_GPR; #if CCALL_NARG_FPR MSize nfpr = 0; #if LJ_TARGET_ARM MSize fprodd = 0; #endif #endif if (slot < cts->cb.sizeid && (id = cts->cb.cbid[slot]) != 0) { ct = ctype_get(cts, id); rid = ctype_cid(ct->info); fn = funcV(lj_tab_getint(cts->miscmap, (int32_t)slot)); } else { /* Must set up frame first, before throwing the error. */ ct = NULL; rid = 0; fn = (GCfunc *)L; } o->u32.lo = LJ_CONT_FFI_CALLBACK; /* Continuation returns from callback. */ o->u32.hi = rid; /* Return type. x86: +(spadj<<16). */ o++; setframe_gc(o, obj2gco(fn)); setframe_ftsz(o, (int)((char *)(o+1) - (char *)L->base) + FRAME_CONT); L->top = L->base = ++o; if (!ct) lj_err_caller(cts->L, LJ_ERR_FFI_BADCBACK); if (isluafunc(fn)) setcframe_pc(L->cframe, proto_bc(funcproto(fn))+1); lj_state_checkstack(L, LUA_MINSTACK); /* May throw. */ o = L->base; /* Might have been reallocated. */ #if LJ_TARGET_X86 /* x86 has several different calling conventions. */ switch (ctype_cconv(ct->info)) { case CTCC_FASTCALL: maxgpr = 2; break; case CTCC_THISCALL: maxgpr = 1; break; default: maxgpr = 0; break; } #endif fid = ct->sib; while (fid) { CType *ctf = ctype_get(cts, fid); if (!ctype_isattrib(ctf->info)) { CType *cta; void *sp; CTSize sz; int isfp; MSize n; lua_assert(ctype_isfield(ctf->info)); cta = ctype_rawchild(cts, ctf); isfp = ctype_isfp(cta->info); sz = (cta->size + CTSIZE_PTR-1) & ~(CTSIZE_PTR-1); n = sz / CTSIZE_PTR; /* Number of GPRs or stack slots needed. */ CALLBACK_HANDLE_REGARG /* Handle register arguments. */ /* Otherwise pass argument on stack. */ if (CCALL_ALIGN_STACKARG && LJ_32 && sz == 8) nsp = (nsp + 1) & ~1u; /* Align 64 bit argument on stack. */ sp = &stack[nsp]; nsp += n; done: if (LJ_BE && cta->size < CTSIZE_PTR) sp = (void *)((uint8_t *)sp + CTSIZE_PTR-cta->size); gcsteps += lj_cconv_tv_ct(cts, cta, 0, o++, sp); } fid = ctf->sib; } L->top = o; #if LJ_TARGET_X86 /* Store stack adjustment for returns from non-cdecl callbacks. */ if (ctype_cconv(ct->info) != CTCC_CDECL) (L->base-2)->u32.hi |= (nsp << (16+2)); #endif while (gcsteps-- > 0) lj_gc_check(L); } /* Convert Lua object to callback result. */ static void callback_conv_result(CTState *cts, lua_State *L, TValue *o) { CType *ctr = ctype_raw(cts, (uint16_t)(L->base-2)->u32.hi); #if LJ_TARGET_X86 cts->cb.gpr[2] = 0; #endif if (!ctype_isvoid(ctr->info)) { uint8_t *dp = (uint8_t *)&cts->cb.gpr[0]; #if CCALL_NUM_FPR if (ctype_isfp(ctr->info)) dp = (uint8_t *)&cts->cb.fpr[0]; #endif lj_cconv_ct_tv(cts, ctr, dp, o, 0); #ifdef CALLBACK_HANDLE_RET CALLBACK_HANDLE_RET #endif /* Extend returned integers to (at least) 32 bits. */ if (ctype_isinteger_or_bool(ctr->info) && ctr->size < 4) { if (ctr->info & CTF_UNSIGNED) *(uint32_t *)dp = ctr->size == 1 ? (uint32_t)*(uint8_t *)dp : (uint32_t)*(uint16_t *)dp; else *(int32_t *)dp = ctr->size == 1 ? (int32_t)*(int8_t *)dp : (int32_t)*(int16_t *)dp; } #if LJ_TARGET_X86 if (ctype_isfp(ctr->info)) cts->cb.gpr[2] = ctr->size == sizeof(float) ? 1 : 2; #endif } } /* Enter callback. */ lua_State * LJ_FASTCALL lj_ccallback_enter(CTState *cts, void *cf) { lua_State *L = cts->L; global_State *g = cts->g; lua_assert(L != NULL); if (gcref(g->jit_L)) { setstrV(L, L->top++, lj_err_str(L, LJ_ERR_FFI_BADCBACK)); if (g->panic) g->panic(L); exit(EXIT_FAILURE); } lj_trace_abort(g); /* Never record across callback. */ /* Setup C frame. */ cframe_prev(cf) = L->cframe; setcframe_L(cf, L); cframe_errfunc(cf) = -1; cframe_nres(cf) = 0; L->cframe = cf; callback_conv_args(cts, L); return L; /* Now call the function on this stack. */ } /* Leave callback. */ void LJ_FASTCALL lj_ccallback_leave(CTState *cts, TValue *o) { lua_State *L = cts->L; GCfunc *fn; TValue *obase = L->base; L->base = L->top; /* Keep continuation frame for throwing errors. */ if (o >= L->base) { /* PC of RET* is lost. Point to last line for result conv. errors. */ fn = curr_func(L); if (isluafunc(fn)) { GCproto *pt = funcproto(fn); setcframe_pc(L->cframe, proto_bc(pt)+pt->sizebc+1); } } callback_conv_result(cts, L, o); /* Finally drop C frame and continuation frame. */ L->cframe = cframe_prev(L->cframe); L->top -= 2; L->base = obase; cts->cb.slot = 0; /* Blacklist C function that called the callback. */ } /* -- C callback management ----------------------------------------------- */ /* Get an unused slot in the callback slot table. */ static MSize callback_slot_new(CTState *cts, CType *ct) { CTypeID id = ctype_typeid(cts, ct); CTypeID1 *cbid = cts->cb.cbid; MSize top; for (top = cts->cb.topid; top < cts->cb.sizeid; top++) if (LJ_LIKELY(cbid[top] == 0)) goto found; #if CALLBACK_MAX_SLOT if (top >= CALLBACK_MAX_SLOT) #endif lj_err_caller(cts->L, LJ_ERR_FFI_CBACKOV); if (!cts->cb.mcode) callback_mcode_new(cts); lj_mem_growvec(cts->L, cbid, cts->cb.sizeid, CALLBACK_MAX_SLOT, CTypeID1); cts->cb.cbid = cbid; memset(cbid+top, 0, (cts->cb.sizeid-top)*sizeof(CTypeID1)); found: cbid[top] = id; cts->cb.topid = top+1; return top; } /* Check for function pointer and supported argument/result types. */ static CType *callback_checkfunc(CTState *cts, CType *ct) { int narg = 0; if (!ctype_isptr(ct->info) || (LJ_64 && ct->size != CTSIZE_PTR)) return NULL; ct = ctype_rawchild(cts, ct); if (ctype_isfunc(ct->info)) { CType *ctr = ctype_rawchild(cts, ct); CTypeID fid = ct->sib; if (!(ctype_isvoid(ctr->info) || ctype_isenum(ctr->info) || ctype_isptr(ctr->info) || (ctype_isnum(ctr->info) && ctr->size <= 8))) return NULL; if ((ct->info & CTF_VARARG)) return NULL; while (fid) { CType *ctf = ctype_get(cts, fid); if (!ctype_isattrib(ctf->info)) { CType *cta; lua_assert(ctype_isfield(ctf->info)); cta = ctype_rawchild(cts, ctf); if (!(ctype_isenum(cta->info) || ctype_isptr(cta->info) || (ctype_isnum(cta->info) && cta->size <= 8)) || ++narg >= LUA_MINSTACK-3) return NULL; } fid = ctf->sib; } return ct; } return NULL; } /* Create a new callback and return the callback function pointer. */ void *lj_ccallback_new(CTState *cts, CType *ct, GCfunc *fn) { ct = callback_checkfunc(cts, ct); if (ct) { MSize slot = callback_slot_new(cts, ct); GCtab *t = cts->miscmap; setfuncV(cts->L, lj_tab_setint(cts->L, t, (int32_t)slot), fn); lj_gc_anybarriert(cts->L, t); return callback_slot2ptr(cts, slot); } return NULL; /* Bad conversion. */ } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lib_io.c0000644000175000017500000003263413122010155016302 0ustar philphil/* ** I/O library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2011 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #include #include #define lib_io_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_state.h" #include "lj_ff.h" #include "lj_lib.h" /* Userdata payload for I/O file. */ typedef struct IOFileUD { FILE *fp; /* File handle. */ uint32_t type; /* File type. */ } IOFileUD; #define IOFILE_TYPE_FILE 0 /* Regular file. */ #define IOFILE_TYPE_PIPE 1 /* Pipe. */ #define IOFILE_TYPE_STDF 2 /* Standard file handle. */ #define IOFILE_TYPE_MASK 3 #define IOFILE_FLAG_CLOSE 4 /* Close after io.lines() iterator. */ #define IOSTDF_UD(L, id) (&gcref(G(L)->gcroot[(id)])->ud) #define IOSTDF_IOF(L, id) ((IOFileUD *)uddata(IOSTDF_UD(L, (id)))) /* -- Open/close helpers -------------------------------------------------- */ static IOFileUD *io_tofilep(lua_State *L) { if (!(L->base < L->top && tvisudata(L->base) && udataV(L->base)->udtype == UDTYPE_IO_FILE)) lj_err_argtype(L, 1, "FILE*"); return (IOFileUD *)uddata(udataV(L->base)); } static IOFileUD *io_tofile(lua_State *L) { IOFileUD *iof = io_tofilep(L); if (iof->fp == NULL) lj_err_caller(L, LJ_ERR_IOCLFL); return iof; } static FILE *io_stdfile(lua_State *L, ptrdiff_t id) { IOFileUD *iof = IOSTDF_IOF(L, id); if (iof->fp == NULL) lj_err_caller(L, LJ_ERR_IOSTDCL); return iof->fp; } static IOFileUD *io_file_new(lua_State *L) { IOFileUD *iof = (IOFileUD *)lua_newuserdata(L, sizeof(IOFileUD)); GCudata *ud = udataV(L->top-1); ud->udtype = UDTYPE_IO_FILE; /* NOBARRIER: The GCudata is new (marked white). */ setgcrefr(ud->metatable, curr_func(L)->c.env); iof->fp = NULL; iof->type = IOFILE_TYPE_FILE; return iof; } static IOFileUD *io_file_open(lua_State *L, const char *mode) { const char *fname = strdata(lj_lib_checkstr(L, 1)); IOFileUD *iof = io_file_new(L); iof->fp = fopen(fname, mode); if (iof->fp == NULL) luaL_argerror(L, 1, lj_str_pushf(L, "%s: %s", fname, strerror(errno))); return iof; } static int io_file_close(lua_State *L, IOFileUD *iof) { int ok; if ((iof->type & IOFILE_TYPE_MASK) == IOFILE_TYPE_FILE) { ok = (fclose(iof->fp) == 0); } else if ((iof->type & IOFILE_TYPE_MASK) == IOFILE_TYPE_PIPE) { int stat = -1; #if LJ_TARGET_POSIX stat = pclose(iof->fp); #elif LJ_TARGET_WINDOWS stat = _pclose(iof->fp); #else lua_assert(0); return 0; #endif #if LJ_52 iof->fp = NULL; return luaL_execresult(L, stat); #else ok = (stat != -1); #endif } else { lua_assert((iof->type & IOFILE_TYPE_MASK) == IOFILE_TYPE_STDF); setnilV(L->top++); lua_pushliteral(L, "cannot close standard file"); return 2; } iof->fp = NULL; return luaL_fileresult(L, ok, NULL); } /* -- Read/write helpers -------------------------------------------------- */ static int io_file_readnum(lua_State *L, FILE *fp) { lua_Number d; if (fscanf(fp, LUA_NUMBER_SCAN, &d) == 1) { if (LJ_DUALNUM) { int32_t i = lj_num2int(d); if (d == (lua_Number)i && !tvismzero((cTValue *)&d)) { setintV(L->top++, i); return 1; } } setnumV(L->top++, d); return 1; } else { setnilV(L->top++); return 0; } } static int io_file_readline(lua_State *L, FILE *fp, MSize chop) { MSize m = LUAL_BUFFERSIZE, n = 0, ok = 0; char *buf; for (;;) { buf = lj_str_needbuf(L, &G(L)->tmpbuf, m); if (fgets(buf+n, m-n, fp) == NULL) break; n += (MSize)strlen(buf+n); ok |= n; if (n && buf[n-1] == '\n') { n -= chop; break; } if (n >= m - 64) m += m; } setstrV(L, L->top++, lj_str_new(L, buf, (size_t)n)); lj_gc_check(L); return (int)ok; } static void io_file_readall(lua_State *L, FILE *fp) { MSize m, n; for (m = LUAL_BUFFERSIZE, n = 0; ; m += m) { char *buf = lj_str_needbuf(L, &G(L)->tmpbuf, m); n += (MSize)fread(buf+n, 1, m-n, fp); if (n != m) { setstrV(L, L->top++, lj_str_new(L, buf, (size_t)n)); lj_gc_check(L); return; } } } static int io_file_readlen(lua_State *L, FILE *fp, MSize m) { if (m) { char *buf = lj_str_needbuf(L, &G(L)->tmpbuf, m); MSize n = (MSize)fread(buf, 1, m, fp); setstrV(L, L->top++, lj_str_new(L, buf, (size_t)n)); lj_gc_check(L); return (n > 0 || m == 0); } else { int c = getc(fp); ungetc(c, fp); setstrV(L, L->top++, &G(L)->strempty); return (c != EOF); } } static int io_file_read(lua_State *L, FILE *fp, int start) { int ok, n, nargs = (int)(L->top - L->base) - start; clearerr(fp); if (nargs == 0) { ok = io_file_readline(L, fp, 1); n = start+1; /* Return 1 result. */ } else { /* The results plus the buffers go on top of the args. */ luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments"); ok = 1; for (n = start; nargs-- && ok; n++) { if (tvisstr(L->base+n)) { const char *p = strVdata(L->base+n); if (p[0] != '*') lj_err_arg(L, n+1, LJ_ERR_INVOPT); if (p[1] == 'n') ok = io_file_readnum(L, fp); else if ((p[1] & ~0x20) == 'L') ok = io_file_readline(L, fp, (p[1] == 'l')); else if (p[1] == 'a') io_file_readall(L, fp); else lj_err_arg(L, n+1, LJ_ERR_INVFMT); } else if (tvisnumber(L->base+n)) { ok = io_file_readlen(L, fp, (MSize)lj_lib_checkint(L, n+1)); } else { lj_err_arg(L, n+1, LJ_ERR_INVOPT); } } } if (ferror(fp)) return luaL_fileresult(L, 0, NULL); if (!ok) setnilV(L->top-1); /* Replace last result with nil. */ return n - start; } static int io_file_write(lua_State *L, FILE *fp, int start) { cTValue *tv; int status = 1; for (tv = L->base+start; tv < L->top; tv++) { if (tvisstr(tv)) { MSize len = strV(tv)->len; status = status && (fwrite(strVdata(tv), 1, len, fp) == len); } else if (tvisint(tv)) { char buf[LJ_STR_INTBUF]; char *p = lj_str_bufint(buf, intV(tv)); size_t len = (size_t)(buf+LJ_STR_INTBUF-p); status = status && (fwrite(p, 1, len, fp) == len); } else if (tvisnum(tv)) { status = status && (fprintf(fp, LUA_NUMBER_FMT, numV(tv)) > 0); } else { lj_err_argt(L, (int)(tv - L->base) + 1, LUA_TSTRING); } } if (LJ_52 && status) { L->top = L->base+1; if (start == 0) setudataV(L, L->base, IOSTDF_UD(L, GCROOT_IO_OUTPUT)); return 1; } return luaL_fileresult(L, status, NULL); } static int io_file_iter(lua_State *L) { GCfunc *fn = curr_func(L); IOFileUD *iof = uddata(udataV(&fn->c.upvalue[0])); int n = fn->c.nupvalues - 1; if (iof->fp == NULL) lj_err_caller(L, LJ_ERR_IOCLFL); L->top = L->base; if (n) { /* Copy upvalues with options to stack. */ if (n > LUAI_MAXCSTACK) lj_err_caller(L, LJ_ERR_STKOV); lj_state_checkstack(L, (MSize)n); memcpy(L->top, &fn->c.upvalue[1], n*sizeof(TValue)); L->top += n; } n = io_file_read(L, iof->fp, 0); if (ferror(iof->fp)) lj_err_callermsg(L, strVdata(L->top-2)); if (tvisnil(L->base) && (iof->type & IOFILE_FLAG_CLOSE)) { io_file_close(L, iof); /* Return values are ignored. */ return 0; } return n; } static int io_file_lines(lua_State *L) { int n = (int)(L->top - L->base); if (n > LJ_MAX_UPVAL) lj_err_caller(L, LJ_ERR_UNPACK); lua_pushcclosure(L, io_file_iter, n); return 1; } /* -- I/O file methods ---------------------------------------------------- */ #define LJLIB_MODULE_io_method LJLIB_CF(io_method_close) { IOFileUD *iof = L->base < L->top ? io_tofile(L) : IOSTDF_IOF(L, GCROOT_IO_OUTPUT); return io_file_close(L, iof); } LJLIB_CF(io_method_read) { return io_file_read(L, io_tofile(L)->fp, 1); } LJLIB_CF(io_method_write) LJLIB_REC(io_write 0) { return io_file_write(L, io_tofile(L)->fp, 1); } LJLIB_CF(io_method_flush) LJLIB_REC(io_flush 0) { return luaL_fileresult(L, fflush(io_tofile(L)->fp) == 0, NULL); } LJLIB_CF(io_method_seek) { FILE *fp = io_tofile(L)->fp; int opt = lj_lib_checkopt(L, 2, 1, "\3set\3cur\3end"); int64_t ofs = 0; cTValue *o; int res; if (opt == 0) opt = SEEK_SET; else if (opt == 1) opt = SEEK_CUR; else if (opt == 2) opt = SEEK_END; o = L->base+2; if (o < L->top) { if (tvisint(o)) ofs = (int64_t)intV(o); else if (tvisnum(o)) ofs = (int64_t)numV(o); else if (!tvisnil(o)) lj_err_argt(L, 3, LUA_TNUMBER); } #if LJ_TARGET_POSIX res = fseeko(fp, ofs, opt); #elif _MSC_VER >= 1400 res = _fseeki64(fp, ofs, opt); #elif defined(__MINGW32__) res = fseeko64(fp, ofs, opt); #else res = fseek(fp, (long)ofs, opt); #endif if (res) return luaL_fileresult(L, 0, NULL); #if LJ_TARGET_POSIX ofs = ftello(fp); #elif _MSC_VER >= 1400 ofs = _ftelli64(fp); #elif defined(__MINGW32__) ofs = ftello64(fp); #else ofs = (int64_t)ftell(fp); #endif setint64V(L->top-1, ofs); return 1; } LJLIB_CF(io_method_setvbuf) { FILE *fp = io_tofile(L)->fp; int opt = lj_lib_checkopt(L, 2, -1, "\4full\4line\2no"); size_t sz = (size_t)lj_lib_optint(L, 3, LUAL_BUFFERSIZE); if (opt == 0) opt = _IOFBF; else if (opt == 1) opt = _IOLBF; else if (opt == 2) opt = _IONBF; return luaL_fileresult(L, setvbuf(fp, NULL, opt, sz) == 0, NULL); } LJLIB_CF(io_method_lines) { io_tofile(L); return io_file_lines(L); } LJLIB_CF(io_method___gc) { IOFileUD *iof = io_tofilep(L); if (iof->fp != NULL && (iof->type & IOFILE_TYPE_MASK) != IOFILE_TYPE_STDF) io_file_close(L, iof); return 0; } LJLIB_CF(io_method___tostring) { IOFileUD *iof = io_tofilep(L); if (iof->fp != NULL) lua_pushfstring(L, "file (%p)", iof->fp); else lua_pushliteral(L, "file (closed)"); return 1; } LJLIB_PUSH(top-1) LJLIB_SET(__index) #include "lj_libdef.h" /* -- I/O library functions ----------------------------------------------- */ #define LJLIB_MODULE_io LJLIB_PUSH(top-2) LJLIB_SET(!) /* Set environment. */ LJLIB_CF(io_open) { const char *fname = strdata(lj_lib_checkstr(L, 1)); GCstr *s = lj_lib_optstr(L, 2); const char *mode = s ? strdata(s) : "r"; IOFileUD *iof = io_file_new(L); iof->fp = fopen(fname, mode); return iof->fp != NULL ? 1 : luaL_fileresult(L, 0, fname); } LJLIB_CF(io_popen) { #if LJ_TARGET_POSIX || LJ_TARGET_WINDOWS const char *fname = strdata(lj_lib_checkstr(L, 1)); GCstr *s = lj_lib_optstr(L, 2); const char *mode = s ? strdata(s) : "r"; IOFileUD *iof = io_file_new(L); iof->type = IOFILE_TYPE_PIPE; #if LJ_TARGET_POSIX fflush(NULL); iof->fp = popen(fname, mode); #else iof->fp = _popen(fname, mode); #endif return iof->fp != NULL ? 1 : luaL_fileresult(L, 0, fname); #else return luaL_error(L, LUA_QL("popen") " not supported"); #endif } LJLIB_CF(io_tmpfile) { IOFileUD *iof = io_file_new(L); #if LJ_TARGET_PS3 || LJ_TARGET_PS4 || LJ_TARGET_PSVITA iof->fp = NULL; errno = ENOSYS; #else iof->fp = tmpfile(); #endif return iof->fp != NULL ? 1 : luaL_fileresult(L, 0, NULL); } LJLIB_CF(io_close) { return lj_cf_io_method_close(L); } LJLIB_CF(io_read) { return io_file_read(L, io_stdfile(L, GCROOT_IO_INPUT), 0); } LJLIB_CF(io_write) LJLIB_REC(io_write GCROOT_IO_OUTPUT) { return io_file_write(L, io_stdfile(L, GCROOT_IO_OUTPUT), 0); } LJLIB_CF(io_flush) LJLIB_REC(io_flush GCROOT_IO_OUTPUT) { return luaL_fileresult(L, fflush(io_stdfile(L, GCROOT_IO_OUTPUT)) == 0, NULL); } static int io_std_getset(lua_State *L, ptrdiff_t id, const char *mode) { if (L->base < L->top && !tvisnil(L->base)) { if (tvisudata(L->base)) { io_tofile(L); L->top = L->base+1; } else { io_file_open(L, mode); } /* NOBARRIER: The standard I/O handles are GC roots. */ setgcref(G(L)->gcroot[id], gcV(L->top-1)); } else { setudataV(L, L->top++, IOSTDF_UD(L, id)); } return 1; } LJLIB_CF(io_input) { return io_std_getset(L, GCROOT_IO_INPUT, "r"); } LJLIB_CF(io_output) { return io_std_getset(L, GCROOT_IO_OUTPUT, "w"); } LJLIB_CF(io_lines) { if (L->base == L->top) setnilV(L->top++); if (!tvisnil(L->base)) { /* io.lines(fname) */ IOFileUD *iof = io_file_open(L, "r"); iof->type = IOFILE_TYPE_FILE|IOFILE_FLAG_CLOSE; L->top--; setudataV(L, L->base, udataV(L->top)); } else { /* io.lines() iterates over stdin. */ setudataV(L, L->base, IOSTDF_UD(L, GCROOT_IO_INPUT)); } return io_file_lines(L); } LJLIB_CF(io_type) { cTValue *o = lj_lib_checkany(L, 1); if (!(tvisudata(o) && udataV(o)->udtype == UDTYPE_IO_FILE)) setnilV(L->top++); else if (((IOFileUD *)uddata(udataV(o)))->fp != NULL) lua_pushliteral(L, "file"); else lua_pushliteral(L, "closed file"); return 1; } #include "lj_libdef.h" /* ------------------------------------------------------------------------ */ static GCobj *io_std_new(lua_State *L, FILE *fp, const char *name) { IOFileUD *iof = (IOFileUD *)lua_newuserdata(L, sizeof(IOFileUD)); GCudata *ud = udataV(L->top-1); ud->udtype = UDTYPE_IO_FILE; /* NOBARRIER: The GCudata is new (marked white). */ setgcref(ud->metatable, gcV(L->top-3)); iof->fp = fp; iof->type = IOFILE_TYPE_STDF; lua_setfield(L, -2, name); return obj2gco(ud); } LUALIB_API int luaopen_io(lua_State *L) { LJ_LIB_REG(L, NULL, io_method); copyTV(L, L->top, L->top-1); L->top++; lua_setfield(L, LUA_REGISTRYINDEX, LUA_FILEHANDLE); LJ_LIB_REG(L, LUA_IOLIBNAME, io); setgcref(G(L)->gcroot[GCROOT_IO_INPUT], io_std_new(L, stdin, "stdin")); setgcref(G(L)->gcroot[GCROOT_IO_OUTPUT], io_std_new(L, stdout, "stdout")); io_std_new(L, stderr, "stderr"); return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ctype.c0000644000175000017500000004332713122010155016657 0ustar philphil/* ** C type management. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_ctype.h" #include "lj_ccallback.h" /* -- C type definitions -------------------------------------------------- */ /* Predefined typedefs. */ #define CTTDDEF(_) \ /* Vararg handling. */ \ _("va_list", P_VOID) \ _("__builtin_va_list", P_VOID) \ _("__gnuc_va_list", P_VOID) \ /* From stddef.h. */ \ _("ptrdiff_t", INT_PSZ) \ _("size_t", UINT_PSZ) \ _("wchar_t", WCHAR) \ /* Subset of stdint.h. */ \ _("int8_t", INT8) \ _("int16_t", INT16) \ _("int32_t", INT32) \ _("int64_t", INT64) \ _("uint8_t", UINT8) \ _("uint16_t", UINT16) \ _("uint32_t", UINT32) \ _("uint64_t", UINT64) \ _("intptr_t", INT_PSZ) \ _("uintptr_t", UINT_PSZ) \ /* End of typedef list. */ /* Keywords (only the ones we actually care for). */ #define CTKWDEF(_) \ /* Type specifiers. */ \ _("void", -1, CTOK_VOID) \ _("_Bool", 0, CTOK_BOOL) \ _("bool", 1, CTOK_BOOL) \ _("char", 1, CTOK_CHAR) \ _("int", 4, CTOK_INT) \ _("__int8", 1, CTOK_INT) \ _("__int16", 2, CTOK_INT) \ _("__int32", 4, CTOK_INT) \ _("__int64", 8, CTOK_INT) \ _("float", 4, CTOK_FP) \ _("double", 8, CTOK_FP) \ _("long", 0, CTOK_LONG) \ _("short", 0, CTOK_SHORT) \ _("_Complex", 0, CTOK_COMPLEX) \ _("complex", 0, CTOK_COMPLEX) \ _("__complex", 0, CTOK_COMPLEX) \ _("__complex__", 0, CTOK_COMPLEX) \ _("signed", 0, CTOK_SIGNED) \ _("__signed", 0, CTOK_SIGNED) \ _("__signed__", 0, CTOK_SIGNED) \ _("unsigned", 0, CTOK_UNSIGNED) \ /* Type qualifiers. */ \ _("const", 0, CTOK_CONST) \ _("__const", 0, CTOK_CONST) \ _("__const__", 0, CTOK_CONST) \ _("volatile", 0, CTOK_VOLATILE) \ _("__volatile", 0, CTOK_VOLATILE) \ _("__volatile__", 0, CTOK_VOLATILE) \ _("restrict", 0, CTOK_RESTRICT) \ _("__restrict", 0, CTOK_RESTRICT) \ _("__restrict__", 0, CTOK_RESTRICT) \ _("inline", 0, CTOK_INLINE) \ _("__inline", 0, CTOK_INLINE) \ _("__inline__", 0, CTOK_INLINE) \ /* Storage class specifiers. */ \ _("typedef", 0, CTOK_TYPEDEF) \ _("extern", 0, CTOK_EXTERN) \ _("static", 0, CTOK_STATIC) \ _("auto", 0, CTOK_AUTO) \ _("register", 0, CTOK_REGISTER) \ /* GCC Attributes. */ \ _("__extension__", 0, CTOK_EXTENSION) \ _("__attribute", 0, CTOK_ATTRIBUTE) \ _("__attribute__", 0, CTOK_ATTRIBUTE) \ _("asm", 0, CTOK_ASM) \ _("__asm", 0, CTOK_ASM) \ _("__asm__", 0, CTOK_ASM) \ /* MSVC Attributes. */ \ _("__declspec", 0, CTOK_DECLSPEC) \ _("__cdecl", CTCC_CDECL, CTOK_CCDECL) \ _("__thiscall", CTCC_THISCALL, CTOK_CCDECL) \ _("__fastcall", CTCC_FASTCALL, CTOK_CCDECL) \ _("__stdcall", CTCC_STDCALL, CTOK_CCDECL) \ _("__ptr32", 4, CTOK_PTRSZ) \ _("__ptr64", 8, CTOK_PTRSZ) \ /* Other type specifiers. */ \ _("struct", 0, CTOK_STRUCT) \ _("union", 0, CTOK_UNION) \ _("enum", 0, CTOK_ENUM) \ /* Operators. */ \ _("sizeof", 0, CTOK_SIZEOF) \ _("__alignof", 0, CTOK_ALIGNOF) \ _("__alignof__", 0, CTOK_ALIGNOF) \ /* End of keyword list. */ /* Type info for predefined types. Size merged in. */ static CTInfo lj_ctype_typeinfo[] = { #define CTTYINFODEF(id, sz, ct, info) CTINFO((ct),(((sz)&0x3fu)<<10)+(info)), #define CTTDINFODEF(name, id) CTINFO(CT_TYPEDEF, CTID_##id), #define CTKWINFODEF(name, sz, kw) CTINFO(CT_KW,(((sz)&0x3fu)<<10)+(kw)), CTTYDEF(CTTYINFODEF) CTTDDEF(CTTDINFODEF) CTKWDEF(CTKWINFODEF) #undef CTTYINFODEF #undef CTTDINFODEF #undef CTKWINFODEF 0 }; /* Predefined type names collected in a single string. */ static const char * const lj_ctype_typenames = #define CTTDNAMEDEF(name, id) name "\0" #define CTKWNAMEDEF(name, sz, cds) name "\0" CTTDDEF(CTTDNAMEDEF) CTKWDEF(CTKWNAMEDEF) #undef CTTDNAMEDEF #undef CTKWNAMEDEF ; #define CTTYPEINFO_NUM (sizeof(lj_ctype_typeinfo)/sizeof(CTInfo)-1) #ifdef LUAJIT_CTYPE_CHECK_ANCHOR #define CTTYPETAB_MIN CTTYPEINFO_NUM #else #define CTTYPETAB_MIN 128 #endif /* -- C type interning ---------------------------------------------------- */ #define ct_hashtype(info, size) (hashrot(info, size) & CTHASH_MASK) #define ct_hashname(name) \ (hashrot(u32ptr(name), u32ptr(name) + HASH_BIAS) & CTHASH_MASK) /* Create new type element. */ CTypeID lj_ctype_new(CTState *cts, CType **ctp) { CTypeID id = cts->top; CType *ct; lua_assert(cts->L); if (LJ_UNLIKELY(id >= cts->sizetab)) { if (id >= CTID_MAX) lj_err_msg(cts->L, LJ_ERR_TABOV); #ifdef LUAJIT_CTYPE_CHECK_ANCHOR ct = lj_mem_newvec(cts->L, id+1, CType); memcpy(ct, cts->tab, id*sizeof(CType)); memset(cts->tab, 0, id*sizeof(CType)); lj_mem_freevec(cts->g, cts->tab, cts->sizetab, CType); cts->tab = ct; cts->sizetab = id+1; #else lj_mem_growvec(cts->L, cts->tab, cts->sizetab, CTID_MAX, CType); #endif } cts->top = id+1; *ctp = ct = &cts->tab[id]; ct->info = 0; ct->size = 0; ct->sib = 0; ct->next = 0; setgcrefnull(ct->name); return id; } /* Intern a type element. */ CTypeID lj_ctype_intern(CTState *cts, CTInfo info, CTSize size) { uint32_t h = ct_hashtype(info, size); CTypeID id = cts->hash[h]; lua_assert(cts->L); while (id) { CType *ct = ctype_get(cts, id); if (ct->info == info && ct->size == size) return id; id = ct->next; } id = cts->top; if (LJ_UNLIKELY(id >= cts->sizetab)) { if (id >= CTID_MAX) lj_err_msg(cts->L, LJ_ERR_TABOV); lj_mem_growvec(cts->L, cts->tab, cts->sizetab, CTID_MAX, CType); } cts->top = id+1; cts->tab[id].info = info; cts->tab[id].size = size; cts->tab[id].sib = 0; cts->tab[id].next = cts->hash[h]; setgcrefnull(cts->tab[id].name); cts->hash[h] = (CTypeID1)id; return id; } /* Add type element to hash table. */ static void ctype_addtype(CTState *cts, CType *ct, CTypeID id) { uint32_t h = ct_hashtype(ct->info, ct->size); ct->next = cts->hash[h]; cts->hash[h] = (CTypeID1)id; } /* Add named element to hash table. */ void lj_ctype_addname(CTState *cts, CType *ct, CTypeID id) { uint32_t h = ct_hashname(gcref(ct->name)); ct->next = cts->hash[h]; cts->hash[h] = (CTypeID1)id; } /* Get a C type by name, matching the type mask. */ CTypeID lj_ctype_getname(CTState *cts, CType **ctp, GCstr *name, uint32_t tmask) { CTypeID id = cts->hash[ct_hashname(name)]; while (id) { CType *ct = ctype_get(cts, id); if (gcref(ct->name) == obj2gco(name) && ((tmask >> ctype_type(ct->info)) & 1)) { *ctp = ct; return id; } id = ct->next; } *ctp = &cts->tab[0]; /* Simplify caller logic. ctype_get() would assert. */ return 0; } /* Get a struct/union/enum/function field by name. */ CType *lj_ctype_getfieldq(CTState *cts, CType *ct, GCstr *name, CTSize *ofs, CTInfo *qual) { while (ct->sib) { ct = ctype_get(cts, ct->sib); if (gcref(ct->name) == obj2gco(name)) { *ofs = ct->size; return ct; } if (ctype_isxattrib(ct->info, CTA_SUBTYPE)) { CType *fct, *cct = ctype_child(cts, ct); CTInfo q = 0; while (ctype_isattrib(cct->info)) { if (ctype_attrib(cct->info) == CTA_QUAL) q |= cct->size; cct = ctype_child(cts, cct); } fct = lj_ctype_getfieldq(cts, cct, name, ofs, qual); if (fct) { if (qual) *qual |= q; *ofs += ct->size; return fct; } } } return NULL; /* Not found. */ } /* -- C type information -------------------------------------------------- */ /* Follow references and get raw type for a C type ID. */ CType *lj_ctype_rawref(CTState *cts, CTypeID id) { CType *ct = ctype_get(cts, id); while (ctype_isattrib(ct->info) || ctype_isref(ct->info)) ct = ctype_child(cts, ct); return ct; } /* Get size for a C type ID. Does NOT support VLA/VLS. */ CTSize lj_ctype_size(CTState *cts, CTypeID id) { CType *ct = ctype_raw(cts, id); return ctype_hassize(ct->info) ? ct->size : CTSIZE_INVALID; } /* Get size for a variable-length C type. Does NOT support other C types. */ CTSize lj_ctype_vlsize(CTState *cts, CType *ct, CTSize nelem) { uint64_t xsz = 0; if (ctype_isstruct(ct->info)) { CTypeID arrid = 0, fid = ct->sib; xsz = ct->size; /* Add the struct size. */ while (fid) { CType *ctf = ctype_get(cts, fid); if (ctype_type(ctf->info) == CT_FIELD) arrid = ctype_cid(ctf->info); /* Remember last field of VLS. */ fid = ctf->sib; } ct = ctype_raw(cts, arrid); } lua_assert(ctype_isvlarray(ct->info)); /* Must be a VLA. */ ct = ctype_rawchild(cts, ct); /* Get array element. */ lua_assert(ctype_hassize(ct->info)); /* Calculate actual size of VLA and check for overflow. */ xsz += (uint64_t)ct->size * nelem; return xsz < 0x80000000u ? (CTSize)xsz : CTSIZE_INVALID; } /* Get type, qualifiers, size and alignment for a C type ID. */ CTInfo lj_ctype_info(CTState *cts, CTypeID id, CTSize *szp) { CTInfo qual = 0; CType *ct = ctype_get(cts, id); for (;;) { CTInfo info = ct->info; if (ctype_isenum(info)) { /* Follow child. Need to look at its attributes, too. */ } else if (ctype_isattrib(info)) { if (ctype_isxattrib(info, CTA_QUAL)) qual |= ct->size; else if (ctype_isxattrib(info, CTA_ALIGN) && !(qual & CTFP_ALIGNED)) qual |= CTFP_ALIGNED + CTALIGN(ct->size); } else { if (!(qual & CTFP_ALIGNED)) qual |= (info & CTF_ALIGN); qual |= (info & ~(CTF_ALIGN|CTMASK_CID)); lua_assert(ctype_hassize(info) || ctype_isfunc(info)); *szp = ctype_isfunc(info) ? CTSIZE_INVALID : ct->size; break; } ct = ctype_get(cts, ctype_cid(info)); } return qual; } /* Get ctype metamethod. */ cTValue *lj_ctype_meta(CTState *cts, CTypeID id, MMS mm) { CType *ct = ctype_get(cts, id); cTValue *tv; while (ctype_isattrib(ct->info) || ctype_isref(ct->info)) { id = ctype_cid(ct->info); ct = ctype_get(cts, id); } if (ctype_isptr(ct->info) && ctype_isfunc(ctype_get(cts, ctype_cid(ct->info))->info)) tv = lj_tab_getstr(cts->miscmap, &cts->g->strempty); else tv = lj_tab_getinth(cts->miscmap, -(int32_t)id); if (tv && tvistab(tv) && (tv = lj_tab_getstr(tabV(tv), mmname_str(cts->g, mm))) && !tvisnil(tv)) return tv; return NULL; } /* -- C type representation ----------------------------------------------- */ /* Fixed max. length of a C type representation. */ #define CTREPR_MAX 512 typedef struct CTRepr { char *pb, *pe; CTState *cts; lua_State *L; int needsp; int ok; char buf[CTREPR_MAX]; } CTRepr; /* Prepend string. */ static void ctype_prepstr(CTRepr *ctr, const char *str, MSize len) { char *p = ctr->pb; if (ctr->buf + len+1 > p) { ctr->ok = 0; return; } if (ctr->needsp) *--p = ' '; ctr->needsp = 1; p -= len; while (len-- > 0) p[len] = str[len]; ctr->pb = p; } #define ctype_preplit(ctr, str) ctype_prepstr((ctr), "" str, sizeof(str)-1) /* Prepend char. */ static void ctype_prepc(CTRepr *ctr, int c) { if (ctr->buf >= ctr->pb) { ctr->ok = 0; return; } *--ctr->pb = c; } /* Prepend number. */ static void ctype_prepnum(CTRepr *ctr, uint32_t n) { char *p = ctr->pb; if (ctr->buf + 10+1 > p) { ctr->ok = 0; return; } do { *--p = (char)('0' + n % 10); } while (n /= 10); ctr->pb = p; ctr->needsp = 0; } /* Append char. */ static void ctype_appc(CTRepr *ctr, int c) { if (ctr->pe >= ctr->buf + CTREPR_MAX) { ctr->ok = 0; return; } *ctr->pe++ = c; } /* Append number. */ static void ctype_appnum(CTRepr *ctr, uint32_t n) { char buf[10]; char *p = buf+sizeof(buf); char *q = ctr->pe; if (q > ctr->buf + CTREPR_MAX - 10) { ctr->ok = 0; return; } do { *--p = (char)('0' + n % 10); } while (n /= 10); do { *q++ = *p++; } while (p < buf+sizeof(buf)); ctr->pe = q; } /* Prepend qualifiers. */ static void ctype_prepqual(CTRepr *ctr, CTInfo info) { if ((info & CTF_VOLATILE)) ctype_preplit(ctr, "volatile"); if ((info & CTF_CONST)) ctype_preplit(ctr, "const"); } /* Prepend named type. */ static void ctype_preptype(CTRepr *ctr, CType *ct, CTInfo qual, const char *t) { if (gcref(ct->name)) { GCstr *str = gco2str(gcref(ct->name)); ctype_prepstr(ctr, strdata(str), str->len); } else { if (ctr->needsp) ctype_prepc(ctr, ' '); ctype_prepnum(ctr, ctype_typeid(ctr->cts, ct)); ctr->needsp = 1; } ctype_prepstr(ctr, t, (MSize)strlen(t)); ctype_prepqual(ctr, qual); } static void ctype_repr(CTRepr *ctr, CTypeID id) { CType *ct = ctype_get(ctr->cts, id); CTInfo qual = 0; int ptrto = 0; for (;;) { CTInfo info = ct->info; CTSize size = ct->size; switch (ctype_type(info)) { case CT_NUM: if ((info & CTF_BOOL)) { ctype_preplit(ctr, "bool"); } else if ((info & CTF_FP)) { if (size == sizeof(double)) ctype_preplit(ctr, "double"); else if (size == sizeof(float)) ctype_preplit(ctr, "float"); else ctype_preplit(ctr, "long double"); } else if (size == 1) { if (!((info ^ CTF_UCHAR) & CTF_UNSIGNED)) ctype_preplit(ctr, "char"); else if (CTF_UCHAR) ctype_preplit(ctr, "signed char"); else ctype_preplit(ctr, "unsigned char"); } else if (size < 8) { if (size == 4) ctype_preplit(ctr, "int"); else ctype_preplit(ctr, "short"); if ((info & CTF_UNSIGNED)) ctype_preplit(ctr, "unsigned"); } else { ctype_preplit(ctr, "_t"); ctype_prepnum(ctr, size*8); ctype_preplit(ctr, "int"); if ((info & CTF_UNSIGNED)) ctype_prepc(ctr, 'u'); } ctype_prepqual(ctr, (qual|info)); return; case CT_VOID: ctype_preplit(ctr, "void"); ctype_prepqual(ctr, (qual|info)); return; case CT_STRUCT: ctype_preptype(ctr, ct, qual, (info & CTF_UNION) ? "union" : "struct"); return; case CT_ENUM: if (id == CTID_CTYPEID) { ctype_preplit(ctr, "ctype"); return; } ctype_preptype(ctr, ct, qual, "enum"); return; case CT_ATTRIB: if (ctype_attrib(info) == CTA_QUAL) qual |= size; break; case CT_PTR: if ((info & CTF_REF)) { ctype_prepc(ctr, '&'); } else { ctype_prepqual(ctr, (qual|info)); if (LJ_64 && size == 4) ctype_preplit(ctr, "__ptr32"); ctype_prepc(ctr, '*'); } qual = 0; ptrto = 1; ctr->needsp = 1; break; case CT_ARRAY: if (ctype_isrefarray(info)) { ctr->needsp = 1; if (ptrto) { ptrto = 0; ctype_prepc(ctr, '('); ctype_appc(ctr, ')'); } ctype_appc(ctr, '['); if (size != CTSIZE_INVALID) { CTSize csize = ctype_child(ctr->cts, ct)->size; ctype_appnum(ctr, csize ? size/csize : 0); } else if ((info & CTF_VLA)) { ctype_appc(ctr, '?'); } ctype_appc(ctr, ']'); } else if ((info & CTF_COMPLEX)) { if (size == 2*sizeof(float)) ctype_preplit(ctr, "float"); ctype_preplit(ctr, "complex"); return; } else { ctype_preplit(ctr, ")))"); ctype_prepnum(ctr, size); ctype_preplit(ctr, "__attribute__((vector_size("); } break; case CT_FUNC: ctr->needsp = 1; if (ptrto) { ptrto = 0; ctype_prepc(ctr, '('); ctype_appc(ctr, ')'); } ctype_appc(ctr, '('); ctype_appc(ctr, ')'); break; default: lua_assert(0); break; } ct = ctype_get(ctr->cts, ctype_cid(info)); } } /* Return a printable representation of a C type. */ GCstr *lj_ctype_repr(lua_State *L, CTypeID id, GCstr *name) { global_State *g = G(L); CTRepr ctr; ctr.pb = ctr.pe = &ctr.buf[CTREPR_MAX/2]; ctr.cts = ctype_ctsG(g); ctr.L = L; ctr.ok = 1; ctr.needsp = 0; if (name) ctype_prepstr(&ctr, strdata(name), name->len); ctype_repr(&ctr, id); if (LJ_UNLIKELY(!ctr.ok)) return lj_str_newlit(L, "?"); return lj_str_new(L, ctr.pb, ctr.pe - ctr.pb); } /* Convert int64_t/uint64_t to string with 'LL' or 'ULL' suffix. */ GCstr *lj_ctype_repr_int64(lua_State *L, uint64_t n, int isunsigned) { char buf[1+20+3]; char *p = buf+sizeof(buf); int sign = 0; *--p = 'L'; *--p = 'L'; if (isunsigned) { *--p = 'U'; } else if ((int64_t)n < 0) { n = (uint64_t)-(int64_t)n; sign = 1; } do { *--p = (char)('0' + n % 10); } while (n /= 10); if (sign) *--p = '-'; return lj_str_new(L, p, (size_t)(buf+sizeof(buf)-p)); } /* Convert complex to string with 'i' or 'I' suffix. */ GCstr *lj_ctype_repr_complex(lua_State *L, void *sp, CTSize size) { char buf[2*LJ_STR_NUMBUF+2+1]; TValue re, im; size_t len; if (size == 2*sizeof(double)) { re.n = *(double *)sp; im.n = ((double *)sp)[1]; } else { re.n = (double)*(float *)sp; im.n = (double)((float *)sp)[1]; } len = lj_str_bufnum(buf, &re); if (!(im.u32.hi & 0x80000000u) || im.n != im.n) buf[len++] = '+'; len += lj_str_bufnum(buf+len, &im); buf[len] = buf[len-1] >= 'a' ? 'I' : 'i'; return lj_str_new(L, buf, len+1); } /* -- C type state -------------------------------------------------------- */ /* Initialize C type table and state. */ CTState *lj_ctype_init(lua_State *L) { CTState *cts = lj_mem_newt(L, sizeof(CTState), CTState); CType *ct = lj_mem_newvec(L, CTTYPETAB_MIN, CType); const char *name = lj_ctype_typenames; CTypeID id; memset(cts, 0, sizeof(CTState)); cts->tab = ct; cts->sizetab = CTTYPETAB_MIN; cts->top = CTTYPEINFO_NUM; cts->L = NULL; cts->g = G(L); for (id = 0; id < CTTYPEINFO_NUM; id++, ct++) { CTInfo info = lj_ctype_typeinfo[id]; ct->size = (CTSize)((int32_t)(info << 16) >> 26); ct->info = info & 0xffff03ffu; ct->sib = 0; if (ctype_type(info) == CT_KW || ctype_istypedef(info)) { size_t len = strlen(name); GCstr *str = lj_str_new(L, name, len); ctype_setname(ct, str); name += len+1; lj_ctype_addname(cts, ct, id); } else { setgcrefnull(ct->name); ct->next = 0; if (!ctype_isenum(info)) ctype_addtype(cts, ct, id); } } setmref(G(L)->ctype_state, cts); return cts; } /* Free C type table and state. */ void lj_ctype_freestate(global_State *g) { CTState *cts = ctype_ctsG(g); if (cts) { lj_ccallback_mcode_free(cts); lj_mem_freevec(g, cts->tab, cts->sizetab, CType); lj_mem_freevec(g, cts->cb.cbid, cts->cb.sizeid, CTypeID1); lj_mem_freet(g, cts); } } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_vmevent.c0000644000175000017500000000275313122010155017215 0ustar philphil/* ** VM event handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include #define lj_vmevent_c #define LUA_CORE #include "lj_obj.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_state.h" #include "lj_dispatch.h" #include "lj_vm.h" #include "lj_vmevent.h" ptrdiff_t lj_vmevent_prepare(lua_State *L, VMEvent ev) { global_State *g = G(L); GCstr *s = lj_str_newlit(L, LJ_VMEVENTS_REGKEY); cTValue *tv = lj_tab_getstr(tabV(registry(L)), s); if (tvistab(tv)) { int hash = VMEVENT_HASH(ev); tv = lj_tab_getint(tabV(tv), hash); if (tv && tvisfunc(tv)) { lj_state_checkstack(L, LUA_MINSTACK); setfuncV(L, L->top++, funcV(tv)); return savestack(L, L->top); } } g->vmevmask &= ~VMEVENT_MASK(ev); /* No handler: cache this fact. */ return 0; } void lj_vmevent_call(lua_State *L, ptrdiff_t argbase) { global_State *g = G(L); uint8_t oldmask = g->vmevmask; uint8_t oldh = hook_save(g); int status; g->vmevmask = 0; /* Disable all events. */ hook_vmevent(g); status = lj_vm_pcall(L, restorestack(L, argbase), 0+1, 0); if (LJ_UNLIKELY(status)) { /* Really shouldn't use stderr here, but where else to complain? */ L->top--; fputs("VM handler failed: ", stderr); fputs(tvisstr(L->top) ? strVdata(L->top) : "?", stderr); fputc('\n', stderr); } hook_restore(g, oldh); if (g->vmevmask != VMEVENT_NOCACHE) g->vmevmask = oldmask; /* Restore event mask, but not if not modified. */ } wcc-0.0.2/src/wsh/luajit-2.0/src/lib_package.c0000644000175000017500000004273113122010155017265 0ustar philphil/* ** Package library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2012 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lib_package_c #define LUA_LIB #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #include "lj_err.h" #include "lj_lib.h" /* ------------------------------------------------------------------------ */ /* Error codes for ll_loadfunc. */ #define PACKAGE_ERR_LIB 1 #define PACKAGE_ERR_FUNC 2 #define PACKAGE_ERR_LOAD 3 /* Redefined in platform specific part. */ #define PACKAGE_LIB_FAIL "open" #define setprogdir(L) ((void)0) /* Symbol name prefixes. */ #define SYMPREFIX_CF "luaopen_%s" #define SYMPREFIX_BC "luaJIT_BC_%s" #if LJ_TARGET_DLOPEN #include static void ll_unloadlib(void *lib) { dlclose(lib); } static void *ll_load(lua_State *L, const char *path, int gl) { void *lib = dlopen(path, RTLD_NOW | (gl ? RTLD_GLOBAL : RTLD_LOCAL)); if (lib == NULL) lua_pushstring(L, dlerror()); return lib; } static lua_CFunction ll_sym(lua_State *L, void *lib, const char *sym) { lua_CFunction f = (lua_CFunction)dlsym(lib, sym); if (f == NULL) lua_pushstring(L, dlerror()); return f; } static const char *ll_bcsym(void *lib, const char *sym) { #if defined(RTLD_DEFAULT) if (lib == NULL) lib = RTLD_DEFAULT; #elif LJ_TARGET_OSX || LJ_TARGET_BSD if (lib == NULL) lib = (void *)(intptr_t)-2; #endif return (const char *)dlsym(lib, sym); } #elif LJ_TARGET_WINDOWS #define WIN32_LEAN_AND_MEAN #include #ifndef GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS #define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 4 #define GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT 2 BOOL WINAPI GetModuleHandleExA(DWORD, LPCSTR, HMODULE*); #endif #undef setprogdir static void setprogdir(lua_State *L) { char buff[MAX_PATH + 1]; char *lb; DWORD nsize = sizeof(buff); DWORD n = GetModuleFileNameA(NULL, buff, nsize); if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL) { luaL_error(L, "unable to get ModuleFileName"); } else { *lb = '\0'; luaL_gsub(L, lua_tostring(L, -1), LUA_EXECDIR, buff); lua_remove(L, -2); /* remove original string */ } } static void pusherror(lua_State *L) { DWORD error = GetLastError(); char buffer[128]; if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM, NULL, error, 0, buffer, sizeof(buffer), NULL)) lua_pushstring(L, buffer); else lua_pushfstring(L, "system error %d\n", error); } static void ll_unloadlib(void *lib) { FreeLibrary((HINSTANCE)lib); } static void *ll_load(lua_State *L, const char *path, int gl) { HINSTANCE lib = LoadLibraryA(path); if (lib == NULL) pusherror(L); UNUSED(gl); return lib; } static lua_CFunction ll_sym(lua_State *L, void *lib, const char *sym) { lua_CFunction f = (lua_CFunction)GetProcAddress((HINSTANCE)lib, sym); if (f == NULL) pusherror(L); return f; } static const char *ll_bcsym(void *lib, const char *sym) { if (lib) { return (const char *)GetProcAddress((HINSTANCE)lib, sym); } else { HINSTANCE h = GetModuleHandleA(NULL); const char *p = (const char *)GetProcAddress(h, sym); if (p == NULL && GetModuleHandleExA(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS|GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT, (const char *)ll_bcsym, &h)) p = (const char *)GetProcAddress(h, sym); return p; } } #else #undef PACKAGE_LIB_FAIL #define PACKAGE_LIB_FAIL "absent" #define DLMSG "dynamic libraries not enabled; no support for target OS" static void ll_unloadlib(void *lib) { UNUSED(lib); } static void *ll_load(lua_State *L, const char *path, int gl) { UNUSED(path); UNUSED(gl); lua_pushliteral(L, DLMSG); return NULL; } static lua_CFunction ll_sym(lua_State *L, void *lib, const char *sym) { UNUSED(lib); UNUSED(sym); lua_pushliteral(L, DLMSG); return NULL; } static const char *ll_bcsym(void *lib, const char *sym) { UNUSED(lib); UNUSED(sym); return NULL; } #endif /* ------------------------------------------------------------------------ */ static void **ll_register(lua_State *L, const char *path) { void **plib; lua_pushfstring(L, "LOADLIB: %s", path); lua_gettable(L, LUA_REGISTRYINDEX); /* check library in registry? */ if (!lua_isnil(L, -1)) { /* is there an entry? */ plib = (void **)lua_touserdata(L, -1); } else { /* no entry yet; create one */ lua_pop(L, 1); plib = (void **)lua_newuserdata(L, sizeof(void *)); *plib = NULL; luaL_getmetatable(L, "_LOADLIB"); lua_setmetatable(L, -2); lua_pushfstring(L, "LOADLIB: %s", path); lua_pushvalue(L, -2); lua_settable(L, LUA_REGISTRYINDEX); } return plib; } static const char *mksymname(lua_State *L, const char *modname, const char *prefix) { const char *funcname; const char *mark = strchr(modname, *LUA_IGMARK); if (mark) modname = mark + 1; funcname = luaL_gsub(L, modname, ".", "_"); funcname = lua_pushfstring(L, prefix, funcname); lua_remove(L, -2); /* remove 'gsub' result */ return funcname; } static int ll_loadfunc(lua_State *L, const char *path, const char *name, int r) { void **reg = ll_register(L, path); if (*reg == NULL) *reg = ll_load(L, path, (*name == '*')); if (*reg == NULL) { return PACKAGE_ERR_LIB; /* Unable to load library. */ } else if (*name == '*') { /* Only load library into global namespace. */ lua_pushboolean(L, 1); return 0; } else { const char *sym = r ? name : mksymname(L, name, SYMPREFIX_CF); lua_CFunction f = ll_sym(L, *reg, sym); if (f) { lua_pushcfunction(L, f); return 0; } if (!r) { const char *bcdata = ll_bcsym(*reg, mksymname(L, name, SYMPREFIX_BC)); lua_pop(L, 1); if (bcdata) { if (luaL_loadbuffer(L, bcdata, ~(size_t)0, name) != 0) return PACKAGE_ERR_LOAD; return 0; } } return PACKAGE_ERR_FUNC; /* Unable to find function. */ } } static int lj_cf_package_loadlib(lua_State *L) { const char *path = luaL_checkstring(L, 1); const char *init = luaL_checkstring(L, 2); int st = ll_loadfunc(L, path, init, 1); if (st == 0) { /* no errors? */ return 1; /* return the loaded function */ } else { /* error; error message is on stack top */ lua_pushnil(L); lua_insert(L, -2); lua_pushstring(L, (st == PACKAGE_ERR_LIB) ? PACKAGE_LIB_FAIL : "init"); return 3; /* return nil, error message, and where */ } } static int lj_cf_package_unloadlib(lua_State *L) { void **lib = (void **)luaL_checkudata(L, 1, "_LOADLIB"); if (*lib) ll_unloadlib(*lib); *lib = NULL; /* mark library as closed */ return 0; } /* ------------------------------------------------------------------------ */ static int readable(const char *filename) { FILE *f = fopen(filename, "r"); /* try to open file */ if (f == NULL) return 0; /* open failed */ fclose(f); return 1; } static const char *pushnexttemplate(lua_State *L, const char *path) { const char *l; while (*path == *LUA_PATHSEP) path++; /* skip separators */ if (*path == '\0') return NULL; /* no more templates */ l = strchr(path, *LUA_PATHSEP); /* find next separator */ if (l == NULL) l = path + strlen(path); lua_pushlstring(L, path, (size_t)(l - path)); /* template */ return l; } static const char *searchpath (lua_State *L, const char *name, const char *path, const char *sep, const char *dirsep) { luaL_Buffer msg; /* to build error message */ luaL_buffinit(L, &msg); if (*sep != '\0') /* non-empty separator? */ name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */ while ((path = pushnexttemplate(L, path)) != NULL) { const char *filename = luaL_gsub(L, lua_tostring(L, -1), LUA_PATH_MARK, name); lua_remove(L, -2); /* remove path template */ if (readable(filename)) /* does file exist and is readable? */ return filename; /* return that file name */ lua_pushfstring(L, "\n\tno file " LUA_QS, filename); lua_remove(L, -2); /* remove file name */ luaL_addvalue(&msg); /* concatenate error msg. entry */ } luaL_pushresult(&msg); /* create error message */ return NULL; /* not found */ } static int lj_cf_package_searchpath(lua_State *L) { const char *f = searchpath(L, luaL_checkstring(L, 1), luaL_checkstring(L, 2), luaL_optstring(L, 3, "."), luaL_optstring(L, 4, LUA_DIRSEP)); if (f != NULL) { return 1; } else { /* error message is on top of the stack */ lua_pushnil(L); lua_insert(L, -2); return 2; /* return nil + error message */ } } static const char *findfile(lua_State *L, const char *name, const char *pname) { const char *path; lua_getfield(L, LUA_ENVIRONINDEX, pname); path = lua_tostring(L, -1); if (path == NULL) luaL_error(L, LUA_QL("package.%s") " must be a string", pname); return searchpath(L, name, path, ".", LUA_DIRSEP); } static void loaderror(lua_State *L, const char *filename) { luaL_error(L, "error loading module " LUA_QS " from file " LUA_QS ":\n\t%s", lua_tostring(L, 1), filename, lua_tostring(L, -1)); } static int lj_cf_package_loader_lua(lua_State *L) { const char *filename; const char *name = luaL_checkstring(L, 1); filename = findfile(L, name, "path"); if (filename == NULL) return 1; /* library not found in this path */ if (luaL_loadfile(L, filename) != 0) loaderror(L, filename); return 1; /* library loaded successfully */ } static int lj_cf_package_loader_c(lua_State *L) { const char *name = luaL_checkstring(L, 1); const char *filename = findfile(L, name, "cpath"); if (filename == NULL) return 1; /* library not found in this path */ if (ll_loadfunc(L, filename, name, 0) != 0) loaderror(L, filename); return 1; /* library loaded successfully */ } static int lj_cf_package_loader_croot(lua_State *L) { const char *filename; const char *name = luaL_checkstring(L, 1); const char *p = strchr(name, '.'); int st; if (p == NULL) return 0; /* is root */ lua_pushlstring(L, name, (size_t)(p - name)); filename = findfile(L, lua_tostring(L, -1), "cpath"); if (filename == NULL) return 1; /* root not found */ if ((st = ll_loadfunc(L, filename, name, 0)) != 0) { if (st != PACKAGE_ERR_FUNC) loaderror(L, filename); /* real error */ lua_pushfstring(L, "\n\tno module " LUA_QS " in file " LUA_QS, name, filename); return 1; /* function not found */ } return 1; } static int lj_cf_package_loader_preload(lua_State *L) { const char *name = luaL_checkstring(L, 1); lua_getfield(L, LUA_ENVIRONINDEX, "preload"); if (!lua_istable(L, -1)) luaL_error(L, LUA_QL("package.preload") " must be a table"); lua_getfield(L, -1, name); if (lua_isnil(L, -1)) { /* Not found? */ const char *bcname = mksymname(L, name, SYMPREFIX_BC); const char *bcdata = ll_bcsym(NULL, bcname); if (bcdata == NULL || luaL_loadbuffer(L, bcdata, ~(size_t)0, name) != 0) lua_pushfstring(L, "\n\tno field package.preload['%s']", name); } return 1; } /* ------------------------------------------------------------------------ */ static const int sentinel_ = 0; #define sentinel ((void *)&sentinel_) static int lj_cf_package_require(lua_State *L) { const char *name = luaL_checkstring(L, 1); int i; lua_settop(L, 1); /* _LOADED table will be at index 2 */ lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); lua_getfield(L, 2, name); if (lua_toboolean(L, -1)) { /* is it there? */ if (lua_touserdata(L, -1) == sentinel) /* check loops */ luaL_error(L, "loop or previous error loading module " LUA_QS, name); return 1; /* package is already loaded */ } /* else must load it; iterate over available loaders */ lua_getfield(L, LUA_ENVIRONINDEX, "loaders"); if (!lua_istable(L, -1)) luaL_error(L, LUA_QL("package.loaders") " must be a table"); lua_pushliteral(L, ""); /* error message accumulator */ for (i = 1; ; i++) { lua_rawgeti(L, -2, i); /* get a loader */ if (lua_isnil(L, -1)) luaL_error(L, "module " LUA_QS " not found:%s", name, lua_tostring(L, -2)); lua_pushstring(L, name); lua_call(L, 1, 1); /* call it */ if (lua_isfunction(L, -1)) /* did it find module? */ break; /* module loaded successfully */ else if (lua_isstring(L, -1)) /* loader returned error message? */ lua_concat(L, 2); /* accumulate it */ else lua_pop(L, 1); } lua_pushlightuserdata(L, sentinel); lua_setfield(L, 2, name); /* _LOADED[name] = sentinel */ lua_pushstring(L, name); /* pass name as argument to module */ lua_call(L, 1, 1); /* run loaded module */ if (!lua_isnil(L, -1)) /* non-nil return? */ lua_setfield(L, 2, name); /* _LOADED[name] = returned value */ lua_getfield(L, 2, name); if (lua_touserdata(L, -1) == sentinel) { /* module did not set a value? */ lua_pushboolean(L, 1); /* use true as result */ lua_pushvalue(L, -1); /* extra copy to be returned */ lua_setfield(L, 2, name); /* _LOADED[name] = true */ } lj_lib_checkfpu(L); return 1; } /* ------------------------------------------------------------------------ */ static void setfenv(lua_State *L) { lua_Debug ar; if (lua_getstack(L, 1, &ar) == 0 || lua_getinfo(L, "f", &ar) == 0 || /* get calling function */ lua_iscfunction(L, -1)) luaL_error(L, LUA_QL("module") " not called from a Lua function"); lua_pushvalue(L, -2); lua_setfenv(L, -2); lua_pop(L, 1); } static void dooptions(lua_State *L, int n) { int i; for (i = 2; i <= n; i++) { lua_pushvalue(L, i); /* get option (a function) */ lua_pushvalue(L, -2); /* module */ lua_call(L, 1, 0); } } static void modinit(lua_State *L, const char *modname) { const char *dot; lua_pushvalue(L, -1); lua_setfield(L, -2, "_M"); /* module._M = module */ lua_pushstring(L, modname); lua_setfield(L, -2, "_NAME"); dot = strrchr(modname, '.'); /* look for last dot in module name */ if (dot == NULL) dot = modname; else dot++; /* set _PACKAGE as package name (full module name minus last part) */ lua_pushlstring(L, modname, (size_t)(dot - modname)); lua_setfield(L, -2, "_PACKAGE"); } static int lj_cf_package_module(lua_State *L) { const char *modname = luaL_checkstring(L, 1); int loaded = lua_gettop(L) + 1; /* index of _LOADED table */ lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); lua_getfield(L, loaded, modname); /* get _LOADED[modname] */ if (!lua_istable(L, -1)) { /* not found? */ lua_pop(L, 1); /* remove previous result */ /* try global variable (and create one if it does not exist) */ if (luaL_findtable(L, LUA_GLOBALSINDEX, modname, 1) != NULL) lj_err_callerv(L, LJ_ERR_BADMODN, modname); lua_pushvalue(L, -1); lua_setfield(L, loaded, modname); /* _LOADED[modname] = new table */ } /* check whether table already has a _NAME field */ lua_getfield(L, -1, "_NAME"); if (!lua_isnil(L, -1)) { /* is table an initialized module? */ lua_pop(L, 1); } else { /* no; initialize it */ lua_pop(L, 1); modinit(L, modname); } lua_pushvalue(L, -1); setfenv(L); dooptions(L, loaded - 1); return 0; } static int lj_cf_package_seeall(lua_State *L) { luaL_checktype(L, 1, LUA_TTABLE); if (!lua_getmetatable(L, 1)) { lua_createtable(L, 0, 1); /* create new metatable */ lua_pushvalue(L, -1); lua_setmetatable(L, 1); } lua_pushvalue(L, LUA_GLOBALSINDEX); lua_setfield(L, -2, "__index"); /* mt.__index = _G */ return 0; } /* ------------------------------------------------------------------------ */ #define AUXMARK "\1" static void setpath(lua_State *L, const char *fieldname, const char *envname, const char *def, int noenv) { #if LJ_TARGET_CONSOLE const char *path = NULL; UNUSED(envname); #else const char *path = getenv(envname); #endif if (path == NULL || noenv) { lua_pushstring(L, def); } else { path = luaL_gsub(L, path, LUA_PATHSEP LUA_PATHSEP, LUA_PATHSEP AUXMARK LUA_PATHSEP); luaL_gsub(L, path, AUXMARK, def); lua_remove(L, -2); } setprogdir(L); lua_setfield(L, -2, fieldname); } static const luaL_Reg package_lib[] = { { "loadlib", lj_cf_package_loadlib }, { "searchpath", lj_cf_package_searchpath }, { "seeall", lj_cf_package_seeall }, { NULL, NULL } }; static const luaL_Reg package_global[] = { { "module", lj_cf_package_module }, { "require", lj_cf_package_require }, { NULL, NULL } }; static const lua_CFunction package_loaders[] = { lj_cf_package_loader_preload, lj_cf_package_loader_lua, lj_cf_package_loader_c, lj_cf_package_loader_croot, NULL }; LUALIB_API int luaopen_package(lua_State *L) { int i; int noenv; luaL_newmetatable(L, "_LOADLIB"); lj_lib_pushcf(L, lj_cf_package_unloadlib, 1); lua_setfield(L, -2, "__gc"); luaL_register(L, LUA_LOADLIBNAME, package_lib); lua_pushvalue(L, -1); lua_replace(L, LUA_ENVIRONINDEX); lua_createtable(L, sizeof(package_loaders)/sizeof(package_loaders[0])-1, 0); for (i = 0; package_loaders[i] != NULL; i++) { lj_lib_pushcf(L, package_loaders[i], 1); lua_rawseti(L, -2, i+1); } lua_setfield(L, -2, "loaders"); lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV"); noenv = lua_toboolean(L, -1); lua_pop(L, 1); setpath(L, "path", LUA_PATH, LUA_PATH_DEFAULT, noenv); setpath(L, "cpath", LUA_CPATH, LUA_CPATH_DEFAULT, noenv); lua_pushliteral(L, LUA_PATH_CONFIG); lua_setfield(L, -2, "config"); luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 16); lua_setfield(L, -2, "loaded"); luaL_findtable(L, LUA_REGISTRYINDEX, "_PRELOAD", 4); lua_setfield(L, -2, "preload"); lua_pushvalue(L, LUA_GLOBALSINDEX); luaL_register(L, NULL, package_global); lua_pop(L, 1); return 1; } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_crecord.h0000644000175000017500000000255013122010155017152 0ustar philphil/* ** Trace recorder for C data operations. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CRECORD_H #define _LJ_CRECORD_H #include "lj_obj.h" #include "lj_jit.h" #include "lj_ffrecord.h" #if LJ_HASJIT && LJ_HASFFI LJ_FUNC void LJ_FASTCALL recff_cdata_index(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_cdata_call(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_cdata_arith(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_clib_index(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_new(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_errno(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_string(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_copy(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_fill(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_typeof(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_istype(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_abi(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_xof(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL recff_ffi_gc(jit_State *J, RecordFFData *rd); LJ_FUNC void LJ_FASTCALL lj_crecord_tonumber(jit_State *J, RecordFFData *rd); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_carith.c0000644000175000017500000002361713122010155017005 0ustar philphil/* ** C data arithmetic. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_tab.h" #include "lj_meta.h" #include "lj_ctype.h" #include "lj_cconv.h" #include "lj_cdata.h" #include "lj_carith.h" /* -- C data arithmetic --------------------------------------------------- */ /* Binary operands of an operator converted to ctypes. */ typedef struct CDArith { uint8_t *p[2]; CType *ct[2]; } CDArith; /* Check arguments for arithmetic metamethods. */ static int carith_checkarg(lua_State *L, CTState *cts, CDArith *ca) { TValue *o = L->base; int ok = 1; MSize i; if (o+1 >= L->top) lj_err_argt(L, 1, LUA_TCDATA); for (i = 0; i < 2; i++, o++) { if (tviscdata(o)) { GCcdata *cd = cdataV(o); CTypeID id = (CTypeID)cd->ctypeid; CType *ct = ctype_raw(cts, id); uint8_t *p = (uint8_t *)cdataptr(cd); if (ctype_isptr(ct->info)) { p = (uint8_t *)cdata_getptr(p, ct->size); if (ctype_isref(ct->info)) ct = ctype_rawchild(cts, ct); } else if (ctype_isfunc(ct->info)) { p = (uint8_t *)*(void **)p; ct = ctype_get(cts, lj_ctype_intern(cts, CTINFO(CT_PTR, CTALIGN_PTR|id), CTSIZE_PTR)); } if (ctype_isenum(ct->info)) ct = ctype_child(cts, ct); ca->ct[i] = ct; ca->p[i] = p; } else if (tvisint(o)) { ca->ct[i] = ctype_get(cts, CTID_INT32); ca->p[i] = (uint8_t *)&o->i; } else if (tvisnum(o)) { ca->ct[i] = ctype_get(cts, CTID_DOUBLE); ca->p[i] = (uint8_t *)&o->n; } else if (tvisnil(o)) { ca->ct[i] = ctype_get(cts, CTID_P_VOID); ca->p[i] = (uint8_t *)0; } else if (tvisstr(o)) { TValue *o2 = i == 0 ? o+1 : o-1; CType *ct = ctype_raw(cts, cdataV(o2)->ctypeid); ca->ct[i] = NULL; ca->p[i] = (uint8_t *)strVdata(o); ok = 0; if (ctype_isenum(ct->info)) { CTSize ofs; CType *cct = lj_ctype_getfield(cts, ct, strV(o), &ofs); if (cct && ctype_isconstval(cct->info)) { ca->ct[i] = ctype_child(cts, cct); ca->p[i] = (uint8_t *)&cct->size; /* Assumes ct does not grow. */ ok = 1; } else { ca->ct[1-i] = ct; /* Use enum to improve error message. */ ca->p[1-i] = NULL; break; } } } else { ca->ct[i] = NULL; ca->p[i] = (void *)(intptr_t)1; /* To make it unequal. */ ok = 0; } } return ok; } /* Pointer arithmetic. */ static int carith_ptr(lua_State *L, CTState *cts, CDArith *ca, MMS mm) { CType *ctp = ca->ct[0]; uint8_t *pp = ca->p[0]; ptrdiff_t idx; CTSize sz; CTypeID id; GCcdata *cd; if (ctype_isptr(ctp->info) || ctype_isrefarray(ctp->info)) { if ((mm == MM_sub || mm == MM_eq || mm == MM_lt || mm == MM_le) && (ctype_isptr(ca->ct[1]->info) || ctype_isrefarray(ca->ct[1]->info))) { uint8_t *pp2 = ca->p[1]; if (mm == MM_eq) { /* Pointer equality. Incompatible pointers are ok. */ setboolV(L->top-1, (pp == pp2)); return 1; } if (!lj_cconv_compatptr(cts, ctp, ca->ct[1], CCF_IGNQUAL)) return 0; if (mm == MM_sub) { /* Pointer difference. */ intptr_t diff; sz = lj_ctype_size(cts, ctype_cid(ctp->info)); /* Element size. */ if (sz == 0 || sz == CTSIZE_INVALID) return 0; diff = ((intptr_t)pp - (intptr_t)pp2) / (int32_t)sz; /* All valid pointer differences on x64 are in (-2^47, +2^47), ** which fits into a double without loss of precision. */ setintptrV(L->top-1, (int32_t)diff); return 1; } else if (mm == MM_lt) { /* Pointer comparison (unsigned). */ setboolV(L->top-1, ((uintptr_t)pp < (uintptr_t)pp2)); return 1; } else { lua_assert(mm == MM_le); setboolV(L->top-1, ((uintptr_t)pp <= (uintptr_t)pp2)); return 1; } } if (!((mm == MM_add || mm == MM_sub) && ctype_isnum(ca->ct[1]->info))) return 0; lj_cconv_ct_ct(cts, ctype_get(cts, CTID_INT_PSZ), ca->ct[1], (uint8_t *)&idx, ca->p[1], 0); if (mm == MM_sub) idx = -idx; } else if (mm == MM_add && ctype_isnum(ctp->info) && (ctype_isptr(ca->ct[1]->info) || ctype_isrefarray(ca->ct[1]->info))) { /* Swap pointer and index. */ ctp = ca->ct[1]; pp = ca->p[1]; lj_cconv_ct_ct(cts, ctype_get(cts, CTID_INT_PSZ), ca->ct[0], (uint8_t *)&idx, ca->p[0], 0); } else { return 0; } sz = lj_ctype_size(cts, ctype_cid(ctp->info)); /* Element size. */ if (sz == CTSIZE_INVALID) return 0; pp += idx*(int32_t)sz; /* Compute pointer + index. */ id = lj_ctype_intern(cts, CTINFO(CT_PTR, CTALIGN_PTR|ctype_cid(ctp->info)), CTSIZE_PTR); cd = lj_cdata_new(cts, id, CTSIZE_PTR); *(uint8_t **)cdataptr(cd) = pp; setcdataV(L, L->top-1, cd); lj_gc_check(L); return 1; } /* 64 bit integer arithmetic. */ static int carith_int64(lua_State *L, CTState *cts, CDArith *ca, MMS mm) { if (ctype_isnum(ca->ct[0]->info) && ca->ct[0]->size <= 8 && ctype_isnum(ca->ct[1]->info) && ca->ct[1]->size <= 8) { CTypeID id = (((ca->ct[0]->info & CTF_UNSIGNED) && ca->ct[0]->size == 8) || ((ca->ct[1]->info & CTF_UNSIGNED) && ca->ct[1]->size == 8)) ? CTID_UINT64 : CTID_INT64; CType *ct = ctype_get(cts, id); GCcdata *cd; uint64_t u0, u1, *up; lj_cconv_ct_ct(cts, ct, ca->ct[0], (uint8_t *)&u0, ca->p[0], 0); if (mm != MM_unm) lj_cconv_ct_ct(cts, ct, ca->ct[1], (uint8_t *)&u1, ca->p[1], 0); switch (mm) { case MM_eq: setboolV(L->top-1, (u0 == u1)); return 1; case MM_lt: setboolV(L->top-1, id == CTID_INT64 ? ((int64_t)u0 < (int64_t)u1) : (u0 < u1)); return 1; case MM_le: setboolV(L->top-1, id == CTID_INT64 ? ((int64_t)u0 <= (int64_t)u1) : (u0 <= u1)); return 1; default: break; } cd = lj_cdata_new(cts, id, 8); up = (uint64_t *)cdataptr(cd); setcdataV(L, L->top-1, cd); switch (mm) { case MM_add: *up = u0 + u1; break; case MM_sub: *up = u0 - u1; break; case MM_mul: *up = u0 * u1; break; case MM_div: if (id == CTID_INT64) *up = (uint64_t)lj_carith_divi64((int64_t)u0, (int64_t)u1); else *up = lj_carith_divu64(u0, u1); break; case MM_mod: if (id == CTID_INT64) *up = (uint64_t)lj_carith_modi64((int64_t)u0, (int64_t)u1); else *up = lj_carith_modu64(u0, u1); break; case MM_pow: if (id == CTID_INT64) *up = (uint64_t)lj_carith_powi64((int64_t)u0, (int64_t)u1); else *up = lj_carith_powu64(u0, u1); break; case MM_unm: *up = (uint64_t)-(int64_t)u0; break; default: lua_assert(0); break; } lj_gc_check(L); return 1; } return 0; } /* Handle ctype arithmetic metamethods. */ static int lj_carith_meta(lua_State *L, CTState *cts, CDArith *ca, MMS mm) { cTValue *tv = NULL; if (tviscdata(L->base)) { CTypeID id = cdataV(L->base)->ctypeid; CType *ct = ctype_raw(cts, id); if (ctype_isptr(ct->info)) id = ctype_cid(ct->info); tv = lj_ctype_meta(cts, id, mm); } if (!tv && L->base+1 < L->top && tviscdata(L->base+1)) { CTypeID id = cdataV(L->base+1)->ctypeid; CType *ct = ctype_raw(cts, id); if (ctype_isptr(ct->info)) id = ctype_cid(ct->info); tv = lj_ctype_meta(cts, id, mm); } if (!tv) { const char *repr[2]; int i, isenum = -1, isstr = -1; if (mm == MM_eq) { /* Equality checks never raise an error. */ int eq = ca->p[0] == ca->p[1]; setboolV(L->top-1, eq); setboolV(&G(L)->tmptv2, eq); /* Remember for trace recorder. */ return 1; } for (i = 0; i < 2; i++) { if (ca->ct[i] && tviscdata(L->base+i)) { if (ctype_isenum(ca->ct[i]->info)) isenum = i; repr[i] = strdata(lj_ctype_repr(L, ctype_typeid(cts, ca->ct[i]), NULL)); } else { if (tvisstr(&L->base[i])) isstr = i; repr[i] = lj_typename(&L->base[i]); } } if ((isenum ^ isstr) == 1) lj_err_callerv(L, LJ_ERR_FFI_BADCONV, repr[isstr], repr[isenum]); lj_err_callerv(L, mm == MM_len ? LJ_ERR_FFI_BADLEN : mm == MM_concat ? LJ_ERR_FFI_BADCONCAT : mm < MM_add ? LJ_ERR_FFI_BADCOMP : LJ_ERR_FFI_BADARITH, repr[0], repr[1]); } return lj_meta_tailcall(L, tv); } /* Arithmetic operators for cdata. */ int lj_carith_op(lua_State *L, MMS mm) { CTState *cts = ctype_cts(L); CDArith ca; if (carith_checkarg(L, cts, &ca)) { if (carith_int64(L, cts, &ca, mm) || carith_ptr(L, cts, &ca, mm)) { copyTV(L, &G(L)->tmptv2, L->top-1); /* Remember for trace recorder. */ return 1; } } return lj_carith_meta(L, cts, &ca, mm); } /* -- 64 bit integer arithmetic helpers ----------------------------------- */ #if LJ_32 && LJ_HASJIT /* Signed/unsigned 64 bit multiplication. */ int64_t lj_carith_mul64(int64_t a, int64_t b) { return a * b; } #endif /* Unsigned 64 bit division. */ uint64_t lj_carith_divu64(uint64_t a, uint64_t b) { if (b == 0) return U64x(80000000,00000000); return a / b; } /* Signed 64 bit division. */ int64_t lj_carith_divi64(int64_t a, int64_t b) { if (b == 0 || (a == (int64_t)U64x(80000000,00000000) && b == -1)) return U64x(80000000,00000000); return a / b; } /* Unsigned 64 bit modulo. */ uint64_t lj_carith_modu64(uint64_t a, uint64_t b) { if (b == 0) return U64x(80000000,00000000); return a % b; } /* Signed 64 bit modulo. */ int64_t lj_carith_modi64(int64_t a, int64_t b) { if (b == 0) return U64x(80000000,00000000); if (a == (int64_t)U64x(80000000,00000000) && b == -1) return 0; return a % b; } /* Unsigned 64 bit x^k. */ uint64_t lj_carith_powu64(uint64_t x, uint64_t k) { uint64_t y; if (k == 0) return 1; for (; (k & 1) == 0; k >>= 1) x *= x; y = x; if ((k >>= 1) != 0) { for (;;) { x *= x; if (k == 1) break; if (k & 1) y *= x; k >>= 1; } y *= x; } return y; } /* Signed 64 bit x^k. */ int64_t lj_carith_powi64(int64_t x, int64_t k) { if (k == 0) return 1; if (k < 0) { if (x == 0) return U64x(7fffffff,ffffffff); else if (x == 1) return 1; else if (x == -1) return (k & 1) ? -1 : 1; else return 0; } return (int64_t)lj_carith_powu64((uint64_t)x, (uint64_t)k); } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_bcdump.h0000644000175000017500000000362013122010155017002 0ustar philphil/* ** Bytecode dump definitions. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_BCDUMP_H #define _LJ_BCDUMP_H #include "lj_obj.h" #include "lj_lex.h" /* -- Bytecode dump format ------------------------------------------------ */ /* ** dump = header proto+ 0U ** header = ESC 'L' 'J' versionB flagsU [namelenU nameB*] ** proto = lengthU pdata ** pdata = phead bcinsW* uvdataH* kgc* knum* [debugB*] ** phead = flagsB numparamsB framesizeB numuvB numkgcU numknU numbcU ** [debuglenU [firstlineU numlineU]] ** kgc = kgctypeU { ktab | (loU hiU) | (rloU rhiU iloU ihiU) | strB* } ** knum = intU0 | (loU1 hiU) ** ktab = narrayU nhashU karray* khash* ** karray = ktabk ** khash = ktabk ktabk ** ktabk = ktabtypeU { intU | (loU hiU) | strB* } ** ** B = 8 bit, H = 16 bit, W = 32 bit, U = ULEB128 of W, U0/U1 = ULEB128 of W+1 */ /* Bytecode dump header. */ #define BCDUMP_HEAD1 0x1b #define BCDUMP_HEAD2 0x4c #define BCDUMP_HEAD3 0x4a /* If you perform *any* kind of private modifications to the bytecode itself ** or to the dump format, you *must* set BCDUMP_VERSION to 0x80 or higher. */ #define BCDUMP_VERSION 1 /* Compatibility flags. */ #define BCDUMP_F_BE 0x01 #define BCDUMP_F_STRIP 0x02 #define BCDUMP_F_FFI 0x04 #define BCDUMP_F_KNOWN (BCDUMP_F_FFI*2-1) /* Type codes for the GC constants of a prototype. Plus length for strings. */ enum { BCDUMP_KGC_CHILD, BCDUMP_KGC_TAB, BCDUMP_KGC_I64, BCDUMP_KGC_U64, BCDUMP_KGC_COMPLEX, BCDUMP_KGC_STR }; /* Type codes for the keys/values of a constant table. */ enum { BCDUMP_KTAB_NIL, BCDUMP_KTAB_FALSE, BCDUMP_KTAB_TRUE, BCDUMP_KTAB_INT, BCDUMP_KTAB_NUM, BCDUMP_KTAB_STR }; /* -- Bytecode reader/writer ---------------------------------------------- */ LJ_FUNC int lj_bcwrite(lua_State *L, GCproto *pt, lua_Writer writer, void *data, int strip); LJ_FUNC GCproto *lj_bcread(LexState *ls); #endif wcc-0.0.2/src/wsh/luajit-2.0/src/Makefile.dep0000644000175000017500000003273613122010155017113 0ustar philphillib_aux.o: lib_aux.c lua.h luaconf.h lauxlib.h lj_obj.h lj_def.h \ lj_arch.h lj_err.h lj_errmsg.h lj_state.h lj_trace.h lj_jit.h lj_ir.h \ lj_dispatch.h lj_bc.h lj_traceerr.h lj_lib.h lj_alloc.h lib_base.o: lib_base.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h \ lj_def.h lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_debug.h lj_str.h \ lj_tab.h lj_meta.h lj_state.h lj_ctype.h lj_cconv.h lj_bc.h lj_ff.h \ lj_ffdef.h lj_dispatch.h lj_jit.h lj_ir.h lj_char.h lj_strscan.h \ lj_lib.h lj_libdef.h lib_bit.o: lib_bit.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h lj_def.h \ lj_arch.h lj_err.h lj_errmsg.h lj_str.h lj_lib.h lj_libdef.h lib_debug.o: lib_debug.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h \ lj_def.h lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_debug.h lj_lib.h \ lj_libdef.h lib_ffi.o: lib_ffi.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h lj_def.h \ lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_meta.h \ lj_ctype.h lj_cparse.h lj_cdata.h lj_cconv.h lj_carith.h lj_ccall.h \ lj_ccallback.h lj_clib.h lj_ff.h lj_ffdef.h lj_lib.h lj_libdef.h lib_init.o: lib_init.c lua.h luaconf.h lauxlib.h lualib.h lj_arch.h lib_io.o: lib_io.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h lj_def.h \ lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_state.h lj_ff.h \ lj_ffdef.h lj_lib.h lj_libdef.h lib_jit.o: lib_jit.c lua.h luaconf.h lauxlib.h lualib.h lj_arch.h \ lj_obj.h lj_def.h lj_err.h lj_errmsg.h lj_debug.h lj_str.h lj_tab.h \ lj_bc.h lj_ir.h lj_jit.h lj_ircall.h lj_iropt.h lj_target.h \ lj_target_*.h lj_dispatch.h lj_vm.h lj_vmevent.h lj_lib.h luajit.h \ lj_libdef.h lib_math.o: lib_math.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h \ lj_def.h lj_arch.h lj_lib.h lj_vm.h lj_libdef.h lib_os.o: lib_os.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h lj_def.h \ lj_arch.h lj_err.h lj_errmsg.h lj_lib.h lj_libdef.h lib_package.o: lib_package.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h \ lj_def.h lj_arch.h lj_err.h lj_errmsg.h lj_lib.h lib_string.o: lib_string.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h \ lj_def.h lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h \ lj_meta.h lj_state.h lj_ff.h lj_ffdef.h lj_bcdump.h lj_lex.h lj_char.h \ lj_lib.h lj_libdef.h lib_table.o: lib_table.c lua.h luaconf.h lauxlib.h lualib.h lj_obj.h \ lj_def.h lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_tab.h lj_lib.h \ lj_libdef.h lj_alloc.o: lj_alloc.c lj_def.h lua.h luaconf.h lj_arch.h lj_alloc.h lj_api.o: lj_api.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_err.h lj_errmsg.h lj_debug.h lj_str.h lj_tab.h lj_func.h lj_udata.h \ lj_meta.h lj_state.h lj_bc.h lj_frame.h lj_trace.h lj_jit.h lj_ir.h \ lj_dispatch.h lj_traceerr.h lj_vm.h lj_strscan.h lj_asm.o: lj_asm.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_str.h lj_tab.h lj_frame.h lj_bc.h lj_ctype.h lj_ir.h lj_jit.h \ lj_ircall.h lj_iropt.h lj_mcode.h lj_trace.h lj_dispatch.h lj_traceerr.h \ lj_snap.h lj_asm.h lj_vm.h lj_target.h lj_target_*.h lj_emit_*.h \ lj_asm_*.h lj_bc.o: lj_bc.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_bc.h \ lj_bcdef.h lj_bcread.o: lj_bcread.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_bc.h lj_ctype.h \ lj_cdata.h lualib.h lj_lex.h lj_bcdump.h lj_state.h lj_bcwrite.o: lj_bcwrite.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_str.h lj_bc.h lj_ctype.h lj_dispatch.h lj_jit.h lj_ir.h \ lj_bcdump.h lj_lex.h lj_err.h lj_errmsg.h lj_vm.h lj_carith.o: lj_carith.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_tab.h lj_meta.h lj_ctype.h lj_cconv.h \ lj_cdata.h lj_carith.h lj_ccall.o: lj_ccall.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_ctype.h lj_cconv.h \ lj_cdata.h lj_ccall.h lj_trace.h lj_jit.h lj_ir.h lj_dispatch.h lj_bc.h \ lj_traceerr.h lj_ccallback.o: lj_ccallback.c lj_obj.h lua.h luaconf.h lj_def.h \ lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_tab.h lj_state.h lj_frame.h \ lj_bc.h lj_ctype.h lj_cconv.h lj_ccall.h lj_ccallback.h lj_target.h \ lj_target_*.h lj_mcode.h lj_jit.h lj_ir.h lj_trace.h lj_dispatch.h \ lj_traceerr.h lj_vm.h lj_cconv.o: lj_cconv.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_err.h lj_errmsg.h lj_tab.h lj_ctype.h lj_gc.h lj_cdata.h lj_cconv.h \ lj_ccallback.h lj_cdata.o: lj_cdata.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_ctype.h lj_cconv.h \ lj_cdata.h lj_char.o: lj_char.c lj_char.h lj_def.h lua.h luaconf.h lj_clib.o: lj_clib.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_err.h lj_errmsg.h lj_tab.h lj_str.h lj_udata.h lj_ctype.h lj_cconv.h \ lj_cdata.h lj_clib.h lj_cparse.o: lj_cparse.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_ctype.h lj_cparse.h lj_frame.h \ lj_bc.h lj_vm.h lj_char.h lj_strscan.h lj_crecord.o: lj_crecord.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_frame.h lj_bc.h lj_ctype.h \ lj_gc.h lj_cdata.h lj_cparse.h lj_cconv.h lj_clib.h lj_ccall.h lj_ff.h \ lj_ffdef.h lj_ir.h lj_jit.h lj_ircall.h lj_iropt.h lj_trace.h \ lj_dispatch.h lj_traceerr.h lj_record.h lj_ffrecord.h lj_snap.h \ lj_crecord.h lj_ctype.o: lj_ctype.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_ctype.h lj_ccallback.h lj_debug.o: lj_debug.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_err.h lj_errmsg.h lj_debug.h lj_str.h lj_tab.h lj_state.h lj_frame.h \ lj_bc.h lj_vm.h lj_jit.h lj_ir.h lj_dispatch.o: lj_dispatch.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_err.h lj_errmsg.h lj_func.h lj_str.h lj_tab.h lj_meta.h lj_debug.h \ lj_state.h lj_frame.h lj_bc.h lj_ff.h lj_ffdef.h lj_jit.h lj_ir.h \ lj_ccallback.h lj_ctype.h lj_gc.h lj_trace.h lj_dispatch.h lj_traceerr.h \ lj_vm.h luajit.h lj_err.o: lj_err.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_err.h \ lj_errmsg.h lj_debug.h lj_str.h lj_func.h lj_state.h lj_frame.h lj_bc.h \ lj_ff.h lj_ffdef.h lj_trace.h lj_jit.h lj_ir.h lj_dispatch.h \ lj_traceerr.h lj_vm.h lj_ffrecord.o: lj_ffrecord.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_frame.h lj_bc.h lj_ff.h \ lj_ffdef.h lj_ir.h lj_jit.h lj_ircall.h lj_iropt.h lj_trace.h \ lj_dispatch.h lj_traceerr.h lj_record.h lj_ffrecord.h lj_crecord.h \ lj_vm.h lj_strscan.h lj_recdef.h lj_func.o: lj_func.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_func.h lj_trace.h lj_jit.h lj_ir.h lj_dispatch.h lj_bc.h \ lj_traceerr.h lj_vm.h lj_gc.o: lj_gc.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_func.h lj_udata.h lj_meta.h \ lj_state.h lj_frame.h lj_bc.h lj_ctype.h lj_cdata.h lj_trace.h lj_jit.h \ lj_ir.h lj_dispatch.h lj_traceerr.h lj_vm.h lj_gdbjit.o: lj_gdbjit.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_debug.h lj_frame.h lj_bc.h lj_jit.h \ lj_ir.h lj_dispatch.h lj_ir.o: lj_ir.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_str.h lj_tab.h lj_ir.h lj_jit.h lj_ircall.h lj_iropt.h lj_trace.h \ lj_dispatch.h lj_bc.h lj_traceerr.h lj_ctype.h lj_cdata.h lj_carith.h \ lj_vm.h lj_strscan.h lj_lib.h lj_lex.o: lj_lex.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_ctype.h lj_cdata.h lualib.h \ lj_state.h lj_lex.h lj_parse.h lj_char.h lj_strscan.h lj_lib.o: lj_lib.c lauxlib.h lua.h luaconf.h lj_obj.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_func.h lj_bc.h \ lj_dispatch.h lj_jit.h lj_ir.h lj_vm.h lj_strscan.h lj_lib.h lj_load.o: lj_load.c lua.h luaconf.h lauxlib.h lj_obj.h lj_def.h \ lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_func.h lj_frame.h \ lj_bc.h lj_vm.h lj_lex.h lj_bcdump.h lj_parse.h lj_mcode.o: lj_mcode.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_jit.h lj_ir.h lj_mcode.h lj_trace.h \ lj_dispatch.h lj_bc.h lj_traceerr.h lj_vm.h lj_meta.o: lj_meta.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_meta.h lj_frame.h lj_bc.h \ lj_vm.h lj_strscan.h lj_obj.o: lj_obj.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_opt_dce.o: lj_opt_dce.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_ir.h lj_jit.h lj_iropt.h lj_opt_fold.o: lj_opt_fold.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_str.h lj_tab.h lj_ir.h lj_jit.h lj_iropt.h lj_trace.h lj_dispatch.h \ lj_bc.h lj_traceerr.h lj_ctype.h lj_gc.h lj_carith.h lj_vm.h \ lj_strscan.h lj_folddef.h lj_opt_loop.o: lj_opt_loop.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_err.h lj_errmsg.h lj_str.h lj_ir.h lj_jit.h lj_iropt.h lj_trace.h \ lj_dispatch.h lj_bc.h lj_traceerr.h lj_snap.h lj_vm.h lj_opt_mem.o: lj_opt_mem.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_tab.h lj_ir.h lj_jit.h lj_iropt.h lj_opt_narrow.o: lj_opt_narrow.c lj_obj.h lua.h luaconf.h lj_def.h \ lj_arch.h lj_bc.h lj_ir.h lj_jit.h lj_iropt.h lj_trace.h lj_dispatch.h \ lj_traceerr.h lj_vm.h lj_strscan.h lj_opt_sink.o: lj_opt_sink.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_ir.h lj_jit.h lj_iropt.h lj_target.h lj_target_*.h lj_opt_split.o: lj_opt_split.c lj_obj.h lua.h luaconf.h lj_def.h \ lj_arch.h lj_err.h lj_errmsg.h lj_str.h lj_ir.h lj_jit.h lj_ircall.h \ lj_iropt.h lj_vm.h lj_parse.o: lj_parse.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_debug.h lj_str.h lj_tab.h lj_func.h \ lj_state.h lj_bc.h lj_ctype.h lj_lex.h lj_parse.h lj_vm.h lj_vmevent.h lj_record.o: lj_record.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_meta.h lj_frame.h lj_bc.h \ lj_ctype.h lj_gc.h lj_ff.h lj_ffdef.h lj_ir.h lj_jit.h lj_ircall.h \ lj_iropt.h lj_trace.h lj_dispatch.h lj_traceerr.h lj_record.h \ lj_ffrecord.h lj_snap.h lj_vm.h lj_snap.o: lj_snap.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_tab.h lj_state.h lj_frame.h lj_bc.h lj_ir.h lj_jit.h lj_iropt.h \ lj_trace.h lj_dispatch.h lj_traceerr.h lj_snap.h lj_target.h \ lj_target_*.h lj_ctype.h lj_cdata.h lj_state.o: lj_state.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_func.h lj_meta.h \ lj_state.h lj_frame.h lj_bc.h lj_ctype.h lj_trace.h lj_jit.h lj_ir.h \ lj_dispatch.h lj_traceerr.h lj_vm.h lj_lex.h lj_alloc.h lj_str.o: lj_str.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_err.h lj_errmsg.h lj_str.h lj_state.h lj_char.h lj_strscan.o: lj_strscan.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_char.h lj_strscan.h lj_tab.o: lj_tab.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h lj_gc.h \ lj_err.h lj_errmsg.h lj_tab.h lj_trace.o: lj_trace.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_err.h lj_errmsg.h lj_debug.h lj_str.h lj_frame.h lj_bc.h \ lj_state.h lj_ir.h lj_jit.h lj_iropt.h lj_mcode.h lj_trace.h \ lj_dispatch.h lj_traceerr.h lj_snap.h lj_gdbjit.h lj_record.h lj_asm.h \ lj_vm.h lj_vmevent.h lj_target.h lj_target_*.h lj_udata.o: lj_udata.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_gc.h lj_udata.h lj_vmevent.o: lj_vmevent.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_str.h lj_tab.h lj_state.h lj_dispatch.h lj_bc.h lj_jit.h lj_ir.h \ lj_vm.h lj_vmevent.h lj_vmmath.o: lj_vmmath.c lj_obj.h lua.h luaconf.h lj_def.h lj_arch.h \ lj_ir.h lj_vm.h ljamalg.o: ljamalg.c lua.h luaconf.h lauxlib.h lj_gc.c lj_obj.h lj_def.h \ lj_arch.h lj_gc.h lj_err.h lj_errmsg.h lj_str.h lj_tab.h lj_func.h \ lj_udata.h lj_meta.h lj_state.h lj_frame.h lj_bc.h lj_ctype.h lj_cdata.h \ lj_trace.h lj_jit.h lj_ir.h lj_dispatch.h lj_traceerr.h lj_vm.h lj_err.c \ lj_debug.h lj_ff.h lj_ffdef.h lj_char.c lj_char.h lj_bc.c lj_bcdef.h \ lj_obj.c lj_str.c lj_tab.c lj_func.c lj_udata.c lj_meta.c lj_strscan.h \ lj_debug.c lj_state.c lj_lex.h lj_alloc.h lj_dispatch.c lj_ccallback.h \ luajit.h lj_vmevent.c lj_vmevent.h lj_vmmath.c lj_strscan.c lj_api.c \ lj_lex.c lualib.h lj_parse.h lj_parse.c lj_bcread.c lj_bcdump.h \ lj_bcwrite.c lj_load.c lj_ctype.c lj_cdata.c lj_cconv.h lj_cconv.c \ lj_ccall.c lj_ccall.h lj_ccallback.c lj_target.h lj_target_*.h \ lj_mcode.h lj_carith.c lj_carith.h lj_clib.c lj_clib.h lj_cparse.c \ lj_cparse.h lj_lib.c lj_lib.h lj_ir.c lj_ircall.h lj_iropt.h \ lj_opt_mem.c lj_opt_fold.c lj_folddef.h lj_opt_narrow.c lj_opt_dce.c \ lj_opt_loop.c lj_snap.h lj_opt_split.c lj_opt_sink.c lj_mcode.c \ lj_snap.c lj_record.c lj_record.h lj_ffrecord.h lj_crecord.c \ lj_crecord.h lj_ffrecord.c lj_recdef.h lj_asm.c lj_asm.h lj_emit_*.h \ lj_asm_*.h lj_trace.c lj_gdbjit.h lj_gdbjit.c lj_alloc.c lib_aux.c \ lib_base.c lj_libdef.h lib_math.c lib_string.c lib_table.c lib_io.c \ lib_os.c lib_package.c lib_debug.c lib_bit.c lib_jit.c lib_ffi.c \ lib_init.c luajit.o: luajit.c lua.h luaconf.h lauxlib.h lualib.h luajit.h lj_arch.h host/buildvm.o: host/buildvm.c host/buildvm.h lj_def.h lua.h luaconf.h \ lj_arch.h lj_obj.h lj_def.h lj_arch.h lj_gc.h lj_obj.h lj_bc.h lj_ir.h \ lj_ircall.h lj_ir.h lj_jit.h lj_frame.h lj_bc.h lj_dispatch.h lj_ctype.h \ lj_gc.h lj_ccall.h lj_ctype.h luajit.h \ host/buildvm_arch.h lj_traceerr.h host/buildvm_asm.o: host/buildvm_asm.c host/buildvm.h lj_def.h lua.h luaconf.h \ lj_arch.h lj_bc.h lj_def.h lj_arch.h host/buildvm_fold.o: host/buildvm_fold.c host/buildvm.h lj_def.h lua.h \ luaconf.h lj_arch.h lj_obj.h lj_def.h lj_arch.h lj_ir.h lj_obj.h host/buildvm_lib.o: host/buildvm_lib.c host/buildvm.h lj_def.h lua.h luaconf.h \ lj_arch.h lj_obj.h lj_def.h lj_arch.h lj_lib.h lj_obj.h host/buildvm_peobj.o: host/buildvm_peobj.c host/buildvm.h lj_def.h lua.h \ luaconf.h lj_arch.h lj_bc.h lj_def.h lj_arch.h host/minilua.o: host/minilua.c wcc-0.0.2/src/wsh/luajit-2.0/src/lj_asm.h0000644000175000017500000000054413122010155016312 0ustar philphil/* ** IR assembler (SSA IR -> machine code). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_ASM_H #define _LJ_ASM_H #include "lj_jit.h" #if LJ_HASJIT LJ_FUNC void lj_asm_trace(jit_State *J, GCtrace *T); LJ_FUNC void lj_asm_patchexit(jit_State *J, GCtrace *T, ExitNo exitno, MCode *target); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_opt_narrow.c0000644000175000017500000006211413122010155017720 0ustar philphil/* ** NARROW: Narrowing of numbers to integers (double to int32_t). ** STRIPOV: Stripping of overflow checks. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_opt_narrow_c #define LUA_CORE #include "lj_obj.h" #if LJ_HASJIT #include "lj_bc.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" #include "lj_trace.h" #include "lj_vm.h" #include "lj_strscan.h" /* Rationale for narrowing optimizations: ** ** Lua has only a single number type and this is a FP double by default. ** Narrowing doubles to integers does not pay off for the interpreter on a ** current-generation x86/x64 machine. Most FP operations need the same ** amount of execution resources as their integer counterparts, except ** with slightly longer latencies. Longer latencies are a non-issue for ** the interpreter, since they are usually hidden by other overhead. ** ** The total CPU execution bandwidth is the sum of the bandwidth of the FP ** and the integer units, because they execute in parallel. The FP units ** have an equal or higher bandwidth than the integer units. Not using ** them means losing execution bandwidth. Moving work away from them to ** the already quite busy integer units is a losing proposition. ** ** The situation for JIT-compiled code is a bit different: the higher code ** density makes the extra latencies much more visible. Tight loops expose ** the latencies for updating the induction variables. Array indexing ** requires narrowing conversions with high latencies and additional ** guards (to check that the index is really an integer). And many common ** optimizations only work on integers. ** ** One solution would be speculative, eager narrowing of all number loads. ** This causes many problems, like losing -0 or the need to resolve type ** mismatches between traces. It also effectively forces the integer type ** to have overflow-checking semantics. This impedes many basic ** optimizations and requires adding overflow checks to all integer ** arithmetic operations (whereas FP arithmetics can do without). ** ** Always replacing an FP op with an integer op plus an overflow check is ** counter-productive on a current-generation super-scalar CPU. Although ** the overflow check branches are highly predictable, they will clog the ** execution port for the branch unit and tie up reorder buffers. This is ** turning a pure data-flow dependency into a different data-flow ** dependency (with slightly lower latency) *plus* a control dependency. ** In general, you don't want to do this since latencies due to data-flow ** dependencies can be well hidden by out-of-order execution. ** ** A better solution is to keep all numbers as FP values and only narrow ** when it's beneficial to do so. LuaJIT uses predictive narrowing for ** induction variables and demand-driven narrowing for index expressions, ** integer arguments and bit operations. Additionally it can eliminate or ** hoist most of the resulting overflow checks. Regular arithmetic ** computations are never narrowed to integers. ** ** The integer type in the IR has convenient wrap-around semantics and ** ignores overflow. Extra operations have been added for ** overflow-checking arithmetic (ADDOV/SUBOV) instead of an extra type. ** Apart from reducing overall complexity of the compiler, this also ** nicely solves the problem where you want to apply algebraic ** simplifications to ADD, but not to ADDOV. And the x86/x64 assembler can ** use lea instead of an add for integer ADD, but not for ADDOV (lea does ** not affect the flags, but it helps to avoid register moves). ** ** ** All of the above has to be reconsidered for architectures with slow FP ** operations or without a hardware FPU. The dual-number mode of LuaJIT ** addresses this issue. Arithmetic operations are performed on integers ** as far as possible and overflow checks are added as needed. ** ** This implies that narrowing for integer arguments and bit operations ** should also strip overflow checks, e.g. replace ADDOV with ADD. The ** original overflow guards are weak and can be eliminated by DCE, if ** there's no other use. ** ** A slight twist is that it's usually beneficial to use overflow-checked ** integer arithmetics if all inputs are already integers. This is the only ** change that affects the single-number mode, too. */ /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) #define fins (&J->fold.ins) /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) #define emitir_raw(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_ir_emit(J)) /* -- Elimination of narrowing type conversions --------------------------- */ /* Narrowing of index expressions and bit operations is demand-driven. The ** trace recorder emits a narrowing type conversion (CONV.int.num or TOBIT) ** in all of these cases (e.g. array indexing or string indexing). FOLD ** already takes care of eliminating simple redundant conversions like ** CONV.int.num(CONV.num.int(x)) ==> x. ** ** But the surrounding code is FP-heavy and arithmetic operations are ** performed on FP numbers (for the single-number mode). Consider a common ** example such as 'x=t[i+1]', with 'i' already an integer (due to induction ** variable narrowing). The index expression would be recorded as ** CONV.int.num(ADD(CONV.num.int(i), 1)) ** which is clearly suboptimal. ** ** One can do better by recursively backpropagating the narrowing type ** conversion across FP arithmetic operations. This turns FP ops into ** their corresponding integer counterparts. Depending on the semantics of ** the conversion they also need to check for overflow. Currently only ADD ** and SUB are supported. ** ** The above example can be rewritten as ** ADDOV(CONV.int.num(CONV.num.int(i)), 1) ** and then into ADDOV(i, 1) after folding of the conversions. The original ** FP ops remain in the IR and are eliminated by DCE since all references to ** them are gone. ** ** [In dual-number mode the trace recorder already emits ADDOV etc., but ** this can be further reduced. See below.] ** ** Special care has to be taken to avoid narrowing across an operation ** which is potentially operating on non-integral operands. One obvious ** case is when an expression contains a non-integral constant, but ends ** up as an integer index at runtime (like t[x+1.5] with x=0.5). ** ** Operations with two non-constant operands illustrate a similar problem ** (like t[a+b] with a=1.5 and b=2.5). Backpropagation has to stop there, ** unless it can be proven that either operand is integral (e.g. by CSEing ** a previous conversion). As a not-so-obvious corollary this logic also ** applies for a whole expression tree (e.g. t[(a+1)+(b+1)]). ** ** Correctness of the transformation is guaranteed by avoiding to expand ** the tree by adding more conversions than the one we would need to emit ** if not backpropagating. TOBIT employs a more optimistic rule, because ** the conversion has special semantics, designed to make the life of the ** compiler writer easier. ;-) ** ** Using on-the-fly backpropagation of an expression tree doesn't work ** because it's unknown whether the transform is correct until the end. ** This either requires IR rollback and cache invalidation for every ** subtree or a two-pass algorithm. The former didn't work out too well, ** so the code now combines a recursive collector with a stack-based ** emitter. ** ** [A recursive backpropagation algorithm with backtracking, employing ** skip-list lookup and round-robin caching, emitting stack operations ** on-the-fly for a stack-based interpreter -- and all of that in a meager ** kilobyte? Yep, compilers are a great treasure chest. Throw away your ** textbooks and read the codebase of a compiler today!] ** ** There's another optimization opportunity for array indexing: it's ** always accompanied by an array bounds-check. The outermost overflow ** check may be delegated to the ABC operation. This works because ABC is ** an unsigned comparison and wrap-around due to overflow creates negative ** numbers. ** ** But this optimization is only valid for constants that cannot overflow ** an int32_t into the range of valid array indexes [0..2^27+1). A check ** for +-2^30 is safe since -2^31 - 2^30 wraps to 2^30 and 2^31-1 + 2^30 ** wraps to -2^30-1. ** ** It's also good enough in practice, since e.g. t[i+1] or t[i-10] are ** quite common. So the above example finally ends up as ADD(i, 1)! ** ** Later on, the assembler is able to fuse the whole array reference and ** the ADD into the memory operands of loads and other instructions. This ** is why LuaJIT is able to generate very pretty (and fast) machine code ** for array indexing. And that, my dear, concludes another story about ** one of the hidden secrets of LuaJIT ... */ /* Maximum backpropagation depth and maximum stack size. */ #define NARROW_MAX_BACKPROP 100 #define NARROW_MAX_STACK 256 /* The stack machine has a 32 bit instruction format: [IROpT | IRRef1] ** The lower 16 bits hold a reference (or 0). The upper 16 bits hold ** the IR opcode + type or one of the following special opcodes: */ enum { NARROW_REF, /* Push ref. */ NARROW_CONV, /* Push conversion of ref. */ NARROW_SEXT, /* Push sign-extension of ref. */ NARROW_INT /* Push KINT ref. The next code holds an int32_t. */ }; typedef uint32_t NarrowIns; #define NARROWINS(op, ref) (((op) << 16) + (ref)) #define narrow_op(ins) ((IROpT)((ins) >> 16)) #define narrow_ref(ins) ((IRRef1)(ins)) /* Context used for narrowing of type conversions. */ typedef struct NarrowConv { jit_State *J; /* JIT compiler state. */ NarrowIns *sp; /* Current stack pointer. */ NarrowIns *maxsp; /* Maximum stack pointer minus redzone. */ IRRef mode; /* Conversion mode (IRCONV_*). */ IRType t; /* Destination type: IRT_INT or IRT_I64. */ NarrowIns stack[NARROW_MAX_STACK]; /* Stack holding stack-machine code. */ } NarrowConv; /* Lookup a reference in the backpropagation cache. */ static BPropEntry *narrow_bpc_get(jit_State *J, IRRef1 key, IRRef mode) { ptrdiff_t i; for (i = 0; i < BPROP_SLOTS; i++) { BPropEntry *bp = &J->bpropcache[i]; /* Stronger checks are ok, too. */ if (bp->key == key && bp->mode >= mode && ((bp->mode ^ mode) & IRCONV_MODEMASK) == 0) return bp; } return NULL; } /* Add an entry to the backpropagation cache. */ static void narrow_bpc_set(jit_State *J, IRRef1 key, IRRef1 val, IRRef mode) { uint32_t slot = J->bpropslot; BPropEntry *bp = &J->bpropcache[slot]; J->bpropslot = (slot + 1) & (BPROP_SLOTS-1); bp->key = key; bp->val = val; bp->mode = mode; } /* Backpropagate overflow stripping. */ static void narrow_stripov_backprop(NarrowConv *nc, IRRef ref, int depth) { jit_State *J = nc->J; IRIns *ir = IR(ref); if (ir->o == IR_ADDOV || ir->o == IR_SUBOV || (ir->o == IR_MULOV && (nc->mode & IRCONV_CONVMASK) == IRCONV_ANY)) { BPropEntry *bp = narrow_bpc_get(nc->J, ref, IRCONV_TOBIT); if (bp) { ref = bp->val; } else if (++depth < NARROW_MAX_BACKPROP && nc->sp < nc->maxsp) { NarrowIns *savesp = nc->sp; narrow_stripov_backprop(nc, ir->op1, depth); if (nc->sp < nc->maxsp) { narrow_stripov_backprop(nc, ir->op2, depth); if (nc->sp < nc->maxsp) { *nc->sp++ = NARROWINS(IRT(ir->o - IR_ADDOV + IR_ADD, IRT_INT), ref); return; } } nc->sp = savesp; /* Path too deep, need to backtrack. */ } } *nc->sp++ = NARROWINS(NARROW_REF, ref); } /* Backpropagate narrowing conversion. Return number of needed conversions. */ static int narrow_conv_backprop(NarrowConv *nc, IRRef ref, int depth) { jit_State *J = nc->J; IRIns *ir = IR(ref); IRRef cref; if (nc->sp >= nc->maxsp) return 10; /* Path too deep. */ /* Check the easy cases first. */ if (ir->o == IR_CONV && (ir->op2 & IRCONV_SRCMASK) == IRT_INT) { if ((nc->mode & IRCONV_CONVMASK) <= IRCONV_ANY) narrow_stripov_backprop(nc, ir->op1, depth+1); else *nc->sp++ = NARROWINS(NARROW_REF, ir->op1); /* Undo conversion. */ if (nc->t == IRT_I64) *nc->sp++ = NARROWINS(NARROW_SEXT, 0); /* Sign-extend integer. */ return 0; } else if (ir->o == IR_KNUM) { /* Narrow FP constant. */ lua_Number n = ir_knum(ir)->n; if ((nc->mode & IRCONV_CONVMASK) == IRCONV_TOBIT) { /* Allows a wider range of constants. */ int64_t k64 = (int64_t)n; if (n == (lua_Number)k64) { /* Only if const doesn't lose precision. */ *nc->sp++ = NARROWINS(NARROW_INT, 0); *nc->sp++ = (NarrowIns)k64; /* But always truncate to 32 bits. */ return 0; } } else { int32_t k = lj_num2int(n); /* Only if constant is a small integer. */ if (checki16(k) && n == (lua_Number)k) { *nc->sp++ = NARROWINS(NARROW_INT, 0); *nc->sp++ = (NarrowIns)k; return 0; } } return 10; /* Never narrow other FP constants (this is rare). */ } /* Try to CSE the conversion. Stronger checks are ok, too. */ cref = J->chain[fins->o]; while (cref > ref) { IRIns *cr = IR(cref); if (cr->op1 == ref && (fins->o == IR_TOBIT || ((cr->op2 & IRCONV_MODEMASK) == (nc->mode & IRCONV_MODEMASK) && irt_isguard(cr->t) >= irt_isguard(fins->t)))) { *nc->sp++ = NARROWINS(NARROW_REF, cref); return 0; /* Already there, no additional conversion needed. */ } cref = cr->prev; } /* Backpropagate across ADD/SUB. */ if (ir->o == IR_ADD || ir->o == IR_SUB) { /* Try cache lookup first. */ IRRef mode = nc->mode; BPropEntry *bp; /* Inner conversions need a stronger check. */ if ((mode & IRCONV_CONVMASK) == IRCONV_INDEX && depth > 0) mode += IRCONV_CHECK-IRCONV_INDEX; bp = narrow_bpc_get(nc->J, (IRRef1)ref, mode); if (bp) { *nc->sp++ = NARROWINS(NARROW_REF, bp->val); return 0; } else if (nc->t == IRT_I64) { /* Try sign-extending from an existing (checked) conversion to int. */ mode = (IRT_INT<<5)|IRT_NUM|IRCONV_INDEX; bp = narrow_bpc_get(nc->J, (IRRef1)ref, mode); if (bp) { *nc->sp++ = NARROWINS(NARROW_REF, bp->val); *nc->sp++ = NARROWINS(NARROW_SEXT, 0); return 0; } } if (++depth < NARROW_MAX_BACKPROP && nc->sp < nc->maxsp) { NarrowIns *savesp = nc->sp; int count = narrow_conv_backprop(nc, ir->op1, depth); count += narrow_conv_backprop(nc, ir->op2, depth); if (count <= 1) { /* Limit total number of conversions. */ *nc->sp++ = NARROWINS(IRT(ir->o, nc->t), ref); return count; } nc->sp = savesp; /* Too many conversions, need to backtrack. */ } } /* Otherwise add a conversion. */ *nc->sp++ = NARROWINS(NARROW_CONV, ref); return 1; } /* Emit the conversions collected during backpropagation. */ static IRRef narrow_conv_emit(jit_State *J, NarrowConv *nc) { /* The fins fields must be saved now -- emitir() overwrites them. */ IROpT guardot = irt_isguard(fins->t) ? IRTG(IR_ADDOV-IR_ADD, 0) : 0; IROpT convot = fins->ot; IRRef1 convop2 = fins->op2; NarrowIns *next = nc->stack; /* List of instructions from backpropagation. */ NarrowIns *last = nc->sp; NarrowIns *sp = nc->stack; /* Recycle the stack to store operands. */ while (next < last) { /* Simple stack machine to process the ins. list. */ NarrowIns ref = *next++; IROpT op = narrow_op(ref); if (op == NARROW_REF) { *sp++ = ref; } else if (op == NARROW_CONV) { *sp++ = emitir_raw(convot, ref, convop2); /* Raw emit avoids a loop. */ } else if (op == NARROW_SEXT) { lua_assert(sp >= nc->stack+1); sp[-1] = emitir(IRT(IR_CONV, IRT_I64), sp[-1], (IRT_I64<<5)|IRT_INT|IRCONV_SEXT); } else if (op == NARROW_INT) { lua_assert(next < last); *sp++ = nc->t == IRT_I64 ? lj_ir_kint64(J, (int64_t)(int32_t)*next++) : lj_ir_kint(J, *next++); } else { /* Regular IROpT. Pops two operands and pushes one result. */ IRRef mode = nc->mode; lua_assert(sp >= nc->stack+2); sp--; /* Omit some overflow checks for array indexing. See comments above. */ if ((mode & IRCONV_CONVMASK) == IRCONV_INDEX) { if (next == last && irref_isk(narrow_ref(sp[0])) && (uint32_t)IR(narrow_ref(sp[0]))->i + 0x40000000u < 0x80000000u) guardot = 0; else /* Otherwise cache a stronger check. */ mode += IRCONV_CHECK-IRCONV_INDEX; } sp[-1] = emitir(op+guardot, sp[-1], sp[0]); /* Add to cache. */ if (narrow_ref(ref)) narrow_bpc_set(J, narrow_ref(ref), narrow_ref(sp[-1]), mode); } } lua_assert(sp == nc->stack+1); return nc->stack[0]; } /* Narrow a type conversion of an arithmetic operation. */ TRef LJ_FASTCALL lj_opt_narrow_convert(jit_State *J) { if ((J->flags & JIT_F_OPT_NARROW)) { NarrowConv nc; nc.J = J; nc.sp = nc.stack; nc.maxsp = &nc.stack[NARROW_MAX_STACK-4]; nc.t = irt_type(fins->t); if (fins->o == IR_TOBIT) { nc.mode = IRCONV_TOBIT; /* Used only in the backpropagation cache. */ } else { nc.mode = fins->op2; } if (narrow_conv_backprop(&nc, fins->op1, 0) <= 1) return narrow_conv_emit(J, &nc); } return NEXTFOLD; } /* -- Narrowing of implicit conversions ----------------------------------- */ /* Recursively strip overflow checks. */ static TRef narrow_stripov(jit_State *J, TRef tr, int lastop, IRRef mode) { IRRef ref = tref_ref(tr); IRIns *ir = IR(ref); int op = ir->o; if (op >= IR_ADDOV && op <= lastop) { BPropEntry *bp = narrow_bpc_get(J, ref, mode); if (bp) { return TREF(bp->val, irt_t(IR(bp->val)->t)); } else { IRRef op1 = ir->op1, op2 = ir->op2; /* The IR may be reallocated. */ op1 = narrow_stripov(J, op1, lastop, mode); op2 = narrow_stripov(J, op2, lastop, mode); tr = emitir(IRT(op - IR_ADDOV + IR_ADD, ((mode & IRCONV_DSTMASK) >> IRCONV_DSH)), op1, op2); narrow_bpc_set(J, ref, tref_ref(tr), mode); } } else if (LJ_64 && (mode & IRCONV_SEXT) && !irt_is64(ir->t)) { tr = emitir(IRT(IR_CONV, IRT_INTP), tr, mode); } return tr; } /* Narrow array index. */ TRef LJ_FASTCALL lj_opt_narrow_index(jit_State *J, TRef tr) { IRIns *ir; lua_assert(tref_isnumber(tr)); if (tref_isnum(tr)) /* Conversion may be narrowed, too. See above. */ return emitir(IRTGI(IR_CONV), tr, IRCONV_INT_NUM|IRCONV_INDEX); /* Omit some overflow checks for array indexing. See comments above. */ ir = IR(tref_ref(tr)); if ((ir->o == IR_ADDOV || ir->o == IR_SUBOV) && irref_isk(ir->op2) && (uint32_t)IR(ir->op2)->i + 0x40000000u < 0x80000000u) return emitir(IRTI(ir->o - IR_ADDOV + IR_ADD), ir->op1, ir->op2); return tr; } /* Narrow conversion to integer operand (overflow undefined). */ TRef LJ_FASTCALL lj_opt_narrow_toint(jit_State *J, TRef tr) { if (tref_isstr(tr)) tr = emitir(IRTG(IR_STRTO, IRT_NUM), tr, 0); if (tref_isnum(tr)) /* Conversion may be narrowed, too. See above. */ return emitir(IRTI(IR_CONV), tr, IRCONV_INT_NUM|IRCONV_ANY); if (!tref_isinteger(tr)) lj_trace_err(J, LJ_TRERR_BADTYPE); /* ** Undefined overflow semantics allow stripping of ADDOV, SUBOV and MULOV. ** Use IRCONV_TOBIT for the cache entries, since the semantics are the same. */ return narrow_stripov(J, tr, IR_MULOV, (IRT_INT<<5)|IRT_INT|IRCONV_TOBIT); } /* Narrow conversion to bitop operand (overflow wrapped). */ TRef LJ_FASTCALL lj_opt_narrow_tobit(jit_State *J, TRef tr) { if (tref_isstr(tr)) tr = emitir(IRTG(IR_STRTO, IRT_NUM), tr, 0); if (tref_isnum(tr)) /* Conversion may be narrowed, too. See above. */ return emitir(IRTI(IR_TOBIT), tr, lj_ir_knum_tobit(J)); if (!tref_isinteger(tr)) lj_trace_err(J, LJ_TRERR_BADTYPE); /* ** Wrapped overflow semantics allow stripping of ADDOV and SUBOV. ** MULOV cannot be stripped due to precision widening. */ return narrow_stripov(J, tr, IR_SUBOV, (IRT_INT<<5)|IRT_INT|IRCONV_TOBIT); } #if LJ_HASFFI /* Narrow C array index (overflow undefined). */ TRef LJ_FASTCALL lj_opt_narrow_cindex(jit_State *J, TRef tr) { lua_assert(tref_isnumber(tr)); if (tref_isnum(tr)) return emitir(IRT(IR_CONV, IRT_INTP), tr, (IRT_INTP<<5)|IRT_NUM|IRCONV_ANY); /* Undefined overflow semantics allow stripping of ADDOV, SUBOV and MULOV. */ return narrow_stripov(J, tr, IR_MULOV, LJ_64 ? ((IRT_INTP<<5)|IRT_INT|IRCONV_SEXT) : ((IRT_INTP<<5)|IRT_INT|IRCONV_TOBIT)); } #endif /* -- Narrowing of arithmetic operators ----------------------------------- */ /* Check whether a number fits into an int32_t (-0 is ok, too). */ static int numisint(lua_Number n) { return (n == (lua_Number)lj_num2int(n)); } /* Convert string to number. Error out for non-numeric string values. */ static TRef conv_str_tonum(jit_State *J, TRef tr, TValue *o) { if (tref_isstr(tr)) { tr = emitir(IRTG(IR_STRTO, IRT_NUM), tr, 0); /* Would need an inverted STRTO for this rare and useless case. */ if (!lj_strscan_num(strV(o), o)) /* Convert in-place. Value used below. */ lj_trace_err(J, LJ_TRERR_BADTYPE); /* Punt if non-numeric. */ } return tr; } /* Narrowing of arithmetic operations. */ TRef lj_opt_narrow_arith(jit_State *J, TRef rb, TRef rc, TValue *vb, TValue *vc, IROp op) { rb = conv_str_tonum(J, rb, vb); rc = conv_str_tonum(J, rc, vc); /* Must not narrow MUL in non-DUALNUM variant, because it loses -0. */ if ((op >= IR_ADD && op <= (LJ_DUALNUM ? IR_MUL : IR_SUB)) && tref_isinteger(rb) && tref_isinteger(rc) && numisint(lj_vm_foldarith(numberVnum(vb), numberVnum(vc), (int)op - (int)IR_ADD))) return emitir(IRTGI((int)op - (int)IR_ADD + (int)IR_ADDOV), rb, rc); if (!tref_isnum(rb)) rb = emitir(IRTN(IR_CONV), rb, IRCONV_NUM_INT); if (!tref_isnum(rc)) rc = emitir(IRTN(IR_CONV), rc, IRCONV_NUM_INT); return emitir(IRTN(op), rb, rc); } /* Narrowing of unary minus operator. */ TRef lj_opt_narrow_unm(jit_State *J, TRef rc, TValue *vc) { rc = conv_str_tonum(J, rc, vc); if (tref_isinteger(rc)) { if ((uint32_t)numberVint(vc) != 0x80000000u) return emitir(IRTGI(IR_SUBOV), lj_ir_kint(J, 0), rc); rc = emitir(IRTN(IR_CONV), rc, IRCONV_NUM_INT); } return emitir(IRTN(IR_NEG), rc, lj_ir_knum_neg(J)); } /* Narrowing of modulo operator. */ TRef lj_opt_narrow_mod(jit_State *J, TRef rb, TRef rc, TValue *vb, TValue *vc) { TRef tmp; rb = conv_str_tonum(J, rb, vb); rc = conv_str_tonum(J, rc, vc); if ((LJ_DUALNUM || (J->flags & JIT_F_OPT_NARROW)) && tref_isinteger(rb) && tref_isinteger(rc) && (tvisint(vc) ? intV(vc) != 0 : !tviszero(vc))) { emitir(IRTGI(IR_NE), rc, lj_ir_kint(J, 0)); return emitir(IRTI(IR_MOD), rb, rc); } /* b % c ==> b - floor(b/c)*c */ rb = lj_ir_tonum(J, rb); rc = lj_ir_tonum(J, rc); tmp = emitir(IRTN(IR_DIV), rb, rc); tmp = emitir(IRTN(IR_FPMATH), tmp, IRFPM_FLOOR); tmp = emitir(IRTN(IR_MUL), tmp, rc); return emitir(IRTN(IR_SUB), rb, tmp); } /* Narrowing of power operator or math.pow. */ TRef lj_opt_narrow_pow(jit_State *J, TRef rb, TRef rc, TValue *vb, TValue *vc) { rb = conv_str_tonum(J, rb, vb); rb = lj_ir_tonum(J, rb); /* Left arg is always treated as an FP number. */ rc = conv_str_tonum(J, rc, vc); /* Narrowing must be unconditional to preserve (-x)^i semantics. */ if (tvisint(vc) || numisint(numV(vc))) { int checkrange = 0; /* Split pow is faster for bigger exponents. But do this only for (+k)^i. */ if (tref_isk(rb) && (int32_t)ir_knum(IR(tref_ref(rb)))->u32.hi >= 0) { int32_t k = numberVint(vc); if (!(k >= -65536 && k <= 65536)) goto split_pow; checkrange = 1; } if (!tref_isinteger(rc)) { /* Guarded conversion to integer! */ rc = emitir(IRTGI(IR_CONV), rc, IRCONV_INT_NUM|IRCONV_CHECK); } if (checkrange && !tref_isk(rc)) { /* Range guard: -65536 <= i <= 65536 */ TRef tmp = emitir(IRTI(IR_ADD), rc, lj_ir_kint(J, 65536)); emitir(IRTGI(IR_ULE), tmp, lj_ir_kint(J, 2*65536)); } return emitir(IRTN(IR_POW), rb, rc); } split_pow: /* FOLD covers most cases, but some are easier to do here. */ if (tref_isk(rb) && tvispone(ir_knum(IR(tref_ref(rb))))) return rb; /* 1 ^ x ==> 1 */ rc = lj_ir_tonum(J, rc); if (tref_isk(rc) && ir_knum(IR(tref_ref(rc)))->n == 0.5) return emitir(IRTN(IR_FPMATH), rb, IRFPM_SQRT); /* x ^ 0.5 ==> sqrt(x) */ /* Split up b^c into exp2(c*log2(b)). Assembler may rejoin later. */ rb = emitir(IRTN(IR_FPMATH), rb, IRFPM_LOG2); rc = emitir(IRTN(IR_MUL), rb, rc); return emitir(IRTN(IR_FPMATH), rc, IRFPM_EXP2); } /* -- Predictive narrowing of induction variables ------------------------- */ /* Narrow a single runtime value. */ static int narrow_forl(jit_State *J, cTValue *o) { if (tvisint(o)) return 1; if (LJ_DUALNUM || (J->flags & JIT_F_OPT_NARROW)) return numisint(numV(o)); return 0; } /* Narrow the FORL index type by looking at the runtime values. */ IRType lj_opt_narrow_forl(jit_State *J, cTValue *tv) { lua_assert(tvisnumber(&tv[FORL_IDX]) && tvisnumber(&tv[FORL_STOP]) && tvisnumber(&tv[FORL_STEP])); /* Narrow only if the runtime values of start/stop/step are all integers. */ if (narrow_forl(J, &tv[FORL_IDX]) && narrow_forl(J, &tv[FORL_STOP]) && narrow_forl(J, &tv[FORL_STEP])) { /* And if the loop index can't possibly overflow. */ lua_Number step = numberVnum(&tv[FORL_STEP]); lua_Number sum = numberVnum(&tv[FORL_STOP]) + step; if (0 <= step ? (sum <= 2147483647.0) : (sum >= -2147483648.0)) return IRT_INT; } return IRT_NUM; } #undef IR #undef fins #undef emitir #undef emitir_raw #endif wcc-0.0.2/src/wsh/luajit-2.0/src/ljamalg.c0000644000175000017500000000437413122010155016454 0ustar philphil/* ** LuaJIT core and libraries amalgamation. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ /* +--------------------------------------------------------------------------+ | WARNING: Compiling the amalgamation needs a lot of virtual memory | | (around 300 MB with GCC 4.x)! If you don't have enough physical memory | | your machine will start swapping to disk and the compile will not finish | | within a reasonable amount of time. | | So either compile on a bigger machine or use the non-amalgamated build. | +--------------------------------------------------------------------------+ */ #define ljamalg_c #define LUA_CORE /* To get the mremap prototype. Must be defined before any system includes. */ #if defined(__linux__) && !defined(_GNU_SOURCE) #define _GNU_SOURCE #endif #ifndef WINVER #define WINVER 0x0501 #endif #include "lua.h" #include "lauxlib.h" #include "lj_gc.c" #include "lj_err.c" #include "lj_char.c" #include "lj_bc.c" #include "lj_obj.c" #include "lj_str.c" #include "lj_tab.c" #include "lj_func.c" #include "lj_udata.c" #include "lj_meta.c" #include "lj_debug.c" #include "lj_state.c" #include "lj_dispatch.c" #include "lj_vmevent.c" #include "lj_vmmath.c" #include "lj_strscan.c" #include "lj_api.c" #include "lj_lex.c" #include "lj_parse.c" #include "lj_bcread.c" #include "lj_bcwrite.c" #include "lj_load.c" #include "lj_ctype.c" #include "lj_cdata.c" #include "lj_cconv.c" #include "lj_ccall.c" #include "lj_ccallback.c" #include "lj_carith.c" #include "lj_clib.c" #include "lj_cparse.c" #include "lj_lib.c" #include "lj_ir.c" #include "lj_opt_mem.c" #include "lj_opt_fold.c" #include "lj_opt_narrow.c" #include "lj_opt_dce.c" #include "lj_opt_loop.c" #include "lj_opt_split.c" #include "lj_opt_sink.c" #include "lj_mcode.c" #include "lj_snap.c" #include "lj_record.c" #include "lj_crecord.c" #include "lj_ffrecord.c" #include "lj_asm.c" #include "lj_trace.c" #include "lj_gdbjit.c" #include "lj_alloc.c" #include "lib_aux.c" #include "lib_base.c" #include "lib_math.c" #include "lib_string.c" #include "lib_table.c" #include "lib_io.c" #include "lib_os.c" #include "lib_package.c" #include "lib_debug.c" #include "lib_bit.c" #include "lib_jit.c" #include "lib_ffi.c" #include "lib_init.c" wcc-0.0.2/src/wsh/luajit-2.0/src/lj_clib.h0000644000175000017500000000136213122010155016442 0ustar philphil/* ** FFI C library loader. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_CLIB_H #define _LJ_CLIB_H #include "lj_obj.h" #if LJ_HASFFI /* Namespace for C library indexing. */ #define CLNS_INDEX ((1u<env. */ } CLibrary; LJ_FUNC TValue *lj_clib_index(lua_State *L, CLibrary *cl, GCstr *name); LJ_FUNC void lj_clib_load(lua_State *L, GCtab *mt, GCstr *name, int global); LJ_FUNC void lj_clib_unload(CLibrary *cl); LJ_FUNC void lj_clib_default(lua_State *L, GCtab *mt); #endif #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_opt_fold.c0000644000175000017500000017221113122010155017334 0ustar philphil/* ** FOLD: Constant Folding, Algebraic Simplifications and Reassociation. ** ABCelim: Array Bounds Check Elimination. ** CSE: Common-Subexpression Elimination. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lj_opt_fold_c #define LUA_CORE #include #include "lj_obj.h" #if LJ_HASJIT #include "lj_str.h" #include "lj_tab.h" #include "lj_ir.h" #include "lj_jit.h" #include "lj_iropt.h" #include "lj_trace.h" #if LJ_HASFFI #include "lj_ctype.h" #endif #include "lj_carith.h" #include "lj_vm.h" #include "lj_strscan.h" /* Here's a short description how the FOLD engine processes instructions: ** ** The FOLD engine receives a single instruction stored in fins (J->fold.ins). ** The instruction and its operands are used to select matching fold rules. ** These are applied iteratively until a fixed point is reached. ** ** The 8 bit opcode of the instruction itself plus the opcodes of the ** two instructions referenced by its operands form a 24 bit key ** 'ins left right' (unused operands -> 0, literals -> lowest 8 bits). ** ** This key is used for partial matching against the fold rules. The ** left/right operand fields of the key are successively masked with ** the 'any' wildcard, from most specific to least specific: ** ** ins left right ** ins any right ** ins left any ** ins any any ** ** The masked key is used to lookup a matching fold rule in a semi-perfect ** hash table. If a matching rule is found, the related fold function is run. ** Multiple rules can share the same fold function. A fold rule may return ** one of several special values: ** ** - NEXTFOLD means no folding was applied, because an additional test ** inside the fold function failed. Matching continues against less ** specific fold rules. Finally the instruction is passed on to CSE. ** ** - RETRYFOLD means the instruction was modified in-place. Folding is ** retried as if this instruction had just been received. ** ** All other return values are terminal actions -- no further folding is ** applied: ** ** - INTFOLD(i) returns a reference to the integer constant i. ** ** - LEFTFOLD and RIGHTFOLD return the left/right operand reference ** without emitting an instruction. ** ** - CSEFOLD and EMITFOLD pass the instruction directly to CSE or emit ** it without passing through any further optimizations. ** ** - FAILFOLD, DROPFOLD and CONDFOLD only apply to instructions which have ** no result (e.g. guarded assertions): FAILFOLD means the guard would ** always fail, i.e. the current trace is pointless. DROPFOLD means ** the guard is always true and has been eliminated. CONDFOLD is a ** shortcut for FAILFOLD + cond (i.e. drop if true, otherwise fail). ** ** - Any other return value is interpreted as an IRRef or TRef. This ** can be a reference to an existing or a newly created instruction. ** Only the least-significant 16 bits (IRRef1) are used to form a TRef ** which is finally returned to the caller. ** ** The FOLD engine receives instructions both from the trace recorder and ** substituted instructions from LOOP unrolling. This means all types ** of instructions may end up here, even though the recorder bypasses ** FOLD in some cases. Thus all loads, stores and allocations must have ** an any/any rule to avoid being passed on to CSE. ** ** Carefully read the following requirements before adding or modifying ** any fold rules: ** ** Requirement #1: All fold rules must preserve their destination type. ** ** Consistently use INTFOLD() (KINT result) or lj_ir_knum() (KNUM result). ** Never use lj_ir_knumint() which can have either a KINT or KNUM result. ** ** Requirement #2: Fold rules should not create *new* instructions which ** reference operands *across* PHIs. ** ** E.g. a RETRYFOLD with 'fins->op1 = fleft->op1' is invalid if the ** left operand is a PHI. Then fleft->op1 would point across the PHI ** frontier to an invariant instruction. Adding a PHI for this instruction ** would be counterproductive. The solution is to add a barrier which ** prevents folding across PHIs, i.e. 'PHIBARRIER(fleft)' in this case. ** The only exception is for recurrences with high latencies like ** repeated int->num->int conversions. ** ** One could relax this condition a bit if the referenced instruction is ** a PHI, too. But this often leads to worse code due to excessive ** register shuffling. ** ** Note: returning *existing* instructions (e.g. LEFTFOLD) is ok, though. ** Even returning fleft->op1 would be ok, because a new PHI will added, ** if needed. But again, this leads to excessive register shuffling and ** should be avoided. ** ** Requirement #3: The set of all fold rules must be monotonic to guarantee ** termination. ** ** The goal is optimization, so one primarily wants to add strength-reducing ** rules. This means eliminating an instruction or replacing an instruction ** with one or more simpler instructions. Don't add fold rules which point ** into the other direction. ** ** Some rules (like commutativity) do not directly reduce the strength of ** an instruction, but enable other fold rules (e.g. by moving constants ** to the right operand). These rules must be made unidirectional to avoid ** cycles. ** ** Rule of thumb: the trace recorder expands the IR and FOLD shrinks it. */ /* Some local macros to save typing. Undef'd at the end. */ #define IR(ref) (&J->cur.ir[(ref)]) #define fins (&J->fold.ins) #define fleft (&J->fold.left) #define fright (&J->fold.right) #define knumleft (ir_knum(fleft)->n) #define knumright (ir_knum(fright)->n) /* Pass IR on to next optimization in chain (FOLD). */ #define emitir(ot, a, b) (lj_ir_set(J, (ot), (a), (b)), lj_opt_fold(J)) /* Fold function type. Fastcall on x86 significantly reduces their size. */ typedef IRRef (LJ_FASTCALL *FoldFunc)(jit_State *J); /* Macros for the fold specs, so buildvm can recognize them. */ #define LJFOLD(x) #define LJFOLDX(x) #define LJFOLDF(name) static TRef LJ_FASTCALL fold_##name(jit_State *J) /* Note: They must be at the start of a line or buildvm ignores them! */ /* Barrier to prevent using operands across PHIs. */ #define PHIBARRIER(ir) if (irt_isphi((ir)->t)) return NEXTFOLD /* Barrier to prevent folding across a GC step. ** GC steps can only happen at the head of a trace and at LOOP. ** And the GC is only driven forward if there is at least one allocation. */ #define gcstep_barrier(J, ref) \ ((ref) < J->chain[IR_LOOP] && \ (J->chain[IR_SNEW] || J->chain[IR_XSNEW] || \ J->chain[IR_TNEW] || J->chain[IR_TDUP] || \ J->chain[IR_CNEW] || J->chain[IR_CNEWI] || J->chain[IR_TOSTR])) /* -- Constant folding for FP numbers ------------------------------------- */ LJFOLD(ADD KNUM KNUM) LJFOLD(SUB KNUM KNUM) LJFOLD(MUL KNUM KNUM) LJFOLD(DIV KNUM KNUM) LJFOLD(NEG KNUM KNUM) LJFOLD(ABS KNUM KNUM) LJFOLD(ATAN2 KNUM KNUM) LJFOLD(LDEXP KNUM KNUM) LJFOLD(MIN KNUM KNUM) LJFOLD(MAX KNUM KNUM) LJFOLDF(kfold_numarith) { lua_Number a = knumleft; lua_Number b = knumright; lua_Number y = lj_vm_foldarith(a, b, fins->o - IR_ADD); return lj_ir_knum(J, y); } LJFOLD(LDEXP KNUM KINT) LJFOLDF(kfold_ldexp) { #if LJ_TARGET_X86ORX64 UNUSED(J); return NEXTFOLD; #else return lj_ir_knum(J, ldexp(knumleft, fright->i)); #endif } LJFOLD(FPMATH KNUM any) LJFOLDF(kfold_fpmath) { lua_Number a = knumleft; lua_Number y = lj_vm_foldfpm(a, fins->op2); return lj_ir_knum(J, y); } LJFOLD(POW KNUM KINT) LJFOLDF(kfold_numpow) { lua_Number a = knumleft; lua_Number b = (lua_Number)fright->i; lua_Number y = lj_vm_foldarith(a, b, IR_POW - IR_ADD); return lj_ir_knum(J, y); } /* Must not use kfold_kref for numbers (could be NaN). */ LJFOLD(EQ KNUM KNUM) LJFOLD(NE KNUM KNUM) LJFOLD(LT KNUM KNUM) LJFOLD(GE KNUM KNUM) LJFOLD(LE KNUM KNUM) LJFOLD(GT KNUM KNUM) LJFOLD(ULT KNUM KNUM) LJFOLD(UGE KNUM KNUM) LJFOLD(ULE KNUM KNUM) LJFOLD(UGT KNUM KNUM) LJFOLDF(kfold_numcomp) { return CONDFOLD(lj_ir_numcmp(knumleft, knumright, (IROp)fins->o)); } /* -- Constant folding for 32 bit integers -------------------------------- */ static int32_t kfold_intop(int32_t k1, int32_t k2, IROp op) { switch (op) { case IR_ADD: k1 += k2; break; case IR_SUB: k1 -= k2; break; case IR_MUL: k1 *= k2; break; case IR_MOD: k1 = lj_vm_modi(k1, k2); break; case IR_NEG: k1 = -k1; break; case IR_BAND: k1 &= k2; break; case IR_BOR: k1 |= k2; break; case IR_BXOR: k1 ^= k2; break; case IR_BSHL: k1 <<= (k2 & 31); break; case IR_BSHR: k1 = (int32_t)((uint32_t)k1 >> (k2 & 31)); break; case IR_BSAR: k1 >>= (k2 & 31); break; case IR_BROL: k1 = (int32_t)lj_rol((uint32_t)k1, (k2 & 31)); break; case IR_BROR: k1 = (int32_t)lj_ror((uint32_t)k1, (k2 & 31)); break; case IR_MIN: k1 = k1 < k2 ? k1 : k2; break; case IR_MAX: k1 = k1 > k2 ? k1 : k2; break; default: lua_assert(0); break; } return k1; } LJFOLD(ADD KINT KINT) LJFOLD(SUB KINT KINT) LJFOLD(MUL KINT KINT) LJFOLD(MOD KINT KINT) LJFOLD(NEG KINT KINT) LJFOLD(BAND KINT KINT) LJFOLD(BOR KINT KINT) LJFOLD(BXOR KINT KINT) LJFOLD(BSHL KINT KINT) LJFOLD(BSHR KINT KINT) LJFOLD(BSAR KINT KINT) LJFOLD(BROL KINT KINT) LJFOLD(BROR KINT KINT) LJFOLD(MIN KINT KINT) LJFOLD(MAX KINT KINT) LJFOLDF(kfold_intarith) { return INTFOLD(kfold_intop(fleft->i, fright->i, (IROp)fins->o)); } LJFOLD(ADDOV KINT KINT) LJFOLD(SUBOV KINT KINT) LJFOLD(MULOV KINT KINT) LJFOLDF(kfold_intovarith) { lua_Number n = lj_vm_foldarith((lua_Number)fleft->i, (lua_Number)fright->i, fins->o - IR_ADDOV); int32_t k = lj_num2int(n); if (n != (lua_Number)k) return FAILFOLD; return INTFOLD(k); } LJFOLD(BNOT KINT) LJFOLDF(kfold_bnot) { return INTFOLD(~fleft->i); } LJFOLD(BSWAP KINT) LJFOLDF(kfold_bswap) { return INTFOLD((int32_t)lj_bswap((uint32_t)fleft->i)); } LJFOLD(LT KINT KINT) LJFOLD(GE KINT KINT) LJFOLD(LE KINT KINT) LJFOLD(GT KINT KINT) LJFOLD(ULT KINT KINT) LJFOLD(UGE KINT KINT) LJFOLD(ULE KINT KINT) LJFOLD(UGT KINT KINT) LJFOLD(ABC KINT KINT) LJFOLDF(kfold_intcomp) { int32_t a = fleft->i, b = fright->i; switch ((IROp)fins->o) { case IR_LT: return CONDFOLD(a < b); case IR_GE: return CONDFOLD(a >= b); case IR_LE: return CONDFOLD(a <= b); case IR_GT: return CONDFOLD(a > b); case IR_ULT: return CONDFOLD((uint32_t)a < (uint32_t)b); case IR_UGE: return CONDFOLD((uint32_t)a >= (uint32_t)b); case IR_ULE: return CONDFOLD((uint32_t)a <= (uint32_t)b); case IR_ABC: case IR_UGT: return CONDFOLD((uint32_t)a > (uint32_t)b); default: lua_assert(0); return FAILFOLD; } } LJFOLD(UGE any KINT) LJFOLDF(kfold_intcomp0) { if (fright->i == 0) return DROPFOLD; return NEXTFOLD; } /* -- Constant folding for 64 bit integers -------------------------------- */ static uint64_t kfold_int64arith(uint64_t k1, uint64_t k2, IROp op) { switch (op) { #if LJ_64 || LJ_HASFFI case IR_ADD: k1 += k2; break; case IR_SUB: k1 -= k2; break; #endif #if LJ_HASFFI case IR_MUL: k1 *= k2; break; case IR_BAND: k1 &= k2; break; case IR_BOR: k1 |= k2; break; case IR_BXOR: k1 ^= k2; break; #endif default: UNUSED(k2); lua_assert(0); break; } return k1; } LJFOLD(ADD KINT64 KINT64) LJFOLD(SUB KINT64 KINT64) LJFOLD(MUL KINT64 KINT64) LJFOLD(BAND KINT64 KINT64) LJFOLD(BOR KINT64 KINT64) LJFOLD(BXOR KINT64 KINT64) LJFOLDF(kfold_int64arith) { return INT64FOLD(kfold_int64arith(ir_k64(fleft)->u64, ir_k64(fright)->u64, (IROp)fins->o)); } LJFOLD(DIV KINT64 KINT64) LJFOLD(MOD KINT64 KINT64) LJFOLD(POW KINT64 KINT64) LJFOLDF(kfold_int64arith2) { #if LJ_HASFFI uint64_t k1 = ir_k64(fleft)->u64, k2 = ir_k64(fright)->u64; if (irt_isi64(fins->t)) { k1 = fins->o == IR_DIV ? lj_carith_divi64((int64_t)k1, (int64_t)k2) : fins->o == IR_MOD ? lj_carith_modi64((int64_t)k1, (int64_t)k2) : lj_carith_powi64((int64_t)k1, (int64_t)k2); } else { k1 = fins->o == IR_DIV ? lj_carith_divu64(k1, k2) : fins->o == IR_MOD ? lj_carith_modu64(k1, k2) : lj_carith_powu64(k1, k2); } return INT64FOLD(k1); #else UNUSED(J); lua_assert(0); return FAILFOLD; #endif } LJFOLD(BSHL KINT64 KINT) LJFOLD(BSHR KINT64 KINT) LJFOLD(BSAR KINT64 KINT) LJFOLD(BROL KINT64 KINT) LJFOLD(BROR KINT64 KINT) LJFOLDF(kfold_int64shift) { #if LJ_HASFFI || LJ_64 uint64_t k = ir_k64(fleft)->u64; int32_t sh = (fright->i & 63); switch ((IROp)fins->o) { case IR_BSHL: k <<= sh; break; #if LJ_HASFFI case IR_BSHR: k >>= sh; break; case IR_BSAR: k = (uint64_t)((int64_t)k >> sh); break; case IR_BROL: k = lj_rol(k, sh); break; case IR_BROR: k = lj_ror(k, sh); break; #endif default: lua_assert(0); break; } return INT64FOLD(k); #else UNUSED(J); lua_assert(0); return FAILFOLD; #endif } LJFOLD(BNOT KINT64) LJFOLDF(kfold_bnot64) { #if LJ_HASFFI return INT64FOLD(~ir_k64(fleft)->u64); #else UNUSED(J); lua_assert(0); return FAILFOLD; #endif } LJFOLD(BSWAP KINT64) LJFOLDF(kfold_bswap64) { #if LJ_HASFFI return INT64FOLD(lj_bswap64(ir_k64(fleft)->u64)); #else UNUSED(J); lua_assert(0); return FAILFOLD; #endif } LJFOLD(LT KINT64 KINT64) LJFOLD(GE KINT64 KINT64) LJFOLD(LE KINT64 KINT64) LJFOLD(GT KINT64 KINT64) LJFOLD(ULT KINT64 KINT64) LJFOLD(UGE KINT64 KINT64) LJFOLD(ULE KINT64 KINT64) LJFOLD(UGT KINT64 KINT64) LJFOLDF(kfold_int64comp) { #if LJ_HASFFI uint64_t a = ir_k64(fleft)->u64, b = ir_k64(fright)->u64; switch ((IROp)fins->o) { case IR_LT: return CONDFOLD(a < b); case IR_GE: return CONDFOLD(a >= b); case IR_LE: return CONDFOLD(a <= b); case IR_GT: return CONDFOLD(a > b); case IR_ULT: return CONDFOLD((uint64_t)a < (uint64_t)b); case IR_UGE: return CONDFOLD((uint64_t)a >= (uint64_t)b); case IR_ULE: return CONDFOLD((uint64_t)a <= (uint64_t)b); case IR_UGT: return CONDFOLD((uint64_t)a > (uint64_t)b); default: lua_assert(0); return FAILFOLD; } #else UNUSED(J); lua_assert(0); return FAILFOLD; #endif } LJFOLD(UGE any KINT64) LJFOLDF(kfold_int64comp0) { #if LJ_HASFFI if (ir_k64(fright)->u64 == 0) return DROPFOLD; return NEXTFOLD; #else UNUSED(J); lua_assert(0); return FAILFOLD; #endif } /* -- Constant folding for strings ---------------------------------------- */ LJFOLD(SNEW KKPTR KINT) LJFOLDF(kfold_snew_kptr) { GCstr *s = lj_str_new(J->L, (const char *)ir_kptr(fleft), (size_t)fright->i); return lj_ir_kstr(J, s); } LJFOLD(SNEW any KINT) LJFOLDF(kfold_snew_empty) { if (fright->i == 0) return lj_ir_kstr(J, &J2G(J)->strempty); return NEXTFOLD; } LJFOLD(STRREF KGC KINT) LJFOLDF(kfold_strref) { GCstr *str = ir_kstr(fleft); lua_assert((MSize)fright->i <= str->len); return lj_ir_kkptr(J, (char *)strdata(str) + fright->i); } LJFOLD(STRREF SNEW any) LJFOLDF(kfold_strref_snew) { PHIBARRIER(fleft); if (irref_isk(fins->op2) && fright->i == 0) { return fleft->op1; /* strref(snew(ptr, len), 0) ==> ptr */ } else { /* Reassociate: strref(snew(strref(str, a), len), b) ==> strref(str, a+b) */ IRIns *ir = IR(fleft->op1); if (ir->o == IR_STRREF) { IRRef1 str = ir->op1; /* IRIns * is not valid across emitir. */ PHIBARRIER(ir); fins->op2 = emitir(IRTI(IR_ADD), ir->op2, fins->op2); /* Clobbers fins! */ fins->op1 = str; fins->ot = IRT(IR_STRREF, IRT_P32); return RETRYFOLD; } } return NEXTFOLD; } LJFOLD(CALLN CARG IRCALL_lj_str_cmp) LJFOLDF(kfold_strcmp) { if (irref_isk(fleft->op1) && irref_isk(fleft->op2)) { GCstr *a = ir_kstr(IR(fleft->op1)); GCstr *b = ir_kstr(IR(fleft->op2)); return INTFOLD(lj_str_cmp(a, b)); } return NEXTFOLD; } /* -- Constant folding of pointer arithmetic ------------------------------ */ LJFOLD(ADD KGC KINT) LJFOLD(ADD KGC KINT64) LJFOLDF(kfold_add_kgc) { GCobj *o = ir_kgc(fleft); #if LJ_64 ptrdiff_t ofs = (ptrdiff_t)ir_kint64(fright)->u64; #else ptrdiff_t ofs = fright->i; #endif #if LJ_HASFFI if (irt_iscdata(fleft->t)) { CType *ct = ctype_raw(ctype_ctsG(J2G(J)), gco2cd(o)->ctypeid); if (ctype_isnum(ct->info) || ctype_isenum(ct->info) || ctype_isptr(ct->info) || ctype_isfunc(ct->info) || ctype_iscomplex(ct->info) || ctype_isvector(ct->info)) return lj_ir_kkptr(J, (char *)o + ofs); } #endif return lj_ir_kptr(J, (char *)o + ofs); } LJFOLD(ADD KPTR KINT) LJFOLD(ADD KPTR KINT64) LJFOLD(ADD KKPTR KINT) LJFOLD(ADD KKPTR KINT64) LJFOLDF(kfold_add_kptr) { void *p = ir_kptr(fleft); #if LJ_64 ptrdiff_t ofs = (ptrdiff_t)ir_kint64(fright)->u64; #else ptrdiff_t ofs = fright->i; #endif return lj_ir_kptr_(J, fleft->o, (char *)p + ofs); } LJFOLD(ADD any KGC) LJFOLD(ADD any KPTR) LJFOLD(ADD any KKPTR) LJFOLDF(kfold_add_kright) { if (fleft->o == IR_KINT || fleft->o == IR_KINT64) { IRRef1 tmp = fins->op1; fins->op1 = fins->op2; fins->op2 = tmp; return RETRYFOLD; } return NEXTFOLD; } /* -- Constant folding of conversions ------------------------------------- */ LJFOLD(TOBIT KNUM KNUM) LJFOLDF(kfold_tobit) { return INTFOLD(lj_num2bit(knumleft)); } LJFOLD(CONV KINT IRCONV_NUM_INT) LJFOLDF(kfold_conv_kint_num) { return lj_ir_knum(J, (lua_Number)fleft->i); } LJFOLD(CONV KINT IRCONV_NUM_U32) LJFOLDF(kfold_conv_kintu32_num) { return lj_ir_knum(J, (lua_Number)(uint32_t)fleft->i); } LJFOLD(CONV KINT IRCONV_INT_I8) LJFOLD(CONV KINT IRCONV_INT_U8) LJFOLD(CONV KINT IRCONV_INT_I16) LJFOLD(CONV KINT IRCONV_INT_U16) LJFOLDF(kfold_conv_kint_ext) { int32_t k = fleft->i; if ((fins->op2 & IRCONV_SRCMASK) == IRT_I8) k = (int8_t)k; else if ((fins->op2 & IRCONV_SRCMASK) == IRT_U8) k = (uint8_t)k; else if ((fins->op2 & IRCONV_SRCMASK) == IRT_I16) k = (int16_t)k; else k = (uint16_t)k; return INTFOLD(k); } LJFOLD(CONV KINT IRCONV_I64_INT) LJFOLD(CONV KINT IRCONV_U64_INT) LJFOLD(CONV KINT IRCONV_I64_U32) LJFOLD(CONV KINT IRCONV_U64_U32) LJFOLDF(kfold_conv_kint_i64) { if ((fins->op2 & IRCONV_SEXT)) return INT64FOLD((uint64_t)(int64_t)fleft->i); else return INT64FOLD((uint64_t)(int64_t)(uint32_t)fleft->i); } LJFOLD(CONV KINT64 IRCONV_NUM_I64) LJFOLDF(kfold_conv_kint64_num_i64) { return lj_ir_knum(J, (lua_Number)(int64_t)ir_kint64(fleft)->u64); } LJFOLD(CONV KINT64 IRCONV_NUM_U64) LJFOLDF(kfold_conv_kint64_num_u64) { return lj_ir_knum(J, (lua_Number)ir_kint64(fleft)->u64); } LJFOLD(CONV KINT64 IRCONV_INT_I64) LJFOLD(CONV KINT64 IRCONV_U32_I64) LJFOLDF(kfold_conv_kint64_int_i64) { return INTFOLD((int32_t)ir_kint64(fleft)->u64); } LJFOLD(CONV KNUM IRCONV_INT_NUM) LJFOLDF(kfold_conv_knum_int_num) { lua_Number n = knumleft; if (!(fins->op2 & IRCONV_TRUNC)) { int32_t k = lj_num2int(n); if (irt_isguard(fins->t) && n != (lua_Number)k) { /* We're about to create a guard which always fails, like CONV +1.5. ** Some pathological loops cause this during LICM, e.g.: ** local x,k,t = 0,1.5,{1,[1.5]=2} ** for i=1,200 do x = x+ t[k]; k = k == 1 and 1.5 or 1 end ** assert(x == 300) */ return FAILFOLD; } return INTFOLD(k); } else { return INTFOLD((int32_t)n); } } LJFOLD(CONV KNUM IRCONV_U32_NUM) LJFOLDF(kfold_conv_knum_u32_num) { lua_assert((fins->op2 & IRCONV_TRUNC)); #ifdef _MSC_VER { /* Workaround for MSVC bug. */ volatile uint32_t u = (uint32_t)knumleft; return INTFOLD((int32_t)u); } #else return INTFOLD((int32_t)(uint32_t)knumleft); #endif } LJFOLD(CONV KNUM IRCONV_I64_NUM) LJFOLDF(kfold_conv_knum_i64_num) { lua_assert((fins->op2 & IRCONV_TRUNC)); return INT64FOLD((uint64_t)(int64_t)knumleft); } LJFOLD(CONV KNUM IRCONV_U64_NUM) LJFOLDF(kfold_conv_knum_u64_num) { lua_assert((fins->op2 & IRCONV_TRUNC)); return INT64FOLD(lj_num2u64(knumleft)); } LJFOLD(TOSTR KNUM) LJFOLDF(kfold_tostr_knum) { return lj_ir_kstr(J, lj_str_fromnum(J->L, &knumleft)); } LJFOLD(TOSTR KINT) LJFOLDF(kfold_tostr_kint) { return lj_ir_kstr(J, lj_str_fromint(J->L, fleft->i)); } LJFOLD(STRTO KGC) LJFOLDF(kfold_strto) { TValue n; if (lj_strscan_num(ir_kstr(fleft), &n)) return lj_ir_knum(J, numV(&n)); return FAILFOLD; } /* -- Constant folding of equality checks --------------------------------- */ /* Don't constant-fold away FLOAD checks against KNULL. */ LJFOLD(EQ FLOAD KNULL) LJFOLD(NE FLOAD KNULL) LJFOLDX(lj_opt_cse) /* But fold all other KNULL compares, since only KNULL is equal to KNULL. */ LJFOLD(EQ any KNULL) LJFOLD(NE any KNULL) LJFOLD(EQ KNULL any) LJFOLD(NE KNULL any) LJFOLD(EQ KINT KINT) /* Constants are unique, so same refs <==> same value. */ LJFOLD(NE KINT KINT) LJFOLD(EQ KINT64 KINT64) LJFOLD(NE KINT64 KINT64) LJFOLD(EQ KGC KGC) LJFOLD(NE KGC KGC) LJFOLDF(kfold_kref) { return CONDFOLD((fins->op1 == fins->op2) ^ (fins->o == IR_NE)); } /* -- Algebraic shortcuts ------------------------------------------------- */ LJFOLD(FPMATH FPMATH IRFPM_FLOOR) LJFOLD(FPMATH FPMATH IRFPM_CEIL) LJFOLD(FPMATH FPMATH IRFPM_TRUNC) LJFOLDF(shortcut_round) { IRFPMathOp op = (IRFPMathOp)fleft->op2; if (op == IRFPM_FLOOR || op == IRFPM_CEIL || op == IRFPM_TRUNC) return LEFTFOLD; /* round(round_left(x)) = round_left(x) */ return NEXTFOLD; } LJFOLD(ABS ABS KNUM) LJFOLDF(shortcut_left) { return LEFTFOLD; /* f(g(x)) ==> g(x) */ } LJFOLD(ABS NEG KNUM) LJFOLDF(shortcut_dropleft) { PHIBARRIER(fleft); fins->op1 = fleft->op1; /* abs(neg(x)) ==> abs(x) */ return RETRYFOLD; } /* Note: no safe shortcuts with STRTO and TOSTR ("1e2" ==> +100 ==> "100"). */ LJFOLD(NEG NEG any) LJFOLD(BNOT BNOT) LJFOLD(BSWAP BSWAP) LJFOLDF(shortcut_leftleft) { PHIBARRIER(fleft); /* See above. Fold would be ok, but not beneficial. */ return fleft->op1; /* f(g(x)) ==> x */ } /* -- FP algebraic simplifications ---------------------------------------- */ /* FP arithmetic is tricky -- there's not much to simplify. ** Please note the following common pitfalls before sending "improvements": ** x+0 ==> x is INVALID for x=-0 ** 0-x ==> -x is INVALID for x=+0 ** x*0 ==> 0 is INVALID for x=-0, x=+-Inf or x=NaN */ LJFOLD(ADD NEG any) LJFOLDF(simplify_numadd_negx) { PHIBARRIER(fleft); fins->o = IR_SUB; /* (-a) + b ==> b - a */ fins->op1 = fins->op2; fins->op2 = fleft->op1; return RETRYFOLD; } LJFOLD(ADD any NEG) LJFOLDF(simplify_numadd_xneg) { PHIBARRIER(fright); fins->o = IR_SUB; /* a + (-b) ==> a - b */ fins->op2 = fright->op1; return RETRYFOLD; } LJFOLD(SUB any KNUM) LJFOLDF(simplify_numsub_k) { lua_Number n = knumright; if (n == 0.0) /* x - (+-0) ==> x */ return LEFTFOLD; return NEXTFOLD; } LJFOLD(SUB NEG KNUM) LJFOLDF(simplify_numsub_negk) { PHIBARRIER(fleft); fins->op2 = fleft->op1; /* (-x) - k ==> (-k) - x */ fins->op1 = (IRRef1)lj_ir_knum(J, -knumright); return RETRYFOLD; } LJFOLD(SUB any NEG) LJFOLDF(simplify_numsub_xneg) { PHIBARRIER(fright); fins->o = IR_ADD; /* a - (-b) ==> a + b */ fins->op2 = fright->op1; return RETRYFOLD; } LJFOLD(MUL any KNUM) LJFOLD(DIV any KNUM) LJFOLDF(simplify_nummuldiv_k) { lua_Number n = knumright; if (n == 1.0) { /* x o 1 ==> x */ return LEFTFOLD; } else if (n == -1.0) { /* x o -1 ==> -x */ fins->o = IR_NEG; fins->op2 = (IRRef1)lj_ir_knum_neg(J); return RETRYFOLD; } else if (fins->o == IR_MUL && n == 2.0) { /* x * 2 ==> x + x */ fins->o = IR_ADD; fins->op2 = fins->op1; return RETRYFOLD; } else if (fins->o == IR_DIV) { /* x / 2^k ==> x * 2^-k */ uint64_t u = ir_knum(fright)->u64; uint32_t ex = ((uint32_t)(u >> 52) & 0x7ff); if ((u & U64x(000fffff,ffffffff)) == 0 && ex - 1 < 0x7fd) { u = (u & ((uint64_t)1 << 63)) | ((uint64_t)(0x7fe - ex) << 52); fins->o = IR_MUL; /* Multiply by exact reciprocal. */ fins->op2 = lj_ir_knum_u64(J, u); return RETRYFOLD; } } return NEXTFOLD; } LJFOLD(MUL NEG KNUM) LJFOLD(DIV NEG KNUM) LJFOLDF(simplify_nummuldiv_negk) { PHIBARRIER(fleft); fins->op1 = fleft->op1; /* (-a) o k ==> a o (-k) */ fins->op2 = (IRRef1)lj_ir_knum(J, -knumright); return RETRYFOLD; } LJFOLD(MUL NEG NEG) LJFOLD(DIV NEG NEG) LJFOLDF(simplify_nummuldiv_negneg) { PHIBARRIER(fleft); PHIBARRIER(fright); fins->op1 = fleft->op1; /* (-a) o (-b) ==> a o b */ fins->op2 = fright->op1; return RETRYFOLD; } LJFOLD(POW any KINT) LJFOLDF(simplify_numpow_xk) { int32_t k = fright->i; TRef ref = fins->op1; if (k == 0) /* x ^ 0 ==> 1 */ return lj_ir_knum_one(J); /* Result must be a number, not an int. */ if (k == 1) /* x ^ 1 ==> x */ return LEFTFOLD; if ((uint32_t)(k+65536) > 2*65536u) /* Limit code explosion. */ return NEXTFOLD; if (k < 0) { /* x ^ (-k) ==> (1/x) ^ k. */ ref = emitir(IRTN(IR_DIV), lj_ir_knum_one(J), ref); k = -k; } /* Unroll x^k for 1 <= k <= 65536. */ for (; (k & 1) == 0; k >>= 1) /* Handle leading zeros. */ ref = emitir(IRTN(IR_MUL), ref, ref); if ((k >>= 1) != 0) { /* Handle trailing bits. */ TRef tmp = emitir(IRTN(IR_MUL), ref, ref); for (; k != 1; k >>= 1) { if (k & 1) ref = emitir(IRTN(IR_MUL), ref, tmp); tmp = emitir(IRTN(IR_MUL), tmp, tmp); } ref = emitir(IRTN(IR_MUL), ref, tmp); } return ref; } LJFOLD(POW KNUM any) LJFOLDF(simplify_numpow_kx) { lua_Number n = knumleft; if (n == 2.0) { /* 2.0 ^ i ==> ldexp(1.0, tonum(i)) */ fins->o = IR_CONV; #if LJ_TARGET_X86ORX64 fins->op1 = fins->op2; fins->op2 = IRCONV_NUM_INT; fins->op2 = (IRRef1)lj_opt_fold(J); #endif fins->op1 = (IRRef1)lj_ir_knum_one(J); fins->o = IR_LDEXP; return RETRYFOLD; } return NEXTFOLD; } /* -- Simplify conversions ------------------------------------------------ */ LJFOLD(CONV CONV IRCONV_NUM_INT) /* _NUM */ LJFOLDF(shortcut_conv_num_int) { PHIBARRIER(fleft); /* Only safe with a guarded conversion to int. */ if ((fleft->op2 & IRCONV_SRCMASK) == IRT_NUM && irt_isguard(fleft->t)) return fleft->op1; /* f(g(x)) ==> x */ return NEXTFOLD; } LJFOLD(CONV CONV IRCONV_INT_NUM) /* _INT */ LJFOLD(CONV CONV IRCONV_U32_NUM) /* _U32*/ LJFOLDF(simplify_conv_int_num) { /* Fold even across PHI to avoid expensive num->int conversions in loop. */ if ((fleft->op2 & IRCONV_SRCMASK) == ((fins->op2 & IRCONV_DSTMASK) >> IRCONV_DSH)) return fleft->op1; return NEXTFOLD; } LJFOLD(CONV CONV IRCONV_I64_NUM) /* _INT or _U32 */ LJFOLD(CONV CONV IRCONV_U64_NUM) /* _INT or _U32 */ LJFOLDF(simplify_conv_i64_num) { PHIBARRIER(fleft); if ((fleft->op2 & IRCONV_SRCMASK) == IRT_INT) { /* Reduce to a sign-extension. */ fins->op1 = fleft->op1; fins->op2 = ((IRT_I64<<5)|IRT_INT|IRCONV_SEXT); return RETRYFOLD; } else if ((fleft->op2 & IRCONV_SRCMASK) == IRT_U32) { #if LJ_TARGET_X64 return fleft->op1; #else /* Reduce to a zero-extension. */ fins->op1 = fleft->op1; fins->op2 = (IRT_I64<<5)|IRT_U32; return RETRYFOLD; #endif } return NEXTFOLD; } LJFOLD(CONV CONV IRCONV_INT_I64) /* _INT or _U32 */ LJFOLD(CONV CONV IRCONV_INT_U64) /* _INT or _U32 */ LJFOLD(CONV CONV IRCONV_U32_I64) /* _INT or _U32 */ LJFOLD(CONV CONV IRCONV_U32_U64) /* _INT or _U32 */ LJFOLDF(simplify_conv_int_i64) { int src; PHIBARRIER(fleft); src = (fleft->op2 & IRCONV_SRCMASK); if (src == IRT_INT || src == IRT_U32) { if (src == ((fins->op2 & IRCONV_DSTMASK) >> IRCONV_DSH)) { return fleft->op1; } else { fins->op2 = ((fins->op2 & IRCONV_DSTMASK) | src); fins->op1 = fleft->op1; return RETRYFOLD; } } return NEXTFOLD; } LJFOLD(CONV CONV IRCONV_FLOAT_NUM) /* _FLOAT */ LJFOLDF(simplify_conv_flt_num) { PHIBARRIER(fleft); if ((fleft->op2 & IRCONV_SRCMASK) == IRT_FLOAT) return fleft->op1; return NEXTFOLD; } /* Shortcut TOBIT + IRT_NUM <- IRT_INT/IRT_U32 conversion. */ LJFOLD(TOBIT CONV KNUM) LJFOLDF(simplify_tobit_conv) { /* Fold even across PHI to avoid expensive num->int conversions in loop. */ if ((fleft->op2 & IRCONV_SRCMASK) == IRT_INT) { lua_assert(irt_isnum(fleft->t)); return fleft->op1; } else if ((fleft->op2 & IRCONV_SRCMASK) == IRT_U32) { lua_assert(irt_isnum(fleft->t)); fins->o = IR_CONV; fins->op1 = fleft->op1; fins->op2 = (IRT_INT<<5)|IRT_U32; return RETRYFOLD; } return NEXTFOLD; } /* Shortcut floor/ceil/round + IRT_NUM <- IRT_INT/IRT_U32 conversion. */ LJFOLD(FPMATH CONV IRFPM_FLOOR) LJFOLD(FPMATH CONV IRFPM_CEIL) LJFOLD(FPMATH CONV IRFPM_TRUNC) LJFOLDF(simplify_floor_conv) { if ((fleft->op2 & IRCONV_SRCMASK) == IRT_INT || (fleft->op2 & IRCONV_SRCMASK) == IRT_U32) return LEFTFOLD; return NEXTFOLD; } /* Strength reduction of widening. */ LJFOLD(CONV any IRCONV_I64_INT) LJFOLD(CONV any IRCONV_U64_INT) LJFOLDF(simplify_conv_sext) { IRRef ref = fins->op1; int64_t ofs = 0; if (!(fins->op2 & IRCONV_SEXT)) return NEXTFOLD; PHIBARRIER(fleft); if (fleft->o == IR_XLOAD && (irt_isu8(fleft->t) || irt_isu16(fleft->t))) goto ok_reduce; if (fleft->o == IR_ADD && irref_isk(fleft->op2)) { ofs = (int64_t)IR(fleft->op2)->i; ref = fleft->op1; } /* Use scalar evolution analysis results to strength-reduce sign-extension. */ if (ref == J->scev.idx) { IRRef lo = J->scev.dir ? J->scev.start : J->scev.stop; lua_assert(irt_isint(J->scev.t)); if (lo && IR(lo)->i + ofs >= 0) { ok_reduce: #if LJ_TARGET_X64 /* Eliminate widening. All 32 bit ops do an implicit zero-extension. */ return LEFTFOLD; #else /* Reduce to a (cheaper) zero-extension. */ fins->op2 &= ~IRCONV_SEXT; return RETRYFOLD; #endif } } return NEXTFOLD; } /* Strength reduction of narrowing. */ LJFOLD(CONV ADD IRCONV_INT_I64) LJFOLD(CONV SUB IRCONV_INT_I64) LJFOLD(CONV MUL IRCONV_INT_I64) LJFOLD(CONV ADD IRCONV_INT_U64) LJFOLD(CONV SUB IRCONV_INT_U64) LJFOLD(CONV MUL IRCONV_INT_U64) LJFOLD(CONV ADD IRCONV_U32_I64) LJFOLD(CONV SUB IRCONV_U32_I64) LJFOLD(CONV MUL IRCONV_U32_I64) LJFOLD(CONV ADD IRCONV_U32_U64) LJFOLD(CONV SUB IRCONV_U32_U64) LJFOLD(CONV MUL IRCONV_U32_U64) LJFOLDF(simplify_conv_narrow) { IROp op = (IROp)fleft->o; IRType t = irt_type(fins->t); IRRef op1 = fleft->op1, op2 = fleft->op2, mode = fins->op2; PHIBARRIER(fleft); op1 = emitir(IRTI(IR_CONV), op1, mode); op2 = emitir(IRTI(IR_CONV), op2, mode); fins->ot = IRT(op, t); fins->op1 = op1; fins->op2 = op2; return RETRYFOLD; } /* Special CSE rule for CONV. */ LJFOLD(CONV any any) LJFOLDF(cse_conv) { if (LJ_LIKELY(J->flags & JIT_F_OPT_CSE)) { IRRef op1 = fins->op1, op2 = (fins->op2 & IRCONV_MODEMASK); uint8_t guard = irt_isguard(fins->t); IRRef ref = J->chain[IR_CONV]; while (ref > op1) { IRIns *ir = IR(ref); /* Commoning with stronger checks is ok. */ if (ir->op1 == op1 && (ir->op2 & IRCONV_MODEMASK) == op2 && irt_isguard(ir->t) >= guard) return ref; ref = ir->prev; } } return EMITFOLD; /* No fallthrough to regular CSE. */ } /* FP conversion narrowing. */ LJFOLD(TOBIT ADD KNUM) LJFOLD(TOBIT SUB KNUM) LJFOLD(CONV ADD IRCONV_INT_NUM) LJFOLD(CONV SUB IRCONV_INT_NUM) LJFOLD(CONV ADD IRCONV_I64_NUM) LJFOLD(CONV SUB IRCONV_I64_NUM) LJFOLDF(narrow_convert) { PHIBARRIER(fleft); /* Narrowing ignores PHIs and repeating it inside the loop is not useful. */ if (J->chain[IR_LOOP]) return NEXTFOLD; lua_assert(fins->o != IR_CONV || (fins->op2&IRCONV_CONVMASK) != IRCONV_TOBIT); return lj_opt_narrow_convert(J); } /* -- Integer algebraic simplifications ----------------------------------- */ LJFOLD(ADD any KINT) LJFOLD(ADDOV any KINT) LJFOLD(SUBOV any KINT) LJFOLDF(simplify_intadd_k) { if (fright->i == 0) /* i o 0 ==> i */ return LEFTFOLD; return NEXTFOLD; } LJFOLD(MULOV any KINT) LJFOLDF(simplify_intmul_k) { if (fright->i == 0) /* i * 0 ==> 0 */ return RIGHTFOLD; if (fright->i == 1) /* i * 1 ==> i */ return LEFTFOLD; if (fright->i == 2) { /* i * 2 ==> i + i */ fins->o = IR_ADDOV; fins->op2 = fins->op1; return RETRYFOLD; } return NEXTFOLD; } LJFOLD(SUB any KINT) LJFOLDF(simplify_intsub_k) { if (fright->i == 0) /* i - 0 ==> i */ return LEFTFOLD; fins->o = IR_ADD; /* i - k ==> i + (-k) */ fins->op2 = (IRRef1)lj_ir_kint(J, -fright->i); /* Overflow for -2^31 ok. */ return RETRYFOLD; } LJFOLD(SUB KINT any) LJFOLD(SUB KINT64 any) LJFOLDF(simplify_intsub_kleft) { if (fleft->o == IR_KINT ? (fleft->i == 0) : (ir_kint64(fleft)->u64 == 0)) { fins->o = IR_NEG; /* 0 - i ==> -i */ fins->op1 = fins->op2; return RETRYFOLD; } return NEXTFOLD; } LJFOLD(ADD any KINT64) LJFOLDF(simplify_intadd_k64) { if (ir_kint64(fright)->u64 == 0) /* i + 0 ==> i */ return LEFTFOLD; return NEXTFOLD; } LJFOLD(SUB any KINT64) LJFOLDF(simplify_intsub_k64) { uint64_t k = ir_kint64(fright)->u64; if (k == 0) /* i - 0 ==> i */ return LEFTFOLD; fins->o = IR_ADD; /* i - k ==> i + (-k) */ fins->op2 = (IRRef1)lj_ir_kint64(J, (uint64_t)-(int64_t)k); return RETRYFOLD; } static TRef simplify_intmul_k(jit_State *J, int32_t k) { /* Note: many more simplifications are possible, e.g. 2^k1 +- 2^k2. ** But this is mainly intended for simple address arithmetic. ** Also it's easier for the backend to optimize the original multiplies. */ if (k == 1) { /* i * 1 ==> i */ return LEFTFOLD; } else if ((k & (k-1)) == 0) { /* i * 2^k ==> i << k */ fins->o = IR_BSHL; fins->op2 = lj_ir_kint(J, lj_fls((uint32_t)k)); return RETRYFOLD; } return NEXTFOLD; } LJFOLD(MUL any KINT) LJFOLDF(simplify_intmul_k32) { if (fright->i == 0) /* i * 0 ==> 0 */ return INTFOLD(0); else if (fright->i > 0) return simplify_intmul_k(J, fright->i); return NEXTFOLD; } LJFOLD(MUL any KINT64) LJFOLDF(simplify_intmul_k64) { if (ir_kint64(fright)->u64 == 0) /* i * 0 ==> 0 */ return INT64FOLD(0); #if LJ_64 /* NYI: SPLIT for BSHL and 32 bit backend support. */ else if (ir_kint64(fright)->u64 < 0x80000000u) return simplify_intmul_k(J, (int32_t)ir_kint64(fright)->u64); #endif return NEXTFOLD; } LJFOLD(MOD any KINT) LJFOLDF(simplify_intmod_k) { int32_t k = fright->i; lua_assert(k != 0); if (k > 0 && (k & (k-1)) == 0) { /* i % (2^k) ==> i & (2^k-1) */ fins->o = IR_BAND; fins->op2 = lj_ir_kint(J, k-1); return RETRYFOLD; } return NEXTFOLD; } LJFOLD(MOD KINT any) LJFOLDF(simplify_intmod_kleft) { if (fleft->i == 0) return INTFOLD(0); return NEXTFOLD; } LJFOLD(SUB any any) LJFOLD(SUBOV any any) LJFOLDF(simplify_intsub) { if (fins->op1 == fins->op2 && !irt_isnum(fins->t)) /* i - i ==> 0 */ return irt_is64(fins->t) ? INT64FOLD(0) : INTFOLD(0); return NEXTFOLD; } LJFOLD(SUB ADD any) LJFOLDF(simplify_intsubadd_leftcancel) { if (!irt_isnum(fins->t)) { PHIBARRIER(fleft); if (fins->op2 == fleft->op1) /* (i + j) - i ==> j */ return fleft->op2; if (fins->op2 == fleft->op2) /* (i + j) - j ==> i */ return fleft->op1; } return NEXTFOLD; } LJFOLD(SUB SUB any) LJFOLDF(simplify_intsubsub_leftcancel) { if (!irt_isnum(fins->t)) { PHIBARRIER(fleft); if (fins->op2 == fleft->op1) { /* (i - j) - i ==> 0 - j */ fins->op1 = (IRRef1)lj_ir_kint(J, 0); fins->op2 = fleft->op2; return RETRYFOLD; } } return NEXTFOLD; } LJFOLD(SUB any SUB) LJFOLDF(simplify_intsubsub_rightcancel) { if (!irt_isnum(fins->t)) { PHIBARRIER(fright); if (fins->op1 == fright->op1) /* i - (i - j) ==> j */ return fright->op2; } return NEXTFOLD; } LJFOLD(SUB any ADD) LJFOLDF(simplify_intsubadd_rightcancel) { if (!irt_isnum(fins->t)) { PHIBARRIER(fright); if (fins->op1 == fright->op1) { /* i - (i + j) ==> 0 - j */ fins->op2 = fright->op2; fins->op1 = (IRRef1)lj_ir_kint(J, 0); return RETRYFOLD; } if (fins->op1 == fright->op2) { /* i - (j + i) ==> 0 - j */ fins->op2 = fright->op1; fins->op1 = (IRRef1)lj_ir_kint(J, 0); return RETRYFOLD; } } return NEXTFOLD; } LJFOLD(SUB ADD ADD) LJFOLDF(simplify_intsubaddadd_cancel) { if (!irt_isnum(fins->t)) { PHIBARRIER(fleft); PHIBARRIER(fright); if (fleft->op1 == fright->op1) { /* (i + j1) - (i + j2) ==> j1 - j2 */ fins->op1 = fleft->op2; fins->op2 = fright->op2; return RETRYFOLD; } if (fleft->op1 == fright->op2) { /* (i + j1) - (j2 + i) ==> j1 - j2 */ fins->op1 = fleft->op2; fins->op2 = fright->op1; return RETRYFOLD; } if (fleft->op2 == fright->op1) { /* (j1 + i) - (i + j2) ==> j1 - j2 */ fins->op1 = fleft->op1; fins->op2 = fright->op2; return RETRYFOLD; } if (fleft->op2 == fright->op2) { /* (j1 + i) - (j2 + i) ==> j1 - j2 */ fins->op1 = fleft->op1; fins->op2 = fright->op1; return RETRYFOLD; } } return NEXTFOLD; } LJFOLD(BAND any KINT) LJFOLD(BAND any KINT64) LJFOLDF(simplify_band_k) { int64_t k = fright->o == IR_KINT ? (int64_t)fright->i : (int64_t)ir_k64(fright)->u64; if (k == 0) /* i & 0 ==> 0 */ return RIGHTFOLD; if (k == -1) /* i & -1 ==> i */ return LEFTFOLD; return NEXTFOLD; } LJFOLD(BOR any KINT) LJFOLD(BOR any KINT64) LJFOLDF(simplify_bor_k) { int64_t k = fright->o == IR_KINT ? (int64_t)fright->i : (int64_t)ir_k64(fright)->u64; if (k == 0) /* i | 0 ==> i */ return LEFTFOLD; if (k == -1) /* i | -1 ==> -1 */ return RIGHTFOLD; return NEXTFOLD; } LJFOLD(BXOR any KINT) LJFOLD(BXOR any KINT64) LJFOLDF(simplify_bxor_k) { int64_t k = fright->o == IR_KINT ? (int64_t)fright->i : (int64_t)ir_k64(fright)->u64; if (k == 0) /* i xor 0 ==> i */ return LEFTFOLD; if (k == -1) { /* i xor -1 ==> ~i */ fins->o = IR_BNOT; fins->op2 = 0; return RETRYFOLD; } return NEXTFOLD; } LJFOLD(BSHL any KINT) LJFOLD(BSHR any KINT) LJFOLD(BSAR any KINT) LJFOLD(BROL any KINT) LJFOLD(BROR any KINT) LJFOLDF(simplify_shift_ik) { int32_t mask = irt_is64(fins->t) ? 63 : 31; int32_t k = (fright->i & mask); if (k == 0) /* i o 0 ==> i */ return LEFTFOLD; if (k == 1 && fins->o == IR_BSHL) { /* i << 1 ==> i + i */ fins->o = IR_ADD; fins->op2 = fins->op1; return RETRYFOLD; } if (k != fright->i) { /* i o k ==> i o (k & mask) */ fins->op2 = (IRRef1)lj_ir_kint(J, k); return RETRYFOLD; } #ifndef LJ_TARGET_UNIFYROT if (fins->o == IR_BROR) { /* bror(i, k) ==> brol(i, (-k)&mask) */ fins->o = IR_BROL; fins->op2 = (IRRef1)lj_ir_kint(J, (-k)&mask); return RETRYFOLD; } #endif return NEXTFOLD; } LJFOLD(BSHL any BAND) LJFOLD(BSHR any BAND) LJFOLD(BSAR any BAND) LJFOLD(BROL any BAND) LJFOLD(BROR any BAND) LJFOLDF(simplify_shift_andk) { IRIns *irk = IR(fright->op2); PHIBARRIER(fright); if ((fins->o < IR_BROL ? LJ_TARGET_MASKSHIFT : LJ_TARGET_MASKROT) && irk->o == IR_KINT) { /* i o (j & mask) ==> i o j */ int32_t mask = irt_is64(fins->t) ? 63 : 31; int32_t k = irk->i & mask; if (k == mask) { fins->op2 = fright->op1; return RETRYFOLD; } } return NEXTFOLD; } LJFOLD(BSHL KINT any) LJFOLD(BSHR KINT any) LJFOLD(BSHL KINT64 any) LJFOLD(BSHR KINT64 any) LJFOLDF(simplify_shift1_ki) { int64_t k = fleft->o == IR_KINT ? (int64_t)fleft->i : (int64_t)ir_k64(fleft)->u64; if (k == 0) /* 0 o i ==> 0 */ return LEFTFOLD; return NEXTFOLD; } LJFOLD(BSAR KINT any) LJFOLD(BROL KINT any) LJFOLD(BROR KINT any) LJFOLD(BSAR KINT64 any) LJFOLD(BROL KINT64 any) LJFOLD(BROR KINT64 any) LJFOLDF(simplify_shift2_ki) { int64_t k = fleft->o == IR_KINT ? (int64_t)fleft->i : (int64_t)ir_k64(fleft)->u64; if (k == 0 || k == -1) /* 0 o i ==> 0; -1 o i ==> -1 */ return LEFTFOLD; return NEXTFOLD; } LJFOLD(BSHL BAND KINT) LJFOLD(BSHR BAND KINT) LJFOLD(BROL BAND KINT) LJFOLD(BROR BAND KINT) LJFOLDF(simplify_shiftk_andk) { IRIns *irk = IR(fleft->op2); PHIBARRIER(fleft); if (irk->o == IR_KINT) { /* (i & k1) o k2 ==> (i o k2) & (k1 o k2) */ int32_t k = kfold_intop(irk->i, fright->i, (IROp)fins->o); fins->op1 = fleft->op1; fins->op1 = (IRRef1)lj_opt_fold(J); fins->op2 = (IRRef1)lj_ir_kint(J, k); fins->ot = IRTI(IR_BAND); return RETRYFOLD; } return NEXTFOLD; } LJFOLD(BAND BSHL KINT) LJFOLD(BAND BSHR KINT) LJFOLDF(simplify_andk_shiftk) { IRIns *irk = IR(fleft->op2); if (irk->o == IR_KINT && kfold_intop(-1, irk->i, (IROp)fleft->o) == fright->i) return LEFTFOLD; /* (i o k1) & k2 ==> i, if (-1 o k1) == k2 */ return NEXTFOLD; } /* -- Reassociation ------------------------------------------------------- */ LJFOLD(ADD ADD KINT) LJFOLD(MUL MUL KINT) LJFOLD(BAND BAND KINT) LJFOLD(BOR BOR KINT) LJFOLD(BXOR BXOR KINT) LJFOLDF(reassoc_intarith_k) { IRIns *irk = IR(fleft->op2); if (irk->o == IR_KINT) { int32_t k = kfold_intop(irk->i, fright->i, (IROp)fins->o); if (k == irk->i) /* (i o k1) o k2 ==> i o k1, if (k1 o k2) == k1. */ return LEFTFOLD; PHIBARRIER(fleft); fins->op1 = fleft->op1; fins->op2 = (IRRef1)lj_ir_kint(J, k); return RETRYFOLD; /* (i o k1) o k2 ==> i o (k1 o k2) */ } return NEXTFOLD; } LJFOLD(ADD ADD KINT64) LJFOLD(MUL MUL KINT64) LJFOLD(BAND BAND KINT64) LJFOLD(BOR BOR KINT64) LJFOLD(BXOR BXOR KINT64) LJFOLDF(reassoc_intarith_k64) { #if LJ_HASFFI || LJ_64 IRIns *irk = IR(fleft->op2); if (irk->o == IR_KINT64) { uint64_t k = kfold_int64arith(ir_k64(irk)->u64, ir_k64(fright)->u64, (IROp)fins->o); PHIBARRIER(fleft); fins->op1 = fleft->op1; fins->op2 = (IRRef1)lj_ir_kint64(J, k); return RETRYFOLD; /* (i o k1) o k2 ==> i o (k1 o k2) */ } return NEXTFOLD; #else UNUSED(J); lua_assert(0); return FAILFOLD; #endif } LJFOLD(MIN MIN any) LJFOLD(MAX MAX any) LJFOLD(BAND BAND any) LJFOLD(BOR BOR any) LJFOLDF(reassoc_dup) { if (fins->op2 == fleft->op1 || fins->op2 == fleft->op2) return LEFTFOLD; /* (a o b) o a ==> a o b; (a o b) o b ==> a o b */ return NEXTFOLD; } LJFOLD(BXOR BXOR any) LJFOLDF(reassoc_bxor) { PHIBARRIER(fleft); if (fins->op2 == fleft->op1) /* (a xor b) xor a ==> b */ return fleft->op2; if (fins->op2 == fleft->op2) /* (a xor b) xor b ==> a */ return fleft->op1; return NEXTFOLD; } LJFOLD(BSHL BSHL KINT) LJFOLD(BSHR BSHR KINT) LJFOLD(BSAR BSAR KINT) LJFOLD(BROL BROL KINT) LJFOLD(BROR BROR KINT) LJFOLDF(reassoc_shift) { IRIns *irk = IR(fleft->op2); PHIBARRIER(fleft); /* The (shift any KINT) rule covers k2 == 0 and more. */ if (irk->o == IR_KINT) { /* (i o k1) o k2 ==> i o (k1 + k2) */ int32_t mask = irt_is64(fins->t) ? 63 : 31; int32_t k = (irk->i & mask) + (fright->i & mask); if (k > mask) { /* Combined shift too wide? */ if (fins->o == IR_BSHL || fins->o == IR_BSHR) return mask == 31 ? INTFOLD(0) : INT64FOLD(0); else if (fins->o == IR_BSAR) k = mask; else k &= mask; } fins->op1 = fleft->op1; fins->op2 = (IRRef1)lj_ir_kint(J, k); return RETRYFOLD; } return NEXTFOLD; } LJFOLD(MIN MIN KNUM) LJFOLD(MAX MAX KNUM) LJFOLD(MIN MIN KINT) LJFOLD(MAX MAX KINT) LJFOLDF(reassoc_minmax_k) { IRIns *irk = IR(fleft->op2); if (irk->o == IR_KNUM) { lua_Number a = ir_knum(irk)->n; lua_Number y = lj_vm_foldarith(a, knumright, fins->o - IR_ADD); if (a == y) /* (x o k1) o k2 ==> x o k1, if (k1 o k2) == k1. */ return LEFTFOLD; PHIBARRIER(fleft); fins->op1 = fleft->op1; fins->op2 = (IRRef1)lj_ir_knum(J, y); return RETRYFOLD; /* (x o k1) o k2 ==> x o (k1 o k2) */ } else if (irk->o == IR_KINT) { int32_t a = irk->i; int32_t y = kfold_intop(a, fright->i, fins->o); if (a == y) /* (x o k1) o k2 ==> x o k1, if (k1 o k2) == k1. */ return LEFTFOLD; PHIBARRIER(fleft); fins->op1 = fleft->op1; fins->op2 = (IRRef1)lj_ir_kint(J, y); return RETRYFOLD; /* (x o k1) o k2 ==> x o (k1 o k2) */ } return NEXTFOLD; } LJFOLD(MIN MAX any) LJFOLD(MAX MIN any) LJFOLDF(reassoc_minmax_left) { if (fins->op2 == fleft->op1 || fins->op2 == fleft->op2) return RIGHTFOLD; /* (b o1 a) o2 b ==> b; (a o1 b) o2 b ==> b */ return NEXTFOLD; } LJFOLD(MIN any MAX) LJFOLD(MAX any MIN) LJFOLDF(reassoc_minmax_right) { if (fins->op1 == fright->op1 || fins->op1 == fright->op2) return LEFTFOLD; /* a o2 (a o1 b) ==> a; a o2 (b o1 a) ==> a */ return NEXTFOLD; } /* -- Array bounds check elimination -------------------------------------- */ /* Eliminate ABC across PHIs to handle t[i-1] forwarding case. ** ABC(asize, (i+k)+(-k)) ==> ABC(asize, i), but only if it already exists. ** Could be generalized to (i+k1)+k2 ==> i+(k1+k2), but needs better disambig. */ LJFOLD(ABC any ADD) LJFOLDF(abc_fwd) { if (LJ_LIKELY(J->flags & JIT_F_OPT_ABC)) { if (irref_isk(fright->op2)) { IRIns *add2 = IR(fright->op1); if (add2->o == IR_ADD && irref_isk(add2->op2) && IR(fright->op2)->i == -IR(add2->op2)->i) { IRRef ref = J->chain[IR_ABC]; IRRef lim = add2->op1; if (fins->op1 > lim) lim = fins->op1; while (ref > lim) { IRIns *ir = IR(ref); if (ir->op1 == fins->op1 && ir->op2 == add2->op1) return DROPFOLD; ref = ir->prev; } } } } return NEXTFOLD; } /* Eliminate ABC for constants. ** ABC(asize, k1), ABC(asize k2) ==> ABC(asize, max(k1, k2)) ** Drop second ABC if k2 is lower. Otherwise patch first ABC with k2. */ LJFOLD(ABC any KINT) LJFOLDF(abc_k) { if (LJ_LIKELY(J->flags & JIT_F_OPT_ABC)) { IRRef ref = J->chain[IR_ABC]; IRRef asize = fins->op1; while (ref > asize) { IRIns *ir = IR(ref); if (ir->op1 == asize && irref_isk(ir->op2)) { int32_t k = IR(ir->op2)->i; if (fright->i > k) ir->op2 = fins->op2; return DROPFOLD; } ref = ir->prev; } return EMITFOLD; /* Already performed CSE. */ } return NEXTFOLD; } /* Eliminate invariant ABC inside loop. */ LJFOLD(ABC any any) LJFOLDF(abc_invar) { /* Invariant ABC marked as PTR. Drop if op1 is invariant, too. */ if (!irt_isint(fins->t) && fins->op1 < J->chain[IR_LOOP] && !irt_isphi(IR(fins->op1)->t)) return DROPFOLD; return NEXTFOLD; } /* -- Commutativity ------------------------------------------------------- */ /* The refs of commutative ops are canonicalized. Lower refs go to the right. ** Rationale behind this: ** - It (also) moves constants to the right. ** - It reduces the number of FOLD rules (e.g. (BOR any KINT) suffices). ** - It helps CSE to find more matches. ** - The assembler generates better code with constants at the right. */ LJFOLD(ADD any any) LJFOLD(MUL any any) LJFOLD(ADDOV any any) LJFOLD(MULOV any any) LJFOLDF(comm_swap) { if (fins->op1 < fins->op2) { /* Move lower ref to the right. */ IRRef1 tmp = fins->op1; fins->op1 = fins->op2; fins->op2 = tmp; return RETRYFOLD; } return NEXTFOLD; } LJFOLD(EQ any any) LJFOLD(NE any any) LJFOLDF(comm_equal) { /* For non-numbers only: x == x ==> drop; x ~= x ==> fail */ if (fins->op1 == fins->op2 && !irt_isnum(fins->t)) return CONDFOLD(fins->o == IR_EQ); return fold_comm_swap(J); } LJFOLD(LT any any) LJFOLD(GE any any) LJFOLD(LE any any) LJFOLD(GT any any) LJFOLD(ULT any any) LJFOLD(UGE any any) LJFOLD(ULE any any) LJFOLD(UGT any any) LJFOLDF(comm_comp) { /* For non-numbers only: x <=> x ==> drop; x <> x ==> fail */ if (fins->op1 == fins->op2 && !irt_isnum(fins->t)) return CONDFOLD((fins->o ^ (fins->o >> 1)) & 1); if (fins->op1 < fins->op2) { /* Move lower ref to the right. */ IRRef1 tmp = fins->op1; fins->op1 = fins->op2; fins->op2 = tmp; fins->o ^= 3; /* GT <-> LT, GE <-> LE, does not affect U */ return RETRYFOLD; } return NEXTFOLD; } LJFOLD(BAND any any) LJFOLD(BOR any any) LJFOLD(MIN any any) LJFOLD(MAX any any) LJFOLDF(comm_dup) { if (fins->op1 == fins->op2) /* x o x ==> x */ return LEFTFOLD; return fold_comm_swap(J); } LJFOLD(BXOR any any) LJFOLDF(comm_bxor) { if (fins->op1 == fins->op2) /* i xor i ==> 0 */ return irt_is64(fins->t) ? INT64FOLD(0) : INTFOLD(0); return fold_comm_swap(J); } /* -- Simplification of compound expressions ------------------------------ */ static TRef kfold_xload(jit_State *J, IRIns *ir, const void *p) { int32_t k; switch (irt_type(ir->t)) { case IRT_NUM: return lj_ir_knum_u64(J, *(uint64_t *)p); case IRT_I8: k = (int32_t)*(int8_t *)p; break; case IRT_U8: k = (int32_t)*(uint8_t *)p; break; case IRT_I16: k = (int32_t)(int16_t)lj_getu16(p); break; case IRT_U16: k = (int32_t)(uint16_t)lj_getu16(p); break; case IRT_INT: case IRT_U32: k = (int32_t)lj_getu32(p); break; case IRT_I64: case IRT_U64: return lj_ir_kint64(J, *(uint64_t *)p); default: return 0; } return lj_ir_kint(J, k); } /* Turn: string.sub(str, a, b) == kstr ** into: string.byte(str, a) == string.byte(kstr, 1) etc. ** Note: this creates unaligned XLOADs on x86/x64. */ LJFOLD(EQ SNEW KGC) LJFOLD(NE SNEW KGC) LJFOLDF(merge_eqne_snew_kgc) { GCstr *kstr = ir_kstr(fright); int32_t len = (int32_t)kstr->len; lua_assert(irt_isstr(fins->t)); #if LJ_TARGET_UNALIGNED #define FOLD_SNEW_MAX_LEN 4 /* Handle string lengths 0, 1, 2, 3, 4. */ #define FOLD_SNEW_TYPE8 IRT_I8 /* Creates shorter immediates. */ #else #define FOLD_SNEW_MAX_LEN 1 /* Handle string lengths 0 or 1. */ #define FOLD_SNEW_TYPE8 IRT_U8 /* Prefer unsigned loads. */ #endif PHIBARRIER(fleft); if (len <= FOLD_SNEW_MAX_LEN) { IROp op = (IROp)fins->o; IRRef strref = fleft->op1; if (IR(strref)->o != IR_STRREF) return NEXTFOLD; if (op == IR_EQ) { emitir(IRTGI(IR_EQ), fleft->op2, lj_ir_kint(J, len)); /* Caveat: fins/fleft/fright is no longer valid after emitir. */ } else { /* NE is not expanded since this would need an OR of two conds. */ if (!irref_isk(fleft->op2)) /* Only handle the constant length case. */ return NEXTFOLD; if (IR(fleft->op2)->i != len) return DROPFOLD; } if (len > 0) { /* A 4 byte load for length 3 is ok -- all strings have an extra NUL. */ uint16_t ot = (uint16_t)(len == 1 ? IRT(IR_XLOAD, FOLD_SNEW_TYPE8) : len == 2 ? IRT(IR_XLOAD, IRT_U16) : IRTI(IR_XLOAD)); TRef tmp = emitir(ot, strref, IRXLOAD_READONLY | (len > 1 ? IRXLOAD_UNALIGNED : 0)); TRef val = kfold_xload(J, IR(tref_ref(tmp)), strdata(kstr)); if (len == 3) tmp = emitir(IRTI(IR_BAND), tmp, lj_ir_kint(J, LJ_ENDIAN_SELECT(0x00ffffff, 0xffffff00))); fins->op1 = (IRRef1)tmp; fins->op2 = (IRRef1)val; fins->ot = (IROpT)IRTGI(op); return RETRYFOLD; } else { return DROPFOLD; } } return NEXTFOLD; } /* -- Loads --------------------------------------------------------------- */ /* Loads cannot be folded or passed on to CSE in general. ** Alias analysis is needed to check for forwarding opportunities. ** ** Caveat: *all* loads must be listed here or they end up at CSE! */ LJFOLD(ALOAD any) LJFOLDX(lj_opt_fwd_aload) /* From HREF fwd (see below). Must eliminate, not supported by fwd/backend. */ LJFOLD(HLOAD KKPTR) LJFOLDF(kfold_hload_kkptr) { UNUSED(J); lua_assert(ir_kptr(fleft) == niltvg(J2G(J))); return TREF_NIL; } LJFOLD(HLOAD any) LJFOLDX(lj_opt_fwd_hload) LJFOLD(ULOAD any) LJFOLDX(lj_opt_fwd_uload) LJFOLD(CALLL any IRCALL_lj_tab_len) LJFOLDX(lj_opt_fwd_tab_len) /* Upvalue refs are really loads, but there are no corresponding stores. ** So CSE is ok for them, except for UREFO across a GC step (see below). ** If the referenced function is const, its upvalue addresses are const, too. ** This can be used to improve CSE by looking for the same address, ** even if the upvalues originate from a different function. */ LJFOLD(UREFO KGC any) LJFOLD(UREFC KGC any) LJFOLDF(cse_uref) { if (LJ_LIKELY(J->flags & JIT_F_OPT_CSE)) { IRRef ref = J->chain[fins->o]; GCfunc *fn = ir_kfunc(fleft); GCupval *uv = gco2uv(gcref(fn->l.uvptr[(fins->op2 >> 8)])); while (ref > 0) { IRIns *ir = IR(ref); if (irref_isk(ir->op1)) { GCfunc *fn2 = ir_kfunc(IR(ir->op1)); if (gco2uv(gcref(fn2->l.uvptr[(ir->op2 >> 8)])) == uv) { if (fins->o == IR_UREFO && gcstep_barrier(J, ref)) break; return ref; } } ref = ir->prev; } } return EMITFOLD; } LJFOLD(HREFK any any) LJFOLDX(lj_opt_fwd_hrefk) LJFOLD(HREF TNEW any) LJFOLDF(fwd_href_tnew) { if (lj_opt_fwd_href_nokey(J)) return lj_ir_kkptr(J, niltvg(J2G(J))); return NEXTFOLD; } LJFOLD(HREF TDUP KPRI) LJFOLD(HREF TDUP KGC) LJFOLD(HREF TDUP KNUM) LJFOLDF(fwd_href_tdup) { TValue keyv; lj_ir_kvalue(J->L, &keyv, fright); if (lj_tab_get(J->L, ir_ktab(IR(fleft->op1)), &keyv) == niltvg(J2G(J)) && lj_opt_fwd_href_nokey(J)) return lj_ir_kkptr(J, niltvg(J2G(J))); return NEXTFOLD; } /* We can safely FOLD/CSE array/hash refs and field loads, since there ** are no corresponding stores. But we need to check for any NEWREF with ** an aliased table, as it may invalidate all of the pointers and fields. ** Only HREF needs the NEWREF check -- AREF and HREFK already depend on ** FLOADs. And NEWREF itself is treated like a store (see below). */ LJFOLD(FLOAD TNEW IRFL_TAB_ASIZE) LJFOLDF(fload_tab_tnew_asize) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD) && lj_opt_fwd_tptr(J, fins->op1)) return INTFOLD(fleft->op1); return NEXTFOLD; } LJFOLD(FLOAD TNEW IRFL_TAB_HMASK) LJFOLDF(fload_tab_tnew_hmask) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD) && lj_opt_fwd_tptr(J, fins->op1)) return INTFOLD((1 << fleft->op2)-1); return NEXTFOLD; } LJFOLD(FLOAD TDUP IRFL_TAB_ASIZE) LJFOLDF(fload_tab_tdup_asize) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD) && lj_opt_fwd_tptr(J, fins->op1)) return INTFOLD((int32_t)ir_ktab(IR(fleft->op1))->asize); return NEXTFOLD; } LJFOLD(FLOAD TDUP IRFL_TAB_HMASK) LJFOLDF(fload_tab_tdup_hmask) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD) && lj_opt_fwd_tptr(J, fins->op1)) return INTFOLD((int32_t)ir_ktab(IR(fleft->op1))->hmask); return NEXTFOLD; } LJFOLD(HREF any any) LJFOLD(FLOAD any IRFL_TAB_ARRAY) LJFOLD(FLOAD any IRFL_TAB_NODE) LJFOLD(FLOAD any IRFL_TAB_ASIZE) LJFOLD(FLOAD any IRFL_TAB_HMASK) LJFOLDF(fload_tab_ah) { TRef tr = lj_opt_cse(J); return lj_opt_fwd_tptr(J, tref_ref(tr)) ? tr : EMITFOLD; } /* Strings are immutable, so we can safely FOLD/CSE the related FLOAD. */ LJFOLD(FLOAD KGC IRFL_STR_LEN) LJFOLDF(fload_str_len_kgc) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD)) return INTFOLD((int32_t)ir_kstr(fleft)->len); return NEXTFOLD; } LJFOLD(FLOAD SNEW IRFL_STR_LEN) LJFOLDF(fload_str_len_snew) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD)) { PHIBARRIER(fleft); return fleft->op2; } return NEXTFOLD; } /* The C type ID of cdata objects is immutable. */ LJFOLD(FLOAD KGC IRFL_CDATA_CTYPEID) LJFOLDF(fload_cdata_typeid_kgc) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD)) return INTFOLD((int32_t)ir_kcdata(fleft)->ctypeid); return NEXTFOLD; } /* Get the contents of immutable cdata objects. */ LJFOLD(FLOAD KGC IRFL_CDATA_PTR) LJFOLD(FLOAD KGC IRFL_CDATA_INT) LJFOLD(FLOAD KGC IRFL_CDATA_INT64) LJFOLDF(fload_cdata_int64_kgc) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD)) { void *p = cdataptr(ir_kcdata(fleft)); if (irt_is64(fins->t)) return INT64FOLD(*(uint64_t *)p); else return INTFOLD(*(int32_t *)p); } return NEXTFOLD; } LJFOLD(FLOAD CNEW IRFL_CDATA_CTYPEID) LJFOLD(FLOAD CNEWI IRFL_CDATA_CTYPEID) LJFOLDF(fload_cdata_typeid_cnew) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD)) return fleft->op1; /* No PHI barrier needed. CNEW/CNEWI op1 is const. */ return NEXTFOLD; } /* Pointer, int and int64 cdata objects are immutable. */ LJFOLD(FLOAD CNEWI IRFL_CDATA_PTR) LJFOLD(FLOAD CNEWI IRFL_CDATA_INT) LJFOLD(FLOAD CNEWI IRFL_CDATA_INT64) LJFOLDF(fload_cdata_ptr_int64_cnew) { if (LJ_LIKELY(J->flags & JIT_F_OPT_FOLD)) return fleft->op2; /* Fold even across PHI to avoid allocations. */ return NEXTFOLD; } LJFOLD(FLOAD any IRFL_STR_LEN) LJFOLD(FLOAD any IRFL_CDATA_CTYPEID) LJFOLD(FLOAD any IRFL_CDATA_PTR) LJFOLD(FLOAD any IRFL_CDATA_INT) LJFOLD(FLOAD any IRFL_CDATA_INT64) LJFOLD(VLOAD any any) /* Vararg loads have no corresponding stores. */ LJFOLDX(lj_opt_cse) /* All other field loads need alias analysis. */ LJFOLD(FLOAD any any) LJFOLDX(lj_opt_fwd_fload) /* This is for LOOP only. Recording handles SLOADs internally. */ LJFOLD(SLOAD any any) LJFOLDF(fwd_sload) { if ((fins->op2 & IRSLOAD_FRAME)) { TRef tr = lj_opt_cse(J); return tref_ref(tr) < J->chain[IR_RETF] ? EMITFOLD : tr; } else { lua_assert(J->slot[fins->op1] != 0); return J->slot[fins->op1]; } } /* Only fold for KKPTR. The pointer _and_ the contents must be const. */ LJFOLD(XLOAD KKPTR any) LJFOLDF(xload_kptr) { TRef tr = kfold_xload(J, fins, ir_kptr(fleft)); return tr ? tr : NEXTFOLD; } LJFOLD(XLOAD any any) LJFOLDX(lj_opt_fwd_xload) /* -- Write barriers ------------------------------------------------------ */ /* Write barriers are amenable to CSE, but not across any incremental ** GC steps. ** ** The same logic applies to open upvalue references, because a stack ** may be resized during a GC step (not the current stack, but maybe that ** of a coroutine). */ LJFOLD(TBAR any) LJFOLD(OBAR any any) LJFOLD(UREFO any any) LJFOLDF(barrier_tab) { TRef tr = lj_opt_cse(J); if (gcstep_barrier(J, tref_ref(tr))) /* CSE across GC step? */ return EMITFOLD; /* Raw emit. Assumes fins is left intact by CSE. */ return tr; } LJFOLD(TBAR TNEW) LJFOLD(TBAR TDUP) LJFOLDF(barrier_tnew_tdup) { /* New tables are always white and never need a barrier. */ if (fins->op1 < J->chain[IR_LOOP]) /* Except across a GC step. */ return NEXTFOLD; return DROPFOLD; } /* -- Stores and allocations ---------------------------------------------- */ /* Stores and allocations cannot be folded or passed on to CSE in general. ** But some stores can be eliminated with dead-store elimination (DSE). ** ** Caveat: *all* stores and allocs must be listed here or they end up at CSE! */ LJFOLD(ASTORE any any) LJFOLD(HSTORE any any) LJFOLDX(lj_opt_dse_ahstore) LJFOLD(USTORE any any) LJFOLDX(lj_opt_dse_ustore) LJFOLD(FSTORE any any) LJFOLDX(lj_opt_dse_fstore) LJFOLD(XSTORE any any) LJFOLDX(lj_opt_dse_xstore) LJFOLD(NEWREF any any) /* Treated like a store. */ LJFOLD(CALLS any any) LJFOLD(CALLL any any) /* Safeguard fallback. */ LJFOLD(CALLXS any any) LJFOLD(XBAR) LJFOLD(RETF any any) /* Modifies BASE. */ LJFOLD(TNEW any any) LJFOLD(TDUP any) LJFOLD(CNEW any any) LJFOLD(XSNEW any any) LJFOLDX(lj_ir_emit) /* ------------------------------------------------------------------------ */ /* Every entry in the generated hash table is a 32 bit pattern: ** ** xxxxxxxx iiiiiii lllllll rrrrrrrrrr ** ** xxxxxxxx = 8 bit index into fold function table ** iiiiiii = 7 bit folded instruction opcode ** lllllll = 7 bit left instruction opcode ** rrrrrrrrrr = 8 bit right instruction opcode or 10 bits from literal field */ #include "lj_folddef.h" /* ------------------------------------------------------------------------ */ /* Fold IR instruction. */ TRef LJ_FASTCALL lj_opt_fold(jit_State *J) { uint32_t key, any; IRRef ref; if (LJ_UNLIKELY((J->flags & JIT_F_OPT_MASK) != JIT_F_OPT_DEFAULT)) { lua_assert(((JIT_F_OPT_FOLD|JIT_F_OPT_FWD|JIT_F_OPT_CSE|JIT_F_OPT_DSE) | JIT_F_OPT_DEFAULT) == JIT_F_OPT_DEFAULT); /* Folding disabled? Chain to CSE, but not for loads/stores/allocs. */ if (!(J->flags & JIT_F_OPT_FOLD) && irm_kind(lj_ir_mode[fins->o]) == IRM_N) return lj_opt_cse(J); /* No FOLD, forwarding or CSE? Emit raw IR for loads, except for SLOAD. */ if ((J->flags & (JIT_F_OPT_FOLD|JIT_F_OPT_FWD|JIT_F_OPT_CSE)) != (JIT_F_OPT_FOLD|JIT_F_OPT_FWD|JIT_F_OPT_CSE) && irm_kind(lj_ir_mode[fins->o]) == IRM_L && fins->o != IR_SLOAD) return lj_ir_emit(J); /* No FOLD or DSE? Emit raw IR for stores. */ if ((J->flags & (JIT_F_OPT_FOLD|JIT_F_OPT_DSE)) != (JIT_F_OPT_FOLD|JIT_F_OPT_DSE) && irm_kind(lj_ir_mode[fins->o]) == IRM_S) return lj_ir_emit(J); } /* Fold engine start/retry point. */ retry: /* Construct key from opcode and operand opcodes (unless literal/none). */ key = ((uint32_t)fins->o << 17); if (fins->op1 >= J->cur.nk) { key += (uint32_t)IR(fins->op1)->o << 10; *fleft = *IR(fins->op1); } if (fins->op2 >= J->cur.nk) { key += (uint32_t)IR(fins->op2)->o; *fright = *IR(fins->op2); } else { key += (fins->op2 & 0x3ffu); /* Literal mask. Must include IRCONV_*MASK. */ } /* Check for a match in order from most specific to least specific. */ any = 0; for (;;) { uint32_t k = key | (any & 0x1ffff); uint32_t h = fold_hashkey(k); uint32_t fh = fold_hash[h]; /* Lookup key in semi-perfect hash table. */ if ((fh & 0xffffff) == k || (fh = fold_hash[h+1], (fh & 0xffffff) == k)) { ref = (IRRef)tref_ref(fold_func[fh >> 24](J)); if (ref != NEXTFOLD) break; } if (any == 0xfffff) /* Exhausted folding. Pass on to CSE. */ return lj_opt_cse(J); any = (any | (any >> 10)) ^ 0xffc00; } /* Return value processing, ordered by frequency. */ if (LJ_LIKELY(ref >= MAX_FOLD)) return TREF(ref, irt_t(IR(ref)->t)); if (ref == RETRYFOLD) goto retry; if (ref == KINTFOLD) return lj_ir_kint(J, fins->i); if (ref == FAILFOLD) lj_trace_err(J, LJ_TRERR_GFAIL); lua_assert(ref == DROPFOLD); return REF_DROP; } /* -- Common-Subexpression Elimination ------------------------------------ */ /* CSE an IR instruction. This is very fast due to the skip-list chains. */ TRef LJ_FASTCALL lj_opt_cse(jit_State *J) { /* Avoid narrow to wide store-to-load forwarding stall */ IRRef2 op12 = (IRRef2)fins->op1 + ((IRRef2)fins->op2 << 16); IROp op = fins->o; if (LJ_LIKELY(J->flags & JIT_F_OPT_CSE)) { /* Limited search for same operands in per-opcode chain. */ IRRef ref = J->chain[op]; IRRef lim = fins->op1; if (fins->op2 > lim) lim = fins->op2; /* Relies on lit < REF_BIAS. */ while (ref > lim) { if (IR(ref)->op12 == op12) return TREF(ref, irt_t(IR(ref)->t)); /* Common subexpression found. */ ref = IR(ref)->prev; } } /* Otherwise emit IR (inlined for speed). */ { IRRef ref = lj_ir_nextins(J); IRIns *ir = IR(ref); ir->prev = J->chain[op]; ir->op12 = op12; J->chain[op] = (IRRef1)ref; ir->o = fins->o; J->guardemit.irt |= fins->t.irt; return TREF(ref, irt_t((ir->t = fins->t))); } } /* CSE with explicit search limit. */ TRef LJ_FASTCALL lj_opt_cselim(jit_State *J, IRRef lim) { IRRef ref = J->chain[fins->o]; IRRef2 op12 = (IRRef2)fins->op1 + ((IRRef2)fins->op2 << 16); while (ref > lim) { if (IR(ref)->op12 == op12) return ref; ref = IR(ref)->prev; } return lj_ir_emit(J); } /* ------------------------------------------------------------------------ */ #undef IR #undef fins #undef fleft #undef fright #undef knumleft #undef knumright #undef emitir #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lib_ffi.c0000644000175000017500000005401513122010155016434 0ustar philphil/* ** FFI library. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #define lib_ffi_c #define LUA_LIB #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_meta.h" #include "lj_ctype.h" #include "lj_cparse.h" #include "lj_cdata.h" #include "lj_cconv.h" #include "lj_carith.h" #include "lj_ccall.h" #include "lj_ccallback.h" #include "lj_clib.h" #include "lj_ff.h" #include "lj_lib.h" /* -- C type checks ------------------------------------------------------- */ /* Check first argument for a C type and returns its ID. */ static CTypeID ffi_checkctype(lua_State *L, CTState *cts, TValue *param) { TValue *o = L->base; if (!(o < L->top)) { err_argtype: lj_err_argtype(L, 1, "C type"); } if (tvisstr(o)) { /* Parse an abstract C type declaration. */ GCstr *s = strV(o); CPState cp; int errcode; cp.L = L; cp.cts = cts; cp.srcname = strdata(s); cp.p = strdata(s); cp.param = param; cp.mode = CPARSE_MODE_ABSTRACT|CPARSE_MODE_NOIMPLICIT; errcode = lj_cparse(&cp); if (errcode) lj_err_throw(L, errcode); /* Propagate errors. */ return cp.val.id; } else { GCcdata *cd; if (!tviscdata(o)) goto err_argtype; if (param && param < L->top) lj_err_arg(L, 1, LJ_ERR_FFI_NUMPARAM); cd = cdataV(o); return cd->ctypeid == CTID_CTYPEID ? *(CTypeID *)cdataptr(cd) : cd->ctypeid; } } /* Check argument for C data and return it. */ static GCcdata *ffi_checkcdata(lua_State *L, int narg) { TValue *o = L->base + narg-1; if (!(o < L->top && tviscdata(o))) lj_err_argt(L, narg, LUA_TCDATA); return cdataV(o); } /* Convert argument to C pointer. */ static void *ffi_checkptr(lua_State *L, int narg, CTypeID id) { CTState *cts = ctype_cts(L); TValue *o = L->base + narg-1; void *p; if (o >= L->top) lj_err_arg(L, narg, LJ_ERR_NOVAL); lj_cconv_ct_tv(cts, ctype_get(cts, id), (uint8_t *)&p, o, CCF_ARG(narg)); return p; } /* Convert argument to int32_t. */ static int32_t ffi_checkint(lua_State *L, int narg) { CTState *cts = ctype_cts(L); TValue *o = L->base + narg-1; int32_t i; if (o >= L->top) lj_err_arg(L, narg, LJ_ERR_NOVAL); lj_cconv_ct_tv(cts, ctype_get(cts, CTID_INT32), (uint8_t *)&i, o, CCF_ARG(narg)); return i; } /* -- C type metamethods -------------------------------------------------- */ #define LJLIB_MODULE_ffi_meta /* Handle ctype __index/__newindex metamethods. */ static int ffi_index_meta(lua_State *L, CTState *cts, CType *ct, MMS mm) { CTypeID id = ctype_typeid(cts, ct); cTValue *tv = lj_ctype_meta(cts, id, mm); TValue *base = L->base; if (!tv) { const char *s; err_index: s = strdata(lj_ctype_repr(L, id, NULL)); if (tvisstr(L->base+1)) { lj_err_callerv(L, LJ_ERR_FFI_BADMEMBER, s, strVdata(L->base+1)); } else { const char *key = tviscdata(L->base+1) ? strdata(lj_ctype_repr(L, cdataV(L->base+1)->ctypeid, NULL)) : lj_typename(L->base+1); lj_err_callerv(L, LJ_ERR_FFI_BADIDXW, s, key); } } if (!tvisfunc(tv)) { if (mm == MM_index) { cTValue *o = lj_meta_tget(L, tv, base+1); if (o) { if (tvisnil(o)) goto err_index; copyTV(L, L->top-1, o); return 1; } } else { TValue *o = lj_meta_tset(L, tv, base+1); if (o) { copyTV(L, o, base+2); return 0; } } copyTV(L, base, L->top); tv = L->top-1; } return lj_meta_tailcall(L, tv); } LJLIB_CF(ffi_meta___index) LJLIB_REC(cdata_index 0) { CTState *cts = ctype_cts(L); CTInfo qual = 0; CType *ct; uint8_t *p; TValue *o = L->base; if (!(o+1 < L->top && tviscdata(o))) /* Also checks for presence of key. */ lj_err_argt(L, 1, LUA_TCDATA); ct = lj_cdata_index(cts, cdataV(o), o+1, &p, &qual); if ((qual & 1)) return ffi_index_meta(L, cts, ct, MM_index); if (lj_cdata_get(cts, ct, L->top-1, p)) lj_gc_check(L); return 1; } LJLIB_CF(ffi_meta___newindex) LJLIB_REC(cdata_index 1) { CTState *cts = ctype_cts(L); CTInfo qual = 0; CType *ct; uint8_t *p; TValue *o = L->base; if (!(o+2 < L->top && tviscdata(o))) /* Also checks for key and value. */ lj_err_argt(L, 1, LUA_TCDATA); ct = lj_cdata_index(cts, cdataV(o), o+1, &p, &qual); if ((qual & 1)) { if ((qual & CTF_CONST)) lj_err_caller(L, LJ_ERR_FFI_WRCONST); return ffi_index_meta(L, cts, ct, MM_newindex); } lj_cdata_set(cts, ct, p, o+2, qual); return 0; } /* Common handler for cdata arithmetic. */ static int ffi_arith(lua_State *L) { MMS mm = (MMS)(curr_func(L)->c.ffid - (int)FF_ffi_meta___eq + (int)MM_eq); return lj_carith_op(L, mm); } /* The following functions must be in contiguous ORDER MM. */ LJLIB_CF(ffi_meta___eq) LJLIB_REC(cdata_arith MM_eq) { return ffi_arith(L); } LJLIB_CF(ffi_meta___len) LJLIB_REC(cdata_arith MM_len) { return ffi_arith(L); } LJLIB_CF(ffi_meta___lt) LJLIB_REC(cdata_arith MM_lt) { return ffi_arith(L); } LJLIB_CF(ffi_meta___le) LJLIB_REC(cdata_arith MM_le) { return ffi_arith(L); } LJLIB_CF(ffi_meta___concat) LJLIB_REC(cdata_arith MM_concat) { return ffi_arith(L); } /* Forward declaration. */ static int lj_cf_ffi_new(lua_State *L); LJLIB_CF(ffi_meta___call) LJLIB_REC(cdata_call) { CTState *cts = ctype_cts(L); GCcdata *cd = ffi_checkcdata(L, 1); CTypeID id = cd->ctypeid; CType *ct; cTValue *tv; MMS mm = MM_call; if (cd->ctypeid == CTID_CTYPEID) { id = *(CTypeID *)cdataptr(cd); mm = MM_new; } else { int ret = lj_ccall_func(L, cd); if (ret >= 0) return ret; } /* Handle ctype __call/__new metamethod. */ ct = ctype_raw(cts, id); if (ctype_isptr(ct->info)) id = ctype_cid(ct->info); tv = lj_ctype_meta(cts, id, mm); if (tv) return lj_meta_tailcall(L, tv); else if (mm == MM_call) lj_err_callerv(L, LJ_ERR_FFI_BADCALL, strdata(lj_ctype_repr(L, id, NULL))); return lj_cf_ffi_new(L); } LJLIB_CF(ffi_meta___add) LJLIB_REC(cdata_arith MM_add) { return ffi_arith(L); } LJLIB_CF(ffi_meta___sub) LJLIB_REC(cdata_arith MM_sub) { return ffi_arith(L); } LJLIB_CF(ffi_meta___mul) LJLIB_REC(cdata_arith MM_mul) { return ffi_arith(L); } LJLIB_CF(ffi_meta___div) LJLIB_REC(cdata_arith MM_div) { return ffi_arith(L); } LJLIB_CF(ffi_meta___mod) LJLIB_REC(cdata_arith MM_mod) { return ffi_arith(L); } LJLIB_CF(ffi_meta___pow) LJLIB_REC(cdata_arith MM_pow) { return ffi_arith(L); } LJLIB_CF(ffi_meta___unm) LJLIB_REC(cdata_arith MM_unm) { return ffi_arith(L); } /* End of contiguous ORDER MM. */ LJLIB_CF(ffi_meta___tostring) { GCcdata *cd = ffi_checkcdata(L, 1); const char *msg = "cdata<%s>: %p"; CTypeID id = cd->ctypeid; void *p = cdataptr(cd); if (id == CTID_CTYPEID) { msg = "ctype<%s>"; id = *(CTypeID *)p; } else { CTState *cts = ctype_cts(L); CType *ct = ctype_raw(cts, id); if (ctype_isref(ct->info)) { p = *(void **)p; ct = ctype_rawchild(cts, ct); } if (ctype_iscomplex(ct->info)) { setstrV(L, L->top-1, lj_ctype_repr_complex(L, cdataptr(cd), ct->size)); goto checkgc; } else if (ct->size == 8 && ctype_isinteger(ct->info)) { setstrV(L, L->top-1, lj_ctype_repr_int64(L, *(uint64_t *)cdataptr(cd), (ct->info & CTF_UNSIGNED))); goto checkgc; } else if (ctype_isfunc(ct->info)) { p = *(void **)p; } else if (ctype_isenum(ct->info)) { msg = "cdata<%s>: %d"; p = (void *)(uintptr_t)*(uint32_t **)p; } else { if (ctype_isptr(ct->info)) { p = cdata_getptr(p, ct->size); ct = ctype_rawchild(cts, ct); } if (ctype_isstruct(ct->info) || ctype_isvector(ct->info)) { /* Handle ctype __tostring metamethod. */ cTValue *tv = lj_ctype_meta(cts, ctype_typeid(cts, ct), MM_tostring); if (tv) return lj_meta_tailcall(L, tv); } } } lj_str_pushf(L, msg, strdata(lj_ctype_repr(L, id, NULL)), p); checkgc: lj_gc_check(L); return 1; } static int ffi_pairs(lua_State *L, MMS mm) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkcdata(L, 1)->ctypeid; CType *ct = ctype_raw(cts, id); cTValue *tv; if (ctype_isptr(ct->info)) id = ctype_cid(ct->info); tv = lj_ctype_meta(cts, id, mm); if (!tv) lj_err_callerv(L, LJ_ERR_FFI_BADMM, strdata(lj_ctype_repr(L, id, NULL)), strdata(mmname_str(G(L), mm))); return lj_meta_tailcall(L, tv); } LJLIB_CF(ffi_meta___pairs) { return ffi_pairs(L, MM_pairs); } LJLIB_CF(ffi_meta___ipairs) { return ffi_pairs(L, MM_ipairs); } LJLIB_PUSH("ffi") LJLIB_SET(__metatable) #include "lj_libdef.h" /* -- C library metamethods ----------------------------------------------- */ #define LJLIB_MODULE_ffi_clib /* Index C library by a name. */ static TValue *ffi_clib_index(lua_State *L) { TValue *o = L->base; CLibrary *cl; if (!(o < L->top && tvisudata(o) && udataV(o)->udtype == UDTYPE_FFI_CLIB)) lj_err_argt(L, 1, LUA_TUSERDATA); cl = (CLibrary *)uddata(udataV(o)); if (!(o+1 < L->top && tvisstr(o+1))) lj_err_argt(L, 2, LUA_TSTRING); return lj_clib_index(L, cl, strV(o+1)); } LJLIB_CF(ffi_clib___index) LJLIB_REC(clib_index 1) { TValue *tv = ffi_clib_index(L); if (tviscdata(tv)) { CTState *cts = ctype_cts(L); GCcdata *cd = cdataV(tv); CType *s = ctype_get(cts, cd->ctypeid); if (ctype_isextern(s->info)) { CTypeID sid = ctype_cid(s->info); void *sp = *(void **)cdataptr(cd); CType *ct = ctype_raw(cts, sid); if (lj_cconv_tv_ct(cts, ct, sid, L->top-1, sp)) lj_gc_check(L); return 1; } } copyTV(L, L->top-1, tv); return 1; } LJLIB_CF(ffi_clib___newindex) LJLIB_REC(clib_index 0) { TValue *tv = ffi_clib_index(L); TValue *o = L->base+2; if (o < L->top && tviscdata(tv)) { CTState *cts = ctype_cts(L); GCcdata *cd = cdataV(tv); CType *d = ctype_get(cts, cd->ctypeid); if (ctype_isextern(d->info)) { CTInfo qual = 0; for (;;) { /* Skip attributes and collect qualifiers. */ d = ctype_child(cts, d); if (!ctype_isattrib(d->info)) break; if (ctype_attrib(d->info) == CTA_QUAL) qual |= d->size; } if (!((d->info|qual) & CTF_CONST)) { lj_cconv_ct_tv(cts, d, *(void **)cdataptr(cd), o, 0); return 0; } } } lj_err_caller(L, LJ_ERR_FFI_WRCONST); return 0; /* unreachable */ } LJLIB_CF(ffi_clib___gc) { TValue *o = L->base; if (o < L->top && tvisudata(o) && udataV(o)->udtype == UDTYPE_FFI_CLIB) lj_clib_unload((CLibrary *)uddata(udataV(o))); return 0; } #include "lj_libdef.h" /* -- Callback function metamethods --------------------------------------- */ #define LJLIB_MODULE_ffi_callback static int ffi_callback_set(lua_State *L, GCfunc *fn) { GCcdata *cd = ffi_checkcdata(L, 1); CTState *cts = ctype_cts(L); CType *ct = ctype_raw(cts, cd->ctypeid); if (ctype_isptr(ct->info) && (LJ_32 || ct->size == 8)) { MSize slot = lj_ccallback_ptr2slot(cts, *(void **)cdataptr(cd)); if (slot < cts->cb.sizeid && cts->cb.cbid[slot] != 0) { GCtab *t = cts->miscmap; TValue *tv = lj_tab_setint(L, t, (int32_t)slot); if (fn) { setfuncV(L, tv, fn); lj_gc_anybarriert(L, t); } else { setnilV(tv); cts->cb.cbid[slot] = 0; cts->cb.topid = slot < cts->cb.topid ? slot : cts->cb.topid; } return 0; } } lj_err_caller(L, LJ_ERR_FFI_BADCBACK); return 0; } LJLIB_CF(ffi_callback_free) { return ffi_callback_set(L, NULL); } LJLIB_CF(ffi_callback_set) { GCfunc *fn = lj_lib_checkfunc(L, 2); return ffi_callback_set(L, fn); } LJLIB_PUSH(top-1) LJLIB_SET(__index) #include "lj_libdef.h" /* -- FFI library functions ----------------------------------------------- */ #define LJLIB_MODULE_ffi LJLIB_CF(ffi_cdef) { GCstr *s = lj_lib_checkstr(L, 1); CPState cp; int errcode; cp.L = L; cp.cts = ctype_cts(L); cp.srcname = strdata(s); cp.p = strdata(s); cp.param = L->base+1; cp.mode = CPARSE_MODE_MULTI|CPARSE_MODE_DIRECT; errcode = lj_cparse(&cp); if (errcode) lj_err_throw(L, errcode); /* Propagate errors. */ lj_gc_check(L); return 0; } LJLIB_CF(ffi_new) LJLIB_REC(.) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkctype(L, cts, NULL); CType *ct = ctype_raw(cts, id); CTSize sz; CTInfo info = lj_ctype_info(cts, id, &sz); TValue *o = L->base+1; GCcdata *cd; if ((info & CTF_VLA)) { o++; sz = lj_ctype_vlsize(cts, ct, (CTSize)ffi_checkint(L, 2)); } if (sz == CTSIZE_INVALID) lj_err_arg(L, 1, LJ_ERR_FFI_INVSIZE); if (!(info & CTF_VLA) && ctype_align(info) <= CT_MEMALIGN) cd = lj_cdata_new(cts, id, sz); else cd = lj_cdata_newv(cts, id, sz, ctype_align(info)); setcdataV(L, o-1, cd); /* Anchor the uninitialized cdata. */ lj_cconv_ct_init(cts, ct, sz, cdataptr(cd), o, (MSize)(L->top - o)); /* Initialize cdata. */ if (ctype_isstruct(ct->info)) { /* Handle ctype __gc metamethod. Use the fast lookup here. */ cTValue *tv = lj_tab_getinth(cts->miscmap, -(int32_t)id); if (tv && tvistab(tv) && (tv = lj_meta_fast(L, tabV(tv), MM_gc))) { GCtab *t = cts->finalizer; if (gcref(t->metatable)) { /* Add to finalizer table, if still enabled. */ copyTV(L, lj_tab_set(L, t, o-1), tv); lj_gc_anybarriert(L, t); cd->marked |= LJ_GC_CDATA_FIN; } } } L->top = o; /* Only return the cdata itself. */ lj_gc_check(L); return 1; } LJLIB_CF(ffi_cast) LJLIB_REC(ffi_new) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkctype(L, cts, NULL); CType *d = ctype_raw(cts, id); TValue *o = lj_lib_checkany(L, 2); L->top = o+1; /* Make sure this is the last item on the stack. */ if (!(ctype_isnum(d->info) || ctype_isptr(d->info) || ctype_isenum(d->info))) lj_err_arg(L, 1, LJ_ERR_FFI_INVTYPE); if (!(tviscdata(o) && cdataV(o)->ctypeid == id)) { GCcdata *cd = lj_cdata_new(cts, id, d->size); lj_cconv_ct_tv(cts, d, cdataptr(cd), o, CCF_CAST); setcdataV(L, o, cd); lj_gc_check(L); } return 1; } LJLIB_CF(ffi_typeof) LJLIB_REC(.) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkctype(L, cts, L->base+1); GCcdata *cd = lj_cdata_new(cts, CTID_CTYPEID, 4); *(CTypeID *)cdataptr(cd) = id; setcdataV(L, L->top-1, cd); lj_gc_check(L); return 1; } LJLIB_CF(ffi_istype) LJLIB_REC(.) { CTState *cts = ctype_cts(L); CTypeID id1 = ffi_checkctype(L, cts, NULL); TValue *o = lj_lib_checkany(L, 2); int b = 0; if (tviscdata(o)) { GCcdata *cd = cdataV(o); CTypeID id2 = cd->ctypeid == CTID_CTYPEID ? *(CTypeID *)cdataptr(cd) : cd->ctypeid; CType *ct1 = lj_ctype_rawref(cts, id1); CType *ct2 = lj_ctype_rawref(cts, id2); if (ct1 == ct2) { b = 1; } else if (ctype_type(ct1->info) == ctype_type(ct2->info) && ct1->size == ct2->size) { if (ctype_ispointer(ct1->info)) b = lj_cconv_compatptr(cts, ct1, ct2, CCF_IGNQUAL); else if (ctype_isnum(ct1->info) || ctype_isvoid(ct1->info)) b = (((ct1->info ^ ct2->info) & ~(CTF_QUAL|CTF_LONG)) == 0); } else if (ctype_isstruct(ct1->info) && ctype_isptr(ct2->info) && ct1 == ctype_rawchild(cts, ct2)) { b = 1; } } setboolV(L->top-1, b); setboolV(&G(L)->tmptv2, b); /* Remember for trace recorder. */ return 1; } LJLIB_CF(ffi_sizeof) LJLIB_REC(ffi_xof FF_ffi_sizeof) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkctype(L, cts, NULL); CTSize sz; if (LJ_UNLIKELY(tviscdata(L->base) && cdataisv(cdataV(L->base)))) { sz = cdatavlen(cdataV(L->base)); } else { CType *ct = lj_ctype_rawref(cts, id); if (ctype_isvltype(ct->info)) sz = lj_ctype_vlsize(cts, ct, (CTSize)ffi_checkint(L, 2)); else sz = ctype_hassize(ct->info) ? ct->size : CTSIZE_INVALID; if (LJ_UNLIKELY(sz == CTSIZE_INVALID)) { setnilV(L->top-1); return 1; } } setintV(L->top-1, (int32_t)sz); return 1; } LJLIB_CF(ffi_alignof) LJLIB_REC(ffi_xof FF_ffi_alignof) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkctype(L, cts, NULL); CTSize sz = 0; CTInfo info = lj_ctype_info(cts, id, &sz); setintV(L->top-1, 1 << ctype_align(info)); return 1; } LJLIB_CF(ffi_offsetof) LJLIB_REC(ffi_xof FF_ffi_offsetof) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkctype(L, cts, NULL); GCstr *name = lj_lib_checkstr(L, 2); CType *ct = lj_ctype_rawref(cts, id); CTSize ofs; if (ctype_isstruct(ct->info) && ct->size != CTSIZE_INVALID) { CType *fct = lj_ctype_getfield(cts, ct, name, &ofs); if (fct) { setintV(L->top-1, ofs); if (ctype_isfield(fct->info)) { return 1; } else if (ctype_isbitfield(fct->info)) { setintV(L->top++, ctype_bitpos(fct->info)); setintV(L->top++, ctype_bitbsz(fct->info)); return 3; } } } return 0; } LJLIB_CF(ffi_errno) LJLIB_REC(.) { int err = errno; if (L->top > L->base) errno = ffi_checkint(L, 1); setintV(L->top++, err); return 1; } LJLIB_CF(ffi_string) LJLIB_REC(.) { CTState *cts = ctype_cts(L); TValue *o = lj_lib_checkany(L, 1); const char *p; size_t len; if (o+1 < L->top && !tvisnil(o+1)) { len = (size_t)ffi_checkint(L, 2); lj_cconv_ct_tv(cts, ctype_get(cts, CTID_P_CVOID), (uint8_t *)&p, o, CCF_ARG(1)); } else { lj_cconv_ct_tv(cts, ctype_get(cts, CTID_P_CCHAR), (uint8_t *)&p, o, CCF_ARG(1)); len = strlen(p); } L->top = o+1; /* Make sure this is the last item on the stack. */ setstrV(L, o, lj_str_new(L, p, len)); lj_gc_check(L); return 1; } LJLIB_CF(ffi_copy) LJLIB_REC(.) { void *dp = ffi_checkptr(L, 1, CTID_P_VOID); void *sp = ffi_checkptr(L, 2, CTID_P_CVOID); TValue *o = L->base+1; CTSize len; if (tvisstr(o) && o+1 >= L->top) len = strV(o)->len+1; /* Copy Lua string including trailing '\0'. */ else len = (CTSize)ffi_checkint(L, 3); memcpy(dp, sp, len); return 0; } LJLIB_CF(ffi_fill) LJLIB_REC(.) { void *dp = ffi_checkptr(L, 1, CTID_P_VOID); CTSize len = (CTSize)ffi_checkint(L, 2); int32_t fill = 0; if (L->base+2 < L->top && !tvisnil(L->base+2)) fill = ffi_checkint(L, 3); memset(dp, fill, len); return 0; } #define H_(le, be) LJ_ENDIAN_SELECT(0x##le, 0x##be) /* Test ABI string. */ LJLIB_CF(ffi_abi) LJLIB_REC(.) { GCstr *s = lj_lib_checkstr(L, 1); int b = 0; switch (s->hash) { #if LJ_64 case H_(849858eb,ad35fd06): b = 1; break; /* 64bit */ #else case H_(662d3c79,d0e22477): b = 1; break; /* 32bit */ #endif #if LJ_ARCH_HASFPU case H_(e33ee463,e33ee463): b = 1; break; /* fpu */ #endif #if LJ_ABI_SOFTFP case H_(61211a23,c2e8c81c): b = 1; break; /* softfp */ #else case H_(539417a8,8ce0812f): b = 1; break; /* hardfp */ #endif #if LJ_ABI_EABI case H_(2182df8f,f2ed1152): b = 1; break; /* eabi */ #endif #if LJ_ABI_WIN case H_(4ab624a8,4ab624a8): b = 1; break; /* win */ #endif case H_(3af93066,1f001464): b = 1; break; /* le/be */ default: break; } setboolV(L->top-1, b); setboolV(&G(L)->tmptv2, b); /* Remember for trace recorder. */ return 1; } #undef H_ LJLIB_PUSH(top-8) LJLIB_SET(!) /* Store reference to miscmap table. */ LJLIB_CF(ffi_metatype) { CTState *cts = ctype_cts(L); CTypeID id = ffi_checkctype(L, cts, NULL); GCtab *mt = lj_lib_checktab(L, 2); GCtab *t = cts->miscmap; CType *ct = ctype_get(cts, id); /* Only allow raw types. */ TValue *tv; GCcdata *cd; if (!(ctype_isstruct(ct->info) || ctype_iscomplex(ct->info) || ctype_isvector(ct->info))) lj_err_arg(L, 1, LJ_ERR_FFI_INVTYPE); tv = lj_tab_setinth(L, t, -(int32_t)id); if (!tvisnil(tv)) lj_err_caller(L, LJ_ERR_PROTMT); settabV(L, tv, mt); lj_gc_anybarriert(L, t); cd = lj_cdata_new(cts, CTID_CTYPEID, 4); *(CTypeID *)cdataptr(cd) = id; setcdataV(L, L->top-1, cd); lj_gc_check(L); return 1; } LJLIB_PUSH(top-7) LJLIB_SET(!) /* Store reference to finalizer table. */ LJLIB_CF(ffi_gc) LJLIB_REC(.) { GCcdata *cd = ffi_checkcdata(L, 1); TValue *fin = lj_lib_checkany(L, 2); CTState *cts = ctype_cts(L); GCtab *t = cts->finalizer; CType *ct = ctype_raw(cts, cd->ctypeid); if (!(ctype_isptr(ct->info) || ctype_isstruct(ct->info) || ctype_isrefarray(ct->info))) lj_err_arg(L, 1, LJ_ERR_FFI_INVTYPE); if (gcref(t->metatable)) { /* Update finalizer table, if still enabled. */ copyTV(L, lj_tab_set(L, t, L->base), fin); lj_gc_anybarriert(L, t); if (!tvisnil(fin)) cd->marked |= LJ_GC_CDATA_FIN; else cd->marked &= ~LJ_GC_CDATA_FIN; } L->top = L->base+1; /* Pass through the cdata object. */ return 1; } LJLIB_PUSH(top-5) LJLIB_SET(!) /* Store clib metatable in func environment. */ LJLIB_CF(ffi_load) { GCstr *name = lj_lib_checkstr(L, 1); int global = (L->base+1 < L->top && tvistruecond(L->base+1)); lj_clib_load(L, tabref(curr_func(L)->c.env), name, global); return 1; } LJLIB_PUSH(top-4) LJLIB_SET(C) LJLIB_PUSH(top-3) LJLIB_SET(os) LJLIB_PUSH(top-2) LJLIB_SET(arch) #include "lj_libdef.h" /* ------------------------------------------------------------------------ */ /* Create special weak-keyed finalizer table. */ static GCtab *ffi_finalizer(lua_State *L) { /* NOBARRIER: The table is new (marked white). */ GCtab *t = lj_tab_new(L, 0, 1); settabV(L, L->top++, t); setgcref(t->metatable, obj2gco(t)); setstrV(L, lj_tab_setstr(L, t, lj_str_newlit(L, "__mode")), lj_str_newlit(L, "K")); t->nomm = (uint8_t)(~(1u<top-1); lj_gc_anybarriert(L, t); } } LUALIB_API int luaopen_ffi(lua_State *L) { CTState *cts = lj_ctype_init(L); settabV(L, L->top++, (cts->miscmap = lj_tab_new(L, 0, 1))); cts->finalizer = ffi_finalizer(L); LJ_LIB_REG(L, NULL, ffi_meta); /* NOBARRIER: basemt is a GC root. */ setgcref(basemt_it(G(L), LJ_TCDATA), obj2gco(tabV(L->top-1))); LJ_LIB_REG(L, NULL, ffi_clib); LJ_LIB_REG(L, NULL, ffi_callback); /* NOBARRIER: the key is new and lj_tab_newkey() handles the barrier. */ settabV(L, lj_tab_setstr(L, cts->miscmap, &cts->g->strempty), tabV(L->top-1)); L->top--; lj_clib_default(L, tabV(L->top-1)); /* Create ffi.C default namespace. */ lua_pushliteral(L, LJ_OS_NAME); lua_pushliteral(L, LJ_ARCH_NAME); LJ_LIB_REG(L, NULL, ffi); /* Note: no global "ffi" created! */ ffi_register_module(L); return 1; } #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ff.h0000644000175000017500000000055413122010155016126 0ustar philphil/* ** Fast function IDs. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #ifndef _LJ_FF_H #define _LJ_FF_H /* Fast function ID. */ typedef enum { FF_LUA_ = FF_LUA, /* Lua function (must be 0). */ FF_C_ = FF_C, /* Regular C function (must be 1). */ #define FFDEF(name) FF_##name, #include "lj_ffdef.h" FF__MAX } FastFunc; #endif wcc-0.0.2/src/wsh/luajit-2.0/src/lj_tab.c0000644000175000017500000004321713122010155016277 0ustar philphil/* ** Table handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Major portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_tab_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_err.h" #include "lj_tab.h" /* -- Object hashing ------------------------------------------------------ */ /* Hash values are masked with the table hash mask and used as an index. */ static LJ_AINLINE Node *hashmask(const GCtab *t, uint32_t hash) { Node *n = noderef(t->node); return &n[hash & t->hmask]; } /* String hashes are precomputed when they are interned. */ #define hashstr(t, s) hashmask(t, (s)->hash) #define hashlohi(t, lo, hi) hashmask((t), hashrot((lo), (hi))) #define hashnum(t, o) hashlohi((t), (o)->u32.lo, ((o)->u32.hi << 1)) #define hashptr(t, p) hashlohi((t), u32ptr(p), u32ptr(p) + HASH_BIAS) #define hashgcref(t, r) hashlohi((t), gcrefu(r), gcrefu(r) + HASH_BIAS) /* Hash an arbitrary key and return its anchor position in the hash table. */ static Node *hashkey(const GCtab *t, cTValue *key) { lua_assert(!tvisint(key)); if (tvisstr(key)) return hashstr(t, strV(key)); else if (tvisnum(key)) return hashnum(t, key); else if (tvisbool(key)) return hashmask(t, boolV(key)); else return hashgcref(t, key->gcr); /* Only hash 32 bits of lightuserdata on a 64 bit CPU. Good enough? */ } /* -- Table creation and destruction -------------------------------------- */ /* Create new hash part for table. */ static LJ_AINLINE void newhpart(lua_State *L, GCtab *t, uint32_t hbits) { uint32_t hsize; Node *node; lua_assert(hbits != 0); if (hbits > LJ_MAX_HBITS) lj_err_msg(L, LJ_ERR_TABOV); hsize = 1u << hbits; node = lj_mem_newvec(L, hsize, Node); setmref(node->freetop, &node[hsize]); setmref(t->node, node); t->hmask = hsize-1; } /* ** Q: Why all of these copies of t->hmask, t->node etc. to local variables? ** A: Because alias analysis for C is _really_ tough. ** Even state-of-the-art C compilers won't produce good code without this. */ /* Clear hash part of table. */ static LJ_AINLINE void clearhpart(GCtab *t) { uint32_t i, hmask = t->hmask; Node *node = noderef(t->node); lua_assert(t->hmask != 0); for (i = 0; i <= hmask; i++) { Node *n = &node[i]; setmref(n->next, NULL); setnilV(&n->key); setnilV(&n->val); } } /* Clear array part of table. */ static LJ_AINLINE void clearapart(GCtab *t) { uint32_t i, asize = t->asize; TValue *array = tvref(t->array); for (i = 0; i < asize; i++) setnilV(&array[i]); } /* Create a new table. Note: the slots are not initialized (yet). */ static GCtab *newtab(lua_State *L, uint32_t asize, uint32_t hbits) { GCtab *t; /* First try to colocate the array part. */ if (LJ_MAX_COLOSIZE != 0 && asize > 0 && asize <= LJ_MAX_COLOSIZE) { lua_assert((sizeof(GCtab) & 7) == 0); t = (GCtab *)lj_mem_newgco(L, sizetabcolo(asize)); t->gct = ~LJ_TTAB; t->nomm = (uint8_t)~0; t->colo = (int8_t)asize; setmref(t->array, (TValue *)((char *)t + sizeof(GCtab))); setgcrefnull(t->metatable); t->asize = asize; t->hmask = 0; setmref(t->node, &G(L)->nilnode); } else { /* Otherwise separately allocate the array part. */ t = lj_mem_newobj(L, GCtab); t->gct = ~LJ_TTAB; t->nomm = (uint8_t)~0; t->colo = 0; setmref(t->array, NULL); setgcrefnull(t->metatable); t->asize = 0; /* In case the array allocation fails. */ t->hmask = 0; setmref(t->node, &G(L)->nilnode); if (asize > 0) { if (asize > LJ_MAX_ASIZE) lj_err_msg(L, LJ_ERR_TABOV); setmref(t->array, lj_mem_newvec(L, asize, TValue)); t->asize = asize; } } if (hbits) newhpart(L, t, hbits); return t; } /* Create a new table. ** ** IMPORTANT NOTE: The API differs from lua_createtable()! ** ** The array size is non-inclusive. E.g. asize=128 creates array slots ** for 0..127, but not for 128. If you need slots 1..128, pass asize=129 ** (slot 0 is wasted in this case). ** ** The hash size is given in hash bits. hbits=0 means no hash part. ** hbits=1 creates 2 hash slots, hbits=2 creates 4 hash slots and so on. */ GCtab *lj_tab_new(lua_State *L, uint32_t asize, uint32_t hbits) { GCtab *t = newtab(L, asize, hbits); clearapart(t); if (t->hmask > 0) clearhpart(t); return t; } #if LJ_HASJIT GCtab * LJ_FASTCALL lj_tab_new1(lua_State *L, uint32_t ahsize) { GCtab *t = newtab(L, ahsize & 0xffffff, ahsize >> 24); clearapart(t); if (t->hmask > 0) clearhpart(t); return t; } #endif /* Duplicate a table. */ GCtab * LJ_FASTCALL lj_tab_dup(lua_State *L, const GCtab *kt) { GCtab *t; uint32_t asize, hmask; t = newtab(L, kt->asize, kt->hmask > 0 ? lj_fls(kt->hmask)+1 : 0); lua_assert(kt->asize == t->asize && kt->hmask == t->hmask); t->nomm = 0; /* Keys with metamethod names may be present. */ asize = kt->asize; if (asize > 0) { TValue *array = tvref(t->array); TValue *karray = tvref(kt->array); if (asize < 64) { /* An inlined loop beats memcpy for < 512 bytes. */ uint32_t i; for (i = 0; i < asize; i++) copyTV(L, &array[i], &karray[i]); } else { memcpy(array, karray, asize*sizeof(TValue)); } } hmask = kt->hmask; if (hmask > 0) { uint32_t i; Node *node = noderef(t->node); Node *knode = noderef(kt->node); ptrdiff_t d = (char *)node - (char *)knode; setmref(node->freetop, (Node *)((char *)noderef(knode->freetop) + d)); for (i = 0; i <= hmask; i++) { Node *kn = &knode[i]; Node *n = &node[i]; Node *next = nextnode(kn); /* Don't use copyTV here, since it asserts on a copy of a dead key. */ n->val = kn->val; n->key = kn->key; setmref(n->next, next == NULL? next : (Node *)((char *)next + d)); } } return t; } /* Free a table. */ void LJ_FASTCALL lj_tab_free(global_State *g, GCtab *t) { if (t->hmask > 0) lj_mem_freevec(g, noderef(t->node), t->hmask+1, Node); if (t->asize > 0 && LJ_MAX_COLOSIZE != 0 && t->colo <= 0) lj_mem_freevec(g, tvref(t->array), t->asize, TValue); if (LJ_MAX_COLOSIZE != 0 && t->colo) lj_mem_free(g, t, sizetabcolo((uint32_t)t->colo & 0x7f)); else lj_mem_freet(g, t); } /* -- Table resizing ------------------------------------------------------ */ /* Resize a table to fit the new array/hash part sizes. */ static void resizetab(lua_State *L, GCtab *t, uint32_t asize, uint32_t hbits) { Node *oldnode = noderef(t->node); uint32_t oldasize = t->asize; uint32_t oldhmask = t->hmask; if (asize > oldasize) { /* Array part grows? */ TValue *array; uint32_t i; if (asize > LJ_MAX_ASIZE) lj_err_msg(L, LJ_ERR_TABOV); if (LJ_MAX_COLOSIZE != 0 && t->colo > 0) { /* A colocated array must be separated and copied. */ TValue *oarray = tvref(t->array); array = lj_mem_newvec(L, asize, TValue); t->colo = (int8_t)(t->colo | 0x80); /* Mark as separated (colo < 0). */ for (i = 0; i < oldasize; i++) copyTV(L, &array[i], &oarray[i]); } else { array = (TValue *)lj_mem_realloc(L, tvref(t->array), oldasize*sizeof(TValue), asize*sizeof(TValue)); } setmref(t->array, array); t->asize = asize; for (i = oldasize; i < asize; i++) /* Clear newly allocated slots. */ setnilV(&array[i]); } /* Create new (empty) hash part. */ if (hbits) { newhpart(L, t, hbits); clearhpart(t); } else { global_State *g = G(L); setmref(t->node, &g->nilnode); t->hmask = 0; } if (asize < oldasize) { /* Array part shrinks? */ TValue *array = tvref(t->array); uint32_t i; t->asize = asize; /* Note: This 'shrinks' even colocated arrays. */ for (i = asize; i < oldasize; i++) /* Reinsert old array values. */ if (!tvisnil(&array[i])) copyTV(L, lj_tab_setinth(L, t, (int32_t)i), &array[i]); /* Physically shrink only separated arrays. */ if (LJ_MAX_COLOSIZE != 0 && t->colo <= 0) setmref(t->array, lj_mem_realloc(L, array, oldasize*sizeof(TValue), asize*sizeof(TValue))); } if (oldhmask > 0) { /* Reinsert pairs from old hash part. */ global_State *g; uint32_t i; for (i = 0; i <= oldhmask; i++) { Node *n = &oldnode[i]; if (!tvisnil(&n->val)) copyTV(L, lj_tab_set(L, t, &n->key), &n->val); } g = G(L); lj_mem_freevec(g, oldnode, oldhmask+1, Node); } } static uint32_t countint(cTValue *key, uint32_t *bins) { lua_assert(!tvisint(key)); if (tvisnum(key)) { lua_Number nk = numV(key); int32_t k = lj_num2int(nk); if ((uint32_t)k < LJ_MAX_ASIZE && nk == (lua_Number)k) { bins[(k > 2 ? lj_fls((uint32_t)(k-1)) : 0)]++; return 1; } } return 0; } static uint32_t countarray(const GCtab *t, uint32_t *bins) { uint32_t na, b, i; if (t->asize == 0) return 0; for (na = i = b = 0; b < LJ_MAX_ABITS; b++) { uint32_t n, top = 2u << b; TValue *array; if (top >= t->asize) { top = t->asize-1; if (i > top) break; } array = tvref(t->array); for (n = 0; i <= top; i++) if (!tvisnil(&array[i])) n++; bins[b] += n; na += n; } return na; } static uint32_t counthash(const GCtab *t, uint32_t *bins, uint32_t *narray) { uint32_t total, na, i, hmask = t->hmask; Node *node = noderef(t->node); for (total = na = 0, i = 0; i <= hmask; i++) { Node *n = &node[i]; if (!tvisnil(&n->val)) { na += countint(&n->key, bins); total++; } } *narray += na; return total; } static uint32_t bestasize(uint32_t bins[], uint32_t *narray) { uint32_t b, sum, na = 0, sz = 0, nn = *narray; for (b = 0, sum = 0; 2*nn > (1u< 0 && 2*(sum += bins[b]) > (1u<hmask > 0 ? lj_fls(t->hmask)+1 : 0); } /* -- Table getters ------------------------------------------------------- */ cTValue * LJ_FASTCALL lj_tab_getinth(GCtab *t, int32_t key) { TValue k; Node *n; k.n = (lua_Number)key; n = hashnum(t, &k); do { if (tvisnum(&n->key) && n->key.n == k.n) return &n->val; } while ((n = nextnode(n))); return NULL; } cTValue *lj_tab_getstr(GCtab *t, GCstr *key) { Node *n = hashstr(t, key); do { if (tvisstr(&n->key) && strV(&n->key) == key) return &n->val; } while ((n = nextnode(n))); return NULL; } cTValue *lj_tab_get(lua_State *L, GCtab *t, cTValue *key) { if (tvisstr(key)) { cTValue *tv = lj_tab_getstr(t, strV(key)); if (tv) return tv; } else if (tvisint(key)) { cTValue *tv = lj_tab_getint(t, intV(key)); if (tv) return tv; } else if (tvisnum(key)) { lua_Number nk = numV(key); int32_t k = lj_num2int(nk); if (nk == (lua_Number)k) { cTValue *tv = lj_tab_getint(t, k); if (tv) return tv; } else { goto genlookup; /* Else use the generic lookup. */ } } else if (!tvisnil(key)) { Node *n; genlookup: n = hashkey(t, key); do { if (lj_obj_equal(&n->key, key)) return &n->val; } while ((n = nextnode(n))); } return niltv(L); } /* -- Table setters ------------------------------------------------------- */ /* Insert new key. Use Brent's variation to optimize the chain length. */ TValue *lj_tab_newkey(lua_State *L, GCtab *t, cTValue *key) { Node *n = hashkey(t, key); if (!tvisnil(&n->val) || t->hmask == 0) { Node *nodebase = noderef(t->node); Node *collide, *freenode = noderef(nodebase->freetop); lua_assert(freenode >= nodebase && freenode <= nodebase+t->hmask+1); do { if (freenode == nodebase) { /* No free node found? */ rehashtab(L, t, key); /* Rehash table. */ return lj_tab_set(L, t, key); /* Retry key insertion. */ } } while (!tvisnil(&(--freenode)->key)); setmref(nodebase->freetop, freenode); lua_assert(freenode != &G(L)->nilnode); collide = hashkey(t, &n->key); if (collide != n) { /* Colliding node not the main node? */ while (noderef(collide->next) != n) /* Find predecessor. */ collide = nextnode(collide); setmref(collide->next, freenode); /* Relink chain. */ /* Copy colliding node into free node and free main node. */ freenode->val = n->val; freenode->key = n->key; freenode->next = n->next; setmref(n->next, NULL); setnilV(&n->val); /* Rechain pseudo-resurrected string keys with colliding hashes. */ while (nextnode(freenode)) { Node *nn = nextnode(freenode); if (tvisstr(&nn->key) && !tvisnil(&nn->val) && hashstr(t, strV(&nn->key)) == n) { freenode->next = nn->next; nn->next = n->next; setmref(n->next, nn); } else { freenode = nn; } } } else { /* Otherwise use free node. */ setmrefr(freenode->next, n->next); /* Insert into chain. */ setmref(n->next, freenode); n = freenode; } } n->key.u64 = key->u64; if (LJ_UNLIKELY(tvismzero(&n->key))) n->key.u64 = 0; lj_gc_anybarriert(L, t); lua_assert(tvisnil(&n->val)); return &n->val; } TValue *lj_tab_setinth(lua_State *L, GCtab *t, int32_t key) { TValue k; Node *n; k.n = (lua_Number)key; n = hashnum(t, &k); do { if (tvisnum(&n->key) && n->key.n == k.n) return &n->val; } while ((n = nextnode(n))); return lj_tab_newkey(L, t, &k); } TValue *lj_tab_setstr(lua_State *L, GCtab *t, GCstr *key) { TValue k; Node *n = hashstr(t, key); do { if (tvisstr(&n->key) && strV(&n->key) == key) return &n->val; } while ((n = nextnode(n))); setstrV(L, &k, key); return lj_tab_newkey(L, t, &k); } TValue *lj_tab_set(lua_State *L, GCtab *t, cTValue *key) { Node *n; t->nomm = 0; /* Invalidate negative metamethod cache. */ if (tvisstr(key)) { return lj_tab_setstr(L, t, strV(key)); } else if (tvisint(key)) { return lj_tab_setint(L, t, intV(key)); } else if (tvisnum(key)) { lua_Number nk = numV(key); int32_t k = lj_num2int(nk); if (nk == (lua_Number)k) return lj_tab_setint(L, t, k); if (tvisnan(key)) lj_err_msg(L, LJ_ERR_NANIDX); /* Else use the generic lookup. */ } else if (tvisnil(key)) { lj_err_msg(L, LJ_ERR_NILIDX); } n = hashkey(t, key); do { if (lj_obj_equal(&n->key, key)) return &n->val; } while ((n = nextnode(n))); return lj_tab_newkey(L, t, key); } /* -- Table traversal ----------------------------------------------------- */ /* Get the traversal index of a key. */ static uint32_t keyindex(lua_State *L, GCtab *t, cTValue *key) { TValue tmp; if (tvisint(key)) { int32_t k = intV(key); if ((uint32_t)k < t->asize) return (uint32_t)k; /* Array key indexes: [0..t->asize-1] */ setnumV(&tmp, (lua_Number)k); key = &tmp; } else if (tvisnum(key)) { lua_Number nk = numV(key); int32_t k = lj_num2int(nk); if ((uint32_t)k < t->asize && nk == (lua_Number)k) return (uint32_t)k; /* Array key indexes: [0..t->asize-1] */ } if (!tvisnil(key)) { Node *n = hashkey(t, key); do { if (lj_obj_equal(&n->key, key)) return t->asize + (uint32_t)(n - noderef(t->node)); /* Hash key indexes: [t->asize..t->asize+t->nmask] */ } while ((n = nextnode(n))); if (key->u32.hi == 0xfffe7fff) /* ITERN was despecialized while running. */ return key->u32.lo - 1; lj_err_msg(L, LJ_ERR_NEXTIDX); return 0; /* unreachable */ } return ~0u; /* A nil key starts the traversal. */ } /* Advance to the next step in a table traversal. */ int lj_tab_next(lua_State *L, GCtab *t, TValue *key) { uint32_t i = keyindex(L, t, key); /* Find predecessor key index. */ for (i++; i < t->asize; i++) /* First traverse the array keys. */ if (!tvisnil(arrayslot(t, i))) { setintV(key, i); copyTV(L, key+1, arrayslot(t, i)); return 1; } for (i -= t->asize; i <= t->hmask; i++) { /* Then traverse the hash keys. */ Node *n = &noderef(t->node)[i]; if (!tvisnil(&n->val)) { copyTV(L, key, &n->key); copyTV(L, key+1, &n->val); return 1; } } return 0; /* End of traversal. */ } /* -- Table length calculation -------------------------------------------- */ static MSize unbound_search(GCtab *t, MSize j) { cTValue *tv; MSize i = j; /* i is zero or a present index */ j++; /* find `i' and `j' such that i is present and j is not */ while ((tv = lj_tab_getint(t, (int32_t)j)) && !tvisnil(tv)) { i = j; j *= 2; if (j > (MSize)(INT_MAX-2)) { /* overflow? */ /* table was built with bad purposes: resort to linear search */ i = 1; while ((tv = lj_tab_getint(t, (int32_t)i)) && !tvisnil(tv)) i++; return i - 1; } } /* now do a binary search between them */ while (j - i > 1) { MSize m = (i+j)/2; cTValue *tvb = lj_tab_getint(t, (int32_t)m); if (tvb && !tvisnil(tvb)) i = m; else j = m; } return i; } /* ** Try to find a boundary in table `t'. A `boundary' is an integer index ** such that t[i] is non-nil and t[i+1] is nil (and 0 if t[1] is nil). */ MSize LJ_FASTCALL lj_tab_len(GCtab *t) { MSize j = (MSize)t->asize; if (j > 1 && tvisnil(arrayslot(t, j-1))) { MSize i = 1; while (j - i > 1) { MSize m = (i+j)/2; if (tvisnil(arrayslot(t, m-1))) j = m; else i = m; } return i-1; } if (j) j--; if (t->hmask <= 0) return j; return unbound_search(t, j); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_func.c0000644000175000017500000001307113122010155016457 0ustar philphil/* ** Function handling (prototypes, functions and upvalues). ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h ** ** Portions taken verbatim or adapted from the Lua interpreter. ** Copyright (C) 1994-2008 Lua.org, PUC-Rio. See Copyright Notice in lua.h */ #define lj_func_c #define LUA_CORE #include "lj_obj.h" #include "lj_gc.h" #include "lj_func.h" #include "lj_trace.h" #include "lj_vm.h" /* -- Prototypes ---------------------------------------------------------- */ void LJ_FASTCALL lj_func_freeproto(global_State *g, GCproto *pt) { lj_mem_free(g, pt, pt->sizept); } /* -- Upvalues ------------------------------------------------------------ */ static void unlinkuv(GCupval *uv) { lua_assert(uvprev(uvnext(uv)) == uv && uvnext(uvprev(uv)) == uv); setgcrefr(uvnext(uv)->prev, uv->prev); setgcrefr(uvprev(uv)->next, uv->next); } /* Find existing open upvalue for a stack slot or create a new one. */ static GCupval *func_finduv(lua_State *L, TValue *slot) { global_State *g = G(L); GCRef *pp = &L->openupval; GCupval *p; GCupval *uv; /* Search the sorted list of open upvalues. */ while (gcref(*pp) != NULL && uvval((p = gco2uv(gcref(*pp)))) >= slot) { lua_assert(!p->closed && uvval(p) != &p->tv); if (uvval(p) == slot) { /* Found open upvalue pointing to same slot? */ if (isdead(g, obj2gco(p))) /* Resurrect it, if it's dead. */ flipwhite(obj2gco(p)); return p; } pp = &p->nextgc; } /* No matching upvalue found. Create a new one. */ uv = lj_mem_newt(L, sizeof(GCupval), GCupval); newwhite(g, uv); uv->gct = ~LJ_TUPVAL; uv->closed = 0; /* Still open. */ setmref(uv->v, slot); /* Pointing to the stack slot. */ /* NOBARRIER: The GCupval is new (marked white) and open. */ setgcrefr(uv->nextgc, *pp); /* Insert into sorted list of open upvalues. */ setgcref(*pp, obj2gco(uv)); setgcref(uv->prev, obj2gco(&g->uvhead)); /* Insert into GC list, too. */ setgcrefr(uv->next, g->uvhead.next); setgcref(uvnext(uv)->prev, obj2gco(uv)); setgcref(g->uvhead.next, obj2gco(uv)); lua_assert(uvprev(uvnext(uv)) == uv && uvnext(uvprev(uv)) == uv); return uv; } /* Create an empty and closed upvalue. */ static GCupval *func_emptyuv(lua_State *L) { GCupval *uv = (GCupval *)lj_mem_newgco(L, sizeof(GCupval)); uv->gct = ~LJ_TUPVAL; uv->closed = 1; setnilV(&uv->tv); setmref(uv->v, &uv->tv); return uv; } /* Close all open upvalues pointing to some stack level or above. */ void LJ_FASTCALL lj_func_closeuv(lua_State *L, TValue *level) { GCupval *uv; global_State *g = G(L); while (gcref(L->openupval) != NULL && uvval((uv = gco2uv(gcref(L->openupval)))) >= level) { GCobj *o = obj2gco(uv); lua_assert(!isblack(o) && !uv->closed && uvval(uv) != &uv->tv); setgcrefr(L->openupval, uv->nextgc); /* No longer in open list. */ if (isdead(g, o)) { lj_func_freeuv(g, uv); } else { unlinkuv(uv); lj_gc_closeuv(g, uv); } } } void LJ_FASTCALL lj_func_freeuv(global_State *g, GCupval *uv) { if (!uv->closed) unlinkuv(uv); lj_mem_freet(g, uv); } /* -- Functions (closures) ------------------------------------------------ */ GCfunc *lj_func_newC(lua_State *L, MSize nelems, GCtab *env) { GCfunc *fn = (GCfunc *)lj_mem_newgco(L, sizeCfunc(nelems)); fn->c.gct = ~LJ_TFUNC; fn->c.ffid = FF_C; fn->c.nupvalues = (uint8_t)nelems; /* NOBARRIER: The GCfunc is new (marked white). */ setmref(fn->c.pc, &G(L)->bc_cfunc_ext); setgcref(fn->c.env, obj2gco(env)); return fn; } static GCfunc *func_newL(lua_State *L, GCproto *pt, GCtab *env) { uint32_t count; GCfunc *fn = (GCfunc *)lj_mem_newgco(L, sizeLfunc((MSize)pt->sizeuv)); fn->l.gct = ~LJ_TFUNC; fn->l.ffid = FF_LUA; fn->l.nupvalues = 0; /* Set to zero until upvalues are initialized. */ /* NOBARRIER: Really a setgcref. But the GCfunc is new (marked white). */ setmref(fn->l.pc, proto_bc(pt)); setgcref(fn->l.env, obj2gco(env)); /* Saturating 3 bit counter (0..7) for created closures. */ count = (uint32_t)pt->flags + PROTO_CLCOUNT; pt->flags = (uint8_t)(count - ((count >> PROTO_CLC_BITS) & PROTO_CLCOUNT)); return fn; } /* Create a new Lua function with empty upvalues. */ GCfunc *lj_func_newL_empty(lua_State *L, GCproto *pt, GCtab *env) { GCfunc *fn = func_newL(L, pt, env); MSize i, nuv = pt->sizeuv; /* NOBARRIER: The GCfunc is new (marked white). */ for (i = 0; i < nuv; i++) { GCupval *uv = func_emptyuv(L); uv->dhash = (uint32_t)(uintptr_t)pt ^ ((uint32_t)proto_uv(pt)[i] << 24); setgcref(fn->l.uvptr[i], obj2gco(uv)); } fn->l.nupvalues = (uint8_t)nuv; return fn; } /* Do a GC check and create a new Lua function with inherited upvalues. */ GCfunc *lj_func_newL_gc(lua_State *L, GCproto *pt, GCfuncL *parent) { GCfunc *fn; GCRef *puv; MSize i, nuv; TValue *base; lj_gc_check_fixtop(L); fn = func_newL(L, pt, tabref(parent->env)); /* NOBARRIER: The GCfunc is new (marked white). */ puv = parent->uvptr; nuv = pt->sizeuv; base = L->base; for (i = 0; i < nuv; i++) { uint32_t v = proto_uv(pt)[i]; GCupval *uv; if ((v & PROTO_UV_LOCAL)) { uv = func_finduv(L, base + (v & 0xff)); uv->immutable = ((v / PROTO_UV_IMMUTABLE) & 1); uv->dhash = (uint32_t)(uintptr_t)mref(parent->pc, char) ^ (v << 24); } else { uv = &gcref(puv[v])->uv; } setgcref(fn->l.uvptr[i], obj2gco(uv)); } fn->l.nupvalues = (uint8_t)nuv; return fn; } void LJ_FASTCALL lj_func_free(global_State *g, GCfunc *fn) { MSize size = isluafunc(fn) ? sizeLfunc((MSize)fn->l.nupvalues) : sizeCfunc((MSize)fn->c.nupvalues); lj_mem_free(g, fn, size); } wcc-0.0.2/src/wsh/luajit-2.0/src/lj_ccall.c0000644000175000017500000006545313122010155016615 0ustar philphil/* ** FFI C call handling. ** Copyright (C) 2005-2016 Mike Pall. See Copyright Notice in luajit.h */ #include "lj_obj.h" #if LJ_HASFFI #include "lj_gc.h" #include "lj_err.h" #include "lj_str.h" #include "lj_tab.h" #include "lj_ctype.h" #include "lj_cconv.h" #include "lj_cdata.h" #include "lj_ccall.h" #include "lj_trace.h" /* Target-specific handling of register arguments. */ #if LJ_TARGET_X86 /* -- x86 calling conventions --------------------------------------------- */ #if LJ_ABI_WIN #define CCALL_HANDLE_STRUCTRET \ /* Return structs bigger than 8 by reference (on stack only). */ \ cc->retref = (sz > 8); \ if (cc->retref) cc->stack[nsp++] = (GPRArg)dp; #define CCALL_HANDLE_COMPLEXRET CCALL_HANDLE_STRUCTRET #else #if LJ_TARGET_OSX #define CCALL_HANDLE_STRUCTRET \ /* Return structs of size 1, 2, 4 or 8 in registers. */ \ cc->retref = !(sz == 1 || sz == 2 || sz == 4 || sz == 8); \ if (cc->retref) { \ if (ngpr < maxgpr) \ cc->gpr[ngpr++] = (GPRArg)dp; \ else \ cc->stack[nsp++] = (GPRArg)dp; \ } else { /* Struct with single FP field ends up in FPR. */ \ cc->resx87 = ccall_classify_struct(cts, ctr); \ } #define CCALL_HANDLE_STRUCTRET2 \ if (cc->resx87) sp = (uint8_t *)&cc->fpr[0]; \ memcpy(dp, sp, ctr->size); #else #define CCALL_HANDLE_STRUCTRET \ cc->retref = 1; /* Return all structs by reference (in reg or on stack). */ \ if (ngpr < maxgpr) \ cc->gpr[ngpr++] = (GPRArg)dp; \ else \ cc->stack[nsp++] = (GPRArg)dp; #endif #define CCALL_HANDLE_COMPLEXRET \ /* Return complex float in GPRs and complex double by reference. */ \ cc->retref = (sz > 8); \ if (cc->retref) { \ if (ngpr < maxgpr) \ cc->gpr[ngpr++] = (GPRArg)dp; \ else \ cc->stack[nsp++] = (GPRArg)dp; \ } #endif #define CCALL_HANDLE_COMPLEXRET2 \ if (!cc->retref) \ *(int64_t *)dp = *(int64_t *)sp; /* Copy complex float from GPRs. */ #define CCALL_HANDLE_STRUCTARG \ ngpr = maxgpr; /* Pass all structs by value on the stack. */ #define CCALL_HANDLE_COMPLEXARG \ isfp = 1; /* Pass complex by value on stack. */ #define CCALL_HANDLE_REGARG \ if (!isfp) { /* Only non-FP values may be passed in registers. */ \ if (n > 1) { /* Anything > 32 bit is passed on the stack. */ \ if (!LJ_ABI_WIN) ngpr = maxgpr; /* Prevent reordering. */ \ } else if (ngpr + 1 <= maxgpr) { \ dp = &cc->gpr[ngpr]; \ ngpr += n; \ goto done; \ } \ } #elif LJ_TARGET_X64 && LJ_ABI_WIN /* -- Windows/x64 calling conventions ------------------------------------- */ #define CCALL_HANDLE_STRUCTRET \ /* Return structs of size 1, 2, 4 or 8 in a GPR. */ \ cc->retref = !(sz == 1 || sz == 2 || sz == 4 || sz == 8); \ if (cc->retref) cc->gpr[ngpr++] = (GPRArg)dp; #define CCALL_HANDLE_COMPLEXRET CCALL_HANDLE_STRUCTRET #define CCALL_HANDLE_COMPLEXRET2 \ if (!cc->retref) \ *(int64_t *)dp = *(int64_t *)sp; /* Copy complex float from GPRs. */ #define CCALL_HANDLE_STRUCTARG \ /* Pass structs of size 1, 2, 4 or 8 in a GPR by value. */ \ if (!(sz == 1 || sz == 2 || sz == 4 || sz == 8)) { \ rp = cdataptr(lj_cdata_new(cts, did, sz)); \ sz = CTSIZE_PTR; /* Pass all other structs by reference. */ \ } #define CCALL_HANDLE_COMPLEXARG \ /* Pass complex float in a GPR and complex double by reference. */ \ if (sz != 2*sizeof(float)) { \ rp = cdataptr(lj_cdata_new(cts, did, sz)); \ sz = CTSIZE_PTR; \ } /* Windows/x64 argument registers are strictly positional (use ngpr). */ #define CCALL_HANDLE_REGARG \ if (isfp) { \ if (ngpr < maxgpr) { dp = &cc->fpr[ngpr++]; nfpr = ngpr; goto done; } \ } else { \ if (ngpr < maxgpr) { dp = &cc->gpr[ngpr++]; goto done; } \ } #elif LJ_TARGET_X64 /* -- POSIX/x64 calling conventions --------------------------------------- */ #define CCALL_HANDLE_STRUCTRET \ int rcl[2]; rcl[0] = rcl[1] = 0; \ if (ccall_classify_struct(cts, ctr, rcl, 0)) { \ cc->retref = 1; /* Return struct by reference. */ \ cc->gpr[ngpr++] = (GPRArg)dp; \ } else { \ cc->retref = 0; /* Return small structs in registers. */ \ } #define CCALL_HANDLE_STRUCTRET2 \ int rcl[2]; rcl[0] = rcl[1] = 0; \ ccall_classify_struct(cts, ctr, rcl, 0); \ ccall_struct_ret(cc, rcl, dp, ctr->size); #define CCALL_HANDLE_COMPLEXRET \ /* Complex values are returned in one or two FPRs. */ \ cc->retref = 0; #define CCALL_HANDLE_COMPLEXRET2 \ if (ctr->size == 2*sizeof(float)) { /* Copy complex float from FPR. */ \ *(int64_t *)dp = cc->fpr[0].l[0]; \ } else { /* Copy non-contiguous complex double from FPRs. */ \ ((int64_t *)dp)[0] = cc->fpr[0].l[0]; \ ((int64_t *)dp)[1] = cc->fpr[1].l[0]; \ } #define CCALL_HANDLE_STRUCTARG \ int rcl[2]; rcl[0] = rcl[1] = 0; \ if (!ccall_classify_struct(cts, d, rcl, 0)) { \ cc->nsp = nsp; cc->ngpr = ngpr; cc->nfpr = nfpr; \ if (ccall_struct_arg(cc, cts, d, rcl, o, narg)) goto err_nyi; \ nsp = cc->nsp; ngpr = cc->ngpr; nfpr = cc->nfpr; \ continue; \ } /* Pass all other structs by value on stack. */ #define CCALL_HANDLE_COMPLEXARG \ isfp = 2; /* Pass complex in FPRs or on stack. Needs postprocessing. */ #define CCALL_HANDLE_REGARG \ if (isfp) { /* Try to pass argument in FPRs. */ \ int n2 = ctype_isvector(d->info) ? 1 : n; \ if (nfpr + n2 <= CCALL_NARG_FPR) { \ dp = &cc->fpr[nfpr]; \ nfpr += n2; \ goto done; \ } \ } else { /* Try to pass argument in GPRs. */ \ /* Note that reordering is explicitly allowed in the x64 ABI. */ \ if (n <= 2 && ngpr + n <= maxgpr) { \ dp = &cc->gpr[ngpr]; \ ngpr += n; \ goto done; \ } \ } #elif LJ_TARGET_ARM /* -- ARM calling conventions --------------------------------------------- */ #if LJ_ABI_SOFTFP #define CCALL_HANDLE_STRUCTRET \ /* Return structs of size <= 4 in a GPR. */ \ cc->retref = !(sz <= 4); \ if (cc->retref) cc->gpr[ngpr++] = (GPRArg)dp; #define CCALL_HANDLE_COMPLEXRET \ cc->retref = 1; /* Return all complex values by reference. */ \ cc->gpr[ngpr++] = (GPRArg)dp; #define CCALL_HANDLE_COMPLEXRET2 \ UNUSED(dp); /* Nothing to do. */ #define CCALL_HANDLE_STRUCTARG \ /* Pass all structs by value in registers and/or on the stack. */ #define CCALL_HANDLE_COMPLEXARG \ /* Pass complex by value in 2 or 4 GPRs. */ #define CCALL_HANDLE_REGARG_FP1 #define CCALL_HANDLE_REGARG_FP2 #else #define CCALL_HANDLE_STRUCTRET \ cc->retref = !ccall_classify_struct(cts, ctr, ct); \ if (cc->retref) cc->gpr[ngpr++] = (GPRArg)dp; #define CCALL_HANDLE_STRUCTRET2 \ if (ccall_classify_struct(cts, ctr, ct) > 1) sp = (uint8_t *)&cc->fpr[0]; \ memcpy(dp, sp, ctr->size); #define CCALL_HANDLE_COMPLEXRET \ if (!(ct->info & CTF_VARARG)) cc->retref = 0; /* Return complex in FPRs. */ #define CCALL_HANDLE_COMPLEXRET2 \ if (!(ct->info & CTF_VARARG)) memcpy(dp, &cc->fpr[0], ctr->size); #define CCALL_HANDLE_STRUCTARG \ isfp = (ccall_classify_struct(cts, d, ct) > 1); /* Pass all structs by value in registers and/or on the stack. */ #define CCALL_HANDLE_COMPLEXARG \ isfp = 1; /* Pass complex by value in FPRs or on stack. */ #define CCALL_HANDLE_REGARG_FP1 \ if (isfp && !(ct->info & CTF_VARARG)) { \ if ((d->info & CTF_ALIGN) > CTALIGN_PTR) { \ if (nfpr + (n >> 1) <= CCALL_NARG_FPR) { \ dp = &cc->fpr[nfpr]; \ nfpr += (n >> 1); \ goto done; \ } \ } else { \ if (sz > 1 && fprodd != nfpr) fprodd = 0; \ if (fprodd) { \ if (2*nfpr+n <= 2*CCALL_NARG_FPR+1) { \ dp = (void *)&cc->fpr[fprodd-1].f[1]; \ nfpr += (n >> 1); \ if ((n & 1)) fprodd = 0; else fprodd = nfpr-1; \ goto done; \ } \ } else { \ if (2*nfpr+n <= 2*CCALL_NARG_FPR) { \ dp = (void *)&cc->fpr[nfpr]; \ nfpr += (n >> 1); \ if ((n & 1)) fprodd = ++nfpr; else fprodd = 0; \ goto done; \ } \ } \ } \ fprodd = 0; /* No reordering after the first FP value is on stack. */ \ } else { #define CCALL_HANDLE_REGARG_FP2 } #endif #define CCALL_HANDLE_REGARG \ CCALL_HANDLE_REGARG_FP1 \ if ((d->info & CTF_ALIGN) > CTALIGN_PTR) { \ if (ngpr < maxgpr) \ ngpr = (ngpr + 1u) & ~1u; /* Align to regpair. */ \ } \ if (ngpr < maxgpr) { \ dp = &cc->gpr[ngpr]; \ if (ngpr + n > maxgpr) { \ nsp += ngpr + n - maxgpr; /* Assumes contiguous gpr/stack fields. */ \ if (nsp > CCALL_MAXSTACK) goto err_nyi; /* Too many arguments. */ \ ngpr = maxgpr; \ } else { \ ngpr += n; \ } \ goto done; \ } CCALL_HANDLE_REGARG_FP2 #define CCALL_HANDLE_RET \ if ((ct->info & CTF_VARARG)) sp = (uint8_t *)&cc->gpr[0]; #elif LJ_TARGET_PPC /* -- PPC calling conventions --------------------------------------------- */ #define CCALL_HANDLE_STRUCTRET \ cc->retref = 1; /* Return all structs by reference. */ \ cc->gpr[ngpr++] = (GPRArg)dp; #define CCALL_HANDLE_COMPLEXRET \ /* Complex values are returned in 2 or 4 GPRs. */ \ cc->retref = 0; #define CCALL_HANDLE_COMPLEXRET2 \ memcpy(dp, sp, ctr->size); /* Copy complex from GPRs. */ #define CCALL_HANDLE_STRUCTARG \ rp = cdataptr(lj_cdata_new(cts, did, sz)); \ sz = CTSIZE_PTR; /* Pass all structs by reference. */ #define CCALL_HANDLE_COMPLEXARG \ /* Pass complex by value in 2 or 4 GPRs. */ #define CCALL_HANDLE_REGARG \ if (isfp) { /* Try to pass argument in FPRs. */ \ if (nfpr + 1 <= CCALL_NARG_FPR) { \ dp = &cc->fpr[nfpr]; \ nfpr += 1; \ d = ctype_get(cts, CTID_DOUBLE); /* FPRs always hold doubles. */ \ goto done; \ } \ } else { /* Try to pass argument in GPRs. */ \ if (n > 1) { \ lua_assert(n == 2 || n == 4); /* int64_t or complex (float). */ \ if (ctype_isinteger(d->info)) \ ngpr = (ngpr + 1u) & ~1u; /* Align int64_t to regpair. */ \ else if (ngpr + n > maxgpr) \ ngpr = maxgpr; /* Prevent reordering. */ \ } \ if (ngpr + n <= maxgpr) { \ dp = &cc->gpr[ngpr]; \ ngpr += n; \ goto done; \ } \ } #define CCALL_HANDLE_RET \ if (ctype_isfp(ctr->info) && ctr->size == sizeof(float)) \ ctr = ctype_get(cts, CTID_DOUBLE); /* FPRs always hold doubles. */ #elif LJ_TARGET_PPCSPE /* -- PPC/SPE calling conventions ----------------------------------------- */ #define CCALL_HANDLE_STRUCTRET \ cc->retref = 1; /* Return all structs by reference. */ \ cc->gpr[ngpr++] = (GPRArg)dp; #define CCALL_HANDLE_COMPLEXRET \ /* Complex values are returned in 2 or 4 GPRs. */ \ cc->retref = 0; #define CCALL_HANDLE_COMPLEXRET2 \ memcpy(dp, sp, ctr->size); /* Copy complex from GPRs. */ #define CCALL_HANDLE_STRUCTARG \ rp = cdataptr(lj_cdata_new(cts, did, sz)); \ sz = CTSIZE_PTR; /* Pass all structs by reference. */ #define CCALL_HANDLE_COMPLEXARG \ /* Pass complex by value in 2 or 4 GPRs. */ /* PPC/SPE has a softfp ABI. */ #define CCALL_HANDLE_REGARG \ if (n > 1) { /* Doesn't fit in a single GPR? */ \ lua_assert(n == 2 || n == 4); /* int64_t, double or complex (float). */ \ if (n == 2) \ ngpr = (ngpr + 1u) & ~1u; /* Only align 64 bit value to regpair. */ \ else if (ngpr + n > maxgpr) \ ngpr = maxgpr; /* Prevent reordering. */ \ } \ if (ngpr + n <= maxgpr) { \ dp = &cc->gpr[ngpr]; \ ngpr += n; \ goto done; \ } #elif LJ_TARGET_MIPS /* -- MIPS calling conventions -------------------------------------------- */ #define CCALL_HANDLE_STRUCTRET \ cc->retref = 1; /* Return all structs by reference. */ \ cc->gpr[ngpr++] = (GPRArg)dp; #define CCALL_HANDLE_COMPLEXRET \ /* Complex values are returned in 1 or 2 FPRs. */ \ cc->retref = 0; #define CCALL_HANDLE_COMPLEXRET2 \ if (ctr->size == 2*sizeof(float)) { /* Copy complex float from FPRs. */ \ ((float *)dp)[0] = cc->fpr[0].f; \ ((float *)dp)[1] = cc->fpr[1].f; \ } else { /* Copy complex double from FPRs. */ \ ((double *)dp)[0] = cc->fpr[0].d; \ ((double *)dp)[1] = cc->fpr[1].d; \ } #define CCALL_HANDLE_STRUCTARG \ /* Pass all structs by value in registers and/or on the stack. */ #define CCALL_HANDLE_COMPLEXARG \ /* Pass complex by value in 2 or 4 GPRs. */ #define CCALL_HANDLE_REGARG \ if (isfp && nfpr < CCALL_NARG_FPR && !(ct->info & CTF_VARARG)) { \ /* Try to pass argument in FPRs. */ \ dp = n == 1 ? (void *)&cc->fpr[nfpr].f : (void *)&cc->fpr[nfpr].d; \ nfpr++; ngpr += n; \ goto done; \ } else { /* Try to pass argument in GPRs. */ \ nfpr = CCALL_NARG_FPR; \ if ((d->info & CTF_ALIGN) > CTALIGN_PTR) \ ngpr = (ngpr + 1u) & ~1u; /* Align to regpair. */ \ if (ngpr < maxgpr) { \ dp = &cc->gpr[ngpr]; \ if (ngpr + n > maxgpr) { \ nsp += ngpr + n - maxgpr; /* Assumes contiguous gpr/stack fields. */ \ if (nsp > CCALL_MAXSTACK) goto err_nyi; /* Too many arguments. */ \ ngpr = maxgpr; \ } else { \ ngpr += n; \ } \ goto done; \ } \ } #define CCALL_HANDLE_RET \ if (ctype_isfp(ctr->info) && ctr->size == sizeof(float)) \ sp = (uint8_t *)&cc->fpr[0].f; #else #error "Missing calling convention definitions for this architecture" #endif #ifndef CCALL_HANDLE_STRUCTRET2 #define CCALL_HANDLE_STRUCTRET2 \ memcpy(dp, sp, ctr->size); /* Copy struct return value from GPRs. */ #endif /* -- x86 OSX ABI struct classification ----------------------------------- */ #if LJ_TARGET_X86 && LJ_TARGET_OSX /* Check for struct with single FP field. */ static int ccall_classify_struct(CTState *cts, CType *ct) { CTSize sz = ct->size; if (!(sz == sizeof(float) || sz == sizeof(double))) return 0; if ((ct->info & CTF_UNION)) return 0; while (ct->sib) { ct = ctype_get(cts, ct->sib); if (ctype_isfield(ct->info)) { CType *sct = ctype_rawchild(cts, ct); if (ctype_isfp(sct->info)) { if (sct->size == sz) return (sz >> 2); /* Return 1 for float or 2 for double. */ } else if (ctype_isstruct(sct->info)) { if (sct->size) return ccall_classify_struct(cts, sct); } else { break; } } else if (ctype_isbitfield(ct->info)) { break; } else if (ctype_isxattrib(ct->info, CTA_SUBTYPE)) { CType *sct = ctype_rawchild(cts, ct); if (sct->size) return ccall_classify_struct(cts, sct); } } return 0; } #endif /* -- x64 struct classification ------------------------------------------- */ #if LJ_TARGET_X64 && !LJ_ABI_WIN /* Register classes for x64 struct classification. */ #define CCALL_RCL_INT 1 #define CCALL_RCL_SSE 2 #define CCALL_RCL_MEM 4 /* NYI: classify vectors. */ static int ccall_classify_struct(CTState *cts, CType *ct, int *rcl, CTSize ofs); /* Classify a C type. */ static void ccall_classify_ct(CTState *cts, CType *ct, int *rcl, CTSize ofs) { if (ctype_isarray(ct->info)) { CType *cct = ctype_rawchild(cts, ct); CTSize eofs, esz = cct->size, asz = ct->size; for (eofs = 0; eofs < asz; eofs += esz) ccall_classify_ct(cts, cct, rcl, ofs+eofs); } else if (ctype_isstruct(ct->info)) { ccall_classify_struct(cts, ct, rcl, ofs); } else { int cl = ctype_isfp(ct->info) ? CCALL_RCL_SSE : CCALL_RCL_INT; lua_assert(ctype_hassize(ct->info)); if ((ofs & (ct->size-1))) cl = CCALL_RCL_MEM; /* Unaligned. */ rcl[(ofs >= 8)] |= cl; } } /* Recursively classify a struct based on its fields. */ static int ccall_classify_struct(CTState *cts, CType *ct, int *rcl, CTSize ofs) { if (ct->size > 16) return CCALL_RCL_MEM; /* Too big, gets memory class. */ while (ct->sib) { CTSize fofs; ct = ctype_get(cts, ct->sib); fofs = ofs+ct->size; if (ctype_isfield(ct->info)) ccall_classify_ct(cts, ctype_rawchild(cts, ct), rcl, fofs); else if (ctype_isbitfield(ct->info)) rcl[(fofs >= 8)] |= CCALL_RCL_INT; /* NYI: unaligned bitfields? */ else if (ctype_isxattrib(ct->info, CTA_SUBTYPE)) ccall_classify_struct(cts, ctype_rawchild(cts, ct), rcl, fofs); } return ((rcl[0]|rcl[1]) & CCALL_RCL_MEM); /* Memory class? */ } /* Try to split up a small struct into registers. */ static int ccall_struct_reg(CCallState *cc, GPRArg *dp, int *rcl) { MSize ngpr = cc->ngpr, nfpr = cc->nfpr; uint32_t i; for (i = 0; i < 2; i++) { lua_assert(!(rcl[i] & CCALL_RCL_MEM)); if ((rcl[i] & CCALL_RCL_INT)) { /* Integer class takes precedence. */ if (ngpr >= CCALL_NARG_GPR) return 1; /* Register overflow. */ cc->gpr[ngpr++] = dp[i]; } else if ((rcl[i] & CCALL_RCL_SSE)) { if (nfpr >= CCALL_NARG_FPR) return 1; /* Register overflow. */ cc->fpr[nfpr++].l[0] = dp[i]; } } cc->ngpr = ngpr; cc->nfpr = nfpr; return 0; /* Ok. */ } /* Pass a small struct argument. */ static int ccall_struct_arg(CCallState *cc, CTState *cts, CType *d, int *rcl, TValue *o, int narg) { GPRArg dp[2]; dp[0] = dp[1] = 0; /* Convert to temp. struct. */ lj_cconv_ct_tv(cts, d, (uint8_t *)dp, o, CCF_ARG(narg)); if (ccall_struct_reg(cc, dp, rcl)) { /* Register overflow? Pass on stack. */ MSize nsp = cc->nsp, n = rcl[1] ? 2 : 1; if (nsp + n > CCALL_MAXSTACK) return 1; /* Too many arguments. */ cc->nsp = nsp + n; memcpy(&cc->stack[nsp], dp, n*CTSIZE_PTR); } return 0; /* Ok. */ } /* Combine returned small struct. */ static void ccall_struct_ret(CCallState *cc, int *rcl, uint8_t *dp, CTSize sz) { GPRArg sp[2]; MSize ngpr = 0, nfpr = 0; uint32_t i; for (i = 0; i < 2; i++) { if ((rcl[i] & CCALL_RCL_INT)) { /* Integer class takes precedence. */ sp[i] = cc->gpr[ngpr++]; } else if ((rcl[i] & CCALL_RCL_SSE)) { sp[i] = cc->fpr[nfpr++].l[0]; } } memcpy(dp, sp, sz); } #endif /* -- ARM hard-float ABI struct classification ---------------------------- */ #if LJ_TARGET_ARM && !LJ_ABI_SOFTFP /* Classify a struct based on its fields. */ static unsigned int ccall_classify_struct(CTState *cts, CType *ct, CType *ctf) { CTSize sz = ct->size; unsigned int r = 0, n = 0, isu = (ct->info & CTF_UNION); if ((ctf->info & CTF_VARARG)) goto noth; while (ct->sib) { CType *sct; ct = ctype_get(cts, ct->sib); if (ctype_isfield(ct->info)) { sct = ctype_rawchild(cts, ct); if (ctype_isfp(sct->info)) { r |= sct->size; if (!isu) n++; else if (n == 0) n = 1; } else if (ctype_iscomplex(sct->info)) { r |= (sct->size >> 1); if (!isu) n += 2; else if (n < 2) n = 2; } else if (ctype_isstruct(sct->info)) { goto substruct; } else { goto noth; } } else if (ctype_isbitfield(ct->info)) { goto noth; } else if (ctype_isxattrib(ct->info, CTA_SUBTYPE)) { sct = ctype_rawchild(cts, ct); substruct: if (sct->size > 0) { unsigned int s = ccall_classify_struct(cts, sct, ctf); if (s <= 1) goto noth; r |= (s & 255); if (!isu) n += (s >> 8); else if (n < (s >>8)) n = (s >> 8); } } } if ((r == 4 || r == 8) && n <= 4) return r + (n << 8); noth: /* Not a homogeneous float/double aggregate. */ return (sz <= 4); /* Return structs of size <= 4 in a GPR. */ } #endif /* -- Common C call handling ---------------------------------------------- */ /* Infer the destination CTypeID for a vararg argument. */ CTypeID lj_ccall_ctid_vararg(CTState *cts, cTValue *o) { if (tvisnumber(o)) { return CTID_DOUBLE; } else if (tviscdata(o)) { CTypeID id = cdataV(o)->ctypeid; CType *s = ctype_get(cts, id); if (ctype_isrefarray(s->info)) { return lj_ctype_intern(cts, CTINFO(CT_PTR, CTALIGN_PTR|ctype_cid(s->info)), CTSIZE_PTR); } else if (ctype_isstruct(s->info) || ctype_isfunc(s->info)) { /* NYI: how to pass a struct by value in a vararg argument? */ return lj_ctype_intern(cts, CTINFO(CT_PTR, CTALIGN_PTR|id), CTSIZE_PTR); } else if (ctype_isfp(s->info) && s->size == sizeof(float)) { return CTID_DOUBLE; } else { return id; } } else if (tvisstr(o)) { return CTID_P_CCHAR; } else if (tvisbool(o)) { return CTID_BOOL; } else { return CTID_P_VOID; } } /* Setup arguments for C call. */ static int ccall_set_args(lua_State *L, CTState *cts, CType *ct, CCallState *cc) { int gcsteps = 0; TValue *o, *top = L->top; CTypeID fid; CType *ctr; MSize maxgpr, ngpr = 0, nsp = 0, narg; #if CCALL_NARG_FPR MSize nfpr = 0; #if LJ_TARGET_ARM MSize fprodd = 0; #endif #endif /* Clear unused regs to get some determinism in case of misdeclaration. */ memset(cc->gpr, 0, sizeof(cc->gpr)); #if CCALL_NUM_FPR memset(cc->fpr, 0, sizeof(cc->fpr)); #endif #if LJ_TARGET_X86 /* x86 has several different calling conventions. */ cc->resx87 = 0; switch (ctype_cconv(ct->info)) { case CTCC_FASTCALL: maxgpr = 2; break; case CTCC_THISCALL: maxgpr = 1; break; default: maxgpr = 0; break; } #else maxgpr = CCALL_NARG_GPR; #endif /* Perform required setup for some result types. */ ctr = ctype_rawchild(cts, ct); if (ctype_isvector(ctr->info)) { if (!(CCALL_VECTOR_REG && (ctr->size == 8 || ctr->size == 16))) goto err_nyi; } else if (ctype_iscomplex(ctr->info) || ctype_isstruct(ctr->info)) { /* Preallocate cdata object and anchor it after arguments. */ CTSize sz = ctr->size; GCcdata *cd = lj_cdata_new(cts, ctype_cid(ct->info), sz); void *dp = cdataptr(cd); setcdataV(L, L->top++, cd); if (ctype_isstruct(ctr->info)) { CCALL_HANDLE_STRUCTRET } else { CCALL_HANDLE_COMPLEXRET } #if LJ_TARGET_X86 } else if (ctype_isfp(ctr->info)) { cc->resx87 = ctr->size == sizeof(float) ? 1 : 2; #endif } /* Skip initial attributes. */ fid = ct->sib; while (fid) { CType *ctf = ctype_get(cts, fid); if (!ctype_isattrib(ctf->info)) break; fid = ctf->sib; } /* Walk through all passed arguments. */ for (o = L->base+1, narg = 1; o < top; o++, narg++) { CTypeID did; CType *d; CTSize sz; MSize n, isfp = 0, isva = 0; void *dp, *rp = NULL; if (fid) { /* Get argument type from field. */ CType *ctf = ctype_get(cts, fid); fid = ctf->sib; lua_assert(ctype_isfield(ctf->info)); did = ctype_cid(ctf->info); } else { if (!(ct->info & CTF_VARARG)) lj_err_caller(L, LJ_ERR_FFI_NUMARG); /* Too many arguments. */ did = lj_ccall_ctid_vararg(cts, o); /* Infer vararg type. */ isva = 1; } d = ctype_raw(cts, did); sz = d->size; /* Find out how (by value/ref) and where (GPR/FPR) to pass an argument. */ if (ctype_isnum(d->info)) { if (sz > 8) goto err_nyi; if ((d->info & CTF_FP)) isfp = 1; } else if (ctype_isvector(d->info)) { if (CCALL_VECTOR_REG && (sz == 8 || sz == 16)) isfp = 1; else goto err_nyi; } else if (ctype_isstruct(d->info)) { CCALL_HANDLE_STRUCTARG } else if (ctype_iscomplex(d->info)) { CCALL_HANDLE_COMPLEXARG } else { sz = CTSIZE_PTR; } sz = (sz + CTSIZE_PTR-1) & ~(CTSIZE_PTR-1); n = sz / CTSIZE_PTR; /* Number of GPRs or stack slots needed. */ CCALL_HANDLE_REGARG /* Handle register arguments. */ /* Otherwise pass argument on stack. */ if (CCALL_ALIGN_STACKARG && !rp && (d->info & CTF_ALIGN) > CTALIGN_PTR) { MSize align = (1u << ctype_align(d->info-CTALIGN_PTR)) -1; nsp = (nsp + align) & ~align; /* Align argument on stack. */ } if (nsp + n > CCALL_MAXSTACK) { /* Too many arguments. */ err_nyi: lj_err_caller(L, LJ_ERR_FFI_NYICALL); } dp = &cc->stack[nsp]; nsp += n; isva = 0; done: if (rp) { /* Pass by reference. */ gcsteps++; *(void **)dp = rp; dp = rp; } lj_cconv_ct_tv(cts, d, (uint8_t *)dp, o, CCF_ARG(narg)); /* Extend passed integers to 32 bits at least. */ if (ctype_isinteger_or_bool(d->info) && d->size < 4) { if (d->info & CTF_UNSIGNED) *(uint32_t *)dp = d->size == 1 ? (uint32_t)*(uint8_t *)dp : (uint32_t)*(uint16_t *)dp; else *(int32_t *)dp = d->size == 1 ? (int32_t)*(int8_t *)dp : (int32_t)*(int16_t *)dp; } #if LJ_TARGET_X64 && LJ_ABI_WIN if (isva) { /* Windows/x64 mirrors varargs in both register sets. */ if (nfpr == ngpr) cc->gpr[ngpr-1] = cc->fpr[ngpr-1].l[0]; else cc->fpr[ngpr-1].l[0] = cc->gpr[ngpr-1]; } #else UNUSED(isva); #endif #if LJ_TARGET_X64 && !LJ_ABI_WIN if (isfp == 2 && n == 2 && (uint8_t *)dp == (uint8_t *)&cc->fpr[nfpr-2]) { cc->fpr[nfpr-1].d[0] = cc->fpr[nfpr-2].d[1]; /* Split complex double. */ cc->fpr[nfpr-2].d[1] = 0; } #else UNUSED(isfp); #endif } if (fid) lj_err_caller(L, LJ_ERR_FFI_NUMARG); /* Too few arguments. */ #if LJ_TARGET_X64 || LJ_TARGET_PPC cc->nfpr = nfpr; /* Required for vararg functions. */ #endif cc->nsp = nsp; cc->spadj = (CCALL_SPS_FREE + CCALL_SPS_EXTRA)*CTSIZE_PTR; if (nsp > CCALL_SPS_FREE) cc->spadj += (((nsp-CCALL_SPS_FREE)*CTSIZE_PTR + 15u) & ~15u); return gcsteps; } /* Get results from C call. */ static int ccall_get_results(lua_State *L, CTState *cts, CType *ct, CCallState *cc, int *ret) { CType *ctr = ctype_rawchild(cts, ct); uint8_t *sp = (uint8_t *)&cc->gpr[0]; if (ctype_isvoid(ctr->info)) { *ret = 0; /* Zero results. */ return 0; /* No additional GC step. */ } *ret = 1; /* One result. */ if (ctype_isstruct(ctr->info)) { /* Return cdata object which is already on top of stack. */ if (!cc->retref) { void *dp = cdataptr(cdataV(L->top-1)); /* Use preallocated object. */ CCALL_HANDLE_STRUCTRET2 } return 1; /* One GC step. */ } if (ctype_iscomplex(ctr->info)) { /* Return cdata object which is already on top of stack. */ void *dp = cdataptr(cdataV(L->top-1)); /* Use preallocated object. */ CCALL_HANDLE_COMPLEXRET2 return 1; /* One GC step. */ } if (LJ_BE && ctype_isinteger_or_bool(ctr->info) && ctr->size < CTSIZE_PTR) sp += (CTSIZE_PTR - ctr->size); #if CCALL_NUM_FPR if (ctype_isfp(ctr->info) || ctype_isvector(ctr->info)) sp = (uint8_t *)&cc->fpr[0]; #endif #ifdef CCALL_HANDLE_RET CCALL_HANDLE_RET #endif /* No reference types end up here, so there's no need for the CTypeID. */ lua_assert(!(ctype_isrefarray(ctr->info) || ctype_isstruct(ctr->info))); return lj_cconv_tv_ct(cts, ctr, 0, L->top-1, sp); } /* Call C function. */ int lj_ccall_func(lua_State *L, GCcdata *cd) { CTState *cts = ctype_cts(L); CType *ct = ctype_raw(cts, cd->ctypeid); CTSize sz = CTSIZE_PTR; if (ctype_isptr(ct->info)) { sz = ct->size; ct = ctype_rawchild(cts, ct); } if (ctype_isfunc(ct->info)) { CCallState cc; int gcsteps, ret; cc.func = (void (*)(void))cdata_getptr(cdataptr(cd), sz); gcsteps = ccall_set_args(L, cts, ct, &cc); ct = (CType *)((intptr_t)ct-(intptr_t)cts->tab); cts->cb.slot = ~0u; lj_vm_ffi_call(&cc); if (cts->cb.slot != ~0u) { /* Blacklist function that called a callback. */ TValue tv; setlightudV(&tv, (void *)cc.func); setboolV(lj_tab_set(L, cts->miscmap, &tv), 1); } ct = (CType *)((intptr_t)ct+(intptr_t)cts->tab); /* May be reallocated. */ gcsteps += ccall_get_results(L, cts, ct, &cc, &ret); #if LJ_TARGET_X86 && LJ_ABI_WIN /* Automatically detect __stdcall and fix up C function declaration. */ if (cc.spadj && ctype_cconv(ct->info) == CTCC_CDECL) { CTF_INSERT(ct->info, CCONV, CTCC_STDCALL); lj_trace_abort(G(L)); } #endif while (gcsteps-- > 0) lj_gc_check(L); return ret; } return -1; /* Not a function. */ } #endif wcc-0.0.2/src/wsh/luajit-2.0/README0000644000175000017500000000067113122010155014766 0ustar philphilREADME for LuaJIT 2.0.4 ----------------------- LuaJIT is a Just-In-Time (JIT) compiler for the Lua programming language. Project Homepage: http://luajit.org/ LuaJIT is Copyright (C) 2005-2016 Mike Pall. LuaJIT is free software, released under the MIT license. See full Copyright Notice in the COPYRIGHT file or in luajit.h. Documentation for LuaJIT is available in HTML format. Please point your favorite browser to: doc/luajit.html wcc-0.0.2/src/wsh/luajit-2.0/dynasm/0000755000175000017500000000000013122010155015375 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_x86.h0000644000175000017500000003571513122010155017212 0ustar philphil/* ** DynASM x86 encoding engine. ** Copyright (C) 2005-2016 Mike Pall. All rights reserved. ** Released under the MIT license. See dynasm.lua for full copyright notice. */ #include #include #include #include #define DASM_ARCH "x86" #ifndef DASM_EXTERN #define DASM_EXTERN(a,b,c,d) 0 #endif /* Action definitions. DASM_STOP must be 255. */ enum { DASM_DISP = 233, DASM_IMM_S, DASM_IMM_B, DASM_IMM_W, DASM_IMM_D, DASM_IMM_WB, DASM_IMM_DB, DASM_VREG, DASM_SPACE, DASM_SETLABEL, DASM_REL_A, DASM_REL_LG, DASM_REL_PC, DASM_IMM_LG, DASM_IMM_PC, DASM_LABEL_LG, DASM_LABEL_PC, DASM_ALIGN, DASM_EXTERN, DASM_ESC, DASM_MARK, DASM_SECTION, DASM_STOP }; /* Maximum number of section buffer positions for a single dasm_put() call. */ #define DASM_MAXSECPOS 25 /* DynASM encoder status codes. Action list offset or number are or'ed in. */ #define DASM_S_OK 0x00000000 #define DASM_S_NOMEM 0x01000000 #define DASM_S_PHASE 0x02000000 #define DASM_S_MATCH_SEC 0x03000000 #define DASM_S_RANGE_I 0x11000000 #define DASM_S_RANGE_SEC 0x12000000 #define DASM_S_RANGE_LG 0x13000000 #define DASM_S_RANGE_PC 0x14000000 #define DASM_S_RANGE_VREG 0x15000000 #define DASM_S_UNDEF_L 0x21000000 #define DASM_S_UNDEF_PC 0x22000000 /* Macros to convert positions (8 bit section + 24 bit index). */ #define DASM_POS2IDX(pos) ((pos)&0x00ffffff) #define DASM_POS2BIAS(pos) ((pos)&0xff000000) #define DASM_SEC2POS(sec) ((sec)<<24) #define DASM_POS2SEC(pos) ((pos)>>24) #define DASM_POS2PTR(D, pos) (D->sections[DASM_POS2SEC(pos)].rbuf + (pos)) /* Action list type. */ typedef const unsigned char *dasm_ActList; /* Per-section structure. */ typedef struct dasm_Section { int *rbuf; /* Biased buffer pointer (negative section bias). */ int *buf; /* True buffer pointer. */ size_t bsize; /* Buffer size in bytes. */ int pos; /* Biased buffer position. */ int epos; /* End of biased buffer position - max single put. */ int ofs; /* Byte offset into section. */ } dasm_Section; /* Core structure holding the DynASM encoding state. */ struct dasm_State { size_t psize; /* Allocated size of this structure. */ dasm_ActList actionlist; /* Current actionlist pointer. */ int *lglabels; /* Local/global chain/pos ptrs. */ size_t lgsize; int *pclabels; /* PC label chains/pos ptrs. */ size_t pcsize; void **globals; /* Array of globals (bias -10). */ dasm_Section *section; /* Pointer to active section. */ size_t codesize; /* Total size of all code sections. */ int maxsection; /* 0 <= sectionidx < maxsection. */ int status; /* Status code. */ dasm_Section sections[1]; /* All sections. Alloc-extended. */ }; /* The size of the core structure depends on the max. number of sections. */ #define DASM_PSZ(ms) (sizeof(dasm_State)+(ms-1)*sizeof(dasm_Section)) /* Initialize DynASM state. */ void dasm_init(Dst_DECL, int maxsection) { dasm_State *D; size_t psz = 0; int i; Dst_REF = NULL; DASM_M_GROW(Dst, struct dasm_State, Dst_REF, psz, DASM_PSZ(maxsection)); D = Dst_REF; D->psize = psz; D->lglabels = NULL; D->lgsize = 0; D->pclabels = NULL; D->pcsize = 0; D->globals = NULL; D->maxsection = maxsection; for (i = 0; i < maxsection; i++) { D->sections[i].buf = NULL; /* Need this for pass3. */ D->sections[i].rbuf = D->sections[i].buf - DASM_SEC2POS(i); D->sections[i].bsize = 0; D->sections[i].epos = 0; /* Wrong, but is recalculated after resize. */ } } /* Free DynASM state. */ void dasm_free(Dst_DECL) { dasm_State *D = Dst_REF; int i; for (i = 0; i < D->maxsection; i++) if (D->sections[i].buf) DASM_M_FREE(Dst, D->sections[i].buf, D->sections[i].bsize); if (D->pclabels) DASM_M_FREE(Dst, D->pclabels, D->pcsize); if (D->lglabels) DASM_M_FREE(Dst, D->lglabels, D->lgsize); DASM_M_FREE(Dst, D, D->psize); } /* Setup global label array. Must be called before dasm_setup(). */ void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl) { dasm_State *D = Dst_REF; D->globals = gl - 10; /* Negative bias to compensate for locals. */ DASM_M_GROW(Dst, int, D->lglabels, D->lgsize, (10+maxgl)*sizeof(int)); } /* Grow PC label array. Can be called after dasm_setup(), too. */ void dasm_growpc(Dst_DECL, unsigned int maxpc) { dasm_State *D = Dst_REF; size_t osz = D->pcsize; DASM_M_GROW(Dst, int, D->pclabels, D->pcsize, maxpc*sizeof(int)); memset((void *)(((unsigned char *)D->pclabels)+osz), 0, D->pcsize-osz); } /* Setup encoder. */ void dasm_setup(Dst_DECL, const void *actionlist) { dasm_State *D = Dst_REF; int i; D->actionlist = (dasm_ActList)actionlist; D->status = DASM_S_OK; D->section = &D->sections[0]; memset((void *)D->lglabels, 0, D->lgsize); if (D->pclabels) memset((void *)D->pclabels, 0, D->pcsize); for (i = 0; i < D->maxsection; i++) { D->sections[i].pos = DASM_SEC2POS(i); D->sections[i].ofs = 0; } } #ifdef DASM_CHECKS #define CK(x, st) \ do { if (!(x)) { \ D->status = DASM_S_##st|(int)(p-D->actionlist-1); return; } } while (0) #define CKPL(kind, st) \ do { if ((size_t)((char *)pl-(char *)D->kind##labels) >= D->kind##size) { \ D->status=DASM_S_RANGE_##st|(int)(p-D->actionlist-1); return; } } while (0) #else #define CK(x, st) ((void)0) #define CKPL(kind, st) ((void)0) #endif /* Pass 1: Store actions and args, link branches/labels, estimate offsets. */ void dasm_put(Dst_DECL, int start, ...) { va_list ap; dasm_State *D = Dst_REF; dasm_ActList p = D->actionlist + start; dasm_Section *sec = D->section; int pos = sec->pos, ofs = sec->ofs, mrm = 4; int *b; if (pos >= sec->epos) { DASM_M_GROW(Dst, int, sec->buf, sec->bsize, sec->bsize + 2*DASM_MAXSECPOS*sizeof(int)); sec->rbuf = sec->buf - DASM_POS2BIAS(pos); sec->epos = (int)sec->bsize/sizeof(int) - DASM_MAXSECPOS+DASM_POS2BIAS(pos); } b = sec->rbuf; b[pos++] = start; va_start(ap, start); while (1) { int action = *p++; if (action < DASM_DISP) { ofs++; } else if (action <= DASM_REL_A) { int n = va_arg(ap, int); b[pos++] = n; switch (action) { case DASM_DISP: if (n == 0) { if ((mrm&7) == 4) mrm = p[-2]; if ((mrm&7) != 5) break; } case DASM_IMM_DB: if (((n+128)&-256) == 0) goto ob; case DASM_REL_A: /* Assumes ptrdiff_t is int. !x64 */ case DASM_IMM_D: ofs += 4; break; case DASM_IMM_S: CK(((n+128)&-256) == 0, RANGE_I); goto ob; case DASM_IMM_B: CK((n&-256) == 0, RANGE_I); ob: ofs++; break; case DASM_IMM_WB: if (((n+128)&-256) == 0) goto ob; case DASM_IMM_W: CK((n&-65536) == 0, RANGE_I); ofs += 2; break; case DASM_SPACE: p++; ofs += n; break; case DASM_SETLABEL: b[pos-2] = -0x40000000; break; /* Neg. label ofs. */ case DASM_VREG: CK((n&-8) == 0 && (n != 4 || (*p&1) == 0), RANGE_VREG); if (*p++ == 1 && *p == DASM_DISP) mrm = n; continue; } mrm = 4; } else { int *pl, n; switch (action) { case DASM_REL_LG: case DASM_IMM_LG: n = *p++; pl = D->lglabels + n; /* Bkwd rel or global. */ if (n <= 246) { CK(n>=10||*pl<0, RANGE_LG); CKPL(lg, LG); goto putrel; } pl -= 246; n = *pl; if (n < 0) n = 0; /* Start new chain for fwd rel if label exists. */ goto linkrel; case DASM_REL_PC: case DASM_IMM_PC: pl = D->pclabels + va_arg(ap, int); CKPL(pc, PC); putrel: n = *pl; if (n < 0) { /* Label exists. Get label pos and store it. */ b[pos] = -n; } else { linkrel: b[pos] = n; /* Else link to rel chain, anchored at label. */ *pl = pos; } pos++; ofs += 4; /* Maximum offset needed. */ if (action == DASM_REL_LG || action == DASM_REL_PC) b[pos++] = ofs; /* Store pass1 offset estimate. */ break; case DASM_LABEL_LG: pl = D->lglabels + *p++; CKPL(lg, LG); goto putlabel; case DASM_LABEL_PC: pl = D->pclabels + va_arg(ap, int); CKPL(pc, PC); putlabel: n = *pl; /* n > 0: Collapse rel chain and replace with label pos. */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = pos; } *pl = -pos; /* Label exists now. */ b[pos++] = ofs; /* Store pass1 offset estimate. */ break; case DASM_ALIGN: ofs += *p++; /* Maximum alignment needed (arg is 2**n-1). */ b[pos++] = ofs; /* Store pass1 offset estimate. */ break; case DASM_EXTERN: p += 2; ofs += 4; break; case DASM_ESC: p++; ofs++; break; case DASM_MARK: mrm = p[-2]; break; case DASM_SECTION: n = *p; CK(n < D->maxsection, RANGE_SEC); D->section = &D->sections[n]; case DASM_STOP: goto stop; } } } stop: va_end(ap); sec->pos = pos; sec->ofs = ofs; } #undef CK /* Pass 2: Link sections, shrink branches/aligns, fix label offsets. */ int dasm_link(Dst_DECL, size_t *szp) { dasm_State *D = Dst_REF; int secnum; int ofs = 0; #ifdef DASM_CHECKS *szp = 0; if (D->status != DASM_S_OK) return D->status; { int pc; for (pc = 0; pc*sizeof(int) < D->pcsize; pc++) if (D->pclabels[pc] > 0) return DASM_S_UNDEF_PC|pc; } #endif { /* Handle globals not defined in this translation unit. */ int idx; for (idx = 10; idx*sizeof(int) < D->lgsize; idx++) { int n = D->lglabels[idx]; /* Undefined label: Collapse rel chain and replace with marker (< 0). */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = -idx; } } } /* Combine all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->rbuf; int pos = DASM_SEC2POS(secnum); int lastpos = sec->pos; while (pos != lastpos) { dasm_ActList p = D->actionlist + b[pos++]; while (1) { int op, action = *p++; switch (action) { case DASM_REL_LG: p++; op = p[-3]; goto rel_pc; case DASM_REL_PC: op = p[-2]; rel_pc: { int shrink = op == 0xe9 ? 3 : ((op&0xf0) == 0x80 ? 4 : 0); if (shrink) { /* Shrinkable branch opcode? */ int lofs, lpos = b[pos]; if (lpos < 0) goto noshrink; /* Ext global? */ lofs = *DASM_POS2PTR(D, lpos); if (lpos > pos) { /* Fwd label: add cumulative section offsets. */ int i; for (i = secnum; i < DASM_POS2SEC(lpos); i++) lofs += D->sections[i].ofs; } else { lofs -= ofs; /* Bkwd label: unfix offset. */ } lofs -= b[pos+1]; /* Short branch ok? */ if (lofs >= -128-shrink && lofs <= 127) ofs -= shrink; /* Yes. */ else { noshrink: shrink = 0; } /* No, cannot shrink op. */ } b[pos+1] = shrink; pos += 2; break; } case DASM_SPACE: case DASM_IMM_LG: case DASM_VREG: p++; case DASM_DISP: case DASM_IMM_S: case DASM_IMM_B: case DASM_IMM_W: case DASM_IMM_D: case DASM_IMM_WB: case DASM_IMM_DB: case DASM_SETLABEL: case DASM_REL_A: case DASM_IMM_PC: pos++; break; case DASM_LABEL_LG: p++; case DASM_LABEL_PC: b[pos++] += ofs; break; /* Fix label offset. */ case DASM_ALIGN: ofs -= (b[pos++]+ofs)&*p++; break; /* Adjust ofs. */ case DASM_EXTERN: p += 2; break; case DASM_ESC: p++; break; case DASM_MARK: break; case DASM_SECTION: case DASM_STOP: goto stop; } } stop: (void)0; } ofs += sec->ofs; /* Next section starts right after current section. */ } D->codesize = ofs; /* Total size of all code sections */ *szp = ofs; return DASM_S_OK; } #define dasmb(x) *cp++ = (unsigned char)(x) #ifndef DASM_ALIGNED_WRITES #define dasmw(x) \ do { *((unsigned short *)cp) = (unsigned short)(x); cp+=2; } while (0) #define dasmd(x) \ do { *((unsigned int *)cp) = (unsigned int)(x); cp+=4; } while (0) #else #define dasmw(x) do { dasmb(x); dasmb((x)>>8); } while (0) #define dasmd(x) do { dasmw(x); dasmw((x)>>16); } while (0) #endif /* Pass 3: Encode sections. */ int dasm_encode(Dst_DECL, void *buffer) { dasm_State *D = Dst_REF; unsigned char *base = (unsigned char *)buffer; unsigned char *cp = base; int secnum; /* Encode all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->buf; int *endb = sec->rbuf + sec->pos; while (b != endb) { dasm_ActList p = D->actionlist + *b++; unsigned char *mark = NULL; while (1) { int action = *p++; int n = (action >= DASM_DISP && action <= DASM_ALIGN) ? *b++ : 0; switch (action) { case DASM_DISP: if (!mark) mark = cp; { unsigned char *mm = mark; if (*p != DASM_IMM_DB && *p != DASM_IMM_WB) mark = NULL; if (n == 0) { int mrm = mm[-1]&7; if (mrm == 4) mrm = mm[0]&7; if (mrm != 5) { mm[-1] -= 0x80; break; } } if (((n+128) & -256) != 0) goto wd; else mm[-1] -= 0x40; } case DASM_IMM_S: case DASM_IMM_B: wb: dasmb(n); break; case DASM_IMM_DB: if (((n+128)&-256) == 0) { db: if (!mark) mark = cp; mark[-2] += 2; mark = NULL; goto wb; } else mark = NULL; case DASM_IMM_D: wd: dasmd(n); break; case DASM_IMM_WB: if (((n+128)&-256) == 0) goto db; else mark = NULL; case DASM_IMM_W: dasmw(n); break; case DASM_VREG: { int t = *p++; if (t >= 2) n<<=3; cp[-1] |= n; break; } case DASM_REL_LG: p++; if (n >= 0) goto rel_pc; b++; n = (int)(ptrdiff_t)D->globals[-n]; case DASM_REL_A: rel_a: n -= (int)(ptrdiff_t)(cp+4); goto wd; /* !x64 */ case DASM_REL_PC: rel_pc: { int shrink = *b++; int *pb = DASM_POS2PTR(D, n); if (*pb < 0) { n = pb[1]; goto rel_a; } n = *pb - ((int)(cp-base) + 4-shrink); if (shrink == 0) goto wd; if (shrink == 4) { cp--; cp[-1] = *cp-0x10; } else cp[-1] = 0xeb; goto wb; } case DASM_IMM_LG: p++; if (n < 0) { n = (int)(ptrdiff_t)D->globals[-n]; goto wd; } case DASM_IMM_PC: { int *pb = DASM_POS2PTR(D, n); n = *pb < 0 ? pb[1] : (*pb + (int)(ptrdiff_t)base); goto wd; } case DASM_LABEL_LG: { int idx = *p++; if (idx >= 10) D->globals[idx] = (void *)(base + (*p == DASM_SETLABEL ? *b : n)); break; } case DASM_LABEL_PC: case DASM_SETLABEL: break; case DASM_SPACE: { int fill = *p++; while (n--) *cp++ = fill; break; } case DASM_ALIGN: n = *p++; while (((cp-base) & n)) *cp++ = 0x90; /* nop */ break; case DASM_EXTERN: n = DASM_EXTERN(Dst, cp, p[1], *p); p += 2; goto wd; case DASM_MARK: mark = cp; break; case DASM_ESC: action = *p++; default: *cp++ = action; break; case DASM_SECTION: case DASM_STOP: goto stop; } } stop: (void)0; } } if (base + D->codesize != cp) /* Check for phase errors. */ return DASM_S_PHASE; return DASM_S_OK; } /* Get PC label offset. */ int dasm_getpclabel(Dst_DECL, unsigned int pc) { dasm_State *D = Dst_REF; if (pc*sizeof(int) < D->pcsize) { int pos = D->pclabels[pc]; if (pos < 0) return *DASM_POS2PTR(D, -pos); if (pos > 0) return -1; /* Undefined. */ } return -2; /* Unused or out of range. */ } #ifdef DASM_CHECKS /* Optional sanity checker to call between isolated encoding steps. */ int dasm_checkstep(Dst_DECL, int secmatch) { dasm_State *D = Dst_REF; if (D->status == DASM_S_OK) { int i; for (i = 1; i <= 9; i++) { if (D->lglabels[i] > 0) { D->status = DASM_S_UNDEF_L|i; break; } D->lglabels[i] = 0; } } if (D->status == DASM_S_OK && secmatch >= 0 && D->section != &D->sections[secmatch]) D->status = DASM_S_MATCH_SEC|(int)(D->section-D->sections); return D->status; } #endif wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_mips.lua0000644000175000017500000006666013122010155020072 0ustar philphil------------------------------------------------------------------------------ -- DynASM MIPS module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- See dynasm.lua for full copyright notice. ------------------------------------------------------------------------------ -- Module information: local _info = { arch = "mips", description = "DynASM MIPS module", version = "1.3.0", vernum = 10300, release = "2012-01-23", author = "Mike Pall", license = "MIT", } -- Exported glue functions for the arch-specific module. local _M = { _info = _info } -- Cache library functions. local type, tonumber, pairs, ipairs = type, tonumber, pairs, ipairs local assert, setmetatable = assert, setmetatable local _s = string local sub, format, byte, char = _s.sub, _s.format, _s.byte, _s.char local match, gmatch = _s.match, _s.gmatch local concat, sort = table.concat, table.sort local bit = bit or require("bit") local band, shl, sar, tohex = bit.band, bit.lshift, bit.arshift, bit.tohex -- Inherited tables and callbacks. local g_opt, g_arch local wline, werror, wfatal, wwarn -- Action name list. -- CHECK: Keep this in sync with the C code! local action_names = { "STOP", "SECTION", "ESC", "REL_EXT", "ALIGN", "REL_LG", "LABEL_LG", "REL_PC", "LABEL_PC", "IMM", } -- Maximum number of section buffer positions for dasm_put(). -- CHECK: Keep this in sync with the C code! local maxsecpos = 25 -- Keep this low, to avoid excessively long C lines. -- Action name -> action number. local map_action = {} for n,name in ipairs(action_names) do map_action[name] = n-1 end -- Action list buffer. local actlist = {} -- Argument list for next dasm_put(). Start with offset 0 into action list. local actargs = { 0 } -- Current number of section buffer positions for dasm_put(). local secpos = 1 ------------------------------------------------------------------------------ -- Dump action names and numbers. local function dumpactions(out) out:write("DynASM encoding engine action codes:\n") for n,name in ipairs(action_names) do local num = map_action[name] out:write(format(" %-10s %02X %d\n", name, num, num)) end out:write("\n") end -- Write action list buffer as a huge static C array. local function writeactions(out, name) local nn = #actlist if nn == 0 then nn = 1; actlist[0] = map_action.STOP end out:write("static const unsigned int ", name, "[", nn, "] = {\n") for i = 1,nn-1 do assert(out:write("0x", tohex(actlist[i]), ",\n")) end assert(out:write("0x", tohex(actlist[nn]), "\n};\n\n")) end ------------------------------------------------------------------------------ -- Add word to action list. local function wputxw(n) assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range") actlist[#actlist+1] = n end -- Add action to list with optional arg. Advance buffer pos, too. local function waction(action, val, a, num) local w = assert(map_action[action], "bad action name `"..action.."'") wputxw(0xff000000 + w * 0x10000 + (val or 0)) if a then actargs[#actargs+1] = a end if a or num then secpos = secpos + (num or 1) end end -- Flush action list (intervening C code or buffer pos overflow). local function wflush(term) if #actlist == actargs[1] then return end -- Nothing to flush. if not term then waction("STOP") end -- Terminate action list. wline(format("dasm_put(Dst, %s);", concat(actargs, ", ")), true) actargs = { #actlist } -- Actionlist offset is 1st arg to next dasm_put(). secpos = 1 -- The actionlist offset occupies a buffer position, too. end -- Put escaped word. local function wputw(n) if n >= 0xff000000 then waction("ESC") end wputxw(n) end -- Reserve position for word. local function wpos() local pos = #actlist+1 actlist[pos] = "" return pos end -- Store word to reserved position. local function wputpos(pos, n) assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range") actlist[pos] = n end ------------------------------------------------------------------------------ -- Global label name -> global label number. With auto assignment on 1st use. local next_global = 20 local map_global = setmetatable({}, { __index = function(t, name) if not match(name, "^[%a_][%w_]*$") then werror("bad global label") end local n = next_global if n > 2047 then werror("too many global labels") end next_global = n + 1 t[name] = n return n end}) -- Dump global labels. local function dumpglobals(out, lvl) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("Global labels:\n") for i=20,next_global-1 do out:write(format(" %s\n", t[i])) end out:write("\n") end -- Write global label enum. local function writeglobals(out, prefix) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("enum {\n") for i=20,next_global-1 do out:write(" ", prefix, t[i], ",\n") end out:write(" ", prefix, "_MAX\n};\n") end -- Write global label names. local function writeglobalnames(out, name) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("static const char *const ", name, "[] = {\n") for i=20,next_global-1 do out:write(" \"", t[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Extern label name -> extern label number. With auto assignment on 1st use. local next_extern = 0 local map_extern_ = {} local map_extern = setmetatable({}, { __index = function(t, name) -- No restrictions on the name for now. local n = next_extern if n > 2047 then werror("too many extern labels") end next_extern = n + 1 t[name] = n map_extern_[n] = name return n end}) -- Dump extern labels. local function dumpexterns(out, lvl) out:write("Extern labels:\n") for i=0,next_extern-1 do out:write(format(" %s\n", map_extern_[i])) end out:write("\n") end -- Write extern label names. local function writeexternnames(out, name) out:write("static const char *const ", name, "[] = {\n") for i=0,next_extern-1 do out:write(" \"", map_extern_[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Arch-specific maps. local map_archdef = { sp="r29", ra="r31" } -- Ext. register name -> int. name. local map_type = {} -- Type name -> { ctype, reg } local ctypenum = 0 -- Type number (for Dt... macros). -- Reverse defines for registers. function _M.revdef(s) if s == "r29" then return "sp" elseif s == "r31" then return "ra" end return s end ------------------------------------------------------------------------------ -- Template strings for MIPS instructions. local map_op = { -- First-level opcodes. j_1 = "08000000J", jal_1 = "0c000000J", b_1 = "10000000B", beqz_2 = "10000000SB", beq_3 = "10000000STB", bnez_2 = "14000000SB", bne_3 = "14000000STB", blez_2 = "18000000SB", bgtz_2 = "1c000000SB", addi_3 = "20000000TSI", li_2 = "24000000TI", addiu_3 = "24000000TSI", slti_3 = "28000000TSI", sltiu_3 = "2c000000TSI", andi_3 = "30000000TSU", lu_2 = "34000000TU", ori_3 = "34000000TSU", xori_3 = "38000000TSU", lui_2 = "3c000000TU", beqzl_2 = "50000000SB", beql_3 = "50000000STB", bnezl_2 = "54000000SB", bnel_3 = "54000000STB", blezl_2 = "58000000SB", bgtzl_2 = "5c000000SB", lb_2 = "80000000TO", lh_2 = "84000000TO", lwl_2 = "88000000TO", lw_2 = "8c000000TO", lbu_2 = "90000000TO", lhu_2 = "94000000TO", lwr_2 = "98000000TO", sb_2 = "a0000000TO", sh_2 = "a4000000TO", swl_2 = "a8000000TO", sw_2 = "ac000000TO", swr_2 = "b8000000TO", cache_2 = "bc000000NO", ll_2 = "c0000000TO", lwc1_2 = "c4000000HO", pref_2 = "cc000000NO", ldc1_2 = "d4000000HO", sc_2 = "e0000000TO", swc1_2 = "e4000000HO", sdc1_2 = "f4000000HO", -- Opcode SPECIAL. nop_0 = "00000000", sll_3 = "00000000DTA", movf_2 = "00000001DS", movf_3 = "00000001DSC", movt_2 = "00010001DS", movt_3 = "00010001DSC", srl_3 = "00000002DTA", rotr_3 = "00200002DTA", sra_3 = "00000003DTA", sllv_3 = "00000004DTS", srlv_3 = "00000006DTS", rotrv_3 = "00000046DTS", srav_3 = "00000007DTS", jr_1 = "00000008S", jalr_1 = "0000f809S", jalr_2 = "00000009DS", movz_3 = "0000000aDST", movn_3 = "0000000bDST", syscall_0 = "0000000c", syscall_1 = "0000000cY", break_0 = "0000000d", break_1 = "0000000dY", sync_0 = "0000000f", mfhi_1 = "00000010D", mthi_1 = "00000011S", mflo_1 = "00000012D", mtlo_1 = "00000013S", mult_2 = "00000018ST", multu_2 = "00000019ST", div_2 = "0000001aST", divu_2 = "0000001bST", add_3 = "00000020DST", move_2 = "00000021DS", addu_3 = "00000021DST", sub_3 = "00000022DST", negu_2 = "00000023DT", subu_3 = "00000023DST", and_3 = "00000024DST", or_3 = "00000025DST", xor_3 = "00000026DST", not_2 = "00000027DS", nor_3 = "00000027DST", slt_3 = "0000002aDST", sltu_3 = "0000002bDST", tge_2 = "00000030ST", tge_3 = "00000030STZ", tgeu_2 = "00000031ST", tgeu_3 = "00000031STZ", tlt_2 = "00000032ST", tlt_3 = "00000032STZ", tltu_2 = "00000033ST", tltu_3 = "00000033STZ", teq_2 = "00000034ST", teq_3 = "00000034STZ", tne_2 = "00000036ST", tne_3 = "00000036STZ", -- Opcode REGIMM. bltz_2 = "04000000SB", bgez_2 = "04010000SB", bltzl_2 = "04020000SB", bgezl_2 = "04030000SB", tgei_2 = "04080000SI", tgeiu_2 = "04090000SI", tlti_2 = "040a0000SI", tltiu_2 = "040b0000SI", teqi_2 = "040c0000SI", tnei_2 = "040e0000SI", bltzal_2 = "04100000SB", bal_1 = "04110000B", bgezal_2 = "04110000SB", bltzall_2 = "04120000SB", bgezall_2 = "04130000SB", synci_1 = "041f0000O", -- Opcode SPECIAL2. madd_2 = "70000000ST", maddu_2 = "70000001ST", mul_3 = "70000002DST", msub_2 = "70000004ST", msubu_2 = "70000005ST", clz_2 = "70000020DS=", clo_2 = "70000021DS=", sdbbp_0 = "7000003f", sdbbp_1 = "7000003fY", -- Opcode SPECIAL3. ext_4 = "7c000000TSAM", -- Note: last arg is msbd = size-1 ins_4 = "7c000004TSAM", -- Note: last arg is msb = pos+size-1 wsbh_2 = "7c0000a0DT", seb_2 = "7c000420DT", seh_2 = "7c000620DT", rdhwr_2 = "7c00003bTD", -- Opcode COP0. mfc0_2 = "40000000TD", mfc0_3 = "40000000TDW", mtc0_2 = "40800000TD", mtc0_3 = "40800000TDW", rdpgpr_2 = "41400000DT", di_0 = "41606000", di_1 = "41606000T", ei_0 = "41606020", ei_1 = "41606020T", wrpgpr_2 = "41c00000DT", tlbr_0 = "42000001", tlbwi_0 = "42000002", tlbwr_0 = "42000006", tlbp_0 = "42000008", eret_0 = "42000018", deret_0 = "4200001f", wait_0 = "42000020", -- Opcode COP1. mfc1_2 = "44000000TG", cfc1_2 = "44400000TG", mfhc1_2 = "44600000TG", mtc1_2 = "44800000TG", ctc1_2 = "44c00000TG", mthc1_2 = "44e00000TG", bc1f_1 = "45000000B", bc1f_2 = "45000000CB", bc1t_1 = "45010000B", bc1t_2 = "45010000CB", bc1fl_1 = "45020000B", bc1fl_2 = "45020000CB", bc1tl_1 = "45030000B", bc1tl_2 = "45030000CB", ["add.s_3"] = "46000000FGH", ["sub.s_3"] = "46000001FGH", ["mul.s_3"] = "46000002FGH", ["div.s_3"] = "46000003FGH", ["sqrt.s_2"] = "46000004FG", ["abs.s_2"] = "46000005FG", ["mov.s_2"] = "46000006FG", ["neg.s_2"] = "46000007FG", ["round.l.s_2"] = "46000008FG", ["trunc.l.s_2"] = "46000009FG", ["ceil.l.s_2"] = "4600000aFG", ["floor.l.s_2"] = "4600000bFG", ["round.w.s_2"] = "4600000cFG", ["trunc.w.s_2"] = "4600000dFG", ["ceil.w.s_2"] = "4600000eFG", ["floor.w.s_2"] = "4600000fFG", ["movf.s_2"] = "46000011FG", ["movf.s_3"] = "46000011FGC", ["movt.s_2"] = "46010011FG", ["movt.s_3"] = "46010011FGC", ["movz.s_3"] = "46000012FGT", ["movn.s_3"] = "46000013FGT", ["recip.s_2"] = "46000015FG", ["rsqrt.s_2"] = "46000016FG", ["cvt.d.s_2"] = "46000021FG", ["cvt.w.s_2"] = "46000024FG", ["cvt.l.s_2"] = "46000025FG", ["cvt.ps.s_3"] = "46000026FGH", ["c.f.s_2"] = "46000030GH", ["c.f.s_3"] = "46000030VGH", ["c.un.s_2"] = "46000031GH", ["c.un.s_3"] = "46000031VGH", ["c.eq.s_2"] = "46000032GH", ["c.eq.s_3"] = "46000032VGH", ["c.ueq.s_2"] = "46000033GH", ["c.ueq.s_3"] = "46000033VGH", ["c.olt.s_2"] = "46000034GH", ["c.olt.s_3"] = "46000034VGH", ["c.ult.s_2"] = "46000035GH", ["c.ult.s_3"] = "46000035VGH", ["c.ole.s_2"] = "46000036GH", ["c.ole.s_3"] = "46000036VGH", ["c.ule.s_2"] = "46000037GH", ["c.ule.s_3"] = "46000037VGH", ["c.sf.s_2"] = "46000038GH", ["c.sf.s_3"] = "46000038VGH", ["c.ngle.s_2"] = "46000039GH", ["c.ngle.s_3"] = "46000039VGH", ["c.seq.s_2"] = "4600003aGH", ["c.seq.s_3"] = "4600003aVGH", ["c.ngl.s_2"] = "4600003bGH", ["c.ngl.s_3"] = "4600003bVGH", ["c.lt.s_2"] = "4600003cGH", ["c.lt.s_3"] = "4600003cVGH", ["c.nge.s_2"] = "4600003dGH", ["c.nge.s_3"] = "4600003dVGH", ["c.le.s_2"] = "4600003eGH", ["c.le.s_3"] = "4600003eVGH", ["c.ngt.s_2"] = "4600003fGH", ["c.ngt.s_3"] = "4600003fVGH", ["add.d_3"] = "46200000FGH", ["sub.d_3"] = "46200001FGH", ["mul.d_3"] = "46200002FGH", ["div.d_3"] = "46200003FGH", ["sqrt.d_2"] = "46200004FG", ["abs.d_2"] = "46200005FG", ["mov.d_2"] = "46200006FG", ["neg.d_2"] = "46200007FG", ["round.l.d_2"] = "46200008FG", ["trunc.l.d_2"] = "46200009FG", ["ceil.l.d_2"] = "4620000aFG", ["floor.l.d_2"] = "4620000bFG", ["round.w.d_2"] = "4620000cFG", ["trunc.w.d_2"] = "4620000dFG", ["ceil.w.d_2"] = "4620000eFG", ["floor.w.d_2"] = "4620000fFG", ["movf.d_2"] = "46200011FG", ["movf.d_3"] = "46200011FGC", ["movt.d_2"] = "46210011FG", ["movt.d_3"] = "46210011FGC", ["movz.d_3"] = "46200012FGT", ["movn.d_3"] = "46200013FGT", ["recip.d_2"] = "46200015FG", ["rsqrt.d_2"] = "46200016FG", ["cvt.s.d_2"] = "46200020FG", ["cvt.w.d_2"] = "46200024FG", ["cvt.l.d_2"] = "46200025FG", ["c.f.d_2"] = "46200030GH", ["c.f.d_3"] = "46200030VGH", ["c.un.d_2"] = "46200031GH", ["c.un.d_3"] = "46200031VGH", ["c.eq.d_2"] = "46200032GH", ["c.eq.d_3"] = "46200032VGH", ["c.ueq.d_2"] = "46200033GH", ["c.ueq.d_3"] = "46200033VGH", ["c.olt.d_2"] = "46200034GH", ["c.olt.d_3"] = "46200034VGH", ["c.ult.d_2"] = "46200035GH", ["c.ult.d_3"] = "46200035VGH", ["c.ole.d_2"] = "46200036GH", ["c.ole.d_3"] = "46200036VGH", ["c.ule.d_2"] = "46200037GH", ["c.ule.d_3"] = "46200037VGH", ["c.sf.d_2"] = "46200038GH", ["c.sf.d_3"] = "46200038VGH", ["c.ngle.d_2"] = "46200039GH", ["c.ngle.d_3"] = "46200039VGH", ["c.seq.d_2"] = "4620003aGH", ["c.seq.d_3"] = "4620003aVGH", ["c.ngl.d_2"] = "4620003bGH", ["c.ngl.d_3"] = "4620003bVGH", ["c.lt.d_2"] = "4620003cGH", ["c.lt.d_3"] = "4620003cVGH", ["c.nge.d_2"] = "4620003dGH", ["c.nge.d_3"] = "4620003dVGH", ["c.le.d_2"] = "4620003eGH", ["c.le.d_3"] = "4620003eVGH", ["c.ngt.d_2"] = "4620003fGH", ["c.ngt.d_3"] = "4620003fVGH", ["add.ps_3"] = "46c00000FGH", ["sub.ps_3"] = "46c00001FGH", ["mul.ps_3"] = "46c00002FGH", ["abs.ps_2"] = "46c00005FG", ["mov.ps_2"] = "46c00006FG", ["neg.ps_2"] = "46c00007FG", ["movf.ps_2"] = "46c00011FG", ["movf.ps_3"] = "46c00011FGC", ["movt.ps_2"] = "46c10011FG", ["movt.ps_3"] = "46c10011FGC", ["movz.ps_3"] = "46c00012FGT", ["movn.ps_3"] = "46c00013FGT", ["cvt.s.pu_2"] = "46c00020FG", ["cvt.s.pl_2"] = "46c00028FG", ["pll.ps_3"] = "46c0002cFGH", ["plu.ps_3"] = "46c0002dFGH", ["pul.ps_3"] = "46c0002eFGH", ["puu.ps_3"] = "46c0002fFGH", ["c.f.ps_2"] = "46c00030GH", ["c.f.ps_3"] = "46c00030VGH", ["c.un.ps_2"] = "46c00031GH", ["c.un.ps_3"] = "46c00031VGH", ["c.eq.ps_2"] = "46c00032GH", ["c.eq.ps_3"] = "46c00032VGH", ["c.ueq.ps_2"] = "46c00033GH", ["c.ueq.ps_3"] = "46c00033VGH", ["c.olt.ps_2"] = "46c00034GH", ["c.olt.ps_3"] = "46c00034VGH", ["c.ult.ps_2"] = "46c00035GH", ["c.ult.ps_3"] = "46c00035VGH", ["c.ole.ps_2"] = "46c00036GH", ["c.ole.ps_3"] = "46c00036VGH", ["c.ule.ps_2"] = "46c00037GH", ["c.ule.ps_3"] = "46c00037VGH", ["c.sf.ps_2"] = "46c00038GH", ["c.sf.ps_3"] = "46c00038VGH", ["c.ngle.ps_2"] = "46c00039GH", ["c.ngle.ps_3"] = "46c00039VGH", ["c.seq.ps_2"] = "46c0003aGH", ["c.seq.ps_3"] = "46c0003aVGH", ["c.ngl.ps_2"] = "46c0003bGH", ["c.ngl.ps_3"] = "46c0003bVGH", ["c.lt.ps_2"] = "46c0003cGH", ["c.lt.ps_3"] = "46c0003cVGH", ["c.nge.ps_2"] = "46c0003dGH", ["c.nge.ps_3"] = "46c0003dVGH", ["c.le.ps_2"] = "46c0003eGH", ["c.le.ps_3"] = "46c0003eVGH", ["c.ngt.ps_2"] = "46c0003fGH", ["c.ngt.ps_3"] = "46c0003fVGH", ["cvt.s.w_2"] = "46800020FG", ["cvt.d.w_2"] = "46800021FG", ["cvt.s.l_2"] = "46a00020FG", ["cvt.d.l_2"] = "46a00021FG", -- Opcode COP1X. lwxc1_2 = "4c000000FX", ldxc1_2 = "4c000001FX", luxc1_2 = "4c000005FX", swxc1_2 = "4c000008FX", sdxc1_2 = "4c000009FX", suxc1_2 = "4c00000dFX", prefx_2 = "4c00000fMX", ["alnv.ps_4"] = "4c00001eFGHS", ["madd.s_4"] = "4c000020FRGH", ["madd.d_4"] = "4c000021FRGH", ["madd.ps_4"] = "4c000026FRGH", ["msub.s_4"] = "4c000028FRGH", ["msub.d_4"] = "4c000029FRGH", ["msub.ps_4"] = "4c00002eFRGH", ["nmadd.s_4"] = "4c000030FRGH", ["nmadd.d_4"] = "4c000031FRGH", ["nmadd.ps_4"] = "4c000036FRGH", ["nmsub.s_4"] = "4c000038FRGH", ["nmsub.d_4"] = "4c000039FRGH", ["nmsub.ps_4"] = "4c00003eFRGH", } ------------------------------------------------------------------------------ local function parse_gpr(expr) local tname, ovreg = match(expr, "^([%w_]+):(r[1-3]?[0-9])$") local tp = map_type[tname or expr] if tp then local reg = ovreg or tp.reg if not reg then werror("type `"..(tname or expr).."' needs a register override") end expr = reg end local r = match(expr, "^r([1-3]?[0-9])$") if r then r = tonumber(r) if r <= 31 then return r, tp end end werror("bad register name `"..expr.."'") end local function parse_fpr(expr) local r = match(expr, "^f([1-3]?[0-9])$") if r then r = tonumber(r) if r <= 31 then return r end end werror("bad register name `"..expr.."'") end local function parse_imm(imm, bits, shift, scale, signed) local n = tonumber(imm) if n then local m = sar(n, scale) if shl(m, scale) == n then if signed then local s = sar(m, bits-1) if s == 0 then return shl(m, shift) elseif s == -1 then return shl(m + shl(1, bits), shift) end else if sar(m, bits) == 0 then return shl(m, shift) end end end werror("out of range immediate `"..imm.."'") elseif match(imm, "^[rf]([1-3]?[0-9])$") or match(imm, "^([%w_]+):([rf][1-3]?[0-9])$") then werror("expected immediate operand, got register") else waction("IMM", (signed and 32768 or 0)+scale*1024+bits*32+shift, imm) return 0 end end local function parse_disp(disp) local imm, reg = match(disp, "^(.*)%(([%w_:]+)%)$") if imm then local r = shl(parse_gpr(reg), 21) local extname = match(imm, "^extern%s+(%S+)$") if extname then waction("REL_EXT", map_extern[extname], nil, 1) return r else return r + parse_imm(imm, 16, 0, 0, true) end end local reg, tailr = match(disp, "^([%w_:]+)%s*(.*)$") if reg and tailr ~= "" then local r, tp = parse_gpr(reg) if tp then waction("IMM", 32768+16*32, format(tp.ctypefmt, tailr)) return shl(r, 21) end end werror("bad displacement `"..disp.."'") end local function parse_index(idx) local rt, rs = match(idx, "^(.*)%(([%w_:]+)%)$") if rt then rt = parse_gpr(rt) rs = parse_gpr(rs) return shl(rt, 16) + shl(rs, 21) end werror("bad index `"..idx.."'") end local function parse_label(label, def) local prefix = sub(label, 1, 2) -- =>label (pc label reference) if prefix == "=>" then return "PC", 0, sub(label, 3) end -- ->name (global label reference) if prefix == "->" then return "LG", map_global[sub(label, 3)] end if def then -- [1-9] (local label definition) if match(label, "^[1-9]$") then return "LG", 10+tonumber(label) end else -- [<>][1-9] (local label reference) local dir, lnum = match(label, "^([<>])([1-9])$") if dir then -- Fwd: 1-9, Bkwd: 11-19. return "LG", lnum + (dir == ">" and 0 or 10) end -- extern label (extern label reference) local extname = match(label, "^extern%s+(%S+)$") if extname then return "EXT", map_extern[extname] end end werror("bad label `"..label.."'") end ------------------------------------------------------------------------------ -- Handle opcodes defined with template strings. map_op[".template__"] = function(params, template, nparams) if not params then return sub(template, 9) end local op = tonumber(sub(template, 1, 8), 16) local n = 1 -- Limit number of section buffer positions used by a single dasm_put(). -- A single opcode needs a maximum of 2 positions (ins/ext). if secpos+2 > maxsecpos then wflush() end local pos = wpos() -- Process each character. for p in gmatch(sub(template, 9), ".") do if p == "D" then op = op + shl(parse_gpr(params[n]), 11); n = n + 1 elseif p == "T" then op = op + shl(parse_gpr(params[n]), 16); n = n + 1 elseif p == "S" then op = op + shl(parse_gpr(params[n]), 21); n = n + 1 elseif p == "F" then op = op + shl(parse_fpr(params[n]), 6); n = n + 1 elseif p == "G" then op = op + shl(parse_fpr(params[n]), 11); n = n + 1 elseif p == "H" then op = op + shl(parse_fpr(params[n]), 16); n = n + 1 elseif p == "R" then op = op + shl(parse_fpr(params[n]), 21); n = n + 1 elseif p == "I" then op = op + parse_imm(params[n], 16, 0, 0, true); n = n + 1 elseif p == "U" then op = op + parse_imm(params[n], 16, 0, 0, false); n = n + 1 elseif p == "O" then op = op + parse_disp(params[n]); n = n + 1 elseif p == "X" then op = op + parse_index(params[n]); n = n + 1 elseif p == "B" or p == "J" then local mode, n, s = parse_label(params[n], false) if p == "B" then n = n + 2048 end waction("REL_"..mode, n, s, 1) n = n + 1 elseif p == "A" then op = op + parse_imm(params[n], 5, 6, 0, false); n = n + 1 elseif p == "M" then op = op + parse_imm(params[n], 5, 11, 0, false); n = n + 1 elseif p == "N" then op = op + parse_imm(params[n], 5, 16, 0, false); n = n + 1 elseif p == "C" then op = op + parse_imm(params[n], 3, 18, 0, false); n = n + 1 elseif p == "V" then op = op + parse_imm(params[n], 3, 8, 0, false); n = n + 1 elseif p == "W" then op = op + parse_imm(params[n], 3, 0, 0, false); n = n + 1 elseif p == "Y" then op = op + parse_imm(params[n], 20, 6, 0, false); n = n + 1 elseif p == "Z" then op = op + parse_imm(params[n], 10, 6, 0, false); n = n + 1 elseif p == "=" then op = op + shl(band(op, 0xf800), 5) -- Copy D to T for clz, clo. else assert(false) end end wputpos(pos, op) end ------------------------------------------------------------------------------ -- Pseudo-opcode to mark the position where the action list is to be emitted. map_op[".actionlist_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeactions(out, name) end) end -- Pseudo-opcode to mark the position where the global enum is to be emitted. map_op[".globals_1"] = function(params) if not params then return "prefix" end local prefix = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobals(out, prefix) end) end -- Pseudo-opcode to mark the position where the global names are to be emitted. map_op[".globalnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobalnames(out, name) end) end -- Pseudo-opcode to mark the position where the extern names are to be emitted. map_op[".externnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeexternnames(out, name) end) end ------------------------------------------------------------------------------ -- Label pseudo-opcode (converted from trailing colon form). map_op[".label_1"] = function(params) if not params then return "[1-9] | ->global | =>pcexpr" end if secpos+1 > maxsecpos then wflush() end local mode, n, s = parse_label(params[1], true) if mode == "EXT" then werror("bad label definition") end waction("LABEL_"..mode, n, s, 1) end ------------------------------------------------------------------------------ -- Pseudo-opcodes for data storage. map_op[".long_*"] = function(params) if not params then return "imm..." end for _,p in ipairs(params) do local n = tonumber(p) if not n then werror("bad immediate `"..p.."'") end if n < 0 then n = n + 2^32 end wputw(n) if secpos+2 > maxsecpos then wflush() end end end -- Alignment pseudo-opcode. map_op[".align_1"] = function(params) if not params then return "numpow2" end if secpos+1 > maxsecpos then wflush() end local align = tonumber(params[1]) if align then local x = align -- Must be a power of 2 in the range (2 ... 256). for i=1,8 do x = x / 2 if x == 1 then waction("ALIGN", align-1, nil, 1) -- Action byte is 2**n-1. return end end end werror("bad alignment") end ------------------------------------------------------------------------------ -- Pseudo-opcode for (primitive) type definitions (map to C types). map_op[".type_3"] = function(params, nparams) if not params then return nparams == 2 and "name, ctype" or "name, ctype, reg" end local name, ctype, reg = params[1], params[2], params[3] if not match(name, "^[%a_][%w_]*$") then werror("bad type name `"..name.."'") end local tp = map_type[name] if tp then werror("duplicate type `"..name.."'") end -- Add #type to defines. A bit unclean to put it in map_archdef. map_archdef["#"..name] = "sizeof("..ctype..")" -- Add new type and emit shortcut define. local num = ctypenum + 1 map_type[name] = { ctype = ctype, ctypefmt = format("Dt%X(%%s)", num), reg = reg, } wline(format("#define Dt%X(_V) (int)(ptrdiff_t)&(((%s *)0)_V)", num, ctype)) ctypenum = num end map_op[".type_2"] = map_op[".type_3"] -- Dump type definitions. local function dumptypes(out, lvl) local t = {} for name in pairs(map_type) do t[#t+1] = name end sort(t) out:write("Type definitions:\n") for _,name in ipairs(t) do local tp = map_type[name] local reg = tp.reg or "" out:write(format(" %-20s %-20s %s\n", name, tp.ctype, reg)) end out:write("\n") end ------------------------------------------------------------------------------ -- Set the current section. function _M.section(num) waction("SECTION", num) wflush(true) -- SECTION is a terminal action. end ------------------------------------------------------------------------------ -- Dump architecture description. function _M.dumparch(out) out:write(format("DynASM %s version %s, released %s\n\n", _info.arch, _info.version, _info.release)) dumpactions(out) end -- Dump all user defined elements. function _M.dumpdef(out, lvl) dumptypes(out, lvl) dumpglobals(out, lvl) dumpexterns(out, lvl) end ------------------------------------------------------------------------------ -- Pass callbacks from/to the DynASM core. function _M.passcb(wl, we, wf, ww) wline, werror, wfatal, wwarn = wl, we, wf, ww return wflush end -- Setup the arch-specific module. function _M.setup(arch, opt) g_arch, g_opt = arch, opt end -- Merge the core maps and the arch-specific maps. function _M.mergemaps(map_coreop, map_def) setmetatable(map_op, { __index = map_coreop }) setmetatable(map_def, { __index = map_archdef }) return map_op, map_def end return _M ------------------------------------------------------------------------------ wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dynasm.lua0000644000175000017500000007441513122010155017406 0ustar philphil------------------------------------------------------------------------------ -- DynASM. A dynamic assembler for code generation engines. -- Originally designed and implemented for LuaJIT. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- See below for full copyright notice. ------------------------------------------------------------------------------ -- Application information. local _info = { name = "DynASM", description = "A dynamic assembler for code generation engines", version = "1.3.0", vernum = 10300, release = "2011-05-05", author = "Mike Pall", url = "http://luajit.org/dynasm.html", license = "MIT", copyright = [[ Copyright (C) 2005-2016 Mike Pall. All rights reserved. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. [ MIT license: http://www.opensource.org/licenses/mit-license.php ] ]], } -- Cache library functions. local type, pairs, ipairs = type, pairs, ipairs local pcall, error, assert = pcall, error, assert local _s = string local sub, match, gmatch, gsub = _s.sub, _s.match, _s.gmatch, _s.gsub local format, rep, upper = _s.format, _s.rep, _s.upper local _t = table local insert, remove, concat, sort = _t.insert, _t.remove, _t.concat, _t.sort local exit = os.exit local io = io local stdin, stdout, stderr = io.stdin, io.stdout, io.stderr ------------------------------------------------------------------------------ -- Program options. local g_opt = {} -- Global state for current file. local g_fname, g_curline, g_indent, g_lineno, g_synclineno, g_arch local g_errcount = 0 -- Write buffer for output file. local g_wbuffer, g_capbuffer ------------------------------------------------------------------------------ -- Write an output line (or callback function) to the buffer. local function wline(line, needindent) local buf = g_capbuffer or g_wbuffer buf[#buf+1] = needindent and g_indent..line or line g_synclineno = g_synclineno + 1 end -- Write assembler line as a comment, if requestd. local function wcomment(aline) if g_opt.comment then wline(g_opt.comment..aline..g_opt.endcomment, true) end end -- Resync CPP line numbers. local function wsync() if g_synclineno ~= g_lineno and g_opt.cpp then wline("#line "..g_lineno..' "'..g_fname..'"') g_synclineno = g_lineno end end -- Dummy action flush function. Replaced with arch-specific function later. local function wflush(term) end -- Dump all buffered output lines. local function wdumplines(out, buf) for _,line in ipairs(buf) do if type(line) == "string" then assert(out:write(line, "\n")) else -- Special callback to dynamically insert lines after end of processing. line(out) end end end ------------------------------------------------------------------------------ -- Emit an error. Processing continues with next statement. local function werror(msg) error(format("%s:%s: error: %s:\n%s", g_fname, g_lineno, msg, g_curline), 0) end -- Emit a fatal error. Processing stops. local function wfatal(msg) g_errcount = "fatal" werror(msg) end -- Print a warning. Processing continues. local function wwarn(msg) stderr:write(format("%s:%s: warning: %s:\n%s\n", g_fname, g_lineno, msg, g_curline)) end -- Print caught error message. But suppress excessive errors. local function wprinterr(...) if type(g_errcount) == "number" then -- Regular error. g_errcount = g_errcount + 1 if g_errcount < 21 then -- Seems to be a reasonable limit. stderr:write(...) elseif g_errcount == 21 then stderr:write(g_fname, ":*: warning: too many errors (suppressed further messages).\n") end else -- Fatal error. stderr:write(...) return true -- Stop processing. end end ------------------------------------------------------------------------------ -- Map holding all option handlers. local opt_map = {} local opt_current -- Print error and exit with error status. local function opterror(...) stderr:write("dynasm.lua: ERROR: ", ...) stderr:write("\n") exit(1) end -- Get option parameter. local function optparam(args) local argn = args.argn local p = args[argn] if not p then opterror("missing parameter for option `", opt_current, "'.") end args.argn = argn + 1 return p end ------------------------------------------------------------------------------ -- Core pseudo-opcodes. local map_coreop = {} -- Dummy opcode map. Replaced by arch-specific map. local map_op = {} -- Forward declarations. local dostmt local readfile ------------------------------------------------------------------------------ -- Map for defines (initially empty, chains to arch-specific map). local map_def = {} -- Pseudo-opcode to define a substitution. map_coreop[".define_2"] = function(params, nparams) if not params then return nparams == 1 and "name" or "name, subst" end local name, def = params[1], params[2] or "1" if not match(name, "^[%a_][%w_]*$") then werror("bad or duplicate define") end map_def[name] = def end map_coreop[".define_1"] = map_coreop[".define_2"] -- Define a substitution on the command line. function opt_map.D(args) local namesubst = optparam(args) local name, subst = match(namesubst, "^([%a_][%w_]*)=(.*)$") if name then map_def[name] = subst elseif match(namesubst, "^[%a_][%w_]*$") then map_def[namesubst] = "1" else opterror("bad define") end end -- Undefine a substitution on the command line. function opt_map.U(args) local name = optparam(args) if match(name, "^[%a_][%w_]*$") then map_def[name] = nil else opterror("bad define") end end -- Helper for definesubst. local gotsubst local function definesubst_one(word) local subst = map_def[word] if subst then gotsubst = word; return subst else return word end end -- Iteratively substitute defines. local function definesubst(stmt) -- Limit number of iterations. for i=1,100 do gotsubst = false stmt = gsub(stmt, "#?[%w_]+", definesubst_one) if not gotsubst then break end end if gotsubst then wfatal("recursive define involving `"..gotsubst.."'") end return stmt end -- Dump all defines. local function dumpdefines(out, lvl) local t = {} for name in pairs(map_def) do t[#t+1] = name end sort(t) out:write("Defines:\n") for _,name in ipairs(t) do local subst = map_def[name] if g_arch then subst = g_arch.revdef(subst) end out:write(format(" %-20s %s\n", name, subst)) end out:write("\n") end ------------------------------------------------------------------------------ -- Support variables for conditional assembly. local condlevel = 0 local condstack = {} -- Evaluate condition with a Lua expression. Substitutions already performed. local function cond_eval(cond) local func, err if setfenv then func, err = loadstring("return "..cond, "=expr") else -- No globals. All unknown identifiers evaluate to nil. func, err = load("return "..cond, "=expr", "t", {}) end if func then if setfenv then setfenv(func, {}) -- No globals. All unknown identifiers evaluate to nil. end local ok, res = pcall(func) if ok then if res == 0 then return false end -- Oh well. return not not res end err = res end wfatal("bad condition: "..err) end -- Skip statements until next conditional pseudo-opcode at the same level. local function stmtskip() local dostmt_save = dostmt local lvl = 0 dostmt = function(stmt) local op = match(stmt, "^%s*(%S+)") if op == ".if" then lvl = lvl + 1 elseif lvl ~= 0 then if op == ".endif" then lvl = lvl - 1 end elseif op == ".elif" or op == ".else" or op == ".endif" then dostmt = dostmt_save dostmt(stmt) end end end -- Pseudo-opcodes for conditional assembly. map_coreop[".if_1"] = function(params) if not params then return "condition" end local lvl = condlevel + 1 local res = cond_eval(params[1]) condlevel = lvl condstack[lvl] = res if not res then stmtskip() end end map_coreop[".elif_1"] = function(params) if not params then return "condition" end if condlevel == 0 then wfatal(".elif without .if") end local lvl = condlevel local res = condstack[lvl] if res then if res == "else" then wfatal(".elif after .else") end else res = cond_eval(params[1]) if res then condstack[lvl] = res return end end stmtskip() end map_coreop[".else_0"] = function(params) if condlevel == 0 then wfatal(".else without .if") end local lvl = condlevel local res = condstack[lvl] condstack[lvl] = "else" if res then if res == "else" then wfatal(".else after .else") end stmtskip() end end map_coreop[".endif_0"] = function(params) local lvl = condlevel if lvl == 0 then wfatal(".endif without .if") end condlevel = lvl - 1 end -- Check for unfinished conditionals. local function checkconds() if g_errcount ~= "fatal" and condlevel ~= 0 then wprinterr(g_fname, ":*: error: unbalanced conditional\n") end end ------------------------------------------------------------------------------ -- Search for a file in the given path and open it for reading. local function pathopen(path, name) local dirsep = package and match(package.path, "\\") and "\\" or "/" for _,p in ipairs(path) do local fullname = p == "" and name or p..dirsep..name local fin = io.open(fullname, "r") if fin then g_fname = fullname return fin end end end -- Include a file. map_coreop[".include_1"] = function(params) if not params then return "filename" end local name = params[1] -- Save state. Ugly, I know. but upvalues are fast. local gf, gl, gcl, gi = g_fname, g_lineno, g_curline, g_indent -- Read the included file. local fatal = readfile(pathopen(g_opt.include, name) or wfatal("include file `"..name.."' not found")) -- Restore state. g_synclineno = -1 g_fname, g_lineno, g_curline, g_indent = gf, gl, gcl, gi if fatal then wfatal("in include file") end end -- Make .include and conditionals initially available, too. map_op[".include_1"] = map_coreop[".include_1"] map_op[".if_1"] = map_coreop[".if_1"] map_op[".elif_1"] = map_coreop[".elif_1"] map_op[".else_0"] = map_coreop[".else_0"] map_op[".endif_0"] = map_coreop[".endif_0"] ------------------------------------------------------------------------------ -- Support variables for macros. local mac_capture, mac_lineno, mac_name local mac_active = {} local mac_list = {} -- Pseudo-opcode to define a macro. map_coreop[".macro_*"] = function(mparams) if not mparams then return "name [, params...]" end -- Split off and validate macro name. local name = remove(mparams, 1) if not name then werror("missing macro name") end if not (match(name, "^[%a_][%w_%.]*$") or match(name, "^%.[%w_%.]*$")) then wfatal("bad macro name `"..name.."'") end -- Validate macro parameter names. local mdup = {} for _,mp in ipairs(mparams) do if not match(mp, "^[%a_][%w_]*$") then wfatal("bad macro parameter name `"..mp.."'") end if mdup[mp] then wfatal("duplicate macro parameter name `"..mp.."'") end mdup[mp] = true end -- Check for duplicate or recursive macro definitions. local opname = name.."_"..#mparams if map_op[opname] or map_op[name.."_*"] then wfatal("duplicate macro `"..name.."' ("..#mparams.." parameters)") end if mac_capture then wfatal("recursive macro definition") end -- Enable statement capture. local lines = {} mac_lineno = g_lineno mac_name = name mac_capture = function(stmt) -- Statement capture function. -- Stop macro definition with .endmacro pseudo-opcode. if not match(stmt, "^%s*.endmacro%s*$") then lines[#lines+1] = stmt return end mac_capture = nil mac_lineno = nil mac_name = nil mac_list[#mac_list+1] = opname -- Add macro-op definition. map_op[opname] = function(params) if not params then return mparams, lines end -- Protect against recursive macro invocation. if mac_active[opname] then wfatal("recursive macro invocation") end mac_active[opname] = true -- Setup substitution map. local subst = {} for i,mp in ipairs(mparams) do subst[mp] = params[i] end local mcom if g_opt.maccomment and g_opt.comment then mcom = " MACRO "..name.." ("..#mparams..")" wcomment("{"..mcom) end -- Loop through all captured statements for _,stmt in ipairs(lines) do -- Substitute macro parameters. local st = gsub(stmt, "[%w_]+", subst) st = definesubst(st) st = gsub(st, "%s*%.%.%s*", "") -- Token paste a..b. if mcom and sub(st, 1, 1) ~= "|" then wcomment(st) end -- Emit statement. Use a protected call for better diagnostics. local ok, err = pcall(dostmt, st) if not ok then -- Add the captured statement to the error. wprinterr(err, "\n", g_indent, "| ", stmt, "\t[MACRO ", name, " (", #mparams, ")]\n") end end if mcom then wcomment("}"..mcom) end mac_active[opname] = nil end end end -- An .endmacro pseudo-opcode outside of a macro definition is an error. map_coreop[".endmacro_0"] = function(params) wfatal(".endmacro without .macro") end -- Dump all macros and their contents (with -PP only). local function dumpmacros(out, lvl) sort(mac_list) out:write("Macros:\n") for _,opname in ipairs(mac_list) do local name = sub(opname, 1, -3) local params, lines = map_op[opname]() out:write(format(" %-20s %s\n", name, concat(params, ", "))) if lvl > 1 then for _,line in ipairs(lines) do out:write(" |", line, "\n") end out:write("\n") end end out:write("\n") end -- Check for unfinished macro definitions. local function checkmacros() if mac_capture then wprinterr(g_fname, ":", mac_lineno, ": error: unfinished .macro `", mac_name ,"'\n") end end ------------------------------------------------------------------------------ -- Support variables for captures. local cap_lineno, cap_name local cap_buffers = {} local cap_used = {} -- Start a capture. map_coreop[".capture_1"] = function(params) if not params then return "name" end wflush() local name = params[1] if not match(name, "^[%a_][%w_]*$") then wfatal("bad capture name `"..name.."'") end if cap_name then wfatal("already capturing to `"..cap_name.."' since line "..cap_lineno) end cap_name = name cap_lineno = g_lineno -- Create or continue a capture buffer and start the output line capture. local buf = cap_buffers[name] if not buf then buf = {}; cap_buffers[name] = buf end g_capbuffer = buf g_synclineno = 0 end -- Stop a capture. map_coreop[".endcapture_0"] = function(params) wflush() if not cap_name then wfatal(".endcapture without a valid .capture") end cap_name = nil cap_lineno = nil g_capbuffer = nil g_synclineno = 0 end -- Dump a capture buffer. map_coreop[".dumpcapture_1"] = function(params) if not params then return "name" end wflush() local name = params[1] if not match(name, "^[%a_][%w_]*$") then wfatal("bad capture name `"..name.."'") end cap_used[name] = true wline(function(out) local buf = cap_buffers[name] if buf then wdumplines(out, buf) end end) g_synclineno = 0 end -- Dump all captures and their buffers (with -PP only). local function dumpcaptures(out, lvl) out:write("Captures:\n") for name,buf in pairs(cap_buffers) do out:write(format(" %-20s %4s)\n", name, "("..#buf)) if lvl > 1 then local bar = rep("=", 76) out:write(" ", bar, "\n") for _,line in ipairs(buf) do out:write(" ", line, "\n") end out:write(" ", bar, "\n\n") end end out:write("\n") end -- Check for unfinished or unused captures. local function checkcaptures() if cap_name then wprinterr(g_fname, ":", cap_lineno, ": error: unfinished .capture `", cap_name,"'\n") return end for name in pairs(cap_buffers) do if not cap_used[name] then wprinterr(g_fname, ":*: error: missing .dumpcapture ", name ,"\n") end end end ------------------------------------------------------------------------------ -- Sections names. local map_sections = {} -- Pseudo-opcode to define code sections. -- TODO: Data sections, BSS sections. Needs extra C code and API. map_coreop[".section_*"] = function(params) if not params then return "name..." end if #map_sections > 0 then werror("duplicate section definition") end wflush() for sn,name in ipairs(params) do local opname = "."..name.."_0" if not match(name, "^[%a][%w_]*$") or map_op[opname] or map_op["."..name.."_*"] then werror("bad section name `"..name.."'") end map_sections[#map_sections+1] = name wline(format("#define DASM_SECTION_%s\t%d", upper(name), sn-1)) map_op[opname] = function(params) g_arch.section(sn-1) end end wline(format("#define DASM_MAXSECTION\t\t%d", #map_sections)) end -- Dump all sections. local function dumpsections(out, lvl) out:write("Sections:\n") for _,name in ipairs(map_sections) do out:write(format(" %s\n", name)) end out:write("\n") end ------------------------------------------------------------------------------ -- Replacement for customized Lua, which lacks the package library. local prefix = "" if not require then function require(name) local fp = assert(io.open(prefix..name..".lua")) local s = fp:read("*a") assert(fp:close()) return assert(loadstring(s, "@"..name..".lua"))() end end -- Load architecture-specific module. local function loadarch(arch) if not match(arch, "^[%w_]+$") then return "bad arch name" end local ok, m_arch = pcall(require, "dasm_"..arch) if not ok then return "cannot load module: "..m_arch end g_arch = m_arch wflush = m_arch.passcb(wline, werror, wfatal, wwarn) m_arch.setup(arch, g_opt) map_op, map_def = m_arch.mergemaps(map_coreop, map_def) end -- Dump architecture description. function opt_map.dumparch(args) local name = optparam(args) if not g_arch then local err = loadarch(name) if err then opterror(err) end end local t = {} for name in pairs(map_coreop) do t[#t+1] = name end for name in pairs(map_op) do t[#t+1] = name end sort(t) local out = stdout local _arch = g_arch._info out:write(format("%s version %s, released %s, %s\n", _info.name, _info.version, _info.release, _info.url)) g_arch.dumparch(out) local pseudo = true out:write("Pseudo-Opcodes:\n") for _,sname in ipairs(t) do local name, nparam = match(sname, "^(.+)_([0-9%*])$") if name then if pseudo and sub(name, 1, 1) ~= "." then out:write("\nOpcodes:\n") pseudo = false end local f = map_op[sname] local s if nparam ~= "*" then nparam = nparam + 0 end if nparam == 0 then s = "" elseif type(f) == "string" then s = map_op[".template__"](nil, f, nparam) else s = f(nil, nparam) end if type(s) == "table" then for _,s2 in ipairs(s) do out:write(format(" %-12s %s\n", name, s2)) end else out:write(format(" %-12s %s\n", name, s)) end end end out:write("\n") exit(0) end -- Pseudo-opcode to set the architecture. -- Only initially available (map_op is replaced when called). map_op[".arch_1"] = function(params) if not params then return "name" end local err = loadarch(params[1]) if err then wfatal(err) end wline(format("#if DASM_VERSION != %d", _info.vernum)) wline('#error "Version mismatch between DynASM and included encoding engine"') wline("#endif") end -- Dummy .arch pseudo-opcode to improve the error report. map_coreop[".arch_1"] = function(params) if not params then return "name" end wfatal("duplicate .arch statement") end ------------------------------------------------------------------------------ -- Dummy pseudo-opcode. Don't confuse '.nop' with 'nop'. map_coreop[".nop_*"] = function(params) if not params then return "[ignored...]" end end -- Pseudo-opcodes to raise errors. map_coreop[".error_1"] = function(params) if not params then return "message" end werror(params[1]) end map_coreop[".fatal_1"] = function(params) if not params then return "message" end wfatal(params[1]) end -- Dump all user defined elements. local function dumpdef(out) local lvl = g_opt.dumpdef if lvl == 0 then return end dumpsections(out, lvl) dumpdefines(out, lvl) if g_arch then g_arch.dumpdef(out, lvl) end dumpmacros(out, lvl) dumpcaptures(out, lvl) end ------------------------------------------------------------------------------ -- Helper for splitstmt. local splitlvl local function splitstmt_one(c) if c == "(" then splitlvl = ")"..splitlvl elseif c == "[" then splitlvl = "]"..splitlvl elseif c == "{" then splitlvl = "}"..splitlvl elseif c == ")" or c == "]" or c == "}" then if sub(splitlvl, 1, 1) ~= c then werror("unbalanced (), [] or {}") end splitlvl = sub(splitlvl, 2) elseif splitlvl == "" then return " \0 " end return c end -- Split statement into (pseudo-)opcode and params. local function splitstmt(stmt) -- Convert label with trailing-colon into .label statement. local label = match(stmt, "^%s*(.+):%s*$") if label then return ".label", {label} end -- Split at commas and equal signs, but obey parentheses and brackets. splitlvl = "" stmt = gsub(stmt, "[,%(%)%[%]{}]", splitstmt_one) if splitlvl ~= "" then werror("unbalanced () or []") end -- Split off opcode. local op, other = match(stmt, "^%s*([^%s%z]+)%s*(.*)$") if not op then werror("bad statement syntax") end -- Split parameters. local params = {} for p in gmatch(other, "%s*(%Z+)%z?") do params[#params+1] = gsub(p, "%s+$", "") end if #params > 16 then werror("too many parameters") end params.op = op return op, params end -- Process a single statement. dostmt = function(stmt) -- Ignore empty statements. if match(stmt, "^%s*$") then return end -- Capture macro defs before substitution. if mac_capture then return mac_capture(stmt) end stmt = definesubst(stmt) -- Emit C code without parsing the line. if sub(stmt, 1, 1) == "|" then local tail = sub(stmt, 2) wflush() if sub(tail, 1, 2) == "//" then wcomment(tail) else wline(tail, true) end return end -- Split into (pseudo-)opcode and params. local op, params = splitstmt(stmt) -- Get opcode handler (matching # of parameters or generic handler). local f = map_op[op.."_"..#params] or map_op[op.."_*"] if not f then if not g_arch then wfatal("first statement must be .arch") end -- Improve error report. for i=0,9 do if map_op[op.."_"..i] then werror("wrong number of parameters for `"..op.."'") end end werror("unknown statement `"..op.."'") end -- Call opcode handler or special handler for template strings. if type(f) == "string" then map_op[".template__"](params, f) else f(params) end end -- Process a single line. local function doline(line) if g_opt.flushline then wflush() end -- Assembler line? local indent, aline = match(line, "^(%s*)%|(.*)$") if not aline then -- No, plain C code line, need to flush first. wflush() wsync() wline(line, false) return end g_indent = indent -- Remember current line indentation. -- Emit C code (even from macros). Avoids echo and line parsing. if sub(aline, 1, 1) == "|" then if not mac_capture then wsync() elseif g_opt.comment then wsync() wcomment(aline) end dostmt(aline) return end -- Echo assembler line as a comment. if g_opt.comment then wsync() wcomment(aline) end -- Strip assembler comments. aline = gsub(aline, "//.*$", "") -- Split line into statements at semicolons. if match(aline, ";") then for stmt in gmatch(aline, "[^;]+") do dostmt(stmt) end else dostmt(aline) end end ------------------------------------------------------------------------------ -- Write DynASM header. local function dasmhead(out) out:write(format([[ /* ** This file has been pre-processed with DynASM. ** %s ** DynASM version %s, DynASM %s version %s ** DO NOT EDIT! The original file is in "%s". */ ]], _info.url, _info.version, g_arch._info.arch, g_arch._info.version, g_fname)) end -- Read input file. readfile = function(fin) g_indent = "" g_lineno = 0 g_synclineno = -1 -- Process all lines. for line in fin:lines() do g_lineno = g_lineno + 1 g_curline = line local ok, err = pcall(doline, line) if not ok and wprinterr(err, "\n") then return true end end wflush() -- Close input file. assert(fin == stdin or fin:close()) end -- Write output file. local function writefile(outfile) local fout -- Open output file. if outfile == nil or outfile == "-" then fout = stdout else fout = assert(io.open(outfile, "w")) end -- Write all buffered lines wdumplines(fout, g_wbuffer) -- Close output file. assert(fout == stdout or fout:close()) -- Optionally dump definitions. dumpdef(fout == stdout and stderr or stdout) end -- Translate an input file to an output file. local function translate(infile, outfile) g_wbuffer = {} g_indent = "" g_lineno = 0 g_synclineno = -1 -- Put header. wline(dasmhead) -- Read input file. local fin if infile == "-" then g_fname = "(stdin)" fin = stdin else g_fname = infile fin = assert(io.open(infile, "r")) end readfile(fin) -- Check for errors. if not g_arch then wprinterr(g_fname, ":*: error: missing .arch directive\n") end checkconds() checkmacros() checkcaptures() if g_errcount ~= 0 then stderr:write(g_fname, ":*: info: ", g_errcount, " error", (type(g_errcount) == "number" and g_errcount > 1) and "s" or "", " in input file -- no output file generated.\n") dumpdef(stderr) exit(1) end -- Write output file. writefile(outfile) end ------------------------------------------------------------------------------ -- Print help text. function opt_map.help() stdout:write("DynASM -- ", _info.description, ".\n") stdout:write("DynASM ", _info.version, " ", _info.release, " ", _info.url, "\n") stdout:write[[ Usage: dynasm [OPTION]... INFILE.dasc|- -h, --help Display this help text. -V, --version Display version and copyright information. -o, --outfile FILE Output file name (default is stdout). -I, --include DIR Add directory to the include search path. -c, --ccomment Use /* */ comments for assembler lines. -C, --cppcomment Use // comments for assembler lines (default). -N, --nocomment Suppress assembler lines in output. -M, --maccomment Show macro expansions as comments (default off). -L, --nolineno Suppress CPP line number information in output. -F, --flushline Flush action list for every line. -D NAME[=SUBST] Define a substitution. -U NAME Undefine a substitution. -P, --dumpdef Dump defines, macros, etc. Repeat for more output. -A, --dumparch ARCH Load architecture ARCH and dump description. ]] exit(0) end -- Print version information. function opt_map.version() stdout:write(format("%s version %s, released %s\n%s\n\n%s", _info.name, _info.version, _info.release, _info.url, _info.copyright)) exit(0) end -- Misc. options. function opt_map.outfile(args) g_opt.outfile = optparam(args) end function opt_map.include(args) insert(g_opt.include, 1, optparam(args)) end function opt_map.ccomment() g_opt.comment = "/*|"; g_opt.endcomment = " */" end function opt_map.cppcomment() g_opt.comment = "//|"; g_opt.endcomment = "" end function opt_map.nocomment() g_opt.comment = false end function opt_map.maccomment() g_opt.maccomment = true end function opt_map.nolineno() g_opt.cpp = false end function opt_map.flushline() g_opt.flushline = true end function opt_map.dumpdef() g_opt.dumpdef = g_opt.dumpdef + 1 end ------------------------------------------------------------------------------ -- Short aliases for long options. local opt_alias = { h = "help", ["?"] = "help", V = "version", o = "outfile", I = "include", c = "ccomment", C = "cppcomment", N = "nocomment", M = "maccomment", L = "nolineno", F = "flushline", P = "dumpdef", A = "dumparch", } -- Parse single option. local function parseopt(opt, args) opt_current = #opt == 1 and "-"..opt or "--"..opt local f = opt_map[opt] or opt_map[opt_alias[opt]] if not f then opterror("unrecognized option `", opt_current, "'. Try `--help'.\n") end f(args) end -- Parse arguments. local function parseargs(args) -- Default options. g_opt.comment = "//|" g_opt.endcomment = "" g_opt.cpp = true g_opt.dumpdef = 0 g_opt.include = { "" } -- Process all option arguments. args.argn = 1 repeat local a = args[args.argn] if not a then break end local lopt, opt = match(a, "^%-(%-?)(.+)") if not opt then break end args.argn = args.argn + 1 if lopt == "" then -- Loop through short options. for o in gmatch(opt, ".") do parseopt(o, args) end else -- Long option. parseopt(opt, args) end until false -- Check for proper number of arguments. local nargs = #args - args.argn + 1 if nargs ~= 1 then if nargs == 0 then if g_opt.dumpdef > 0 then return dumpdef(stdout) end end opt_map.help() end -- Translate a single input file to a single output file -- TODO: Handle multiple files? translate(args[args.argn], g_opt.outfile) end ------------------------------------------------------------------------------ -- Add the directory dynasm.lua resides in to the Lua module search path. local arg = arg if arg and arg[0] then prefix = match(arg[0], "^(.*[/\\])") if package and prefix then package.path = prefix.."?.lua;"..package.path end end -- Start DynASM. parseargs{...} ------------------------------------------------------------------------------ wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_arm.lua0000644000175000017500000010344613122010155017673 0ustar philphil------------------------------------------------------------------------------ -- DynASM ARM module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- See dynasm.lua for full copyright notice. ------------------------------------------------------------------------------ -- Module information: local _info = { arch = "arm", description = "DynASM ARM module", version = "1.3.0", vernum = 10300, release = "2011-05-05", author = "Mike Pall", license = "MIT", } -- Exported glue functions for the arch-specific module. local _M = { _info = _info } -- Cache library functions. local type, tonumber, pairs, ipairs = type, tonumber, pairs, ipairs local assert, setmetatable, rawget = assert, setmetatable, rawget local _s = string local sub, format, byte, char = _s.sub, _s.format, _s.byte, _s.char local match, gmatch, gsub = _s.match, _s.gmatch, _s.gsub local concat, sort, insert = table.concat, table.sort, table.insert local bit = bit or require("bit") local band, shl, shr, sar = bit.band, bit.lshift, bit.rshift, bit.arshift local ror, tohex = bit.ror, bit.tohex -- Inherited tables and callbacks. local g_opt, g_arch local wline, werror, wfatal, wwarn -- Action name list. -- CHECK: Keep this in sync with the C code! local action_names = { "STOP", "SECTION", "ESC", "REL_EXT", "ALIGN", "REL_LG", "LABEL_LG", "REL_PC", "LABEL_PC", "IMM", "IMM12", "IMM16", "IMML8", "IMML12", "IMMV8", } -- Maximum number of section buffer positions for dasm_put(). -- CHECK: Keep this in sync with the C code! local maxsecpos = 25 -- Keep this low, to avoid excessively long C lines. -- Action name -> action number. local map_action = {} for n,name in ipairs(action_names) do map_action[name] = n-1 end -- Action list buffer. local actlist = {} -- Argument list for next dasm_put(). Start with offset 0 into action list. local actargs = { 0 } -- Current number of section buffer positions for dasm_put(). local secpos = 1 ------------------------------------------------------------------------------ -- Dump action names and numbers. local function dumpactions(out) out:write("DynASM encoding engine action codes:\n") for n,name in ipairs(action_names) do local num = map_action[name] out:write(format(" %-10s %02X %d\n", name, num, num)) end out:write("\n") end -- Write action list buffer as a huge static C array. local function writeactions(out, name) local nn = #actlist if nn == 0 then nn = 1; actlist[0] = map_action.STOP end out:write("static const unsigned int ", name, "[", nn, "] = {\n") for i = 1,nn-1 do assert(out:write("0x", tohex(actlist[i]), ",\n")) end assert(out:write("0x", tohex(actlist[nn]), "\n};\n\n")) end ------------------------------------------------------------------------------ -- Add word to action list. local function wputxw(n) assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range") actlist[#actlist+1] = n end -- Add action to list with optional arg. Advance buffer pos, too. local function waction(action, val, a, num) local w = assert(map_action[action], "bad action name `"..action.."'") wputxw(w * 0x10000 + (val or 0)) if a then actargs[#actargs+1] = a end if a or num then secpos = secpos + (num or 1) end end -- Flush action list (intervening C code or buffer pos overflow). local function wflush(term) if #actlist == actargs[1] then return end -- Nothing to flush. if not term then waction("STOP") end -- Terminate action list. wline(format("dasm_put(Dst, %s);", concat(actargs, ", ")), true) actargs = { #actlist } -- Actionlist offset is 1st arg to next dasm_put(). secpos = 1 -- The actionlist offset occupies a buffer position, too. end -- Put escaped word. local function wputw(n) if n <= 0x000fffff then waction("ESC") end wputxw(n) end -- Reserve position for word. local function wpos() local pos = #actlist+1 actlist[pos] = "" return pos end -- Store word to reserved position. local function wputpos(pos, n) assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range") if n <= 0x000fffff then insert(actlist, pos+1, n) n = map_action.ESC * 0x10000 end actlist[pos] = n end ------------------------------------------------------------------------------ -- Global label name -> global label number. With auto assignment on 1st use. local next_global = 20 local map_global = setmetatable({}, { __index = function(t, name) if not match(name, "^[%a_][%w_]*$") then werror("bad global label") end local n = next_global if n > 2047 then werror("too many global labels") end next_global = n + 1 t[name] = n return n end}) -- Dump global labels. local function dumpglobals(out, lvl) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("Global labels:\n") for i=20,next_global-1 do out:write(format(" %s\n", t[i])) end out:write("\n") end -- Write global label enum. local function writeglobals(out, prefix) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("enum {\n") for i=20,next_global-1 do out:write(" ", prefix, t[i], ",\n") end out:write(" ", prefix, "_MAX\n};\n") end -- Write global label names. local function writeglobalnames(out, name) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("static const char *const ", name, "[] = {\n") for i=20,next_global-1 do out:write(" \"", t[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Extern label name -> extern label number. With auto assignment on 1st use. local next_extern = 0 local map_extern_ = {} local map_extern = setmetatable({}, { __index = function(t, name) -- No restrictions on the name for now. local n = next_extern if n > 2047 then werror("too many extern labels") end next_extern = n + 1 t[name] = n map_extern_[n] = name return n end}) -- Dump extern labels. local function dumpexterns(out, lvl) out:write("Extern labels:\n") for i=0,next_extern-1 do out:write(format(" %s\n", map_extern_[i])) end out:write("\n") end -- Write extern label names. local function writeexternnames(out, name) out:write("static const char *const ", name, "[] = {\n") for i=0,next_extern-1 do out:write(" \"", map_extern_[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Arch-specific maps. -- Ext. register name -> int. name. local map_archdef = { sp = "r13", lr = "r14", pc = "r15", } -- Int. register name -> ext. name. local map_reg_rev = { r13 = "sp", r14 = "lr", r15 = "pc", } local map_type = {} -- Type name -> { ctype, reg } local ctypenum = 0 -- Type number (for Dt... macros). -- Reverse defines for registers. function _M.revdef(s) return map_reg_rev[s] or s end local map_shift = { lsl = 0, lsr = 1, asr = 2, ror = 3, } local map_cond = { eq = 0, ne = 1, cs = 2, cc = 3, mi = 4, pl = 5, vs = 6, vc = 7, hi = 8, ls = 9, ge = 10, lt = 11, gt = 12, le = 13, al = 14, hs = 2, lo = 3, } ------------------------------------------------------------------------------ -- Template strings for ARM instructions. local map_op = { -- Basic data processing instructions. and_3 = "e0000000DNPs", eor_3 = "e0200000DNPs", sub_3 = "e0400000DNPs", rsb_3 = "e0600000DNPs", add_3 = "e0800000DNPs", adc_3 = "e0a00000DNPs", sbc_3 = "e0c00000DNPs", rsc_3 = "e0e00000DNPs", tst_2 = "e1100000NP", teq_2 = "e1300000NP", cmp_2 = "e1500000NP", cmn_2 = "e1700000NP", orr_3 = "e1800000DNPs", mov_2 = "e1a00000DPs", bic_3 = "e1c00000DNPs", mvn_2 = "e1e00000DPs", and_4 = "e0000000DNMps", eor_4 = "e0200000DNMps", sub_4 = "e0400000DNMps", rsb_4 = "e0600000DNMps", add_4 = "e0800000DNMps", adc_4 = "e0a00000DNMps", sbc_4 = "e0c00000DNMps", rsc_4 = "e0e00000DNMps", tst_3 = "e1100000NMp", teq_3 = "e1300000NMp", cmp_3 = "e1500000NMp", cmn_3 = "e1700000NMp", orr_4 = "e1800000DNMps", mov_3 = "e1a00000DMps", bic_4 = "e1c00000DNMps", mvn_3 = "e1e00000DMps", lsl_3 = "e1a00000DMws", lsr_3 = "e1a00020DMws", asr_3 = "e1a00040DMws", ror_3 = "e1a00060DMws", rrx_2 = "e1a00060DMs", -- Multiply and multiply-accumulate. mul_3 = "e0000090NMSs", mla_4 = "e0200090NMSDs", umaal_4 = "e0400090DNMSs", -- v6 mls_4 = "e0600090DNMSs", -- v6T2 umull_4 = "e0800090DNMSs", umlal_4 = "e0a00090DNMSs", smull_4 = "e0c00090DNMSs", smlal_4 = "e0e00090DNMSs", -- Halfword multiply and multiply-accumulate. smlabb_4 = "e1000080NMSD", -- v5TE smlatb_4 = "e10000a0NMSD", -- v5TE smlabt_4 = "e10000c0NMSD", -- v5TE smlatt_4 = "e10000e0NMSD", -- v5TE smlawb_4 = "e1200080NMSD", -- v5TE smulwb_3 = "e12000a0NMS", -- v5TE smlawt_4 = "e12000c0NMSD", -- v5TE smulwt_3 = "e12000e0NMS", -- v5TE smlalbb_4 = "e1400080NMSD", -- v5TE smlaltb_4 = "e14000a0NMSD", -- v5TE smlalbt_4 = "e14000c0NMSD", -- v5TE smlaltt_4 = "e14000e0NMSD", -- v5TE smulbb_3 = "e1600080NMS", -- v5TE smultb_3 = "e16000a0NMS", -- v5TE smulbt_3 = "e16000c0NMS", -- v5TE smultt_3 = "e16000e0NMS", -- v5TE -- Miscellaneous data processing instructions. clz_2 = "e16f0f10DM", -- v5T rev_2 = "e6bf0f30DM", -- v6 rev16_2 = "e6bf0fb0DM", -- v6 revsh_2 = "e6ff0fb0DM", -- v6 sel_3 = "e6800fb0DNM", -- v6 usad8_3 = "e780f010NMS", -- v6 usada8_4 = "e7800010NMSD", -- v6 rbit_2 = "e6ff0f30DM", -- v6T2 movw_2 = "e3000000DW", -- v6T2 movt_2 = "e3400000DW", -- v6T2 -- Note: the X encodes width-1, not width. sbfx_4 = "e7a00050DMvX", -- v6T2 ubfx_4 = "e7e00050DMvX", -- v6T2 -- Note: the X encodes the msb field, not the width. bfc_3 = "e7c0001fDvX", -- v6T2 bfi_4 = "e7c00010DMvX", -- v6T2 -- Packing and unpacking instructions. pkhbt_3 = "e6800010DNM", pkhbt_4 = "e6800010DNMv", -- v6 pkhtb_3 = "e6800050DNM", pkhtb_4 = "e6800050DNMv", -- v6 sxtab_3 = "e6a00070DNM", sxtab_4 = "e6a00070DNMv", -- v6 sxtab16_3 = "e6800070DNM", sxtab16_4 = "e6800070DNMv", -- v6 sxtah_3 = "e6b00070DNM", sxtah_4 = "e6b00070DNMv", -- v6 sxtb_2 = "e6af0070DM", sxtb_3 = "e6af0070DMv", -- v6 sxtb16_2 = "e68f0070DM", sxtb16_3 = "e68f0070DMv", -- v6 sxth_2 = "e6bf0070DM", sxth_3 = "e6bf0070DMv", -- v6 uxtab_3 = "e6e00070DNM", uxtab_4 = "e6e00070DNMv", -- v6 uxtab16_3 = "e6c00070DNM", uxtab16_4 = "e6c00070DNMv", -- v6 uxtah_3 = "e6f00070DNM", uxtah_4 = "e6f00070DNMv", -- v6 uxtb_2 = "e6ef0070DM", uxtb_3 = "e6ef0070DMv", -- v6 uxtb16_2 = "e6cf0070DM", uxtb16_3 = "e6cf0070DMv", -- v6 uxth_2 = "e6ff0070DM", uxth_3 = "e6ff0070DMv", -- v6 -- Saturating instructions. qadd_3 = "e1000050DMN", -- v5TE qsub_3 = "e1200050DMN", -- v5TE qdadd_3 = "e1400050DMN", -- v5TE qdsub_3 = "e1600050DMN", -- v5TE -- Note: the X for ssat* encodes sat_imm-1, not sat_imm. ssat_3 = "e6a00010DXM", ssat_4 = "e6a00010DXMp", -- v6 usat_3 = "e6e00010DXM", usat_4 = "e6e00010DXMp", -- v6 ssat16_3 = "e6a00f30DXM", -- v6 usat16_3 = "e6e00f30DXM", -- v6 -- Parallel addition and subtraction. sadd16_3 = "e6100f10DNM", -- v6 sasx_3 = "e6100f30DNM", -- v6 ssax_3 = "e6100f50DNM", -- v6 ssub16_3 = "e6100f70DNM", -- v6 sadd8_3 = "e6100f90DNM", -- v6 ssub8_3 = "e6100ff0DNM", -- v6 qadd16_3 = "e6200f10DNM", -- v6 qasx_3 = "e6200f30DNM", -- v6 qsax_3 = "e6200f50DNM", -- v6 qsub16_3 = "e6200f70DNM", -- v6 qadd8_3 = "e6200f90DNM", -- v6 qsub8_3 = "e6200ff0DNM", -- v6 shadd16_3 = "e6300f10DNM", -- v6 shasx_3 = "e6300f30DNM", -- v6 shsax_3 = "e6300f50DNM", -- v6 shsub16_3 = "e6300f70DNM", -- v6 shadd8_3 = "e6300f90DNM", -- v6 shsub8_3 = "e6300ff0DNM", -- v6 uadd16_3 = "e6500f10DNM", -- v6 uasx_3 = "e6500f30DNM", -- v6 usax_3 = "e6500f50DNM", -- v6 usub16_3 = "e6500f70DNM", -- v6 uadd8_3 = "e6500f90DNM", -- v6 usub8_3 = "e6500ff0DNM", -- v6 uqadd16_3 = "e6600f10DNM", -- v6 uqasx_3 = "e6600f30DNM", -- v6 uqsax_3 = "e6600f50DNM", -- v6 uqsub16_3 = "e6600f70DNM", -- v6 uqadd8_3 = "e6600f90DNM", -- v6 uqsub8_3 = "e6600ff0DNM", -- v6 uhadd16_3 = "e6700f10DNM", -- v6 uhasx_3 = "e6700f30DNM", -- v6 uhsax_3 = "e6700f50DNM", -- v6 uhsub16_3 = "e6700f70DNM", -- v6 uhadd8_3 = "e6700f90DNM", -- v6 uhsub8_3 = "e6700ff0DNM", -- v6 -- Load/store instructions. str_2 = "e4000000DL", str_3 = "e4000000DL", str_4 = "e4000000DL", strb_2 = "e4400000DL", strb_3 = "e4400000DL", strb_4 = "e4400000DL", ldr_2 = "e4100000DL", ldr_3 = "e4100000DL", ldr_4 = "e4100000DL", ldrb_2 = "e4500000DL", ldrb_3 = "e4500000DL", ldrb_4 = "e4500000DL", strh_2 = "e00000b0DL", strh_3 = "e00000b0DL", ldrh_2 = "e01000b0DL", ldrh_3 = "e01000b0DL", ldrd_2 = "e00000d0DL", ldrd_3 = "e00000d0DL", -- v5TE ldrsb_2 = "e01000d0DL", ldrsb_3 = "e01000d0DL", strd_2 = "e00000f0DL", strd_3 = "e00000f0DL", -- v5TE ldrsh_2 = "e01000f0DL", ldrsh_3 = "e01000f0DL", ldm_2 = "e8900000oR", ldmia_2 = "e8900000oR", ldmfd_2 = "e8900000oR", ldmda_2 = "e8100000oR", ldmfa_2 = "e8100000oR", ldmdb_2 = "e9100000oR", ldmea_2 = "e9100000oR", ldmib_2 = "e9900000oR", ldmed_2 = "e9900000oR", stm_2 = "e8800000oR", stmia_2 = "e8800000oR", stmfd_2 = "e8800000oR", stmda_2 = "e8000000oR", stmfa_2 = "e8000000oR", stmdb_2 = "e9000000oR", stmea_2 = "e9000000oR", stmib_2 = "e9800000oR", stmed_2 = "e9800000oR", pop_1 = "e8bd0000R", push_1 = "e92d0000R", -- Branch instructions. b_1 = "ea000000B", bl_1 = "eb000000B", blx_1 = "e12fff30C", bx_1 = "e12fff10M", -- Miscellaneous instructions. nop_0 = "e1a00000", mrs_1 = "e10f0000D", bkpt_1 = "e1200070K", -- v5T svc_1 = "ef000000T", swi_1 = "ef000000T", ud_0 = "e7f001f0", -- VFP instructions. ["vadd.f32_3"] = "ee300a00dnm", ["vadd.f64_3"] = "ee300b00Gdnm", ["vsub.f32_3"] = "ee300a40dnm", ["vsub.f64_3"] = "ee300b40Gdnm", ["vmul.f32_3"] = "ee200a00dnm", ["vmul.f64_3"] = "ee200b00Gdnm", ["vnmul.f32_3"] = "ee200a40dnm", ["vnmul.f64_3"] = "ee200b40Gdnm", ["vmla.f32_3"] = "ee000a00dnm", ["vmla.f64_3"] = "ee000b00Gdnm", ["vmls.f32_3"] = "ee000a40dnm", ["vmls.f64_3"] = "ee000b40Gdnm", ["vnmla.f32_3"] = "ee100a40dnm", ["vnmla.f64_3"] = "ee100b40Gdnm", ["vnmls.f32_3"] = "ee100a00dnm", ["vnmls.f64_3"] = "ee100b00Gdnm", ["vdiv.f32_3"] = "ee800a00dnm", ["vdiv.f64_3"] = "ee800b00Gdnm", ["vabs.f32_2"] = "eeb00ac0dm", ["vabs.f64_2"] = "eeb00bc0Gdm", ["vneg.f32_2"] = "eeb10a40dm", ["vneg.f64_2"] = "eeb10b40Gdm", ["vsqrt.f32_2"] = "eeb10ac0dm", ["vsqrt.f64_2"] = "eeb10bc0Gdm", ["vcmp.f32_2"] = "eeb40a40dm", ["vcmp.f64_2"] = "eeb40b40Gdm", ["vcmpe.f32_2"] = "eeb40ac0dm", ["vcmpe.f64_2"] = "eeb40bc0Gdm", ["vcmpz.f32_1"] = "eeb50a40d", ["vcmpz.f64_1"] = "eeb50b40Gd", ["vcmpze.f32_1"] = "eeb50ac0d", ["vcmpze.f64_1"] = "eeb50bc0Gd", vldr_2 = "ed100a00dl|ed100b00Gdl", vstr_2 = "ed000a00dl|ed000b00Gdl", vldm_2 = "ec900a00or", vldmia_2 = "ec900a00or", vldmdb_2 = "ed100a00or", vpop_1 = "ecbd0a00r", vstm_2 = "ec800a00or", vstmia_2 = "ec800a00or", vstmdb_2 = "ed000a00or", vpush_1 = "ed2d0a00r", ["vmov.f32_2"] = "eeb00a40dm|eeb00a00dY", -- #imm is VFPv3 only ["vmov.f64_2"] = "eeb00b40Gdm|eeb00b00GdY", -- #imm is VFPv3 only vmov_2 = "ee100a10Dn|ee000a10nD", vmov_3 = "ec500a10DNm|ec400a10mDN|ec500b10GDNm|ec400b10GmDN", vmrs_0 = "eef1fa10", vmrs_1 = "eef10a10D", vmsr_1 = "eee10a10D", ["vcvt.s32.f32_2"] = "eebd0ac0dm", ["vcvt.s32.f64_2"] = "eebd0bc0dGm", ["vcvt.u32.f32_2"] = "eebc0ac0dm", ["vcvt.u32.f64_2"] = "eebc0bc0dGm", ["vcvtr.s32.f32_2"] = "eebd0a40dm", ["vcvtr.s32.f64_2"] = "eebd0b40dGm", ["vcvtr.u32.f32_2"] = "eebc0a40dm", ["vcvtr.u32.f64_2"] = "eebc0b40dGm", ["vcvt.f32.s32_2"] = "eeb80ac0dm", ["vcvt.f64.s32_2"] = "eeb80bc0GdFm", ["vcvt.f32.u32_2"] = "eeb80a40dm", ["vcvt.f64.u32_2"] = "eeb80b40GdFm", ["vcvt.f32.f64_2"] = "eeb70bc0dGm", ["vcvt.f64.f32_2"] = "eeb70ac0GdFm", -- VFPv4 only: ["vfma.f32_3"] = "eea00a00dnm", ["vfma.f64_3"] = "eea00b00Gdnm", ["vfms.f32_3"] = "eea00a40dnm", ["vfms.f64_3"] = "eea00b40Gdnm", ["vfnma.f32_3"] = "ee900a40dnm", ["vfnma.f64_3"] = "ee900b40Gdnm", ["vfnms.f32_3"] = "ee900a00dnm", ["vfnms.f64_3"] = "ee900b00Gdnm", -- NYI: Advanced SIMD instructions. -- NYI: I have no need for these instructions right now: -- swp, swpb, strex, ldrex, strexd, ldrexd, strexb, ldrexb, strexh, ldrexh -- msr, nopv6, yield, wfe, wfi, sev, dbg, bxj, smc, srs, rfe -- cps, setend, pli, pld, pldw, clrex, dsb, dmb, isb -- stc, ldc, mcr, mcr2, mrc, mrc2, mcrr, mcrr2, mrrc, mrrc2, cdp, cdp2 } -- Add mnemonics for "s" variants. do local t = {} for k,v in pairs(map_op) do if sub(v, -1) == "s" then local v2 = sub(v, 1, 2)..char(byte(v, 3)+1)..sub(v, 4, -2) t[sub(k, 1, -3).."s"..sub(k, -2)] = v2 end end for k,v in pairs(t) do map_op[k] = v end end ------------------------------------------------------------------------------ local function parse_gpr(expr) local tname, ovreg = match(expr, "^([%w_]+):(r1?[0-9])$") local tp = map_type[tname or expr] if tp then local reg = ovreg or tp.reg if not reg then werror("type `"..(tname or expr).."' needs a register override") end expr = reg end local r = match(expr, "^r(1?[0-9])$") if r then r = tonumber(r) if r <= 15 then return r, tp end end werror("bad register name `"..expr.."'") end local function parse_gpr_pm(expr) local pm, expr2 = match(expr, "^([+-]?)(.*)$") return parse_gpr(expr2), (pm == "-") end local function parse_vr(expr, tp) local t, r = match(expr, "^([sd])([0-9]+)$") if t == tp then r = tonumber(r) if r <= 31 then if t == "s" then return shr(r, 1), band(r, 1) end return band(r, 15), shr(r, 4) end end werror("bad register name `"..expr.."'") end local function parse_reglist(reglist) reglist = match(reglist, "^{%s*([^}]*)}$") if not reglist then werror("register list expected") end local rr = 0 for p in gmatch(reglist..",", "%s*([^,]*),") do local rbit = shl(1, parse_gpr(gsub(p, "%s+$", ""))) if band(rr, rbit) ~= 0 then werror("duplicate register `"..p.."'") end rr = rr + rbit end return rr end local function parse_vrlist(reglist) local ta, ra, tb, rb = match(reglist, "^{%s*([sd])([0-9]+)%s*%-%s*([sd])([0-9]+)%s*}$") ra, rb = tonumber(ra), tonumber(rb) if ta and ta == tb and ra and rb and ra <= 31 and rb <= 31 and ra <= rb then local nr = rb+1 - ra if ta == "s" then return shl(shr(ra,1),12)+shl(band(ra,1),22) + nr else return shl(band(ra,15),12)+shl(shr(ra,4),22) + nr*2 + 0x100 end end werror("register list expected") end local function parse_imm(imm, bits, shift, scale, signed) imm = match(imm, "^#(.*)$") if not imm then werror("expected immediate operand") end local n = tonumber(imm) if n then local m = sar(n, scale) if shl(m, scale) == n then if signed then local s = sar(m, bits-1) if s == 0 then return shl(m, shift) elseif s == -1 then return shl(m + shl(1, bits), shift) end else if sar(m, bits) == 0 then return shl(m, shift) end end end werror("out of range immediate `"..imm.."'") else waction("IMM", (signed and 32768 or 0)+scale*1024+bits*32+shift, imm) return 0 end end local function parse_imm12(imm) local n = tonumber(imm) if n then local m = band(n) for i=0,-15,-1 do if shr(m, 8) == 0 then return m + shl(band(i, 15), 8) end m = ror(m, 2) end werror("out of range immediate `"..imm.."'") else waction("IMM12", 0, imm) return 0 end end local function parse_imm16(imm) imm = match(imm, "^#(.*)$") if not imm then werror("expected immediate operand") end local n = tonumber(imm) if n then if shr(n, 16) == 0 then return band(n, 0x0fff) + shl(band(n, 0xf000), 4) end werror("out of range immediate `"..imm.."'") else waction("IMM16", 32*16, imm) return 0 end end local function parse_imm_load(imm, ext) local n = tonumber(imm) if n then if ext then if n >= -255 and n <= 255 then local up = 0x00800000 if n < 0 then n = -n; up = 0 end return shl(band(n, 0xf0), 4) + band(n, 0x0f) + up end else if n >= -4095 and n <= 4095 then if n >= 0 then return n+0x00800000 end return -n end end werror("out of range immediate `"..imm.."'") else waction(ext and "IMML8" or "IMML12", 32768 + shl(ext and 8 or 12, 5), imm) return 0 end end local function parse_shift(shift, gprok) if shift == "rrx" then return 3 * 32 else local s, s2 = match(shift, "^(%S+)%s*(.*)$") s = map_shift[s] if not s then werror("expected shift operand") end if sub(s2, 1, 1) == "#" then return parse_imm(s2, 5, 7, 0, false) + shl(s, 5) else if not gprok then werror("expected immediate shift operand") end return shl(parse_gpr(s2), 8) + shl(s, 5) + 16 end end end local function parse_label(label, def) local prefix = sub(label, 1, 2) -- =>label (pc label reference) if prefix == "=>" then return "PC", 0, sub(label, 3) end -- ->name (global label reference) if prefix == "->" then return "LG", map_global[sub(label, 3)] end if def then -- [1-9] (local label definition) if match(label, "^[1-9]$") then return "LG", 10+tonumber(label) end else -- [<>][1-9] (local label reference) local dir, lnum = match(label, "^([<>])([1-9])$") if dir then -- Fwd: 1-9, Bkwd: 11-19. return "LG", lnum + (dir == ">" and 0 or 10) end -- extern label (extern label reference) local extname = match(label, "^extern%s+(%S+)$") if extname then return "EXT", map_extern[extname] end end werror("bad label `"..label.."'") end local function parse_load(params, nparams, n, op) local oplo = band(op, 255) local ext, ldrd = (oplo ~= 0), (oplo == 208) local d if (ldrd or oplo == 240) then d = band(shr(op, 12), 15) if band(d, 1) ~= 0 then werror("odd destination register") end end local pn = params[n] local p1, wb = match(pn, "^%[%s*(.-)%s*%](!?)$") local p2 = params[n+1] if not p1 then if not p2 then if match(pn, "^[<>=%-]") or match(pn, "^extern%s+") then local mode, n, s = parse_label(pn, false) waction("REL_"..mode, n + (ext and 0x1800 or 0x0800), s, 1) return op + 15 * 65536 + 0x01000000 + (ext and 0x00400000 or 0) end local reg, tailr = match(pn, "^([%w_:]+)%s*(.*)$") if reg and tailr ~= "" then local d, tp = parse_gpr(reg) if tp then waction(ext and "IMML8" or "IMML12", 32768 + 32*(ext and 8 or 12), format(tp.ctypefmt, tailr)) return op + shl(d, 16) + 0x01000000 + (ext and 0x00400000 or 0) end end end werror("expected address operand") end if wb == "!" then op = op + 0x00200000 end if p2 then if wb == "!" then werror("bad use of '!'") end local p3 = params[n+2] op = op + shl(parse_gpr(p1), 16) local imm = match(p2, "^#(.*)$") if imm then local m = parse_imm_load(imm, ext) if p3 then werror("too many parameters") end op = op + m + (ext and 0x00400000 or 0) else local m, neg = parse_gpr_pm(p2) if ldrd and (m == d or m-1 == d) then werror("register conflict") end op = op + m + (neg and 0 or 0x00800000) + (ext and 0 or 0x02000000) if p3 then op = op + parse_shift(p3) end end else local p1a, p2 = match(p1, "^([^,%s]*)%s*(.*)$") op = op + shl(parse_gpr(p1a), 16) + 0x01000000 if p2 ~= "" then local imm = match(p2, "^,%s*#(.*)$") if imm then local m = parse_imm_load(imm, ext) op = op + m + (ext and 0x00400000 or 0) else local p2a, p3 = match(p2, "^,%s*([^,%s]*)%s*,?%s*(.*)$") local m, neg = parse_gpr_pm(p2a) if ldrd and (m == d or m-1 == d) then werror("register conflict") end op = op + m + (neg and 0 or 0x00800000) + (ext and 0 or 0x02000000) if p3 ~= "" then if ext then werror("too many parameters") end op = op + parse_shift(p3) end end else if wb == "!" then werror("bad use of '!'") end op = op + (ext and 0x00c00000 or 0x00800000) end end return op end local function parse_vload(q) local reg, imm = match(q, "^%[%s*([^,%s]*)%s*(.*)%]$") if reg then local d = shl(parse_gpr(reg), 16) if imm == "" then return d end imm = match(imm, "^,%s*#(.*)$") if imm then local n = tonumber(imm) if n then if n >= -1020 and n <= 1020 and n%4 == 0 then return d + (n >= 0 and n/4+0x00800000 or -n/4) end werror("out of range immediate `"..imm.."'") else waction("IMMV8", 32768 + 32*8, imm) return d end end else if match(q, "^[<>=%-]") or match(q, "^extern%s+") then local mode, n, s = parse_label(q, false) waction("REL_"..mode, n + 0x2800, s, 1) return 15 * 65536 end local reg, tailr = match(q, "^([%w_:]+)%s*(.*)$") if reg and tailr ~= "" then local d, tp = parse_gpr(reg) if tp then waction("IMMV8", 32768 + 32*8, format(tp.ctypefmt, tailr)) return shl(d, 16) end end end werror("expected address operand") end ------------------------------------------------------------------------------ -- Handle opcodes defined with template strings. local function parse_template(params, template, nparams, pos) local op = tonumber(sub(template, 1, 8), 16) local n = 1 local vr = "s" -- Process each character. for p in gmatch(sub(template, 9), ".") do local q = params[n] if p == "D" then op = op + shl(parse_gpr(q), 12); n = n + 1 elseif p == "N" then op = op + shl(parse_gpr(q), 16); n = n + 1 elseif p == "S" then op = op + shl(parse_gpr(q), 8); n = n + 1 elseif p == "M" then op = op + parse_gpr(q); n = n + 1 elseif p == "d" then local r,h = parse_vr(q, vr); op = op+shl(r,12)+shl(h,22); n = n + 1 elseif p == "n" then local r,h = parse_vr(q, vr); op = op+shl(r,16)+shl(h,7); n = n + 1 elseif p == "m" then local r,h = parse_vr(q, vr); op = op+r+shl(h,5); n = n + 1 elseif p == "P" then local imm = match(q, "^#(.*)$") if imm then op = op + parse_imm12(imm) + 0x02000000 else op = op + parse_gpr(q) end n = n + 1 elseif p == "p" then op = op + parse_shift(q, true); n = n + 1 elseif p == "L" then op = parse_load(params, nparams, n, op) elseif p == "l" then op = op + parse_vload(q) elseif p == "B" then local mode, n, s = parse_label(q, false) waction("REL_"..mode, n, s, 1) elseif p == "C" then -- blx gpr vs. blx label. if match(q, "^([%w_]+):(r1?[0-9])$") or match(q, "^r(1?[0-9])$") then op = op + parse_gpr(q) else if op < 0xe0000000 then werror("unconditional instruction") end local mode, n, s = parse_label(q, false) waction("REL_"..mode, n, s, 1) op = 0xfa000000 end elseif p == "F" then vr = "s" elseif p == "G" then vr = "d" elseif p == "o" then local r, wb = match(q, "^([^!]*)(!?)$") op = op + shl(parse_gpr(r), 16) + (wb == "!" and 0x00200000 or 0) n = n + 1 elseif p == "R" then op = op + parse_reglist(q); n = n + 1 elseif p == "r" then op = op + parse_vrlist(q); n = n + 1 elseif p == "W" then op = op + parse_imm16(q); n = n + 1 elseif p == "v" then op = op + parse_imm(q, 5, 7, 0, false); n = n + 1 elseif p == "w" then local imm = match(q, "^#(.*)$") if imm then op = op + parse_imm(q, 5, 7, 0, false); n = n + 1 else op = op + shl(parse_gpr(q), 8) + 16 end elseif p == "X" then op = op + parse_imm(q, 5, 16, 0, false); n = n + 1 elseif p == "Y" then local imm = tonumber(match(q, "^#(.*)$")); n = n + 1 if not imm or shr(imm, 8) ~= 0 then werror("bad immediate operand") end op = op + shl(band(imm, 0xf0), 12) + band(imm, 0x0f) elseif p == "K" then local imm = tonumber(match(q, "^#(.*)$")); n = n + 1 if not imm or shr(imm, 16) ~= 0 then werror("bad immediate operand") end op = op + shl(band(imm, 0xfff0), 4) + band(imm, 0x000f) elseif p == "T" then op = op + parse_imm(q, 24, 0, 0, false); n = n + 1 elseif p == "s" then -- Ignored. else assert(false) end end wputpos(pos, op) end map_op[".template__"] = function(params, template, nparams) if not params then return template:gsub("%x%x%x%x%x%x%x%x", "") end -- Limit number of section buffer positions used by a single dasm_put(). -- A single opcode needs a maximum of 3 positions. if secpos+3 > maxsecpos then wflush() end local pos = wpos() local lpos, apos, spos = #actlist, #actargs, secpos local ok, err for t in gmatch(template, "[^|]+") do ok, err = pcall(parse_template, params, t, nparams, pos) if ok then return end secpos = spos actlist[lpos+1] = nil actlist[lpos+2] = nil actlist[lpos+3] = nil actargs[apos+1] = nil actargs[apos+2] = nil actargs[apos+3] = nil end error(err, 0) end ------------------------------------------------------------------------------ -- Pseudo-opcode to mark the position where the action list is to be emitted. map_op[".actionlist_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeactions(out, name) end) end -- Pseudo-opcode to mark the position where the global enum is to be emitted. map_op[".globals_1"] = function(params) if not params then return "prefix" end local prefix = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobals(out, prefix) end) end -- Pseudo-opcode to mark the position where the global names are to be emitted. map_op[".globalnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobalnames(out, name) end) end -- Pseudo-opcode to mark the position where the extern names are to be emitted. map_op[".externnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeexternnames(out, name) end) end ------------------------------------------------------------------------------ -- Label pseudo-opcode (converted from trailing colon form). map_op[".label_1"] = function(params) if not params then return "[1-9] | ->global | =>pcexpr" end if secpos+1 > maxsecpos then wflush() end local mode, n, s = parse_label(params[1], true) if mode == "EXT" then werror("bad label definition") end waction("LABEL_"..mode, n, s, 1) end ------------------------------------------------------------------------------ -- Pseudo-opcodes for data storage. map_op[".long_*"] = function(params) if not params then return "imm..." end for _,p in ipairs(params) do local n = tonumber(p) if not n then werror("bad immediate `"..p.."'") end if n < 0 then n = n + 2^32 end wputw(n) if secpos+2 > maxsecpos then wflush() end end end -- Alignment pseudo-opcode. map_op[".align_1"] = function(params) if not params then return "numpow2" end if secpos+1 > maxsecpos then wflush() end local align = tonumber(params[1]) if align then local x = align -- Must be a power of 2 in the range (2 ... 256). for i=1,8 do x = x / 2 if x == 1 then waction("ALIGN", align-1, nil, 1) -- Action byte is 2**n-1. return end end end werror("bad alignment") end ------------------------------------------------------------------------------ -- Pseudo-opcode for (primitive) type definitions (map to C types). map_op[".type_3"] = function(params, nparams) if not params then return nparams == 2 and "name, ctype" or "name, ctype, reg" end local name, ctype, reg = params[1], params[2], params[3] if not match(name, "^[%a_][%w_]*$") then werror("bad type name `"..name.."'") end local tp = map_type[name] if tp then werror("duplicate type `"..name.."'") end -- Add #type to defines. A bit unclean to put it in map_archdef. map_archdef["#"..name] = "sizeof("..ctype..")" -- Add new type and emit shortcut define. local num = ctypenum + 1 map_type[name] = { ctype = ctype, ctypefmt = format("Dt%X(%%s)", num), reg = reg, } wline(format("#define Dt%X(_V) (int)(ptrdiff_t)&(((%s *)0)_V)", num, ctype)) ctypenum = num end map_op[".type_2"] = map_op[".type_3"] -- Dump type definitions. local function dumptypes(out, lvl) local t = {} for name in pairs(map_type) do t[#t+1] = name end sort(t) out:write("Type definitions:\n") for _,name in ipairs(t) do local tp = map_type[name] local reg = tp.reg or "" out:write(format(" %-20s %-20s %s\n", name, tp.ctype, reg)) end out:write("\n") end ------------------------------------------------------------------------------ -- Set the current section. function _M.section(num) waction("SECTION", num) wflush(true) -- SECTION is a terminal action. end ------------------------------------------------------------------------------ -- Dump architecture description. function _M.dumparch(out) out:write(format("DynASM %s version %s, released %s\n\n", _info.arch, _info.version, _info.release)) dumpactions(out) end -- Dump all user defined elements. function _M.dumpdef(out, lvl) dumptypes(out, lvl) dumpglobals(out, lvl) dumpexterns(out, lvl) end ------------------------------------------------------------------------------ -- Pass callbacks from/to the DynASM core. function _M.passcb(wl, we, wf, ww) wline, werror, wfatal, wwarn = wl, we, wf, ww return wflush end -- Setup the arch-specific module. function _M.setup(arch, opt) g_arch, g_opt = arch, opt end -- Merge the core maps and the arch-specific maps. function _M.mergemaps(map_coreop, map_def) setmetatable(map_op, { __index = function(t, k) local v = map_coreop[k] if v then return v end local k1, cc, k2 = match(k, "^(.-)(..)([._].*)$") local cv = map_cond[cc] if cv then local v = rawget(t, k1..k2) if type(v) == "string" then local scv = format("%x", cv) return gsub(scv..sub(v, 2), "|e", "|"..scv) end end end }) setmetatable(map_def, { __index = map_archdef }) return map_op, map_def end return _M ------------------------------------------------------------------------------ wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_x86.lua0000644000175000017500000016322513122010155017542 0ustar philphil------------------------------------------------------------------------------ -- DynASM x86/x64 module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- See dynasm.lua for full copyright notice. ------------------------------------------------------------------------------ local x64 = x64 -- Module information: local _info = { arch = x64 and "x64" or "x86", description = "DynASM x86/x64 module", version = "1.3.0", vernum = 10300, release = "2011-05-05", author = "Mike Pall", license = "MIT", } -- Exported glue functions for the arch-specific module. local _M = { _info = _info } -- Cache library functions. local type, tonumber, pairs, ipairs = type, tonumber, pairs, ipairs local assert, unpack, setmetatable = assert, unpack or table.unpack, setmetatable local _s = string local sub, format, byte, char = _s.sub, _s.format, _s.byte, _s.char local find, match, gmatch, gsub = _s.find, _s.match, _s.gmatch, _s.gsub local concat, sort = table.concat, table.sort local bit = bit or require("bit") local band, shl, shr = bit.band, bit.lshift, bit.rshift -- Inherited tables and callbacks. local g_opt, g_arch local wline, werror, wfatal, wwarn -- Action name list. -- CHECK: Keep this in sync with the C code! local action_names = { -- int arg, 1 buffer pos: "DISP", "IMM_S", "IMM_B", "IMM_W", "IMM_D", "IMM_WB", "IMM_DB", -- action arg (1 byte), int arg, 1 buffer pos (reg/num): "VREG", "SPACE", -- !x64: VREG support NYI. -- ptrdiff_t arg, 1 buffer pos (address): !x64 "SETLABEL", "REL_A", -- action arg (1 byte) or int arg, 2 buffer pos (link, offset): "REL_LG", "REL_PC", -- action arg (1 byte) or int arg, 1 buffer pos (link): "IMM_LG", "IMM_PC", -- action arg (1 byte) or int arg, 1 buffer pos (offset): "LABEL_LG", "LABEL_PC", -- action arg (1 byte), 1 buffer pos (offset): "ALIGN", -- action args (2 bytes), no buffer pos. "EXTERN", -- action arg (1 byte), no buffer pos. "ESC", -- no action arg, no buffer pos. "MARK", -- action arg (1 byte), no buffer pos, terminal action: "SECTION", -- no args, no buffer pos, terminal action: "STOP" } -- Maximum number of section buffer positions for dasm_put(). -- CHECK: Keep this in sync with the C code! local maxsecpos = 25 -- Keep this low, to avoid excessively long C lines. -- Action name -> action number (dynamically generated below). local map_action = {} -- First action number. Everything below does not need to be escaped. local actfirst = 256-#action_names -- Action list buffer and string (only used to remove dupes). local actlist = {} local actstr = "" -- Argument list for next dasm_put(). Start with offset 0 into action list. local actargs = { 0 } -- Current number of section buffer positions for dasm_put(). local secpos = 1 ------------------------------------------------------------------------------ -- Compute action numbers for action names. for n,name in ipairs(action_names) do local num = actfirst + n - 1 map_action[name] = num end -- Dump action names and numbers. local function dumpactions(out) out:write("DynASM encoding engine action codes:\n") for n,name in ipairs(action_names) do local num = map_action[name] out:write(format(" %-10s %02X %d\n", name, num, num)) end out:write("\n") end -- Write action list buffer as a huge static C array. local function writeactions(out, name) local nn = #actlist local last = actlist[nn] or 255 actlist[nn] = nil -- Remove last byte. if nn == 0 then nn = 1 end out:write("static const unsigned char ", name, "[", nn, "] = {\n") local s = " " for n,b in ipairs(actlist) do s = s..b.."," if #s >= 75 then assert(out:write(s, "\n")) s = " " end end out:write(s, last, "\n};\n\n") -- Add last byte back. end ------------------------------------------------------------------------------ -- Add byte to action list. local function wputxb(n) assert(n >= 0 and n <= 255 and n % 1 == 0, "byte out of range") actlist[#actlist+1] = n end -- Add action to list with optional arg. Advance buffer pos, too. local function waction(action, a, num) wputxb(assert(map_action[action], "bad action name `"..action.."'")) if a then actargs[#actargs+1] = a end if a or num then secpos = secpos + (num or 1) end end -- Add call to embedded DynASM C code. local function wcall(func, args) wline(format("dasm_%s(Dst, %s);", func, concat(args, ", ")), true) end -- Delete duplicate action list chunks. A tad slow, but so what. local function dedupechunk(offset) local al, as = actlist, actstr local chunk = char(unpack(al, offset+1, #al)) local orig = find(as, chunk, 1, true) if orig then actargs[1] = orig-1 -- Replace with original offset. for i=offset+1,#al do al[i] = nil end -- Kill dupe. else actstr = as..chunk end end -- Flush action list (intervening C code or buffer pos overflow). local function wflush(term) local offset = actargs[1] if #actlist == offset then return end -- Nothing to flush. if not term then waction("STOP") end -- Terminate action list. dedupechunk(offset) wcall("put", actargs) -- Add call to dasm_put(). actargs = { #actlist } -- Actionlist offset is 1st arg to next dasm_put(). secpos = 1 -- The actionlist offset occupies a buffer position, too. end -- Put escaped byte. local function wputb(n) if n >= actfirst then waction("ESC") end -- Need to escape byte. wputxb(n) end ------------------------------------------------------------------------------ -- Global label name -> global label number. With auto assignment on 1st use. local next_global = 10 local map_global = setmetatable({}, { __index = function(t, name) if not match(name, "^[%a_][%w_@]*$") then werror("bad global label") end local n = next_global if n > 246 then werror("too many global labels") end next_global = n + 1 t[name] = n return n end}) -- Dump global labels. local function dumpglobals(out, lvl) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("Global labels:\n") for i=10,next_global-1 do out:write(format(" %s\n", t[i])) end out:write("\n") end -- Write global label enum. local function writeglobals(out, prefix) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("enum {\n") for i=10,next_global-1 do out:write(" ", prefix, gsub(t[i], "@.*", ""), ",\n") end out:write(" ", prefix, "_MAX\n};\n") end -- Write global label names. local function writeglobalnames(out, name) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("static const char *const ", name, "[] = {\n") for i=10,next_global-1 do out:write(" \"", t[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Extern label name -> extern label number. With auto assignment on 1st use. local next_extern = -1 local map_extern = setmetatable({}, { __index = function(t, name) -- No restrictions on the name for now. local n = next_extern if n < -256 then werror("too many extern labels") end next_extern = n - 1 t[name] = n return n end}) -- Dump extern labels. local function dumpexterns(out, lvl) local t = {} for name, n in pairs(map_extern) do t[-n] = name end out:write("Extern labels:\n") for i=1,-next_extern-1 do out:write(format(" %s\n", t[i])) end out:write("\n") end -- Write extern label names. local function writeexternnames(out, name) local t = {} for name, n in pairs(map_extern) do t[-n] = name end out:write("static const char *const ", name, "[] = {\n") for i=1,-next_extern-1 do out:write(" \"", t[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Arch-specific maps. local map_archdef = {} -- Ext. register name -> int. name. local map_reg_rev = {} -- Int. register name -> ext. name. local map_reg_num = {} -- Int. register name -> register number. local map_reg_opsize = {} -- Int. register name -> operand size. local map_reg_valid_base = {} -- Int. register name -> valid base register? local map_reg_valid_index = {} -- Int. register name -> valid index register? local map_reg_needrex = {} -- Int. register name -> need rex vs. no rex. local reg_list = {} -- Canonical list of int. register names. local map_type = {} -- Type name -> { ctype, reg } local ctypenum = 0 -- Type number (for _PTx macros). local addrsize = x64 and "q" or "d" -- Size for address operands. -- Helper functions to fill register maps. local function mkrmap(sz, cl, names) local cname = format("@%s", sz) reg_list[#reg_list+1] = cname map_archdef[cl] = cname map_reg_rev[cname] = cl map_reg_num[cname] = -1 map_reg_opsize[cname] = sz if sz == addrsize or sz == "d" then map_reg_valid_base[cname] = true map_reg_valid_index[cname] = true end if names then for n,name in ipairs(names) do local iname = format("@%s%x", sz, n-1) reg_list[#reg_list+1] = iname map_archdef[name] = iname map_reg_rev[iname] = name map_reg_num[iname] = n-1 map_reg_opsize[iname] = sz if sz == "b" and n > 4 then map_reg_needrex[iname] = false end if sz == addrsize or sz == "d" then map_reg_valid_base[iname] = true map_reg_valid_index[iname] = true end end end for i=0,(x64 and sz ~= "f") and 15 or 7 do local needrex = sz == "b" and i > 3 local iname = format("@%s%x%s", sz, i, needrex and "R" or "") if needrex then map_reg_needrex[iname] = true end local name if sz == "o" then name = format("xmm%d", i) elseif sz == "f" then name = format("st%d", i) else name = format("r%d%s", i, sz == addrsize and "" or sz) end map_archdef[name] = iname if not map_reg_rev[iname] then reg_list[#reg_list+1] = iname map_reg_rev[iname] = name map_reg_num[iname] = i map_reg_opsize[iname] = sz if sz == addrsize or sz == "d" then map_reg_valid_base[iname] = true map_reg_valid_index[iname] = true end end end reg_list[#reg_list+1] = "" end -- Integer registers (qword, dword, word and byte sized). if x64 then mkrmap("q", "Rq", {"rax", "rcx", "rdx", "rbx", "rsp", "rbp", "rsi", "rdi"}) end mkrmap("d", "Rd", {"eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi"}) mkrmap("w", "Rw", {"ax", "cx", "dx", "bx", "sp", "bp", "si", "di"}) mkrmap("b", "Rb", {"al", "cl", "dl", "bl", "ah", "ch", "dh", "bh"}) map_reg_valid_index[map_archdef.esp] = false if x64 then map_reg_valid_index[map_archdef.rsp] = false end map_archdef["Ra"] = "@"..addrsize -- FP registers (internally tword sized, but use "f" as operand size). mkrmap("f", "Rf") -- SSE registers (oword sized, but qword and dword accessible). mkrmap("o", "xmm") -- Operand size prefixes to codes. local map_opsize = { byte = "b", word = "w", dword = "d", qword = "q", oword = "o", tword = "t", aword = addrsize, } -- Operand size code to number. local map_opsizenum = { b = 1, w = 2, d = 4, q = 8, o = 16, t = 10, } -- Operand size code to name. local map_opsizename = { b = "byte", w = "word", d = "dword", q = "qword", o = "oword", t = "tword", f = "fpword", } -- Valid index register scale factors. local map_xsc = { ["1"] = 0, ["2"] = 1, ["4"] = 2, ["8"] = 3, } -- Condition codes. local map_cc = { o = 0, no = 1, b = 2, nb = 3, e = 4, ne = 5, be = 6, nbe = 7, s = 8, ns = 9, p = 10, np = 11, l = 12, nl = 13, le = 14, nle = 15, c = 2, nae = 2, nc = 3, ae = 3, z = 4, nz = 5, na = 6, a = 7, pe = 10, po = 11, nge = 12, ge = 13, ng = 14, g = 15, } -- Reverse defines for registers. function _M.revdef(s) return gsub(s, "@%w+", map_reg_rev) end -- Dump register names and numbers local function dumpregs(out) out:write("Register names, sizes and internal numbers:\n") for _,reg in ipairs(reg_list) do if reg == "" then out:write("\n") else local name = map_reg_rev[reg] local num = map_reg_num[reg] local opsize = map_opsizename[map_reg_opsize[reg]] out:write(format(" %-5s %-8s %s\n", name, opsize, num < 0 and "(variable)" or num)) end end end ------------------------------------------------------------------------------ -- Put action for label arg (IMM_LG, IMM_PC, REL_LG, REL_PC). local function wputlabel(aprefix, imm, num) if type(imm) == "number" then if imm < 0 then waction("EXTERN") wputxb(aprefix == "IMM_" and 0 or 1) imm = -imm-1 else waction(aprefix.."LG", nil, num); end wputxb(imm) else waction(aprefix.."PC", imm, num) end end -- Put signed byte or arg. local function wputsbarg(n) if type(n) == "number" then if n < -128 or n > 127 then werror("signed immediate byte out of range") end if n < 0 then n = n + 256 end wputb(n) else waction("IMM_S", n) end end -- Put unsigned byte or arg. local function wputbarg(n) if type(n) == "number" then if n < 0 or n > 255 then werror("unsigned immediate byte out of range") end wputb(n) else waction("IMM_B", n) end end -- Put unsigned word or arg. local function wputwarg(n) if type(n) == "number" then if shr(n, 16) ~= 0 then werror("unsigned immediate word out of range") end wputb(band(n, 255)); wputb(shr(n, 8)); else waction("IMM_W", n) end end -- Put signed or unsigned dword or arg. local function wputdarg(n) local tn = type(n) if tn == "number" then wputb(band(n, 255)) wputb(band(shr(n, 8), 255)) wputb(band(shr(n, 16), 255)) wputb(shr(n, 24)) elseif tn == "table" then wputlabel("IMM_", n[1], 1) else waction("IMM_D", n) end end -- Put operand-size dependent number or arg (defaults to dword). local function wputszarg(sz, n) if not sz or sz == "d" or sz == "q" then wputdarg(n) elseif sz == "w" then wputwarg(n) elseif sz == "b" then wputbarg(n) elseif sz == "s" then wputsbarg(n) else werror("bad operand size") end end -- Put multi-byte opcode with operand-size dependent modifications. local function wputop(sz, op, rex) local r if rex ~= 0 and not x64 then werror("bad operand size") end if sz == "w" then wputb(102) end -- Needs >32 bit numbers, but only for crc32 eax, word [ebx] if op >= 4294967296 then r = op%4294967296 wputb((op-r)/4294967296) op = r end if op >= 16777216 then wputb(shr(op, 24)); op = band(op, 0xffffff) end if op >= 65536 then if rex ~= 0 then local opc3 = band(op, 0xffff00) if opc3 == 0x0f3a00 or opc3 == 0x0f3800 then wputb(64 + band(rex, 15)); rex = 0 end end wputb(shr(op, 16)); op = band(op, 0xffff) end if op >= 256 then local b = shr(op, 8) if b == 15 and rex ~= 0 then wputb(64 + band(rex, 15)); rex = 0 end wputb(b) op = band(op, 255) end if rex ~= 0 then wputb(64 + band(rex, 15)) end if sz == "b" then op = op - 1 end wputb(op) end -- Put ModRM or SIB formatted byte. local function wputmodrm(m, s, rm, vs, vrm) assert(m < 4 and s < 16 and rm < 16, "bad modrm operands") wputb(shl(m, 6) + shl(band(s, 7), 3) + band(rm, 7)) end -- Put ModRM/SIB plus optional displacement. local function wputmrmsib(t, imark, s, vsreg) local vreg, vxreg local reg, xreg = t.reg, t.xreg if reg and reg < 0 then reg = 0; vreg = t.vreg end if xreg and xreg < 0 then xreg = 0; vxreg = t.vxreg end if s < 0 then s = 0 end -- Register mode. if sub(t.mode, 1, 1) == "r" then wputmodrm(3, s, reg) if vsreg then waction("VREG", vsreg); wputxb(2) end if vreg then waction("VREG", vreg); wputxb(0) end return end local disp = t.disp local tdisp = type(disp) -- No base register? if not reg then local riprel = false if xreg then -- Indexed mode with index register only. -- [xreg*xsc+disp] -> (0, s, esp) (xsc, xreg, ebp) wputmodrm(0, s, 4) if imark == "I" then waction("MARK") end if vsreg then waction("VREG", vsreg); wputxb(2) end wputmodrm(t.xsc, xreg, 5) if vxreg then waction("VREG", vxreg); wputxb(3) end else -- Pure 32 bit displacement. if x64 and tdisp ~= "table" then wputmodrm(0, s, 4) -- [disp] -> (0, s, esp) (0, esp, ebp) if imark == "I" then waction("MARK") end wputmodrm(0, 4, 5) else riprel = x64 wputmodrm(0, s, 5) -- [disp|rip-label] -> (0, s, ebp) if imark == "I" then waction("MARK") end end if vsreg then waction("VREG", vsreg); wputxb(2) end end if riprel then -- Emit rip-relative displacement. if match("UWSiI", imark) then werror("NYI: rip-relative displacement followed by immediate") end -- The previous byte in the action buffer cannot be 0xe9 or 0x80-0x8f. wputlabel("REL_", disp[1], 2) else wputdarg(disp) end return end local m if tdisp == "number" then -- Check displacement size at assembly time. if disp == 0 and band(reg, 7) ~= 5 then -- [ebp] -> [ebp+0] (in SIB, too) if not vreg then m = 0 end -- Force DISP to allow [Rd(5)] -> [ebp+0] elseif disp >= -128 and disp <= 127 then m = 1 else m = 2 end elseif tdisp == "table" then m = 2 end -- Index register present or esp as base register: need SIB encoding. if xreg or band(reg, 7) == 4 then wputmodrm(m or 2, s, 4) -- ModRM. if m == nil or imark == "I" then waction("MARK") end if vsreg then waction("VREG", vsreg); wputxb(2) end wputmodrm(t.xsc or 0, xreg or 4, reg) -- SIB. if vxreg then waction("VREG", vxreg); wputxb(3) end if vreg then waction("VREG", vreg); wputxb(1) end else wputmodrm(m or 2, s, reg) -- ModRM. if (imark == "I" and (m == 1 or m == 2)) or (m == nil and (vsreg or vreg)) then waction("MARK") end if vsreg then waction("VREG", vsreg); wputxb(2) end if vreg then waction("VREG", vreg); wputxb(1) end end -- Put displacement. if m == 1 then wputsbarg(disp) elseif m == 2 then wputdarg(disp) elseif m == nil then waction("DISP", disp) end end ------------------------------------------------------------------------------ -- Return human-readable operand mode string. local function opmodestr(op, args) local m = {} for i=1,#args do local a = args[i] m[#m+1] = sub(a.mode, 1, 1)..(a.opsize or "?") end return op.." "..concat(m, ",") end -- Convert number to valid integer or nil. local function toint(expr) local n = tonumber(expr) if n then if n % 1 ~= 0 or n < -2147483648 or n > 4294967295 then werror("bad integer number `"..expr.."'") end return n end end -- Parse immediate expression. local function immexpr(expr) -- &expr (pointer) if sub(expr, 1, 1) == "&" then return "iPJ", format("(ptrdiff_t)(%s)", sub(expr,2)) end local prefix = sub(expr, 1, 2) -- =>expr (pc label reference) if prefix == "=>" then return "iJ", sub(expr, 3) end -- ->name (global label reference) if prefix == "->" then return "iJ", map_global[sub(expr, 3)] end -- [<>][1-9] (local label reference) local dir, lnum = match(expr, "^([<>])([1-9])$") if dir then -- Fwd: 247-255, Bkwd: 1-9. return "iJ", lnum + (dir == ">" and 246 or 0) end local extname = match(expr, "^extern%s+(%S+)$") if extname then return "iJ", map_extern[extname] end -- expr (interpreted as immediate) return "iI", expr end -- Parse displacement expression: +-num, +-expr, +-opsize*num local function dispexpr(expr) local disp = expr == "" and 0 or toint(expr) if disp then return disp end local c, dispt = match(expr, "^([+-])%s*(.+)$") if c == "+" then expr = dispt elseif not c then werror("bad displacement expression `"..expr.."'") end local opsize, tailops = match(dispt, "^(%w+)%s*%*%s*(.+)$") local ops, imm = map_opsize[opsize], toint(tailops) if ops and imm then if c == "-" then imm = -imm end return imm*map_opsizenum[ops] end local mode, iexpr = immexpr(dispt) if mode == "iJ" then if c == "-" then werror("cannot invert label reference") end return { iexpr } end return expr -- Need to return original signed expression. end -- Parse register or type expression. local function rtexpr(expr) if not expr then return end local tname, ovreg = match(expr, "^([%w_]+):(@[%w_]+)$") local tp = map_type[tname or expr] if tp then local reg = ovreg or tp.reg local rnum = map_reg_num[reg] if not rnum then werror("type `"..(tname or expr).."' needs a register override") end if not map_reg_valid_base[reg] then werror("bad base register override `"..(map_reg_rev[reg] or reg).."'") end return reg, rnum, tp end return expr, map_reg_num[expr] end -- Parse operand and return { mode, opsize, reg, xreg, xsc, disp, imm }. local function parseoperand(param) local t = {} local expr = param local opsize, tailops = match(param, "^(%w+)%s*(.+)$") if opsize then t.opsize = map_opsize[opsize] if t.opsize then expr = tailops end end local br = match(expr, "^%[%s*(.-)%s*%]$") repeat if br then t.mode = "xm" -- [disp] t.disp = toint(br) if t.disp then t.mode = x64 and "xm" or "xmO" break end -- [reg...] local tp local reg, tailr = match(br, "^([@%w_:]+)%s*(.*)$") reg, t.reg, tp = rtexpr(reg) if not t.reg then -- [expr] t.mode = x64 and "xm" or "xmO" t.disp = dispexpr("+"..br) break end if t.reg == -1 then t.vreg, tailr = match(tailr, "^(%b())(.*)$") if not t.vreg then werror("bad variable register expression") end end -- [xreg*xsc] or [xreg*xsc+-disp] or [xreg*xsc+-expr] local xsc, tailsc = match(tailr, "^%*%s*([1248])%s*(.*)$") if xsc then if not map_reg_valid_index[reg] then werror("bad index register `"..map_reg_rev[reg].."'") end t.xsc = map_xsc[xsc] t.xreg = t.reg t.vxreg = t.vreg t.reg = nil t.vreg = nil t.disp = dispexpr(tailsc) break end if not map_reg_valid_base[reg] then werror("bad base register `"..map_reg_rev[reg].."'") end -- [reg] or [reg+-disp] t.disp = toint(tailr) or (tailr == "" and 0) if t.disp then break end -- [reg+xreg...] local xreg, tailx = match(tailr, "^+%s*([@%w_:]+)%s*(.*)$") xreg, t.xreg, tp = rtexpr(xreg) if not t.xreg then -- [reg+-expr] t.disp = dispexpr(tailr) break end if not map_reg_valid_index[xreg] then werror("bad index register `"..map_reg_rev[xreg].."'") end if t.xreg == -1 then t.vxreg, tailx = match(tailx, "^(%b())(.*)$") if not t.vxreg then werror("bad variable register expression") end end -- [reg+xreg*xsc...] local xsc, tailsc = match(tailx, "^%*%s*([1248])%s*(.*)$") if xsc then t.xsc = map_xsc[xsc] tailx = tailsc end -- [...] or [...+-disp] or [...+-expr] t.disp = dispexpr(tailx) else -- imm or opsize*imm local imm = toint(expr) if not imm and sub(expr, 1, 1) == "*" and t.opsize then imm = toint(sub(expr, 2)) if imm then imm = imm * map_opsizenum[t.opsize] t.opsize = nil end end if imm then if t.opsize then werror("bad operand size override") end local m = "i" if imm == 1 then m = m.."1" end if imm >= 4294967168 and imm <= 4294967295 then imm = imm-4294967296 end if imm >= -128 and imm <= 127 then m = m.."S" end t.imm = imm t.mode = m break end local tp local reg, tailr = match(expr, "^([@%w_:]+)%s*(.*)$") reg, t.reg, tp = rtexpr(reg) if t.reg then if t.reg == -1 then t.vreg, tailr = match(tailr, "^(%b())(.*)$") if not t.vreg then werror("bad variable register expression") end end -- reg if tailr == "" then if t.opsize then werror("bad operand size override") end t.opsize = map_reg_opsize[reg] if t.opsize == "f" then t.mode = t.reg == 0 and "fF" or "f" else if reg == "@w4" or (x64 and reg == "@d4") then wwarn("bad idea, try again with `"..(x64 and "rsp'" or "esp'")) end t.mode = t.reg == 0 and "rmR" or (reg == "@b1" and "rmC" or "rm") end t.needrex = map_reg_needrex[reg] break end -- type[idx], type[idx].field, type->field -> [reg+offset_expr] if not tp then werror("bad operand `"..param.."'") end t.mode = "xm" t.disp = format(tp.ctypefmt, tailr) else t.mode, t.imm = immexpr(expr) if sub(t.mode, -1) == "J" then if t.opsize and t.opsize ~= addrsize then werror("bad operand size override") end t.opsize = addrsize end end end until true return t end ------------------------------------------------------------------------------ -- x86 Template String Description -- =============================== -- -- Each template string is a list of [match:]pattern pairs, -- separated by "|". The first match wins. No match means a -- bad or unsupported combination of operand modes or sizes. -- -- The match part and the ":" is omitted if the operation has -- no operands. Otherwise the first N characters are matched -- against the mode strings of each of the N operands. -- -- The mode string for each operand type is (see parseoperand()): -- Integer register: "rm", +"R" for eax, ax, al, +"C" for cl -- FP register: "f", +"F" for st0 -- Index operand: "xm", +"O" for [disp] (pure offset) -- Immediate: "i", +"S" for signed 8 bit, +"1" for 1, -- +"I" for arg, +"P" for pointer -- Any: +"J" for valid jump targets -- -- So a match character "m" (mixed) matches both an integer register -- and an index operand (to be encoded with the ModRM/SIB scheme). -- But "r" matches only a register and "x" only an index operand -- (e.g. for FP memory access operations). -- -- The operand size match string starts right after the mode match -- characters and ends before the ":". "dwb" or "qdwb" is assumed, if empty. -- The effective data size of the operation is matched against this list. -- -- If only the regular "b", "w", "d", "q", "t" operand sizes are -- present, then all operands must be the same size. Unspecified sizes -- are ignored, but at least one operand must have a size or the pattern -- won't match (use the "byte", "word", "dword", "qword", "tword" -- operand size overrides. E.g.: mov dword [eax], 1). -- -- If the list has a "1" or "2" prefix, the operand size is taken -- from the respective operand and any other operand sizes are ignored. -- If the list contains only ".", all operand sizes are ignored. -- If the list has a "/" prefix, the concatenated (mixed) operand sizes -- are compared to the match. -- -- E.g. "rrdw" matches for either two dword registers or two word -- registers. "Fx2dq" matches an st0 operand plus an index operand -- pointing to a dword (float) or qword (double). -- -- Every character after the ":" is part of the pattern string: -- Hex chars are accumulated to form the opcode (left to right). -- "n" disables the standard opcode mods -- (otherwise: -1 for "b", o16 prefix for "w", rex.w for "q") -- "X" Force REX.W. -- "r"/"R" adds the reg. number from the 1st/2nd operand to the opcode. -- "m"/"M" generates ModRM/SIB from the 1st/2nd operand. -- The spare 3 bits are either filled with the last hex digit or -- the result from a previous "r"/"R". The opcode is restored. -- -- All of the following characters force a flush of the opcode: -- "o"/"O" stores a pure 32 bit disp (offset) from the 1st/2nd operand. -- "S" stores a signed 8 bit immediate from the last operand. -- "U" stores an unsigned 8 bit immediate from the last operand. -- "W" stores an unsigned 16 bit immediate from the last operand. -- "i" stores an operand sized immediate from the last operand. -- "I" dito, but generates an action code to optionally modify -- the opcode (+2) for a signed 8 bit immediate. -- "J" generates one of the REL action codes from the last operand. -- ------------------------------------------------------------------------------ -- Template strings for x86 instructions. Ordered by first opcode byte. -- Unimplemented opcodes (deliberate omissions) are marked with *. local map_op = { -- 00-05: add... -- 06: *push es -- 07: *pop es -- 08-0D: or... -- 0E: *push cs -- 0F: two byte opcode prefix -- 10-15: adc... -- 16: *push ss -- 17: *pop ss -- 18-1D: sbb... -- 1E: *push ds -- 1F: *pop ds -- 20-25: and... es_0 = "26", -- 27: *daa -- 28-2D: sub... cs_0 = "2E", -- 2F: *das -- 30-35: xor... ss_0 = "36", -- 37: *aaa -- 38-3D: cmp... ds_0 = "3E", -- 3F: *aas inc_1 = x64 and "m:FF0m" or "rdw:40r|m:FF0m", dec_1 = x64 and "m:FF1m" or "rdw:48r|m:FF1m", push_1 = (x64 and "rq:n50r|rw:50r|mq:nFF6m|mw:FF6m" or "rdw:50r|mdw:FF6m").."|S.:6AS|ib:n6Ai|i.:68i", pop_1 = x64 and "rq:n58r|rw:58r|mq:n8F0m|mw:8F0m" or "rdw:58r|mdw:8F0m", -- 60: *pusha, *pushad, *pushaw -- 61: *popa, *popad, *popaw -- 62: *bound rdw,x -- 63: x86: *arpl mw,rw movsxd_2 = x64 and "rm/qd:63rM", fs_0 = "64", gs_0 = "65", o16_0 = "66", a16_0 = not x64 and "67" or nil, a32_0 = x64 and "67", -- 68: push idw -- 69: imul rdw,mdw,idw -- 6A: push ib -- 6B: imul rdw,mdw,S -- 6C: *insb -- 6D: *insd, *insw -- 6E: *outsb -- 6F: *outsd, *outsw -- 70-7F: jcc lb -- 80: add... mb,i -- 81: add... mdw,i -- 82: *undefined -- 83: add... mdw,S test_2 = "mr:85Rm|rm:85rM|Ri:A9ri|mi:F70mi", -- 86: xchg rb,mb -- 87: xchg rdw,mdw -- 88: mov mb,r -- 89: mov mdw,r -- 8A: mov r,mb -- 8B: mov r,mdw -- 8C: *mov mdw,seg lea_2 = "rx1dq:8DrM", -- 8E: *mov seg,mdw -- 8F: pop mdw nop_0 = "90", xchg_2 = "Rrqdw:90R|rRqdw:90r|rm:87rM|mr:87Rm", cbw_0 = "6698", cwde_0 = "98", cdqe_0 = "4898", cwd_0 = "6699", cdq_0 = "99", cqo_0 = "4899", -- 9A: *call iw:idw wait_0 = "9B", fwait_0 = "9B", pushf_0 = "9C", pushfd_0 = not x64 and "9C", pushfq_0 = x64 and "9C", popf_0 = "9D", popfd_0 = not x64 and "9D", popfq_0 = x64 and "9D", sahf_0 = "9E", lahf_0 = "9F", mov_2 = "OR:A3o|RO:A1O|mr:89Rm|rm:8BrM|rib:nB0ri|ridw:B8ri|mi:C70mi", movsb_0 = "A4", movsw_0 = "66A5", movsd_0 = "A5", cmpsb_0 = "A6", cmpsw_0 = "66A7", cmpsd_0 = "A7", -- A8: test Rb,i -- A9: test Rdw,i stosb_0 = "AA", stosw_0 = "66AB", stosd_0 = "AB", lodsb_0 = "AC", lodsw_0 = "66AD", lodsd_0 = "AD", scasb_0 = "AE", scasw_0 = "66AF", scasd_0 = "AF", -- B0-B7: mov rb,i -- B8-BF: mov rdw,i -- C0: rol... mb,i -- C1: rol... mdw,i ret_1 = "i.:nC2W", ret_0 = "C3", -- C4: *les rdw,mq -- C5: *lds rdw,mq -- C6: mov mb,i -- C7: mov mdw,i -- C8: *enter iw,ib leave_0 = "C9", -- CA: *retf iw -- CB: *retf int3_0 = "CC", int_1 = "i.:nCDU", into_0 = "CE", -- CF: *iret -- D0: rol... mb,1 -- D1: rol... mdw,1 -- D2: rol... mb,cl -- D3: rol... mb,cl -- D4: *aam ib -- D5: *aad ib -- D6: *salc -- D7: *xlat -- D8-DF: floating point ops -- E0: *loopne -- E1: *loope -- E2: *loop -- E3: *jcxz, *jecxz -- E4: *in Rb,ib -- E5: *in Rdw,ib -- E6: *out ib,Rb -- E7: *out ib,Rdw call_1 = x64 and "mq:nFF2m|J.:E8nJ" or "md:FF2m|J.:E8J", jmp_1 = x64 and "mq:nFF4m|J.:E9nJ" or "md:FF4m|J.:E9J", -- short: EB -- EA: *jmp iw:idw -- EB: jmp ib -- EC: *in Rb,dx -- ED: *in Rdw,dx -- EE: *out dx,Rb -- EF: *out dx,Rdw lock_0 = "F0", int1_0 = "F1", repne_0 = "F2", repnz_0 = "F2", rep_0 = "F3", repe_0 = "F3", repz_0 = "F3", -- F4: *hlt cmc_0 = "F5", -- F6: test... mb,i; div... mb -- F7: test... mdw,i; div... mdw clc_0 = "F8", stc_0 = "F9", -- FA: *cli cld_0 = "FC", std_0 = "FD", -- FE: inc... mb -- FF: inc... mdw -- misc ops not_1 = "m:F72m", neg_1 = "m:F73m", mul_1 = "m:F74m", imul_1 = "m:F75m", div_1 = "m:F76m", idiv_1 = "m:F77m", imul_2 = "rmqdw:0FAFrM|rIqdw:69rmI|rSqdw:6BrmS|riqdw:69rmi", imul_3 = "rmIqdw:69rMI|rmSqdw:6BrMS|rmiqdw:69rMi", movzx_2 = "rm/db:0FB6rM|rm/qb:|rm/wb:0FB6rM|rm/dw:0FB7rM|rm/qw:", movsx_2 = "rm/db:0FBErM|rm/qb:|rm/wb:0FBErM|rm/dw:0FBFrM|rm/qw:", bswap_1 = "rqd:0FC8r", bsf_2 = "rmqdw:0FBCrM", bsr_2 = "rmqdw:0FBDrM", bt_2 = "mrqdw:0FA3Rm|miqdw:0FBA4mU", btc_2 = "mrqdw:0FBBRm|miqdw:0FBA7mU", btr_2 = "mrqdw:0FB3Rm|miqdw:0FBA6mU", bts_2 = "mrqdw:0FABRm|miqdw:0FBA5mU", shld_3 = "mriqdw:0FA4RmU|mrC/qq:0FA5Rm|mrC/dd:|mrC/ww:", shrd_3 = "mriqdw:0FACRmU|mrC/qq:0FADRm|mrC/dd:|mrC/ww:", rdtsc_0 = "0F31", -- P1+ rdpmc_0 = "0F33", -- P6+ cpuid_0 = "0FA2", -- P1+ -- floating point ops fst_1 = "ff:DDD0r|xd:D92m|xq:nDD2m", fstp_1 = "ff:DDD8r|xd:D93m|xq:nDD3m|xt:DB7m", fld_1 = "ff:D9C0r|xd:D90m|xq:nDD0m|xt:DB5m", fpop_0 = "DDD8", -- Alias for fstp st0. fist_1 = "xw:nDF2m|xd:DB2m", fistp_1 = "xw:nDF3m|xd:DB3m|xq:nDF7m", fild_1 = "xw:nDF0m|xd:DB0m|xq:nDF5m", fxch_0 = "D9C9", fxch_1 = "ff:D9C8r", fxch_2 = "fFf:D9C8r|Fff:D9C8R", fucom_1 = "ff:DDE0r", fucom_2 = "Fff:DDE0R", fucomp_1 = "ff:DDE8r", fucomp_2 = "Fff:DDE8R", fucomi_1 = "ff:DBE8r", -- P6+ fucomi_2 = "Fff:DBE8R", -- P6+ fucomip_1 = "ff:DFE8r", -- P6+ fucomip_2 = "Fff:DFE8R", -- P6+ fcomi_1 = "ff:DBF0r", -- P6+ fcomi_2 = "Fff:DBF0R", -- P6+ fcomip_1 = "ff:DFF0r", -- P6+ fcomip_2 = "Fff:DFF0R", -- P6+ fucompp_0 = "DAE9", fcompp_0 = "DED9", fldenv_1 = "x.:D94m", fnstenv_1 = "x.:D96m", fstenv_1 = "x.:9BD96m", fldcw_1 = "xw:nD95m", fstcw_1 = "xw:n9BD97m", fnstcw_1 = "xw:nD97m", fstsw_1 = "Rw:n9BDFE0|xw:n9BDD7m", fnstsw_1 = "Rw:nDFE0|xw:nDD7m", fclex_0 = "9BDBE2", fnclex_0 = "DBE2", fnop_0 = "D9D0", -- D9D1-D9DF: unassigned fchs_0 = "D9E0", fabs_0 = "D9E1", -- D9E2: unassigned -- D9E3: unassigned ftst_0 = "D9E4", fxam_0 = "D9E5", -- D9E6: unassigned -- D9E7: unassigned fld1_0 = "D9E8", fldl2t_0 = "D9E9", fldl2e_0 = "D9EA", fldpi_0 = "D9EB", fldlg2_0 = "D9EC", fldln2_0 = "D9ED", fldz_0 = "D9EE", -- D9EF: unassigned f2xm1_0 = "D9F0", fyl2x_0 = "D9F1", fptan_0 = "D9F2", fpatan_0 = "D9F3", fxtract_0 = "D9F4", fprem1_0 = "D9F5", fdecstp_0 = "D9F6", fincstp_0 = "D9F7", fprem_0 = "D9F8", fyl2xp1_0 = "D9F9", fsqrt_0 = "D9FA", fsincos_0 = "D9FB", frndint_0 = "D9FC", fscale_0 = "D9FD", fsin_0 = "D9FE", fcos_0 = "D9FF", -- SSE, SSE2 andnpd_2 = "rmo:660F55rM", andnps_2 = "rmo:0F55rM", andpd_2 = "rmo:660F54rM", andps_2 = "rmo:0F54rM", clflush_1 = "x.:0FAE7m", cmppd_3 = "rmio:660FC2rMU", cmpps_3 = "rmio:0FC2rMU", cmpsd_3 = "rrio:F20FC2rMU|rxi/oq:", cmpss_3 = "rrio:F30FC2rMU|rxi/od:", comisd_2 = "rro:660F2FrM|rx/oq:", comiss_2 = "rro:0F2FrM|rx/od:", cvtdq2pd_2 = "rro:F30FE6rM|rx/oq:", cvtdq2ps_2 = "rmo:0F5BrM", cvtpd2dq_2 = "rmo:F20FE6rM", cvtpd2ps_2 = "rmo:660F5ArM", cvtpi2pd_2 = "rx/oq:660F2ArM", cvtpi2ps_2 = "rx/oq:0F2ArM", cvtps2dq_2 = "rmo:660F5BrM", cvtps2pd_2 = "rro:0F5ArM|rx/oq:", cvtsd2si_2 = "rr/do:F20F2DrM|rr/qo:|rx/dq:|rxq:", cvtsd2ss_2 = "rro:F20F5ArM|rx/oq:", cvtsi2sd_2 = "rm/od:F20F2ArM|rm/oq:F20F2ArXM", cvtsi2ss_2 = "rm/od:F30F2ArM|rm/oq:F30F2ArXM", cvtss2sd_2 = "rro:F30F5ArM|rx/od:", cvtss2si_2 = "rr/do:F30F2DrM|rr/qo:|rxd:|rx/qd:", cvttpd2dq_2 = "rmo:660FE6rM", cvttps2dq_2 = "rmo:F30F5BrM", cvttsd2si_2 = "rr/do:F20F2CrM|rr/qo:|rx/dq:|rxq:", cvttss2si_2 = "rr/do:F30F2CrM|rr/qo:|rxd:|rx/qd:", fxsave_1 = "x.:0FAE0m", fxrstor_1 = "x.:0FAE1m", ldmxcsr_1 = "xd:0FAE2m", lfence_0 = "0FAEE8", maskmovdqu_2 = "rro:660FF7rM", mfence_0 = "0FAEF0", movapd_2 = "rmo:660F28rM|mro:660F29Rm", movaps_2 = "rmo:0F28rM|mro:0F29Rm", movd_2 = "rm/od:660F6ErM|rm/oq:660F6ErXM|mr/do:660F7ERm|mr/qo:", movdqa_2 = "rmo:660F6FrM|mro:660F7FRm", movdqu_2 = "rmo:F30F6FrM|mro:F30F7FRm", movhlps_2 = "rro:0F12rM", movhpd_2 = "rx/oq:660F16rM|xr/qo:n660F17Rm", movhps_2 = "rx/oq:0F16rM|xr/qo:n0F17Rm", movlhps_2 = "rro:0F16rM", movlpd_2 = "rx/oq:660F12rM|xr/qo:n660F13Rm", movlps_2 = "rx/oq:0F12rM|xr/qo:n0F13Rm", movmskpd_2 = "rr/do:660F50rM", movmskps_2 = "rr/do:0F50rM", movntdq_2 = "xro:660FE7Rm", movnti_2 = "xrqd:0FC3Rm", movntpd_2 = "xro:660F2BRm", movntps_2 = "xro:0F2BRm", movq_2 = "rro:F30F7ErM|rx/oq:|xr/qo:n660FD6Rm", movsd_2 = "rro:F20F10rM|rx/oq:|xr/qo:nF20F11Rm", movss_2 = "rro:F30F10rM|rx/od:|xr/do:F30F11Rm", movupd_2 = "rmo:660F10rM|mro:660F11Rm", movups_2 = "rmo:0F10rM|mro:0F11Rm", orpd_2 = "rmo:660F56rM", orps_2 = "rmo:0F56rM", packssdw_2 = "rmo:660F6BrM", packsswb_2 = "rmo:660F63rM", packuswb_2 = "rmo:660F67rM", paddb_2 = "rmo:660FFCrM", paddd_2 = "rmo:660FFErM", paddq_2 = "rmo:660FD4rM", paddsb_2 = "rmo:660FECrM", paddsw_2 = "rmo:660FEDrM", paddusb_2 = "rmo:660FDCrM", paddusw_2 = "rmo:660FDDrM", paddw_2 = "rmo:660FFDrM", pand_2 = "rmo:660FDBrM", pandn_2 = "rmo:660FDFrM", pause_0 = "F390", pavgb_2 = "rmo:660FE0rM", pavgw_2 = "rmo:660FE3rM", pcmpeqb_2 = "rmo:660F74rM", pcmpeqd_2 = "rmo:660F76rM", pcmpeqw_2 = "rmo:660F75rM", pcmpgtb_2 = "rmo:660F64rM", pcmpgtd_2 = "rmo:660F66rM", pcmpgtw_2 = "rmo:660F65rM", pextrw_3 = "rri/do:660FC5rMU|xri/wo:660F3A15nRmU", -- Mem op: SSE4.1 only. pinsrw_3 = "rri/od:660FC4rMU|rxi/ow:", pmaddwd_2 = "rmo:660FF5rM", pmaxsw_2 = "rmo:660FEErM", pmaxub_2 = "rmo:660FDErM", pminsw_2 = "rmo:660FEArM", pminub_2 = "rmo:660FDArM", pmovmskb_2 = "rr/do:660FD7rM", pmulhuw_2 = "rmo:660FE4rM", pmulhw_2 = "rmo:660FE5rM", pmullw_2 = "rmo:660FD5rM", pmuludq_2 = "rmo:660FF4rM", por_2 = "rmo:660FEBrM", prefetchnta_1 = "xb:n0F180m", prefetcht0_1 = "xb:n0F181m", prefetcht1_1 = "xb:n0F182m", prefetcht2_1 = "xb:n0F183m", psadbw_2 = "rmo:660FF6rM", pshufd_3 = "rmio:660F70rMU", pshufhw_3 = "rmio:F30F70rMU", pshuflw_3 = "rmio:F20F70rMU", pslld_2 = "rmo:660FF2rM|rio:660F726mU", pslldq_2 = "rio:660F737mU", psllq_2 = "rmo:660FF3rM|rio:660F736mU", psllw_2 = "rmo:660FF1rM|rio:660F716mU", psrad_2 = "rmo:660FE2rM|rio:660F724mU", psraw_2 = "rmo:660FE1rM|rio:660F714mU", psrld_2 = "rmo:660FD2rM|rio:660F722mU", psrldq_2 = "rio:660F733mU", psrlq_2 = "rmo:660FD3rM|rio:660F732mU", psrlw_2 = "rmo:660FD1rM|rio:660F712mU", psubb_2 = "rmo:660FF8rM", psubd_2 = "rmo:660FFArM", psubq_2 = "rmo:660FFBrM", psubsb_2 = "rmo:660FE8rM", psubsw_2 = "rmo:660FE9rM", psubusb_2 = "rmo:660FD8rM", psubusw_2 = "rmo:660FD9rM", psubw_2 = "rmo:660FF9rM", punpckhbw_2 = "rmo:660F68rM", punpckhdq_2 = "rmo:660F6ArM", punpckhqdq_2 = "rmo:660F6DrM", punpckhwd_2 = "rmo:660F69rM", punpcklbw_2 = "rmo:660F60rM", punpckldq_2 = "rmo:660F62rM", punpcklqdq_2 = "rmo:660F6CrM", punpcklwd_2 = "rmo:660F61rM", pxor_2 = "rmo:660FEFrM", rcpps_2 = "rmo:0F53rM", rcpss_2 = "rro:F30F53rM|rx/od:", rsqrtps_2 = "rmo:0F52rM", rsqrtss_2 = "rmo:F30F52rM", sfence_0 = "0FAEF8", shufpd_3 = "rmio:660FC6rMU", shufps_3 = "rmio:0FC6rMU", stmxcsr_1 = "xd:0FAE3m", ucomisd_2 = "rro:660F2ErM|rx/oq:", ucomiss_2 = "rro:0F2ErM|rx/od:", unpckhpd_2 = "rmo:660F15rM", unpckhps_2 = "rmo:0F15rM", unpcklpd_2 = "rmo:660F14rM", unpcklps_2 = "rmo:0F14rM", xorpd_2 = "rmo:660F57rM", xorps_2 = "rmo:0F57rM", -- SSE3 ops fisttp_1 = "xw:nDF1m|xd:DB1m|xq:nDD1m", addsubpd_2 = "rmo:660FD0rM", addsubps_2 = "rmo:F20FD0rM", haddpd_2 = "rmo:660F7CrM", haddps_2 = "rmo:F20F7CrM", hsubpd_2 = "rmo:660F7DrM", hsubps_2 = "rmo:F20F7DrM", lddqu_2 = "rxo:F20FF0rM", movddup_2 = "rmo:F20F12rM", movshdup_2 = "rmo:F30F16rM", movsldup_2 = "rmo:F30F12rM", -- SSSE3 ops pabsb_2 = "rmo:660F381CrM", pabsd_2 = "rmo:660F381ErM", pabsw_2 = "rmo:660F381DrM", palignr_3 = "rmio:660F3A0FrMU", phaddd_2 = "rmo:660F3802rM", phaddsw_2 = "rmo:660F3803rM", phaddw_2 = "rmo:660F3801rM", phsubd_2 = "rmo:660F3806rM", phsubsw_2 = "rmo:660F3807rM", phsubw_2 = "rmo:660F3805rM", pmaddubsw_2 = "rmo:660F3804rM", pmulhrsw_2 = "rmo:660F380BrM", pshufb_2 = "rmo:660F3800rM", psignb_2 = "rmo:660F3808rM", psignd_2 = "rmo:660F380ArM", psignw_2 = "rmo:660F3809rM", -- SSE4.1 ops blendpd_3 = "rmio:660F3A0DrMU", blendps_3 = "rmio:660F3A0CrMU", blendvpd_3 = "rmRo:660F3815rM", blendvps_3 = "rmRo:660F3814rM", dppd_3 = "rmio:660F3A41rMU", dpps_3 = "rmio:660F3A40rMU", extractps_3 = "mri/do:660F3A17RmU|rri/qo:660F3A17RXmU", insertps_3 = "rrio:660F3A41rMU|rxi/od:", movntdqa_2 = "rxo:660F382ArM", mpsadbw_3 = "rmio:660F3A42rMU", packusdw_2 = "rmo:660F382BrM", pblendvb_3 = "rmRo:660F3810rM", pblendw_3 = "rmio:660F3A0ErMU", pcmpeqq_2 = "rmo:660F3829rM", pextrb_3 = "rri/do:660F3A14nRmU|rri/qo:|xri/bo:", pextrd_3 = "mri/do:660F3A16RmU", pextrq_3 = "mri/qo:660F3A16RmU", -- pextrw is SSE2, mem operand is SSE4.1 only phminposuw_2 = "rmo:660F3841rM", pinsrb_3 = "rri/od:660F3A20nrMU|rxi/ob:", pinsrd_3 = "rmi/od:660F3A22rMU", pinsrq_3 = "rmi/oq:660F3A22rXMU", pmaxsb_2 = "rmo:660F383CrM", pmaxsd_2 = "rmo:660F383DrM", pmaxud_2 = "rmo:660F383FrM", pmaxuw_2 = "rmo:660F383ErM", pminsb_2 = "rmo:660F3838rM", pminsd_2 = "rmo:660F3839rM", pminud_2 = "rmo:660F383BrM", pminuw_2 = "rmo:660F383ArM", pmovsxbd_2 = "rro:660F3821rM|rx/od:", pmovsxbq_2 = "rro:660F3822rM|rx/ow:", pmovsxbw_2 = "rro:660F3820rM|rx/oq:", pmovsxdq_2 = "rro:660F3825rM|rx/oq:", pmovsxwd_2 = "rro:660F3823rM|rx/oq:", pmovsxwq_2 = "rro:660F3824rM|rx/od:", pmovzxbd_2 = "rro:660F3831rM|rx/od:", pmovzxbq_2 = "rro:660F3832rM|rx/ow:", pmovzxbw_2 = "rro:660F3830rM|rx/oq:", pmovzxdq_2 = "rro:660F3835rM|rx/oq:", pmovzxwd_2 = "rro:660F3833rM|rx/oq:", pmovzxwq_2 = "rro:660F3834rM|rx/od:", pmuldq_2 = "rmo:660F3828rM", pmulld_2 = "rmo:660F3840rM", ptest_2 = "rmo:660F3817rM", roundpd_3 = "rmio:660F3A09rMU", roundps_3 = "rmio:660F3A08rMU", roundsd_3 = "rrio:660F3A0BrMU|rxi/oq:", roundss_3 = "rrio:660F3A0ArMU|rxi/od:", -- SSE4.2 ops crc32_2 = "rmqd:F20F38F1rM|rm/dw:66F20F38F1rM|rm/db:F20F38F0rM|rm/qb:", pcmpestri_3 = "rmio:660F3A61rMU", pcmpestrm_3 = "rmio:660F3A60rMU", pcmpgtq_2 = "rmo:660F3837rM", pcmpistri_3 = "rmio:660F3A63rMU", pcmpistrm_3 = "rmio:660F3A62rMU", popcnt_2 = "rmqdw:F30FB8rM", -- SSE4a extrq_2 = "rro:660F79rM", extrq_3 = "riio:660F780mUU", insertq_2 = "rro:F20F79rM", insertq_4 = "rriio:F20F78rMUU", lzcnt_2 = "rmqdw:F30FBDrM", movntsd_2 = "xr/qo:nF20F2BRm", movntss_2 = "xr/do:F30F2BRm", -- popcnt is also in SSE4.2 } ------------------------------------------------------------------------------ -- Arithmetic ops. for name,n in pairs{ add = 0, ["or"] = 1, adc = 2, sbb = 3, ["and"] = 4, sub = 5, xor = 6, cmp = 7 } do local n8 = shl(n, 3) map_op[name.."_2"] = format( "mr:%02XRm|rm:%02XrM|mI1qdw:81%XmI|mS1qdw:83%XmS|Ri1qdwb:%02Xri|mi1qdwb:81%Xmi", 1+n8, 3+n8, n, n, 5+n8, n) end -- Shift ops. for name,n in pairs{ rol = 0, ror = 1, rcl = 2, rcr = 3, shl = 4, shr = 5, sar = 7, sal = 4 } do map_op[name.."_2"] = format("m1:D1%Xm|mC1qdwb:D3%Xm|mi:C1%XmU", n, n, n) end -- Conditional ops. for cc,n in pairs(map_cc) do map_op["j"..cc.."_1"] = format("J.:n0F8%XJ", n) -- short: 7%X map_op["set"..cc.."_1"] = format("mb:n0F9%X2m", n) map_op["cmov"..cc.."_2"] = format("rmqdw:0F4%XrM", n) -- P6+ end -- FP arithmetic ops. for name,n in pairs{ add = 0, mul = 1, com = 2, comp = 3, sub = 4, subr = 5, div = 6, divr = 7 } do local nc = 0xc0 + shl(n, 3) local nr = nc + (n < 4 and 0 or (n % 2 == 0 and 8 or -8)) local fn = "f"..name map_op[fn.."_1"] = format("ff:D8%02Xr|xd:D8%Xm|xq:nDC%Xm", nc, n, n) if n == 2 or n == 3 then map_op[fn.."_2"] = format("Fff:D8%02XR|Fx2d:D8%XM|Fx2q:nDC%XM", nc, n, n) else map_op[fn.."_2"] = format("Fff:D8%02XR|fFf:DC%02Xr|Fx2d:D8%XM|Fx2q:nDC%XM", nc, nr, n, n) map_op[fn.."p_1"] = format("ff:DE%02Xr", nr) map_op[fn.."p_2"] = format("fFf:DE%02Xr", nr) end map_op["fi"..name.."_1"] = format("xd:DA%Xm|xw:nDE%Xm", n, n) end -- FP conditional moves. for cc,n in pairs{ b=0, e=1, be=2, u=3, nb=4, ne=5, nbe=6, nu=7 } do local nc = 0xdac0 + shl(band(n, 3), 3) + shl(band(n, 4), 6) map_op["fcmov"..cc.."_1"] = format("ff:%04Xr", nc) -- P6+ map_op["fcmov"..cc.."_2"] = format("Fff:%04XR", nc) -- P6+ end -- SSE FP arithmetic ops. for name,n in pairs{ sqrt = 1, add = 8, mul = 9, sub = 12, min = 13, div = 14, max = 15 } do map_op[name.."ps_2"] = format("rmo:0F5%XrM", n) map_op[name.."ss_2"] = format("rro:F30F5%XrM|rx/od:", n) map_op[name.."pd_2"] = format("rmo:660F5%XrM", n) map_op[name.."sd_2"] = format("rro:F20F5%XrM|rx/oq:", n) end ------------------------------------------------------------------------------ -- Process pattern string. local function dopattern(pat, args, sz, op, needrex) local digit, addin local opcode = 0 local szov = sz local narg = 1 local rex = 0 -- Limit number of section buffer positions used by a single dasm_put(). -- A single opcode needs a maximum of 5 positions. if secpos+5 > maxsecpos then wflush() end -- Process each character. for c in gmatch(pat.."|", ".") do if match(c, "%x") then -- Hex digit. digit = byte(c) - 48 if digit > 48 then digit = digit - 39 elseif digit > 16 then digit = digit - 7 end opcode = opcode*16 + digit addin = nil elseif c == "n" then -- Disable operand size mods for opcode. szov = nil elseif c == "X" then -- Force REX.W. rex = 8 elseif c == "r" then -- Merge 1st operand regno. into opcode. addin = args[1]; opcode = opcode + (addin.reg % 8) if narg < 2 then narg = 2 end elseif c == "R" then -- Merge 2nd operand regno. into opcode. addin = args[2]; opcode = opcode + (addin.reg % 8) narg = 3 elseif c == "m" or c == "M" then -- Encode ModRM/SIB. local s if addin then s = addin.reg opcode = opcode - band(s, 7) -- Undo regno opcode merge. else s = band(opcode, 15) -- Undo last digit. opcode = shr(opcode, 4) end local nn = c == "m" and 1 or 2 local t = args[nn] if narg <= nn then narg = nn + 1 end if szov == "q" and rex == 0 then rex = rex + 8 end if t.reg and t.reg > 7 then rex = rex + 1 end if t.xreg and t.xreg > 7 then rex = rex + 2 end if s > 7 then rex = rex + 4 end if needrex then rex = rex + 16 end wputop(szov, opcode, rex); opcode = nil local imark = sub(pat, -1) -- Force a mark (ugly). -- Put ModRM/SIB with regno/last digit as spare. wputmrmsib(t, imark, s, addin and addin.vreg) addin = nil else if opcode then -- Flush opcode. if szov == "q" and rex == 0 then rex = rex + 8 end if needrex then rex = rex + 16 end if addin and addin.reg == -1 then wputop(szov, opcode - 7, rex) waction("VREG", addin.vreg); wputxb(0) else if addin and addin.reg > 7 then rex = rex + 1 end wputop(szov, opcode, rex) end opcode = nil end if c == "|" then break end if c == "o" then -- Offset (pure 32 bit displacement). wputdarg(args[1].disp); if narg < 2 then narg = 2 end elseif c == "O" then wputdarg(args[2].disp); narg = 3 else -- Anything else is an immediate operand. local a = args[narg] narg = narg + 1 local mode, imm = a.mode, a.imm if mode == "iJ" and not match("iIJ", c) then werror("bad operand size for label") end if c == "S" then wputsbarg(imm) elseif c == "U" then wputbarg(imm) elseif c == "W" then wputwarg(imm) elseif c == "i" or c == "I" then if mode == "iJ" then wputlabel("IMM_", imm, 1) elseif mode == "iI" and c == "I" then waction(sz == "w" and "IMM_WB" or "IMM_DB", imm) else wputszarg(sz, imm) end elseif c == "J" then if mode == "iPJ" then waction("REL_A", imm) -- !x64 (secpos) else wputlabel("REL_", imm, 2) end else werror("bad char `"..c.."' in pattern `"..pat.."' for `"..op.."'") end end end end end ------------------------------------------------------------------------------ -- Mapping of operand modes to short names. Suppress output with '#'. local map_modename = { r = "reg", R = "eax", C = "cl", x = "mem", m = "mrm", i = "imm", f = "stx", F = "st0", J = "lbl", ["1"] = "1", I = "#", S = "#", O = "#", } -- Return a table/string showing all possible operand modes. local function templatehelp(template, nparams) if nparams == 0 then return "" end local t = {} for tm in gmatch(template, "[^%|]+") do local s = map_modename[sub(tm, 1, 1)] s = s..gsub(sub(tm, 2, nparams), ".", function(c) return ", "..map_modename[c] end) if not match(s, "#") then t[#t+1] = s end end return t end -- Match operand modes against mode match part of template. local function matchtm(tm, args) for i=1,#args do if not match(args[i].mode, sub(tm, i, i)) then return end end return true end -- Handle opcodes defined with template strings. map_op[".template__"] = function(params, template, nparams) if not params then return templatehelp(template, nparams) end local args = {} -- Zero-operand opcodes have no match part. if #params == 0 then dopattern(template, args, "d", params.op, nil) return end -- Determine common operand size (coerce undefined size) or flag as mixed. local sz, szmix, needrex for i,p in ipairs(params) do args[i] = parseoperand(p) local nsz = args[i].opsize if nsz then if sz and sz ~= nsz then szmix = true else sz = nsz end end local nrex = args[i].needrex if nrex ~= nil then if needrex == nil then needrex = nrex elseif needrex ~= nrex then werror("bad mix of byte-addressable registers") end end end -- Try all match:pattern pairs (separated by '|'). local gotmatch, lastpat for tm in gmatch(template, "[^%|]+") do -- Split off size match (starts after mode match) and pattern string. local szm, pat = match(tm, "^(.-):(.*)$", #args+1) if pat == "" then pat = lastpat else lastpat = pat end if matchtm(tm, args) then local prefix = sub(szm, 1, 1) if prefix == "/" then -- Match both operand sizes. if args[1].opsize == sub(szm, 2, 2) and args[2].opsize == sub(szm, 3, 3) then dopattern(pat, args, sz, params.op, needrex) -- Process pattern. return end else -- Match common operand size. local szp = sz if szm == "" then szm = x64 and "qdwb" or "dwb" end -- Default sizes. if prefix == "1" then szp = args[1].opsize; szmix = nil elseif prefix == "2" then szp = args[2].opsize; szmix = nil end if not szmix and (prefix == "." or match(szm, szp or "#")) then dopattern(pat, args, szp, params.op, needrex) -- Process pattern. return end end gotmatch = true end end local msg = "bad operand mode" if gotmatch then if szmix then msg = "mixed operand size" else msg = sz and "bad operand size" or "missing operand size" end end werror(msg.." in `"..opmodestr(params.op, args).."'") end ------------------------------------------------------------------------------ -- x64-specific opcode for 64 bit immediates and displacements. if x64 then function map_op.mov64_2(params) if not params then return { "reg, imm", "reg, [disp]", "[disp], reg" } end if secpos+2 > maxsecpos then wflush() end local opcode, op64, sz, rex, vreg local op64 = match(params[1], "^%[%s*(.-)%s*%]$") if op64 then local a = parseoperand(params[2]) if a.mode ~= "rmR" then werror("bad operand mode") end sz = a.opsize rex = sz == "q" and 8 or 0 opcode = 0xa3 else op64 = match(params[2], "^%[%s*(.-)%s*%]$") local a = parseoperand(params[1]) if op64 then if a.mode ~= "rmR" then werror("bad operand mode") end sz = a.opsize rex = sz == "q" and 8 or 0 opcode = 0xa1 else if sub(a.mode, 1, 1) ~= "r" or a.opsize ~= "q" then werror("bad operand mode") end op64 = params[2] if a.reg == -1 then vreg = a.vreg opcode = 0xb8 else opcode = 0xb8 + band(a.reg, 7) end rex = a.reg > 7 and 9 or 8 end end wputop(sz, opcode, rex) if vreg then waction("VREG", vreg); wputxb(0) end waction("IMM_D", format("(unsigned int)(%s)", op64)) waction("IMM_D", format("(unsigned int)((%s)>>32)", op64)) end end ------------------------------------------------------------------------------ -- Pseudo-opcodes for data storage. local function op_data(params) if not params then return "imm..." end local sz = sub(params.op, 2, 2) if sz == "a" then sz = addrsize end for _,p in ipairs(params) do local a = parseoperand(p) if sub(a.mode, 1, 1) ~= "i" or (a.opsize and a.opsize ~= sz) then werror("bad mode or size in `"..p.."'") end if a.mode == "iJ" then wputlabel("IMM_", a.imm, 1) else wputszarg(sz, a.imm) end if secpos+2 > maxsecpos then wflush() end end end map_op[".byte_*"] = op_data map_op[".sbyte_*"] = op_data map_op[".word_*"] = op_data map_op[".dword_*"] = op_data map_op[".aword_*"] = op_data ------------------------------------------------------------------------------ -- Pseudo-opcode to mark the position where the action list is to be emitted. map_op[".actionlist_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeactions(out, name) end) end -- Pseudo-opcode to mark the position where the global enum is to be emitted. map_op[".globals_1"] = function(params) if not params then return "prefix" end local prefix = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobals(out, prefix) end) end -- Pseudo-opcode to mark the position where the global names are to be emitted. map_op[".globalnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobalnames(out, name) end) end -- Pseudo-opcode to mark the position where the extern names are to be emitted. map_op[".externnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeexternnames(out, name) end) end ------------------------------------------------------------------------------ -- Label pseudo-opcode (converted from trailing colon form). map_op[".label_2"] = function(params) if not params then return "[1-9] | ->global | =>pcexpr [, addr]" end if secpos+2 > maxsecpos then wflush() end local a = parseoperand(params[1]) local mode, imm = a.mode, a.imm if type(imm) == "number" and (mode == "iJ" or (imm >= 1 and imm <= 9)) then -- Local label (1: ... 9:) or global label (->global:). waction("LABEL_LG", nil, 1) wputxb(imm) elseif mode == "iJ" then -- PC label (=>pcexpr:). waction("LABEL_PC", imm) else werror("bad label definition") end -- SETLABEL must immediately follow LABEL_LG/LABEL_PC. local addr = params[2] if addr then local a = parseoperand(addr) if a.mode == "iPJ" then waction("SETLABEL", a.imm) else werror("bad label assignment") end end end map_op[".label_1"] = map_op[".label_2"] ------------------------------------------------------------------------------ -- Alignment pseudo-opcode. map_op[".align_1"] = function(params) if not params then return "numpow2" end if secpos+1 > maxsecpos then wflush() end local align = tonumber(params[1]) or map_opsizenum[map_opsize[params[1]]] if align then local x = align -- Must be a power of 2 in the range (2 ... 256). for i=1,8 do x = x / 2 if x == 1 then waction("ALIGN", nil, 1) wputxb(align-1) -- Action byte is 2**n-1. return end end end werror("bad alignment") end -- Spacing pseudo-opcode. map_op[".space_2"] = function(params) if not params then return "num [, filler]" end if secpos+1 > maxsecpos then wflush() end waction("SPACE", params[1]) local fill = params[2] if fill then fill = tonumber(fill) if not fill or fill < 0 or fill > 255 then werror("bad filler") end end wputxb(fill or 0) end map_op[".space_1"] = map_op[".space_2"] ------------------------------------------------------------------------------ -- Pseudo-opcode for (primitive) type definitions (map to C types). map_op[".type_3"] = function(params, nparams) if not params then return nparams == 2 and "name, ctype" or "name, ctype, reg" end local name, ctype, reg = params[1], params[2], params[3] if not match(name, "^[%a_][%w_]*$") then werror("bad type name `"..name.."'") end local tp = map_type[name] if tp then werror("duplicate type `"..name.."'") end if reg and not map_reg_valid_base[reg] then werror("bad base register `"..(map_reg_rev[reg] or reg).."'") end -- Add #type to defines. A bit unclean to put it in map_archdef. map_archdef["#"..name] = "sizeof("..ctype..")" -- Add new type and emit shortcut define. local num = ctypenum + 1 map_type[name] = { ctype = ctype, ctypefmt = format("Dt%X(%%s)", num), reg = reg, } wline(format("#define Dt%X(_V) (int)(ptrdiff_t)&(((%s *)0)_V)", num, ctype)) ctypenum = num end map_op[".type_2"] = map_op[".type_3"] -- Dump type definitions. local function dumptypes(out, lvl) local t = {} for name in pairs(map_type) do t[#t+1] = name end sort(t) out:write("Type definitions:\n") for _,name in ipairs(t) do local tp = map_type[name] local reg = tp.reg and map_reg_rev[tp.reg] or "" out:write(format(" %-20s %-20s %s\n", name, tp.ctype, reg)) end out:write("\n") end ------------------------------------------------------------------------------ -- Set the current section. function _M.section(num) waction("SECTION") wputxb(num) wflush(true) -- SECTION is a terminal action. end ------------------------------------------------------------------------------ -- Dump architecture description. function _M.dumparch(out) out:write(format("DynASM %s version %s, released %s\n\n", _info.arch, _info.version, _info.release)) dumpregs(out) dumpactions(out) end -- Dump all user defined elements. function _M.dumpdef(out, lvl) dumptypes(out, lvl) dumpglobals(out, lvl) dumpexterns(out, lvl) end ------------------------------------------------------------------------------ -- Pass callbacks from/to the DynASM core. function _M.passcb(wl, we, wf, ww) wline, werror, wfatal, wwarn = wl, we, wf, ww return wflush end -- Setup the arch-specific module. function _M.setup(arch, opt) g_arch, g_opt = arch, opt end -- Merge the core maps and the arch-specific maps. function _M.mergemaps(map_coreop, map_def) setmetatable(map_op, { __index = map_coreop }) setmetatable(map_def, { __index = map_archdef }) return map_op, map_def end return _M ------------------------------------------------------------------------------ wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_ppc.h0000644000175000017500000002751613122010155017347 0ustar philphil/* ** DynASM PPC encoding engine. ** Copyright (C) 2005-2016 Mike Pall. All rights reserved. ** Released under the MIT license. See dynasm.lua for full copyright notice. */ #include #include #include #include #define DASM_ARCH "ppc" #ifndef DASM_EXTERN #define DASM_EXTERN(a,b,c,d) 0 #endif /* Action definitions. */ enum { DASM_STOP, DASM_SECTION, DASM_ESC, DASM_REL_EXT, /* The following actions need a buffer position. */ DASM_ALIGN, DASM_REL_LG, DASM_LABEL_LG, /* The following actions also have an argument. */ DASM_REL_PC, DASM_LABEL_PC, DASM_IMM, DASM__MAX }; /* Maximum number of section buffer positions for a single dasm_put() call. */ #define DASM_MAXSECPOS 25 /* DynASM encoder status codes. Action list offset or number are or'ed in. */ #define DASM_S_OK 0x00000000 #define DASM_S_NOMEM 0x01000000 #define DASM_S_PHASE 0x02000000 #define DASM_S_MATCH_SEC 0x03000000 #define DASM_S_RANGE_I 0x11000000 #define DASM_S_RANGE_SEC 0x12000000 #define DASM_S_RANGE_LG 0x13000000 #define DASM_S_RANGE_PC 0x14000000 #define DASM_S_RANGE_REL 0x15000000 #define DASM_S_UNDEF_LG 0x21000000 #define DASM_S_UNDEF_PC 0x22000000 /* Macros to convert positions (8 bit section + 24 bit index). */ #define DASM_POS2IDX(pos) ((pos)&0x00ffffff) #define DASM_POS2BIAS(pos) ((pos)&0xff000000) #define DASM_SEC2POS(sec) ((sec)<<24) #define DASM_POS2SEC(pos) ((pos)>>24) #define DASM_POS2PTR(D, pos) (D->sections[DASM_POS2SEC(pos)].rbuf + (pos)) /* Action list type. */ typedef const unsigned int *dasm_ActList; /* Per-section structure. */ typedef struct dasm_Section { int *rbuf; /* Biased buffer pointer (negative section bias). */ int *buf; /* True buffer pointer. */ size_t bsize; /* Buffer size in bytes. */ int pos; /* Biased buffer position. */ int epos; /* End of biased buffer position - max single put. */ int ofs; /* Byte offset into section. */ } dasm_Section; /* Core structure holding the DynASM encoding state. */ struct dasm_State { size_t psize; /* Allocated size of this structure. */ dasm_ActList actionlist; /* Current actionlist pointer. */ int *lglabels; /* Local/global chain/pos ptrs. */ size_t lgsize; int *pclabels; /* PC label chains/pos ptrs. */ size_t pcsize; void **globals; /* Array of globals (bias -10). */ dasm_Section *section; /* Pointer to active section. */ size_t codesize; /* Total size of all code sections. */ int maxsection; /* 0 <= sectionidx < maxsection. */ int status; /* Status code. */ dasm_Section sections[1]; /* All sections. Alloc-extended. */ }; /* The size of the core structure depends on the max. number of sections. */ #define DASM_PSZ(ms) (sizeof(dasm_State)+(ms-1)*sizeof(dasm_Section)) /* Initialize DynASM state. */ void dasm_init(Dst_DECL, int maxsection) { dasm_State *D; size_t psz = 0; int i; Dst_REF = NULL; DASM_M_GROW(Dst, struct dasm_State, Dst_REF, psz, DASM_PSZ(maxsection)); D = Dst_REF; D->psize = psz; D->lglabels = NULL; D->lgsize = 0; D->pclabels = NULL; D->pcsize = 0; D->globals = NULL; D->maxsection = maxsection; for (i = 0; i < maxsection; i++) { D->sections[i].buf = NULL; /* Need this for pass3. */ D->sections[i].rbuf = D->sections[i].buf - DASM_SEC2POS(i); D->sections[i].bsize = 0; D->sections[i].epos = 0; /* Wrong, but is recalculated after resize. */ } } /* Free DynASM state. */ void dasm_free(Dst_DECL) { dasm_State *D = Dst_REF; int i; for (i = 0; i < D->maxsection; i++) if (D->sections[i].buf) DASM_M_FREE(Dst, D->sections[i].buf, D->sections[i].bsize); if (D->pclabels) DASM_M_FREE(Dst, D->pclabels, D->pcsize); if (D->lglabels) DASM_M_FREE(Dst, D->lglabels, D->lgsize); DASM_M_FREE(Dst, D, D->psize); } /* Setup global label array. Must be called before dasm_setup(). */ void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl) { dasm_State *D = Dst_REF; D->globals = gl - 10; /* Negative bias to compensate for locals. */ DASM_M_GROW(Dst, int, D->lglabels, D->lgsize, (10+maxgl)*sizeof(int)); } /* Grow PC label array. Can be called after dasm_setup(), too. */ void dasm_growpc(Dst_DECL, unsigned int maxpc) { dasm_State *D = Dst_REF; size_t osz = D->pcsize; DASM_M_GROW(Dst, int, D->pclabels, D->pcsize, maxpc*sizeof(int)); memset((void *)(((unsigned char *)D->pclabels)+osz), 0, D->pcsize-osz); } /* Setup encoder. */ void dasm_setup(Dst_DECL, const void *actionlist) { dasm_State *D = Dst_REF; int i; D->actionlist = (dasm_ActList)actionlist; D->status = DASM_S_OK; D->section = &D->sections[0]; memset((void *)D->lglabels, 0, D->lgsize); if (D->pclabels) memset((void *)D->pclabels, 0, D->pcsize); for (i = 0; i < D->maxsection; i++) { D->sections[i].pos = DASM_SEC2POS(i); D->sections[i].ofs = 0; } } #ifdef DASM_CHECKS #define CK(x, st) \ do { if (!(x)) { \ D->status = DASM_S_##st|(p-D->actionlist-1); return; } } while (0) #define CKPL(kind, st) \ do { if ((size_t)((char *)pl-(char *)D->kind##labels) >= D->kind##size) { \ D->status = DASM_S_RANGE_##st|(p-D->actionlist-1); return; } } while (0) #else #define CK(x, st) ((void)0) #define CKPL(kind, st) ((void)0) #endif /* Pass 1: Store actions and args, link branches/labels, estimate offsets. */ void dasm_put(Dst_DECL, int start, ...) { va_list ap; dasm_State *D = Dst_REF; dasm_ActList p = D->actionlist + start; dasm_Section *sec = D->section; int pos = sec->pos, ofs = sec->ofs; int *b; if (pos >= sec->epos) { DASM_M_GROW(Dst, int, sec->buf, sec->bsize, sec->bsize + 2*DASM_MAXSECPOS*sizeof(int)); sec->rbuf = sec->buf - DASM_POS2BIAS(pos); sec->epos = (int)sec->bsize/sizeof(int) - DASM_MAXSECPOS+DASM_POS2BIAS(pos); } b = sec->rbuf; b[pos++] = start; va_start(ap, start); while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16); if (action >= DASM__MAX) { ofs += 4; } else { int *pl, n = action >= DASM_REL_PC ? va_arg(ap, int) : 0; switch (action) { case DASM_STOP: goto stop; case DASM_SECTION: n = (ins & 255); CK(n < D->maxsection, RANGE_SEC); D->section = &D->sections[n]; goto stop; case DASM_ESC: p++; ofs += 4; break; case DASM_REL_EXT: break; case DASM_ALIGN: ofs += (ins & 255); b[pos++] = ofs; break; case DASM_REL_LG: n = (ins & 2047) - 10; pl = D->lglabels + n; /* Bkwd rel or global. */ if (n >= 0) { CK(n>=10||*pl<0, RANGE_LG); CKPL(lg, LG); goto putrel; } pl += 10; n = *pl; if (n < 0) n = 0; /* Start new chain for fwd rel if label exists. */ goto linkrel; case DASM_REL_PC: pl = D->pclabels + n; CKPL(pc, PC); putrel: n = *pl; if (n < 0) { /* Label exists. Get label pos and store it. */ b[pos] = -n; } else { linkrel: b[pos] = n; /* Else link to rel chain, anchored at label. */ *pl = pos; } pos++; break; case DASM_LABEL_LG: pl = D->lglabels + (ins & 2047) - 10; CKPL(lg, LG); goto putlabel; case DASM_LABEL_PC: pl = D->pclabels + n; CKPL(pc, PC); putlabel: n = *pl; /* n > 0: Collapse rel chain and replace with label pos. */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = pos; } *pl = -pos; /* Label exists now. */ b[pos++] = ofs; /* Store pass1 offset estimate. */ break; case DASM_IMM: #ifdef DASM_CHECKS CK((n & ((1<<((ins>>10)&31))-1)) == 0, RANGE_I); #endif n >>= ((ins>>10)&31); #ifdef DASM_CHECKS if (ins & 0x8000) CK(((n + (1<<(((ins>>5)&31)-1)))>>((ins>>5)&31)) == 0, RANGE_I); else CK((n>>((ins>>5)&31)) == 0, RANGE_I); #endif b[pos++] = n; break; } } } stop: va_end(ap); sec->pos = pos; sec->ofs = ofs; } #undef CK /* Pass 2: Link sections, shrink aligns, fix label offsets. */ int dasm_link(Dst_DECL, size_t *szp) { dasm_State *D = Dst_REF; int secnum; int ofs = 0; #ifdef DASM_CHECKS *szp = 0; if (D->status != DASM_S_OK) return D->status; { int pc; for (pc = 0; pc*sizeof(int) < D->pcsize; pc++) if (D->pclabels[pc] > 0) return DASM_S_UNDEF_PC|pc; } #endif { /* Handle globals not defined in this translation unit. */ int idx; for (idx = 20; idx*sizeof(int) < D->lgsize; idx++) { int n = D->lglabels[idx]; /* Undefined label: Collapse rel chain and replace with marker (< 0). */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = -idx; } } } /* Combine all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->rbuf; int pos = DASM_SEC2POS(secnum); int lastpos = sec->pos; while (pos != lastpos) { dasm_ActList p = D->actionlist + b[pos++]; while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16); switch (action) { case DASM_STOP: case DASM_SECTION: goto stop; case DASM_ESC: p++; break; case DASM_REL_EXT: break; case DASM_ALIGN: ofs -= (b[pos++] + ofs) & (ins & 255); break; case DASM_REL_LG: case DASM_REL_PC: pos++; break; case DASM_LABEL_LG: case DASM_LABEL_PC: b[pos++] += ofs; break; case DASM_IMM: pos++; break; } } stop: (void)0; } ofs += sec->ofs; /* Next section starts right after current section. */ } D->codesize = ofs; /* Total size of all code sections */ *szp = ofs; return DASM_S_OK; } #ifdef DASM_CHECKS #define CK(x, st) \ do { if (!(x)) return DASM_S_##st|(p-D->actionlist-1); } while (0) #else #define CK(x, st) ((void)0) #endif /* Pass 3: Encode sections. */ int dasm_encode(Dst_DECL, void *buffer) { dasm_State *D = Dst_REF; char *base = (char *)buffer; unsigned int *cp = (unsigned int *)buffer; int secnum; /* Encode all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->buf; int *endb = sec->rbuf + sec->pos; while (b != endb) { dasm_ActList p = D->actionlist + *b++; while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16); int n = (action >= DASM_ALIGN && action < DASM__MAX) ? *b++ : 0; switch (action) { case DASM_STOP: case DASM_SECTION: goto stop; case DASM_ESC: *cp++ = *p++; break; case DASM_REL_EXT: n = DASM_EXTERN(Dst, (unsigned char *)cp, (ins & 2047), 1) - 4; goto patchrel; case DASM_ALIGN: ins &= 255; while ((((char *)cp - base) & ins)) *cp++ = 0x60000000; break; case DASM_REL_LG: CK(n >= 0, UNDEF_LG); case DASM_REL_PC: CK(n >= 0, UNDEF_PC); n = *DASM_POS2PTR(D, n) - (int)((char *)cp - base); patchrel: CK((n & 3) == 0 && (((n+4) + ((ins & 2048) ? 0x00008000 : 0x02000000)) >> ((ins & 2048) ? 16 : 26)) == 0, RANGE_REL); cp[-1] |= ((n+4) & ((ins & 2048) ? 0x0000fffc: 0x03fffffc)); break; case DASM_LABEL_LG: ins &= 2047; if (ins >= 20) D->globals[ins-10] = (void *)(base + n); break; case DASM_LABEL_PC: break; case DASM_IMM: cp[-1] |= (n & ((1<<((ins>>5)&31))-1)) << (ins&31); break; default: *cp++ = ins; break; } } stop: (void)0; } } if (base + D->codesize != (char *)cp) /* Check for phase errors. */ return DASM_S_PHASE; return DASM_S_OK; } #undef CK /* Get PC label offset. */ int dasm_getpclabel(Dst_DECL, unsigned int pc) { dasm_State *D = Dst_REF; if (pc*sizeof(int) < D->pcsize) { int pos = D->pclabels[pc]; if (pos < 0) return *DASM_POS2PTR(D, -pos); if (pos > 0) return -1; /* Undefined. */ } return -2; /* Unused or out of range. */ } #ifdef DASM_CHECKS /* Optional sanity checker to call between isolated encoding steps. */ int dasm_checkstep(Dst_DECL, int secmatch) { dasm_State *D = Dst_REF; if (D->status == DASM_S_OK) { int i; for (i = 1; i <= 9; i++) { if (D->lglabels[i] > 0) { D->status = DASM_S_UNDEF_LG|i; break; } D->lglabels[i] = 0; } } if (D->status == DASM_S_OK && secmatch >= 0 && D->section != &D->sections[secmatch]) D->status = DASM_S_MATCH_SEC|(D->section-D->sections); return D->status; } #endif wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_proto.h0000644000175000017500000000401613122010155017716 0ustar philphil/* ** DynASM encoding engine prototypes. ** Copyright (C) 2005-2016 Mike Pall. All rights reserved. ** Released under the MIT license. See dynasm.lua for full copyright notice. */ #ifndef _DASM_PROTO_H #define _DASM_PROTO_H #include #include #define DASM_IDENT "DynASM 1.3.0" #define DASM_VERSION 10300 /* 1.3.0 */ #ifndef Dst_DECL #define Dst_DECL dasm_State **Dst #endif #ifndef Dst_REF #define Dst_REF (*Dst) #endif #ifndef DASM_FDEF #define DASM_FDEF extern #endif #ifndef DASM_M_GROW #define DASM_M_GROW(ctx, t, p, sz, need) \ do { \ size_t _sz = (sz), _need = (need); \ if (_sz < _need) { \ if (_sz < 16) _sz = 16; \ while (_sz < _need) _sz += _sz; \ (p) = (t *)realloc((p), _sz); \ if ((p) == NULL) exit(1); \ (sz) = _sz; \ } \ } while(0) #endif #ifndef DASM_M_FREE #define DASM_M_FREE(ctx, p, sz) free(p) #endif /* Internal DynASM encoder state. */ typedef struct dasm_State dasm_State; /* Initialize and free DynASM state. */ DASM_FDEF void dasm_init(Dst_DECL, int maxsection); DASM_FDEF void dasm_free(Dst_DECL); /* Setup global array. Must be called before dasm_setup(). */ DASM_FDEF void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl); /* Grow PC label array. Can be called after dasm_setup(), too. */ DASM_FDEF void dasm_growpc(Dst_DECL, unsigned int maxpc); /* Setup encoder. */ DASM_FDEF void dasm_setup(Dst_DECL, const void *actionlist); /* Feed encoder with actions. Calls are generated by pre-processor. */ DASM_FDEF void dasm_put(Dst_DECL, int start, ...); /* Link sections and return the resulting size. */ DASM_FDEF int dasm_link(Dst_DECL, size_t *szp); /* Encode sections into buffer. */ DASM_FDEF int dasm_encode(Dst_DECL, void *buffer); /* Get PC label offset. */ DASM_FDEF int dasm_getpclabel(Dst_DECL, unsigned int pc); #ifdef DASM_CHECKS /* Optional sanity checker to call between isolated encoding steps. */ DASM_FDEF int dasm_checkstep(Dst_DECL, int secmatch); #else #define dasm_checkstep(a, b) 0 #endif #endif /* _DASM_PROTO_H */ wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_x64.lua0000644000175000017500000000107013122010155017523 0ustar philphil------------------------------------------------------------------------------ -- DynASM x64 module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- See dynasm.lua for full copyright notice. ------------------------------------------------------------------------------ -- This module just sets 64 bit mode for the combined x86/x64 module. -- All the interesting stuff is there. ------------------------------------------------------------------------------ x64 = true -- Using a global is an ugly, but effective solution. return require("dasm_x86") wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_arm.h0000644000175000017500000003215713122010155017341 0ustar philphil/* ** DynASM ARM encoding engine. ** Copyright (C) 2005-2016 Mike Pall. All rights reserved. ** Released under the MIT license. See dynasm.lua for full copyright notice. */ #include #include #include #include #define DASM_ARCH "arm" #ifndef DASM_EXTERN #define DASM_EXTERN(a,b,c,d) 0 #endif /* Action definitions. */ enum { DASM_STOP, DASM_SECTION, DASM_ESC, DASM_REL_EXT, /* The following actions need a buffer position. */ DASM_ALIGN, DASM_REL_LG, DASM_LABEL_LG, /* The following actions also have an argument. */ DASM_REL_PC, DASM_LABEL_PC, DASM_IMM, DASM_IMM12, DASM_IMM16, DASM_IMML8, DASM_IMML12, DASM_IMMV8, DASM__MAX }; /* Maximum number of section buffer positions for a single dasm_put() call. */ #define DASM_MAXSECPOS 25 /* DynASM encoder status codes. Action list offset or number are or'ed in. */ #define DASM_S_OK 0x00000000 #define DASM_S_NOMEM 0x01000000 #define DASM_S_PHASE 0x02000000 #define DASM_S_MATCH_SEC 0x03000000 #define DASM_S_RANGE_I 0x11000000 #define DASM_S_RANGE_SEC 0x12000000 #define DASM_S_RANGE_LG 0x13000000 #define DASM_S_RANGE_PC 0x14000000 #define DASM_S_RANGE_REL 0x15000000 #define DASM_S_UNDEF_LG 0x21000000 #define DASM_S_UNDEF_PC 0x22000000 /* Macros to convert positions (8 bit section + 24 bit index). */ #define DASM_POS2IDX(pos) ((pos)&0x00ffffff) #define DASM_POS2BIAS(pos) ((pos)&0xff000000) #define DASM_SEC2POS(sec) ((sec)<<24) #define DASM_POS2SEC(pos) ((pos)>>24) #define DASM_POS2PTR(D, pos) (D->sections[DASM_POS2SEC(pos)].rbuf + (pos)) /* Action list type. */ typedef const unsigned int *dasm_ActList; /* Per-section structure. */ typedef struct dasm_Section { int *rbuf; /* Biased buffer pointer (negative section bias). */ int *buf; /* True buffer pointer. */ size_t bsize; /* Buffer size in bytes. */ int pos; /* Biased buffer position. */ int epos; /* End of biased buffer position - max single put. */ int ofs; /* Byte offset into section. */ } dasm_Section; /* Core structure holding the DynASM encoding state. */ struct dasm_State { size_t psize; /* Allocated size of this structure. */ dasm_ActList actionlist; /* Current actionlist pointer. */ int *lglabels; /* Local/global chain/pos ptrs. */ size_t lgsize; int *pclabels; /* PC label chains/pos ptrs. */ size_t pcsize; void **globals; /* Array of globals (bias -10). */ dasm_Section *section; /* Pointer to active section. */ size_t codesize; /* Total size of all code sections. */ int maxsection; /* 0 <= sectionidx < maxsection. */ int status; /* Status code. */ dasm_Section sections[1]; /* All sections. Alloc-extended. */ }; /* The size of the core structure depends on the max. number of sections. */ #define DASM_PSZ(ms) (sizeof(dasm_State)+(ms-1)*sizeof(dasm_Section)) /* Initialize DynASM state. */ void dasm_init(Dst_DECL, int maxsection) { dasm_State *D; size_t psz = 0; int i; Dst_REF = NULL; DASM_M_GROW(Dst, struct dasm_State, Dst_REF, psz, DASM_PSZ(maxsection)); D = Dst_REF; D->psize = psz; D->lglabels = NULL; D->lgsize = 0; D->pclabels = NULL; D->pcsize = 0; D->globals = NULL; D->maxsection = maxsection; for (i = 0; i < maxsection; i++) { D->sections[i].buf = NULL; /* Need this for pass3. */ D->sections[i].rbuf = D->sections[i].buf - DASM_SEC2POS(i); D->sections[i].bsize = 0; D->sections[i].epos = 0; /* Wrong, but is recalculated after resize. */ } } /* Free DynASM state. */ void dasm_free(Dst_DECL) { dasm_State *D = Dst_REF; int i; for (i = 0; i < D->maxsection; i++) if (D->sections[i].buf) DASM_M_FREE(Dst, D->sections[i].buf, D->sections[i].bsize); if (D->pclabels) DASM_M_FREE(Dst, D->pclabels, D->pcsize); if (D->lglabels) DASM_M_FREE(Dst, D->lglabels, D->lgsize); DASM_M_FREE(Dst, D, D->psize); } /* Setup global label array. Must be called before dasm_setup(). */ void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl) { dasm_State *D = Dst_REF; D->globals = gl - 10; /* Negative bias to compensate for locals. */ DASM_M_GROW(Dst, int, D->lglabels, D->lgsize, (10+maxgl)*sizeof(int)); } /* Grow PC label array. Can be called after dasm_setup(), too. */ void dasm_growpc(Dst_DECL, unsigned int maxpc) { dasm_State *D = Dst_REF; size_t osz = D->pcsize; DASM_M_GROW(Dst, int, D->pclabels, D->pcsize, maxpc*sizeof(int)); memset((void *)(((unsigned char *)D->pclabels)+osz), 0, D->pcsize-osz); } /* Setup encoder. */ void dasm_setup(Dst_DECL, const void *actionlist) { dasm_State *D = Dst_REF; int i; D->actionlist = (dasm_ActList)actionlist; D->status = DASM_S_OK; D->section = &D->sections[0]; memset((void *)D->lglabels, 0, D->lgsize); if (D->pclabels) memset((void *)D->pclabels, 0, D->pcsize); for (i = 0; i < D->maxsection; i++) { D->sections[i].pos = DASM_SEC2POS(i); D->sections[i].ofs = 0; } } #ifdef DASM_CHECKS #define CK(x, st) \ do { if (!(x)) { \ D->status = DASM_S_##st|(p-D->actionlist-1); return; } } while (0) #define CKPL(kind, st) \ do { if ((size_t)((char *)pl-(char *)D->kind##labels) >= D->kind##size) { \ D->status = DASM_S_RANGE_##st|(p-D->actionlist-1); return; } } while (0) #else #define CK(x, st) ((void)0) #define CKPL(kind, st) ((void)0) #endif static int dasm_imm12(unsigned int n) { int i; for (i = 0; i < 16; i++, n = (n << 2) | (n >> 30)) if (n <= 255) return (int)(n + (i << 8)); return -1; } /* Pass 1: Store actions and args, link branches/labels, estimate offsets. */ void dasm_put(Dst_DECL, int start, ...) { va_list ap; dasm_State *D = Dst_REF; dasm_ActList p = D->actionlist + start; dasm_Section *sec = D->section; int pos = sec->pos, ofs = sec->ofs; int *b; if (pos >= sec->epos) { DASM_M_GROW(Dst, int, sec->buf, sec->bsize, sec->bsize + 2*DASM_MAXSECPOS*sizeof(int)); sec->rbuf = sec->buf - DASM_POS2BIAS(pos); sec->epos = (int)sec->bsize/sizeof(int) - DASM_MAXSECPOS+DASM_POS2BIAS(pos); } b = sec->rbuf; b[pos++] = start; va_start(ap, start); while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16); if (action >= DASM__MAX) { ofs += 4; } else { int *pl, n = action >= DASM_REL_PC ? va_arg(ap, int) : 0; switch (action) { case DASM_STOP: goto stop; case DASM_SECTION: n = (ins & 255); CK(n < D->maxsection, RANGE_SEC); D->section = &D->sections[n]; goto stop; case DASM_ESC: p++; ofs += 4; break; case DASM_REL_EXT: break; case DASM_ALIGN: ofs += (ins & 255); b[pos++] = ofs; break; case DASM_REL_LG: n = (ins & 2047) - 10; pl = D->lglabels + n; /* Bkwd rel or global. */ if (n >= 0) { CK(n>=10||*pl<0, RANGE_LG); CKPL(lg, LG); goto putrel; } pl += 10; n = *pl; if (n < 0) n = 0; /* Start new chain for fwd rel if label exists. */ goto linkrel; case DASM_REL_PC: pl = D->pclabels + n; CKPL(pc, PC); putrel: n = *pl; if (n < 0) { /* Label exists. Get label pos and store it. */ b[pos] = -n; } else { linkrel: b[pos] = n; /* Else link to rel chain, anchored at label. */ *pl = pos; } pos++; break; case DASM_LABEL_LG: pl = D->lglabels + (ins & 2047) - 10; CKPL(lg, LG); goto putlabel; case DASM_LABEL_PC: pl = D->pclabels + n; CKPL(pc, PC); putlabel: n = *pl; /* n > 0: Collapse rel chain and replace with label pos. */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = pos; } *pl = -pos; /* Label exists now. */ b[pos++] = ofs; /* Store pass1 offset estimate. */ break; case DASM_IMM: case DASM_IMM16: #ifdef DASM_CHECKS CK((n & ((1<<((ins>>10)&31))-1)) == 0, RANGE_I); if ((ins & 0x8000)) CK(((n + (1<<(((ins>>5)&31)-1)))>>((ins>>5)&31)) == 0, RANGE_I); else CK((n>>((ins>>5)&31)) == 0, RANGE_I); #endif b[pos++] = n; break; case DASM_IMMV8: CK((n & 3) == 0, RANGE_I); n >>= 2; case DASM_IMML8: case DASM_IMML12: CK(n >= 0 ? ((n>>((ins>>5)&31)) == 0) : (((-n)>>((ins>>5)&31)) == 0), RANGE_I); b[pos++] = n; break; case DASM_IMM12: CK(dasm_imm12((unsigned int)n) != -1, RANGE_I); b[pos++] = n; break; } } } stop: va_end(ap); sec->pos = pos; sec->ofs = ofs; } #undef CK /* Pass 2: Link sections, shrink aligns, fix label offsets. */ int dasm_link(Dst_DECL, size_t *szp) { dasm_State *D = Dst_REF; int secnum; int ofs = 0; #ifdef DASM_CHECKS *szp = 0; if (D->status != DASM_S_OK) return D->status; { int pc; for (pc = 0; pc*sizeof(int) < D->pcsize; pc++) if (D->pclabels[pc] > 0) return DASM_S_UNDEF_PC|pc; } #endif { /* Handle globals not defined in this translation unit. */ int idx; for (idx = 20; idx*sizeof(int) < D->lgsize; idx++) { int n = D->lglabels[idx]; /* Undefined label: Collapse rel chain and replace with marker (< 0). */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = -idx; } } } /* Combine all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->rbuf; int pos = DASM_SEC2POS(secnum); int lastpos = sec->pos; while (pos != lastpos) { dasm_ActList p = D->actionlist + b[pos++]; while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16); switch (action) { case DASM_STOP: case DASM_SECTION: goto stop; case DASM_ESC: p++; break; case DASM_REL_EXT: break; case DASM_ALIGN: ofs -= (b[pos++] + ofs) & (ins & 255); break; case DASM_REL_LG: case DASM_REL_PC: pos++; break; case DASM_LABEL_LG: case DASM_LABEL_PC: b[pos++] += ofs; break; case DASM_IMM: case DASM_IMM12: case DASM_IMM16: case DASM_IMML8: case DASM_IMML12: case DASM_IMMV8: pos++; break; } } stop: (void)0; } ofs += sec->ofs; /* Next section starts right after current section. */ } D->codesize = ofs; /* Total size of all code sections */ *szp = ofs; return DASM_S_OK; } #ifdef DASM_CHECKS #define CK(x, st) \ do { if (!(x)) return DASM_S_##st|(p-D->actionlist-1); } while (0) #else #define CK(x, st) ((void)0) #endif /* Pass 3: Encode sections. */ int dasm_encode(Dst_DECL, void *buffer) { dasm_State *D = Dst_REF; char *base = (char *)buffer; unsigned int *cp = (unsigned int *)buffer; int secnum; /* Encode all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->buf; int *endb = sec->rbuf + sec->pos; while (b != endb) { dasm_ActList p = D->actionlist + *b++; while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16); int n = (action >= DASM_ALIGN && action < DASM__MAX) ? *b++ : 0; switch (action) { case DASM_STOP: case DASM_SECTION: goto stop; case DASM_ESC: *cp++ = *p++; break; case DASM_REL_EXT: n = DASM_EXTERN(Dst, (unsigned char *)cp, (ins&2047), !(ins&2048)); goto patchrel; case DASM_ALIGN: ins &= 255; while ((((char *)cp - base) & ins)) *cp++ = 0xe1a00000; break; case DASM_REL_LG: CK(n >= 0, UNDEF_LG); case DASM_REL_PC: CK(n >= 0, UNDEF_PC); n = *DASM_POS2PTR(D, n) - (int)((char *)cp - base) - 4; patchrel: if ((ins & 0x800) == 0) { CK((n & 3) == 0 && ((n+0x02000000) >> 26) == 0, RANGE_REL); cp[-1] |= ((n >> 2) & 0x00ffffff); } else if ((ins & 0x1000)) { CK((n & 3) == 0 && -256 <= n && n <= 256, RANGE_REL); goto patchimml8; } else if ((ins & 0x2000) == 0) { CK((n & 3) == 0 && -4096 <= n && n <= 4096, RANGE_REL); goto patchimml; } else { CK((n & 3) == 0 && -1020 <= n && n <= 1020, RANGE_REL); n >>= 2; goto patchimml; } break; case DASM_LABEL_LG: ins &= 2047; if (ins >= 20) D->globals[ins-10] = (void *)(base + n); break; case DASM_LABEL_PC: break; case DASM_IMM: cp[-1] |= ((n>>((ins>>10)&31)) & ((1<<((ins>>5)&31))-1)) << (ins&31); break; case DASM_IMM12: cp[-1] |= dasm_imm12((unsigned int)n); break; case DASM_IMM16: cp[-1] |= ((n & 0xf000) << 4) | (n & 0x0fff); break; case DASM_IMML8: patchimml8: cp[-1] |= n >= 0 ? (0x00800000 | (n & 0x0f) | ((n & 0xf0) << 4)) : ((-n & 0x0f) | ((-n & 0xf0) << 4)); break; case DASM_IMML12: case DASM_IMMV8: patchimml: cp[-1] |= n >= 0 ? (0x00800000 | n) : (-n); break; default: *cp++ = ins; break; } } stop: (void)0; } } if (base + D->codesize != (char *)cp) /* Check for phase errors. */ return DASM_S_PHASE; return DASM_S_OK; } #undef CK /* Get PC label offset. */ int dasm_getpclabel(Dst_DECL, unsigned int pc) { dasm_State *D = Dst_REF; if (pc*sizeof(int) < D->pcsize) { int pos = D->pclabels[pc]; if (pos < 0) return *DASM_POS2PTR(D, -pos); if (pos > 0) return -1; /* Undefined. */ } return -2; /* Unused or out of range. */ } #ifdef DASM_CHECKS /* Optional sanity checker to call between isolated encoding steps. */ int dasm_checkstep(Dst_DECL, int secmatch) { dasm_State *D = Dst_REF; if (D->status == DASM_S_OK) { int i; for (i = 1; i <= 9; i++) { if (D->lglabels[i] > 0) { D->status = DASM_S_UNDEF_LG|i; break; } D->lglabels[i] = 0; } } if (D->status == DASM_S_OK && secmatch >= 0 && D->section != &D->sections[secmatch]) D->status = DASM_S_MATCH_SEC|(D->section-D->sections); return D->status; } #endif wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_mips.h0000644000175000017500000002765013122010155017534 0ustar philphil/* ** DynASM MIPS encoding engine. ** Copyright (C) 2005-2016 Mike Pall. All rights reserved. ** Released under the MIT license. See dynasm.lua for full copyright notice. */ #include #include #include #include #define DASM_ARCH "mips" #ifndef DASM_EXTERN #define DASM_EXTERN(a,b,c,d) 0 #endif /* Action definitions. */ enum { DASM_STOP, DASM_SECTION, DASM_ESC, DASM_REL_EXT, /* The following actions need a buffer position. */ DASM_ALIGN, DASM_REL_LG, DASM_LABEL_LG, /* The following actions also have an argument. */ DASM_REL_PC, DASM_LABEL_PC, DASM_IMM, DASM__MAX }; /* Maximum number of section buffer positions for a single dasm_put() call. */ #define DASM_MAXSECPOS 25 /* DynASM encoder status codes. Action list offset or number are or'ed in. */ #define DASM_S_OK 0x00000000 #define DASM_S_NOMEM 0x01000000 #define DASM_S_PHASE 0x02000000 #define DASM_S_MATCH_SEC 0x03000000 #define DASM_S_RANGE_I 0x11000000 #define DASM_S_RANGE_SEC 0x12000000 #define DASM_S_RANGE_LG 0x13000000 #define DASM_S_RANGE_PC 0x14000000 #define DASM_S_RANGE_REL 0x15000000 #define DASM_S_UNDEF_LG 0x21000000 #define DASM_S_UNDEF_PC 0x22000000 /* Macros to convert positions (8 bit section + 24 bit index). */ #define DASM_POS2IDX(pos) ((pos)&0x00ffffff) #define DASM_POS2BIAS(pos) ((pos)&0xff000000) #define DASM_SEC2POS(sec) ((sec)<<24) #define DASM_POS2SEC(pos) ((pos)>>24) #define DASM_POS2PTR(D, pos) (D->sections[DASM_POS2SEC(pos)].rbuf + (pos)) /* Action list type. */ typedef const unsigned int *dasm_ActList; /* Per-section structure. */ typedef struct dasm_Section { int *rbuf; /* Biased buffer pointer (negative section bias). */ int *buf; /* True buffer pointer. */ size_t bsize; /* Buffer size in bytes. */ int pos; /* Biased buffer position. */ int epos; /* End of biased buffer position - max single put. */ int ofs; /* Byte offset into section. */ } dasm_Section; /* Core structure holding the DynASM encoding state. */ struct dasm_State { size_t psize; /* Allocated size of this structure. */ dasm_ActList actionlist; /* Current actionlist pointer. */ int *lglabels; /* Local/global chain/pos ptrs. */ size_t lgsize; int *pclabels; /* PC label chains/pos ptrs. */ size_t pcsize; void **globals; /* Array of globals (bias -10). */ dasm_Section *section; /* Pointer to active section. */ size_t codesize; /* Total size of all code sections. */ int maxsection; /* 0 <= sectionidx < maxsection. */ int status; /* Status code. */ dasm_Section sections[1]; /* All sections. Alloc-extended. */ }; /* The size of the core structure depends on the max. number of sections. */ #define DASM_PSZ(ms) (sizeof(dasm_State)+(ms-1)*sizeof(dasm_Section)) /* Initialize DynASM state. */ void dasm_init(Dst_DECL, int maxsection) { dasm_State *D; size_t psz = 0; int i; Dst_REF = NULL; DASM_M_GROW(Dst, struct dasm_State, Dst_REF, psz, DASM_PSZ(maxsection)); D = Dst_REF; D->psize = psz; D->lglabels = NULL; D->lgsize = 0; D->pclabels = NULL; D->pcsize = 0; D->globals = NULL; D->maxsection = maxsection; for (i = 0; i < maxsection; i++) { D->sections[i].buf = NULL; /* Need this for pass3. */ D->sections[i].rbuf = D->sections[i].buf - DASM_SEC2POS(i); D->sections[i].bsize = 0; D->sections[i].epos = 0; /* Wrong, but is recalculated after resize. */ } } /* Free DynASM state. */ void dasm_free(Dst_DECL) { dasm_State *D = Dst_REF; int i; for (i = 0; i < D->maxsection; i++) if (D->sections[i].buf) DASM_M_FREE(Dst, D->sections[i].buf, D->sections[i].bsize); if (D->pclabels) DASM_M_FREE(Dst, D->pclabels, D->pcsize); if (D->lglabels) DASM_M_FREE(Dst, D->lglabels, D->lgsize); DASM_M_FREE(Dst, D, D->psize); } /* Setup global label array. Must be called before dasm_setup(). */ void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl) { dasm_State *D = Dst_REF; D->globals = gl - 10; /* Negative bias to compensate for locals. */ DASM_M_GROW(Dst, int, D->lglabels, D->lgsize, (10+maxgl)*sizeof(int)); } /* Grow PC label array. Can be called after dasm_setup(), too. */ void dasm_growpc(Dst_DECL, unsigned int maxpc) { dasm_State *D = Dst_REF; size_t osz = D->pcsize; DASM_M_GROW(Dst, int, D->pclabels, D->pcsize, maxpc*sizeof(int)); memset((void *)(((unsigned char *)D->pclabels)+osz), 0, D->pcsize-osz); } /* Setup encoder. */ void dasm_setup(Dst_DECL, const void *actionlist) { dasm_State *D = Dst_REF; int i; D->actionlist = (dasm_ActList)actionlist; D->status = DASM_S_OK; D->section = &D->sections[0]; memset((void *)D->lglabels, 0, D->lgsize); if (D->pclabels) memset((void *)D->pclabels, 0, D->pcsize); for (i = 0; i < D->maxsection; i++) { D->sections[i].pos = DASM_SEC2POS(i); D->sections[i].ofs = 0; } } #ifdef DASM_CHECKS #define CK(x, st) \ do { if (!(x)) { \ D->status = DASM_S_##st|(p-D->actionlist-1); return; } } while (0) #define CKPL(kind, st) \ do { if ((size_t)((char *)pl-(char *)D->kind##labels) >= D->kind##size) { \ D->status = DASM_S_RANGE_##st|(p-D->actionlist-1); return; } } while (0) #else #define CK(x, st) ((void)0) #define CKPL(kind, st) ((void)0) #endif /* Pass 1: Store actions and args, link branches/labels, estimate offsets. */ void dasm_put(Dst_DECL, int start, ...) { va_list ap; dasm_State *D = Dst_REF; dasm_ActList p = D->actionlist + start; dasm_Section *sec = D->section; int pos = sec->pos, ofs = sec->ofs; int *b; if (pos >= sec->epos) { DASM_M_GROW(Dst, int, sec->buf, sec->bsize, sec->bsize + 2*DASM_MAXSECPOS*sizeof(int)); sec->rbuf = sec->buf - DASM_POS2BIAS(pos); sec->epos = (int)sec->bsize/sizeof(int) - DASM_MAXSECPOS+DASM_POS2BIAS(pos); } b = sec->rbuf; b[pos++] = start; va_start(ap, start); while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16) - 0xff00; if (action >= DASM__MAX) { ofs += 4; } else { int *pl, n = action >= DASM_REL_PC ? va_arg(ap, int) : 0; switch (action) { case DASM_STOP: goto stop; case DASM_SECTION: n = (ins & 255); CK(n < D->maxsection, RANGE_SEC); D->section = &D->sections[n]; goto stop; case DASM_ESC: p++; ofs += 4; break; case DASM_REL_EXT: break; case DASM_ALIGN: ofs += (ins & 255); b[pos++] = ofs; break; case DASM_REL_LG: n = (ins & 2047) - 10; pl = D->lglabels + n; /* Bkwd rel or global. */ if (n >= 0) { CK(n>=10||*pl<0, RANGE_LG); CKPL(lg, LG); goto putrel; } pl += 10; n = *pl; if (n < 0) n = 0; /* Start new chain for fwd rel if label exists. */ goto linkrel; case DASM_REL_PC: pl = D->pclabels + n; CKPL(pc, PC); putrel: n = *pl; if (n < 0) { /* Label exists. Get label pos and store it. */ b[pos] = -n; } else { linkrel: b[pos] = n; /* Else link to rel chain, anchored at label. */ *pl = pos; } pos++; break; case DASM_LABEL_LG: pl = D->lglabels + (ins & 2047) - 10; CKPL(lg, LG); goto putlabel; case DASM_LABEL_PC: pl = D->pclabels + n; CKPL(pc, PC); putlabel: n = *pl; /* n > 0: Collapse rel chain and replace with label pos. */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = pos; } *pl = -pos; /* Label exists now. */ b[pos++] = ofs; /* Store pass1 offset estimate. */ break; case DASM_IMM: #ifdef DASM_CHECKS CK((n & ((1<<((ins>>10)&31))-1)) == 0, RANGE_I); #endif n >>= ((ins>>10)&31); #ifdef DASM_CHECKS if (ins & 0x8000) CK(((n + (1<<(((ins>>5)&31)-1)))>>((ins>>5)&31)) == 0, RANGE_I); else CK((n>>((ins>>5)&31)) == 0, RANGE_I); #endif b[pos++] = n; break; } } } stop: va_end(ap); sec->pos = pos; sec->ofs = ofs; } #undef CK /* Pass 2: Link sections, shrink aligns, fix label offsets. */ int dasm_link(Dst_DECL, size_t *szp) { dasm_State *D = Dst_REF; int secnum; int ofs = 0; #ifdef DASM_CHECKS *szp = 0; if (D->status != DASM_S_OK) return D->status; { int pc; for (pc = 0; pc*sizeof(int) < D->pcsize; pc++) if (D->pclabels[pc] > 0) return DASM_S_UNDEF_PC|pc; } #endif { /* Handle globals not defined in this translation unit. */ int idx; for (idx = 20; idx*sizeof(int) < D->lgsize; idx++) { int n = D->lglabels[idx]; /* Undefined label: Collapse rel chain and replace with marker (< 0). */ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = -idx; } } } /* Combine all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->rbuf; int pos = DASM_SEC2POS(secnum); int lastpos = sec->pos; while (pos != lastpos) { dasm_ActList p = D->actionlist + b[pos++]; while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16) - 0xff00; switch (action) { case DASM_STOP: case DASM_SECTION: goto stop; case DASM_ESC: p++; break; case DASM_REL_EXT: break; case DASM_ALIGN: ofs -= (b[pos++] + ofs) & (ins & 255); break; case DASM_REL_LG: case DASM_REL_PC: pos++; break; case DASM_LABEL_LG: case DASM_LABEL_PC: b[pos++] += ofs; break; case DASM_IMM: pos++; break; } } stop: (void)0; } ofs += sec->ofs; /* Next section starts right after current section. */ } D->codesize = ofs; /* Total size of all code sections */ *szp = ofs; return DASM_S_OK; } #ifdef DASM_CHECKS #define CK(x, st) \ do { if (!(x)) return DASM_S_##st|(p-D->actionlist-1); } while (0) #else #define CK(x, st) ((void)0) #endif /* Pass 3: Encode sections. */ int dasm_encode(Dst_DECL, void *buffer) { dasm_State *D = Dst_REF; char *base = (char *)buffer; unsigned int *cp = (unsigned int *)buffer; int secnum; /* Encode all code sections. No support for data sections (yet). */ for (secnum = 0; secnum < D->maxsection; secnum++) { dasm_Section *sec = D->sections + secnum; int *b = sec->buf; int *endb = sec->rbuf + sec->pos; while (b != endb) { dasm_ActList p = D->actionlist + *b++; while (1) { unsigned int ins = *p++; unsigned int action = (ins >> 16) - 0xff00; int n = (action >= DASM_ALIGN && action < DASM__MAX) ? *b++ : 0; switch (action) { case DASM_STOP: case DASM_SECTION: goto stop; case DASM_ESC: *cp++ = *p++; break; case DASM_REL_EXT: n = DASM_EXTERN(Dst, (unsigned char *)cp, (ins & 2047), 1); goto patchrel; case DASM_ALIGN: ins &= 255; while ((((char *)cp - base) & ins)) *cp++ = 0x60000000; break; case DASM_REL_LG: CK(n >= 0, UNDEF_LG); case DASM_REL_PC: CK(n >= 0, UNDEF_PC); n = *DASM_POS2PTR(D, n); if (ins & 2048) n = n - (int)((char *)cp - base); else n = (n + (int)base) & 0x0fffffff; patchrel: CK((n & 3) == 0 && ((n + ((ins & 2048) ? 0x00020000 : 0)) >> ((ins & 2048) ? 18 : 28)) == 0, RANGE_REL); cp[-1] |= ((n>>2) & ((ins & 2048) ? 0x0000ffff: 0x03ffffff)); break; case DASM_LABEL_LG: ins &= 2047; if (ins >= 20) D->globals[ins-10] = (void *)(base + n); break; case DASM_LABEL_PC: break; case DASM_IMM: cp[-1] |= (n & ((1<<((ins>>5)&31))-1)) << (ins&31); break; default: *cp++ = ins; break; } } stop: (void)0; } } if (base + D->codesize != (char *)cp) /* Check for phase errors. */ return DASM_S_PHASE; return DASM_S_OK; } #undef CK /* Get PC label offset. */ int dasm_getpclabel(Dst_DECL, unsigned int pc) { dasm_State *D = Dst_REF; if (pc*sizeof(int) < D->pcsize) { int pos = D->pclabels[pc]; if (pos < 0) return *DASM_POS2PTR(D, -pos); if (pos > 0) return -1; /* Undefined. */ } return -2; /* Unused or out of range. */ } #ifdef DASM_CHECKS /* Optional sanity checker to call between isolated encoding steps. */ int dasm_checkstep(Dst_DECL, int secmatch) { dasm_State *D = Dst_REF; if (D->status == DASM_S_OK) { int i; for (i = 1; i <= 9; i++) { if (D->lglabels[i] > 0) { D->status = DASM_S_UNDEF_LG|i; break; } D->lglabels[i] = 0; } } if (D->status == DASM_S_OK && secmatch >= 0 && D->section != &D->sections[secmatch]) D->status = DASM_S_MATCH_SEC|(D->section-D->sections); return D->status; } #endif wcc-0.0.2/src/wsh/luajit-2.0/dynasm/dasm_ppc.lua0000644000175000017500000011031013122010155017662 0ustar philphil------------------------------------------------------------------------------ -- DynASM PPC module. -- -- Copyright (C) 2005-2016 Mike Pall. All rights reserved. -- See dynasm.lua for full copyright notice. ------------------------------------------------------------------------------ -- Module information: local _info = { arch = "ppc", description = "DynASM PPC module", version = "1.3.0", vernum = 10300, release = "2011-05-05", author = "Mike Pall", license = "MIT", } -- Exported glue functions for the arch-specific module. local _M = { _info = _info } -- Cache library functions. local type, tonumber, pairs, ipairs = type, tonumber, pairs, ipairs local assert, setmetatable = assert, setmetatable local _s = string local sub, format, byte, char = _s.sub, _s.format, _s.byte, _s.char local match, gmatch = _s.match, _s.gmatch local concat, sort = table.concat, table.sort local bit = bit or require("bit") local band, shl, shr, sar = bit.band, bit.lshift, bit.rshift, bit.arshift local tohex = bit.tohex -- Inherited tables and callbacks. local g_opt, g_arch local wline, werror, wfatal, wwarn -- Action name list. -- CHECK: Keep this in sync with the C code! local action_names = { "STOP", "SECTION", "ESC", "REL_EXT", "ALIGN", "REL_LG", "LABEL_LG", "REL_PC", "LABEL_PC", "IMM", } -- Maximum number of section buffer positions for dasm_put(). -- CHECK: Keep this in sync with the C code! local maxsecpos = 25 -- Keep this low, to avoid excessively long C lines. -- Action name -> action number. local map_action = {} for n,name in ipairs(action_names) do map_action[name] = n-1 end -- Action list buffer. local actlist = {} -- Argument list for next dasm_put(). Start with offset 0 into action list. local actargs = { 0 } -- Current number of section buffer positions for dasm_put(). local secpos = 1 ------------------------------------------------------------------------------ -- Dump action names and numbers. local function dumpactions(out) out:write("DynASM encoding engine action codes:\n") for n,name in ipairs(action_names) do local num = map_action[name] out:write(format(" %-10s %02X %d\n", name, num, num)) end out:write("\n") end -- Write action list buffer as a huge static C array. local function writeactions(out, name) local nn = #actlist if nn == 0 then nn = 1; actlist[0] = map_action.STOP end out:write("static const unsigned int ", name, "[", nn, "] = {\n") for i = 1,nn-1 do assert(out:write("0x", tohex(actlist[i]), ",\n")) end assert(out:write("0x", tohex(actlist[nn]), "\n};\n\n")) end ------------------------------------------------------------------------------ -- Add word to action list. local function wputxw(n) assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range") actlist[#actlist+1] = n end -- Add action to list with optional arg. Advance buffer pos, too. local function waction(action, val, a, num) local w = assert(map_action[action], "bad action name `"..action.."'") wputxw(w * 0x10000 + (val or 0)) if a then actargs[#actargs+1] = a end if a or num then secpos = secpos + (num or 1) end end -- Flush action list (intervening C code or buffer pos overflow). local function wflush(term) if #actlist == actargs[1] then return end -- Nothing to flush. if not term then waction("STOP") end -- Terminate action list. wline(format("dasm_put(Dst, %s);", concat(actargs, ", ")), true) actargs = { #actlist } -- Actionlist offset is 1st arg to next dasm_put(). secpos = 1 -- The actionlist offset occupies a buffer position, too. end -- Put escaped word. local function wputw(n) if n <= 0xffffff then waction("ESC") end wputxw(n) end -- Reserve position for word. local function wpos() local pos = #actlist+1 actlist[pos] = "" return pos end -- Store word to reserved position. local function wputpos(pos, n) assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range") actlist[pos] = n end ------------------------------------------------------------------------------ -- Global label name -> global label number. With auto assignment on 1st use. local next_global = 20 local map_global = setmetatable({}, { __index = function(t, name) if not match(name, "^[%a_][%w_]*$") then werror("bad global label") end local n = next_global if n > 2047 then werror("too many global labels") end next_global = n + 1 t[name] = n return n end}) -- Dump global labels. local function dumpglobals(out, lvl) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("Global labels:\n") for i=20,next_global-1 do out:write(format(" %s\n", t[i])) end out:write("\n") end -- Write global label enum. local function writeglobals(out, prefix) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("enum {\n") for i=20,next_global-1 do out:write(" ", prefix, t[i], ",\n") end out:write(" ", prefix, "_MAX\n};\n") end -- Write global label names. local function writeglobalnames(out, name) local t = {} for name, n in pairs(map_global) do t[n] = name end out:write("static const char *const ", name, "[] = {\n") for i=20,next_global-1 do out:write(" \"", t[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Extern label name -> extern label number. With auto assignment on 1st use. local next_extern = 0 local map_extern_ = {} local map_extern = setmetatable({}, { __index = function(t, name) -- No restrictions on the name for now. local n = next_extern if n > 2047 then werror("too many extern labels") end next_extern = n + 1 t[name] = n map_extern_[n] = name return n end}) -- Dump extern labels. local function dumpexterns(out, lvl) out:write("Extern labels:\n") for i=0,next_extern-1 do out:write(format(" %s\n", map_extern_[i])) end out:write("\n") end -- Write extern label names. local function writeexternnames(out, name) out:write("static const char *const ", name, "[] = {\n") for i=0,next_extern-1 do out:write(" \"", map_extern_[i], "\",\n") end out:write(" (const char *)0\n};\n") end ------------------------------------------------------------------------------ -- Arch-specific maps. local map_archdef = { sp = "r1" } -- Ext. register name -> int. name. local map_type = {} -- Type name -> { ctype, reg } local ctypenum = 0 -- Type number (for Dt... macros). -- Reverse defines for registers. function _M.revdef(s) if s == "r1" then return "sp" end return s end local map_cond = { lt = 0, gt = 1, eq = 2, so = 3, ge = 4, le = 5, ne = 6, ns = 7, } ------------------------------------------------------------------------------ -- Template strings for PPC instructions. local map_op = { tdi_3 = "08000000ARI", twi_3 = "0c000000ARI", mulli_3 = "1c000000RRI", subfic_3 = "20000000RRI", cmplwi_3 = "28000000XRU", cmplwi_2 = "28000000-RU", cmpldi_3 = "28200000XRU", cmpldi_2 = "28200000-RU", cmpwi_3 = "2c000000XRI", cmpwi_2 = "2c000000-RI", cmpdi_3 = "2c200000XRI", cmpdi_2 = "2c200000-RI", addic_3 = "30000000RRI", ["addic._3"] = "34000000RRI", addi_3 = "38000000RR0I", li_2 = "38000000RI", la_2 = "38000000RD", addis_3 = "3c000000RR0I", lis_2 = "3c000000RI", lus_2 = "3c000000RU", bc_3 = "40000000AAK", bcl_3 = "40000001AAK", bdnz_1 = "42000000K", bdz_1 = "42400000K", sc_0 = "44000000", b_1 = "48000000J", bl_1 = "48000001J", rlwimi_5 = "50000000RR~AAA.", rlwinm_5 = "54000000RR~AAA.", rlwnm_5 = "5c000000RR~RAA.", ori_3 = "60000000RR~U", nop_0 = "60000000", oris_3 = "64000000RR~U", xori_3 = "68000000RR~U", xoris_3 = "6c000000RR~U", ["andi._3"] = "70000000RR~U", ["andis._3"] = "74000000RR~U", lwz_2 = "80000000RD", lwzu_2 = "84000000RD", lbz_2 = "88000000RD", lbzu_2 = "8c000000RD", stw_2 = "90000000RD", stwu_2 = "94000000RD", stb_2 = "98000000RD", stbu_2 = "9c000000RD", lhz_2 = "a0000000RD", lhzu_2 = "a4000000RD", lha_2 = "a8000000RD", lhau_2 = "ac000000RD", sth_2 = "b0000000RD", sthu_2 = "b4000000RD", lmw_2 = "b8000000RD", stmw_2 = "bc000000RD", lfs_2 = "c0000000FD", lfsu_2 = "c4000000FD", lfd_2 = "c8000000FD", lfdu_2 = "cc000000FD", stfs_2 = "d0000000FD", stfsu_2 = "d4000000FD", stfd_2 = "d8000000FD", stfdu_2 = "dc000000FD", ld_2 = "e8000000RD", -- NYI: displacement must be divisible by 4. ldu_2 = "e8000001RD", lwa_2 = "e8000002RD", std_2 = "f8000000RD", stdu_2 = "f8000001RD", -- Primary opcode 19: mcrf_2 = "4c000000XX", isync_0 = "4c00012c", crnor_3 = "4c000042CCC", crnot_2 = "4c000042CC=", crandc_3 = "4c000102CCC", crxor_3 = "4c000182CCC", crclr_1 = "4c000182C==", crnand_3 = "4c0001c2CCC", crand_3 = "4c000202CCC", creqv_3 = "4c000242CCC", crset_1 = "4c000242C==", crorc_3 = "4c000342CCC", cror_3 = "4c000382CCC", crmove_2 = "4c000382CC=", bclr_2 = "4c000020AA", bclrl_2 = "4c000021AA", bcctr_2 = "4c000420AA", bcctrl_2 = "4c000421AA", blr_0 = "4e800020", blrl_0 = "4e800021", bctr_0 = "4e800420", bctrl_0 = "4e800421", -- Primary opcode 31: cmpw_3 = "7c000000XRR", cmpw_2 = "7c000000-RR", cmpd_3 = "7c200000XRR", cmpd_2 = "7c200000-RR", tw_3 = "7c000008ARR", subfc_3 = "7c000010RRR.", subc_3 = "7c000010RRR~.", mulhdu_3 = "7c000012RRR.", addc_3 = "7c000014RRR.", mulhwu_3 = "7c000016RRR.", isel_4 = "7c00001eRRRC", isellt_3 = "7c00001eRRR", iselgt_3 = "7c00005eRRR", iseleq_3 = "7c00009eRRR", mfcr_1 = "7c000026R", mfocrf_2 = "7c100026RG", mtcrf_2 = "7c000120GR", mtocrf_2 = "7c100120GR", lwarx_3 = "7c000028RR0R", ldx_3 = "7c00002aRR0R", lwzx_3 = "7c00002eRR0R", slw_3 = "7c000030RR~R.", cntlzw_2 = "7c000034RR~", sld_3 = "7c000036RR~R.", and_3 = "7c000038RR~R.", cmplw_3 = "7c000040XRR", cmplw_2 = "7c000040-RR", cmpld_3 = "7c200040XRR", cmpld_2 = "7c200040-RR", subf_3 = "7c000050RRR.", sub_3 = "7c000050RRR~.", ldux_3 = "7c00006aRR0R", dcbst_2 = "7c00006c-RR", lwzux_3 = "7c00006eRR0R", cntlzd_2 = "7c000074RR~", andc_3 = "7c000078RR~R.", td_3 = "7c000088ARR", mulhd_3 = "7c000092RRR.", mulhw_3 = "7c000096RRR.", ldarx_3 = "7c0000a8RR0R", dcbf_2 = "7c0000ac-RR", lbzx_3 = "7c0000aeRR0R", neg_2 = "7c0000d0RR.", lbzux_3 = "7c0000eeRR0R", popcntb_2 = "7c0000f4RR~", not_2 = "7c0000f8RR~%.", nor_3 = "7c0000f8RR~R.", subfe_3 = "7c000110RRR.", sube_3 = "7c000110RRR~.", adde_3 = "7c000114RRR.", stdx_3 = "7c00012aRR0R", stwcx_3 = "7c00012cRR0R.", stwx_3 = "7c00012eRR0R", prtyw_2 = "7c000134RR~", stdux_3 = "7c00016aRR0R", stwux_3 = "7c00016eRR0R", prtyd_2 = "7c000174RR~", subfze_2 = "7c000190RR.", addze_2 = "7c000194RR.", stdcx_3 = "7c0001acRR0R.", stbx_3 = "7c0001aeRR0R", subfme_2 = "7c0001d0RR.", mulld_3 = "7c0001d2RRR.", addme_2 = "7c0001d4RR.", mullw_3 = "7c0001d6RRR.", dcbtst_2 = "7c0001ec-RR", stbux_3 = "7c0001eeRR0R", add_3 = "7c000214RRR.", dcbt_2 = "7c00022c-RR", lhzx_3 = "7c00022eRR0R", eqv_3 = "7c000238RR~R.", eciwx_3 = "7c00026cRR0R", lhzux_3 = "7c00026eRR0R", xor_3 = "7c000278RR~R.", mfspefscr_1 = "7c0082a6R", mfxer_1 = "7c0102a6R", mflr_1 = "7c0802a6R", mfctr_1 = "7c0902a6R", lwax_3 = "7c0002aaRR0R", lhax_3 = "7c0002aeRR0R", mftb_1 = "7c0c42e6R", mftbu_1 = "7c0d42e6R", lwaux_3 = "7c0002eaRR0R", lhaux_3 = "7c0002eeRR0R", sthx_3 = "7c00032eRR0R", orc_3 = "7c000338RR~R.", ecowx_3 = "7c00036cRR0R", sthux_3 = "7c00036eRR0R", or_3 = "7c000378RR~R.", mr_2 = "7c000378RR~%.", divdu_3 = "7c000392RRR.", divwu_3 = "7c000396RRR.", mtspefscr_1 = "7c0083a6R", mtxer_1 = "7c0103a6R", mtlr_1 = "7c0803a6R", mtctr_1 = "7c0903a6R", dcbi_2 = "7c0003ac-RR", nand_3 = "7c0003b8RR~R.", divd_3 = "7c0003d2RRR.", divw_3 = "7c0003d6RRR.", cmpb_3 = "7c0003f8RR~R.", mcrxr_1 = "7c000400X", subfco_3 = "7c000410RRR.", subco_3 = "7c000410RRR~.", addco_3 = "7c000414RRR.", ldbrx_3 = "7c000428RR0R", lswx_3 = "7c00042aRR0R", lwbrx_3 = "7c00042cRR0R", lfsx_3 = "7c00042eFR0R", srw_3 = "7c000430RR~R.", srd_3 = "7c000436RR~R.", subfo_3 = "7c000450RRR.", subo_3 = "7c000450RRR~.", lfsux_3 = "7c00046eFR0R", lswi_3 = "7c0004aaRR0A", sync_0 = "7c0004ac", lwsync_0 = "7c2004ac", ptesync_0 = "7c4004ac", lfdx_3 = "7c0004aeFR0R", nego_2 = "7c0004d0RR.", lfdux_3 = "7c0004eeFR0R", subfeo_3 = "7c000510RRR.", subeo_3 = "7c000510RRR~.", addeo_3 = "7c000514RRR.", stdbrx_3 = "7c000528RR0R", stswx_3 = "7c00052aRR0R", stwbrx_3 = "7c00052cRR0R", stfsx_3 = "7c00052eFR0R", stfsux_3 = "7c00056eFR0R", subfzeo_2 = "7c000590RR.", addzeo_2 = "7c000594RR.", stswi_3 = "7c0005aaRR0A", stfdx_3 = "7c0005aeFR0R", subfmeo_2 = "7c0005d0RR.", mulldo_3 = "7c0005d2RRR.", addmeo_2 = "7c0005d4RR.", mullwo_3 = "7c0005d6RRR.", dcba_2 = "7c0005ec-RR", stfdux_3 = "7c0005eeFR0R", addo_3 = "7c000614RRR.", lhbrx_3 = "7c00062cRR0R", sraw_3 = "7c000630RR~R.", srad_3 = "7c000634RR~R.", srawi_3 = "7c000670RR~A.", sradi_3 = "7c000674RR~H.", eieio_0 = "7c0006ac", lfiwax_3 = "7c0006aeFR0R", sthbrx_3 = "7c00072cRR0R", extsh_2 = "7c000734RR~.", extsb_2 = "7c000774RR~.", divduo_3 = "7c000792RRR.", divwou_3 = "7c000796RRR.", icbi_2 = "7c0007ac-RR", stfiwx_3 = "7c0007aeFR0R", extsw_2 = "7c0007b4RR~.", divdo_3 = "7c0007d2RRR.", divwo_3 = "7c0007d6RRR.", dcbz_2 = "7c0007ec-RR", -- Primary opcode 30: rldicl_4 = "78000000RR~HM.", rldicr_4 = "78000004RR~HM.", rldic_4 = "78000008RR~HM.", rldimi_4 = "7800000cRR~HM.", rldcl_4 = "78000010RR~RM.", rldcr_4 = "78000012RR~RM.", -- Primary opcode 59: fdivs_3 = "ec000024FFF.", fsubs_3 = "ec000028FFF.", fadds_3 = "ec00002aFFF.", fsqrts_2 = "ec00002cF-F.", fres_2 = "ec000030F-F.", fmuls_3 = "ec000032FF-F.", frsqrtes_2 = "ec000034F-F.", fmsubs_4 = "ec000038FFFF~.", fmadds_4 = "ec00003aFFFF~.", fnmsubs_4 = "ec00003cFFFF~.", fnmadds_4 = "ec00003eFFFF~.", -- Primary opcode 63: fdiv_3 = "fc000024FFF.", fsub_3 = "fc000028FFF.", fadd_3 = "fc00002aFFF.", fsqrt_2 = "fc00002cF-F.", fsel_4 = "fc00002eFFFF~.", fre_2 = "fc000030F-F.", fmul_3 = "fc000032FF-F.", frsqrte_2 = "fc000034F-F.", fmsub_4 = "fc000038FFFF~.", fmadd_4 = "fc00003aFFFF~.", fnmsub_4 = "fc00003cFFFF~.", fnmadd_4 = "fc00003eFFFF~.", fcmpu_3 = "fc000000XFF", fcpsgn_3 = "fc000010FFF.", fcmpo_3 = "fc000040XFF", mtfsb1_1 = "fc00004cA", fneg_2 = "fc000050F-F.", mcrfs_2 = "fc000080XX", mtfsb0_1 = "fc00008cA", fmr_2 = "fc000090F-F.", frsp_2 = "fc000018F-F.", fctiw_2 = "fc00001cF-F.", fctiwz_2 = "fc00001eF-F.", mtfsfi_2 = "fc00010cAA", -- NYI: upshift. fnabs_2 = "fc000110F-F.", fabs_2 = "fc000210F-F.", frin_2 = "fc000310F-F.", friz_2 = "fc000350F-F.", frip_2 = "fc000390F-F.", frim_2 = "fc0003d0F-F.", mffs_1 = "fc00048eF.", -- NYI: mtfsf, mtfsb0, mtfsb1. fctid_2 = "fc00065cF-F.", fctidz_2 = "fc00065eF-F.", fcfid_2 = "fc00069cF-F.", -- Primary opcode 4, SPE APU extension: evaddw_3 = "10000200RRR", evaddiw_3 = "10000202RAR~", evsubw_3 = "10000204RRR~", evsubiw_3 = "10000206RAR~", evabs_2 = "10000208RR", evneg_2 = "10000209RR", evextsb_2 = "1000020aRR", evextsh_2 = "1000020bRR", evrndw_2 = "1000020cRR", evcntlzw_2 = "1000020dRR", evcntlsw_2 = "1000020eRR", brinc_3 = "1000020fRRR", evand_3 = "10000211RRR", evandc_3 = "10000212RRR", evxor_3 = "10000216RRR", evor_3 = "10000217RRR", evmr_2 = "10000217RR=", evnor_3 = "10000218RRR", evnot_2 = "10000218RR=", eveqv_3 = "10000219RRR", evorc_3 = "1000021bRRR", evnand_3 = "1000021eRRR", evsrwu_3 = "10000220RRR", evsrws_3 = "10000221RRR", evsrwiu_3 = "10000222RRA", evsrwis_3 = "10000223RRA", evslw_3 = "10000224RRR", evslwi_3 = "10000226RRA", evrlw_3 = "10000228RRR", evsplati_2 = "10000229RS", evrlwi_3 = "1000022aRRA", evsplatfi_2 = "1000022bRS", evmergehi_3 = "1000022cRRR", evmergelo_3 = "1000022dRRR", evcmpgtu_3 = "10000230XRR", evcmpgtu_2 = "10000230-RR", evcmpgts_3 = "10000231XRR", evcmpgts_2 = "10000231-RR", evcmpltu_3 = "10000232XRR", evcmpltu_2 = "10000232-RR", evcmplts_3 = "10000233XRR", evcmplts_2 = "10000233-RR", evcmpeq_3 = "10000234XRR", evcmpeq_2 = "10000234-RR", evsel_4 = "10000278RRRW", evsel_3 = "10000278RRR", evfsadd_3 = "10000280RRR", evfssub_3 = "10000281RRR", evfsabs_2 = "10000284RR", evfsnabs_2 = "10000285RR", evfsneg_2 = "10000286RR", evfsmul_3 = "10000288RRR", evfsdiv_3 = "10000289RRR", evfscmpgt_3 = "1000028cXRR", evfscmpgt_2 = "1000028c-RR", evfscmplt_3 = "1000028dXRR", evfscmplt_2 = "1000028d-RR", evfscmpeq_3 = "1000028eXRR", evfscmpeq_2 = "1000028e-RR", evfscfui_2 = "10000290R-R", evfscfsi_2 = "10000291R-R", evfscfuf_2 = "10000292R-R", evfscfsf_2 = "10000293R-R", evfsctui_2 = "10000294R-R", evfsctsi_2 = "10000295R-R", evfsctuf_2 = "10000296R-R", evfsctsf_2 = "10000297R-R", evfsctuiz_2 = "10000298R-R", evfsctsiz_2 = "1000029aR-R", evfststgt_3 = "1000029cXRR", evfststgt_2 = "1000029c-RR", evfststlt_3 = "1000029dXRR", evfststlt_2 = "1000029d-RR", evfststeq_3 = "1000029eXRR", evfststeq_2 = "1000029e-RR", efsadd_3 = "100002c0RRR", efssub_3 = "100002c1RRR", efsabs_2 = "100002c4RR", efsnabs_2 = "100002c5RR", efsneg_2 = "100002c6RR", efsmul_3 = "100002c8RRR", efsdiv_3 = "100002c9RRR", efscmpgt_3 = "100002ccXRR", efscmpgt_2 = "100002cc-RR", efscmplt_3 = "100002cdXRR", efscmplt_2 = "100002cd-RR", efscmpeq_3 = "100002ceXRR", efscmpeq_2 = "100002ce-RR", efscfd_2 = "100002cfR-R", efscfui_2 = "100002d0R-R", efscfsi_2 = "100002d1R-R", efscfuf_2 = "100002d2R-R", efscfsf_2 = "100002d3R-R", efsctui_2 = "100002d4R-R", efsctsi_2 = "100002d5R-R", efsctuf_2 = "100002d6R-R", efsctsf_2 = "100002d7R-R", efsctuiz_2 = "100002d8R-R", efsctsiz_2 = "100002daR-R", efststgt_3 = "100002dcXRR", efststgt_2 = "100002dc-RR", efststlt_3 = "100002ddXRR", efststlt_2 = "100002dd-RR", efststeq_3 = "100002deXRR", efststeq_2 = "100002de-RR", efdadd_3 = "100002e0RRR", efdsub_3 = "100002e1RRR", efdcfuid_2 = "100002e2R-R", efdcfsid_2 = "100002e3R-R", efdabs_2 = "100002e4RR", efdnabs_2 = "100002e5RR", efdneg_2 = "100002e6RR", efdmul_3 = "100002e8RRR", efddiv_3 = "100002e9RRR", efdctuidz_2 = "100002eaR-R", efdctsidz_2 = "100002ebR-R", efdcmpgt_3 = "100002ecXRR", efdcmpgt_2 = "100002ec-RR", efdcmplt_3 = "100002edXRR", efdcmplt_2 = "100002ed-RR", efdcmpeq_3 = "100002eeXRR", efdcmpeq_2 = "100002ee-RR", efdcfs_2 = "100002efR-R", efdcfui_2 = "100002f0R-R", efdcfsi_2 = "100002f1R-R", efdcfuf_2 = "100002f2R-R", efdcfsf_2 = "100002f3R-R", efdctui_2 = "100002f4R-R", efdctsi_2 = "100002f5R-R", efdctuf_2 = "100002f6R-R", efdctsf_2 = "100002f7R-R", efdctuiz_2 = "100002f8R-R", efdctsiz_2 = "100002faR-R", efdtstgt_3 = "100002fcXRR", efdtstgt_2 = "100002fc-RR", efdtstlt_3 = "100002fdXRR", efdtstlt_2 = "100002fd-RR", efdtsteq_3 = "100002feXRR", efdtsteq_2 = "100002fe-RR", evlddx_3 = "10000300RR0R", evldd_2 = "10000301R8", evldwx_3 = "10000302RR0R", evldw_2 = "10000303R8", evldhx_3 = "10000304RR0R", evldh_2 = "10000305R8", evlwhex_3 = "10000310RR0R", evlwhe_2 = "10000311R4", evlwhoux_3 = "10000314RR0R", evlwhou_2 = "10000315R4", evlwhosx_3 = "10000316RR0R", evlwhos_2 = "10000317R4", evstddx_3 = "10000320RR0R", evstdd_2 = "10000321R8", evstdwx_3 = "10000322RR0R", evstdw_2 = "10000323R8", evstdhx_3 = "10000324RR0R", evstdh_2 = "10000325R8", evstwhex_3 = "10000330RR0R", evstwhe_2 = "10000331R4", evstwhox_3 = "10000334RR0R", evstwho_2 = "10000335R4", evstwwex_3 = "10000338RR0R", evstwwe_2 = "10000339R4", evstwwox_3 = "1000033cRR0R", evstwwo_2 = "1000033dR4", evmhessf_3 = "10000403RRR", evmhossf_3 = "10000407RRR", evmheumi_3 = "10000408RRR", evmhesmi_3 = "10000409RRR", evmhesmf_3 = "1000040bRRR", evmhoumi_3 = "1000040cRRR", evmhosmi_3 = "1000040dRRR", evmhosmf_3 = "1000040fRRR", evmhessfa_3 = "10000423RRR", evmhossfa_3 = "10000427RRR", evmheumia_3 = "10000428RRR", evmhesmia_3 = "10000429RRR", evmhesmfa_3 = "1000042bRRR", evmhoumia_3 = "1000042cRRR", evmhosmia_3 = "1000042dRRR", evmhosmfa_3 = "1000042fRRR", evmwhssf_3 = "10000447RRR", evmwlumi_3 = "10000448RRR", evmwhumi_3 = "1000044cRRR", evmwhsmi_3 = "1000044dRRR", evmwhsmf_3 = "1000044fRRR", evmwssf_3 = "10000453RRR", evmwumi_3 = "10000458RRR", evmwsmi_3 = "10000459RRR", evmwsmf_3 = "1000045bRRR", evmwhssfa_3 = "10000467RRR", evmwlumia_3 = "10000468RRR", evmwhumia_3 = "1000046cRRR", evmwhsmia_3 = "1000046dRRR", evmwhsmfa_3 = "1000046fRRR", evmwssfa_3 = "10000473RRR", evmwumia_3 = "10000478RRR", evmwsmia_3 = "10000479RRR", evmwsmfa_3 = "1000047bRRR", evmra_2 = "100004c4RR", evdivws_3 = "100004c6RRR", evdivwu_3 = "100004c7RRR", evmwssfaa_3 = "10000553RRR", evmwumiaa_3 = "10000558RRR", evmwsmiaa_3 = "10000559RRR", evmwsmfaa_3 = "1000055bRRR", evmwssfan_3 = "100005d3RRR", evmwumian_3 = "100005d8RRR", evmwsmian_3 = "100005d9RRR", evmwsmfan_3 = "100005dbRRR", evmergehilo_3 = "1000022eRRR", evmergelohi_3 = "1000022fRRR", evlhhesplatx_3 = "10000308RR0R", evlhhesplat_2 = "10000309R2", evlhhousplatx_3 = "1000030cRR0R", evlhhousplat_2 = "1000030dR2", evlhhossplatx_3 = "1000030eRR0R", evlhhossplat_2 = "1000030fR2", evlwwsplatx_3 = "10000318RR0R", evlwwsplat_2 = "10000319R4", evlwhsplatx_3 = "1000031cRR0R", evlwhsplat_2 = "1000031dR4", evaddusiaaw_2 = "100004c0RR", evaddssiaaw_2 = "100004c1RR", evsubfusiaaw_2 = "100004c2RR", evsubfssiaaw_2 = "100004c3RR", evaddumiaaw_2 = "100004c8RR", evaddsmiaaw_2 = "100004c9RR", evsubfumiaaw_2 = "100004caRR", evsubfsmiaaw_2 = "100004cbRR", evmheusiaaw_3 = "10000500RRR", evmhessiaaw_3 = "10000501RRR", evmhessfaaw_3 = "10000503RRR", evmhousiaaw_3 = "10000504RRR", evmhossiaaw_3 = "10000505RRR", evmhossfaaw_3 = "10000507RRR", evmheumiaaw_3 = "10000508RRR", evmhesmiaaw_3 = "10000509RRR", evmhesmfaaw_3 = "1000050bRRR", evmhoumiaaw_3 = "1000050cRRR", evmhosmiaaw_3 = "1000050dRRR", evmhosmfaaw_3 = "1000050fRRR", evmhegumiaa_3 = "10000528RRR", evmhegsmiaa_3 = "10000529RRR", evmhegsmfaa_3 = "1000052bRRR", evmhogumiaa_3 = "1000052cRRR", evmhogsmiaa_3 = "1000052dRRR", evmhogsmfaa_3 = "1000052fRRR", evmwlusiaaw_3 = "10000540RRR", evmwlssiaaw_3 = "10000541RRR", evmwlumiaaw_3 = "10000548RRR", evmwlsmiaaw_3 = "10000549RRR", evmheusianw_3 = "10000580RRR", evmhessianw_3 = "10000581RRR", evmhessfanw_3 = "10000583RRR", evmhousianw_3 = "10000584RRR", evmhossianw_3 = "10000585RRR", evmhossfanw_3 = "10000587RRR", evmheumianw_3 = "10000588RRR", evmhesmianw_3 = "10000589RRR", evmhesmfanw_3 = "1000058bRRR", evmhoumianw_3 = "1000058cRRR", evmhosmianw_3 = "1000058dRRR", evmhosmfanw_3 = "1000058fRRR", evmhegumian_3 = "100005a8RRR", evmhegsmian_3 = "100005a9RRR", evmhegsmfan_3 = "100005abRRR", evmhogumian_3 = "100005acRRR", evmhogsmian_3 = "100005adRRR", evmhogsmfan_3 = "100005afRRR", evmwlusianw_3 = "100005c0RRR", evmwlssianw_3 = "100005c1RRR", evmwlumianw_3 = "100005c8RRR", evmwlsmianw_3 = "100005c9RRR", -- NYI: Book E instructions. } -- Add mnemonics for "." variants. do local t = {} for k,v in pairs(map_op) do if sub(v, -1) == "." then local v2 = sub(v, 1, 7)..char(byte(v, 8)+1)..sub(v, 9, -2) t[sub(k, 1, -3).."."..sub(k, -2)] = v2 end end for k,v in pairs(t) do map_op[k] = v end end -- Add more branch mnemonics. for cond,c in pairs(map_cond) do local b1 = "b"..cond local c1 = shl(band(c, 3), 16) + (c < 4 and 0x01000000 or 0) -- bX[l] map_op[b1.."_1"] = tohex(0x40800000 + c1).."K" map_op[b1.."y_1"] = tohex(0x40a00000 + c1).."K" map_op[b1.."l_1"] = tohex(0x40800001 + c1).."K" map_op[b1.."_2"] = tohex(0x40800000 + c1).."-XK" map_op[b1.."y_2"] = tohex(0x40a00000 + c1).."-XK" map_op[b1.."l_2"] = tohex(0x40800001 + c1).."-XK" -- bXlr[l] map_op[b1.."lr_0"] = tohex(0x4c800020 + c1) map_op[b1.."lrl_0"] = tohex(0x4c800021 + c1) map_op[b1.."ctr_0"] = tohex(0x4c800420 + c1) map_op[b1.."ctrl_0"] = tohex(0x4c800421 + c1) -- bXctr[l] map_op[b1.."lr_1"] = tohex(0x4c800020 + c1).."-X" map_op[b1.."lrl_1"] = tohex(0x4c800021 + c1).."-X" map_op[b1.."ctr_1"] = tohex(0x4c800420 + c1).."-X" map_op[b1.."ctrl_1"] = tohex(0x4c800421 + c1).."-X" end ------------------------------------------------------------------------------ local function parse_gpr(expr) local tname, ovreg = match(expr, "^([%w_]+):(r[1-3]?[0-9])$") local tp = map_type[tname or expr] if tp then local reg = ovreg or tp.reg if not reg then werror("type `"..(tname or expr).."' needs a register override") end expr = reg end local r = match(expr, "^r([1-3]?[0-9])$") if r then r = tonumber(r) if r <= 31 then return r, tp end end werror("bad register name `"..expr.."'") end local function parse_fpr(expr) local r = match(expr, "^f([1-3]?[0-9])$") if r then r = tonumber(r) if r <= 31 then return r end end werror("bad register name `"..expr.."'") end local function parse_cr(expr) local r = match(expr, "^cr([0-7])$") if r then return tonumber(r) end werror("bad condition register name `"..expr.."'") end local function parse_cond(expr) local r, cond = match(expr, "^4%*cr([0-7])%+(%w%w)$") if r then r = tonumber(r) local c = map_cond[cond] if c and c < 4 then return r*4+c end end werror("bad condition bit name `"..expr.."'") end local function parse_imm(imm, bits, shift, scale, signed) local n = tonumber(imm) if n then local m = sar(n, scale) if shl(m, scale) == n then if signed then local s = sar(m, bits-1) if s == 0 then return shl(m, shift) elseif s == -1 then return shl(m + shl(1, bits), shift) end else if sar(m, bits) == 0 then return shl(m, shift) end end end werror("out of range immediate `"..imm.."'") elseif match(imm, "^r([1-3]?[0-9])$") or match(imm, "^([%w_]+):(r[1-3]?[0-9])$") then werror("expected immediate operand, got register") else waction("IMM", (signed and 32768 or 0)+scale*1024+bits*32+shift, imm) return 0 end end local function parse_shiftmask(imm, isshift) local n = tonumber(imm) if n then if shr(n, 6) == 0 then local lsb = band(imm, 31) local msb = imm - lsb return isshift and (shl(lsb, 11)+shr(msb, 4)) or (shl(lsb, 6)+msb) end werror("out of range immediate `"..imm.."'") elseif match(imm, "^r([1-3]?[0-9])$") or match(imm, "^([%w_]+):(r[1-3]?[0-9])$") then werror("expected immediate operand, got register") else werror("NYI: parameterized 64 bit shift/mask") end end local function parse_disp(disp) local imm, reg = match(disp, "^(.*)%(([%w_:]+)%)$") if imm then local r = parse_gpr(reg) if r == 0 then werror("cannot use r0 in displacement") end return shl(r, 16) + parse_imm(imm, 16, 0, 0, true) end local reg, tailr = match(disp, "^([%w_:]+)%s*(.*)$") if reg and tailr ~= "" then local r, tp = parse_gpr(reg) if r == 0 then werror("cannot use r0 in displacement") end if tp then waction("IMM", 32768+16*32, format(tp.ctypefmt, tailr)) return shl(r, 16) end end werror("bad displacement `"..disp.."'") end local function parse_u5disp(disp, scale) local imm, reg = match(disp, "^(.*)%(([%w_:]+)%)$") if imm then local r = parse_gpr(reg) if r == 0 then werror("cannot use r0 in displacement") end return shl(r, 16) + parse_imm(imm, 5, 11, scale, false) end local reg, tailr = match(disp, "^([%w_:]+)%s*(.*)$") if reg and tailr ~= "" then local r, tp = parse_gpr(reg) if r == 0 then werror("cannot use r0 in displacement") end if tp then waction("IMM", scale*1024+5*32+11, format(tp.ctypefmt, tailr)) return shl(r, 16) end end werror("bad displacement `"..disp.."'") end local function parse_label(label, def) local prefix = sub(label, 1, 2) -- =>label (pc label reference) if prefix == "=>" then return "PC", 0, sub(label, 3) end -- ->name (global label reference) if prefix == "->" then return "LG", map_global[sub(label, 3)] end if def then -- [1-9] (local label definition) if match(label, "^[1-9]$") then return "LG", 10+tonumber(label) end else -- [<>][1-9] (local label reference) local dir, lnum = match(label, "^([<>])([1-9])$") if dir then -- Fwd: 1-9, Bkwd: 11-19. return "LG", lnum + (dir == ">" and 0 or 10) end -- extern label (extern label reference) local extname = match(label, "^extern%s+(%S+)$") if extname then return "EXT", map_extern[extname] end end werror("bad label `"..label.."'") end ------------------------------------------------------------------------------ -- Handle opcodes defined with template strings. map_op[".template__"] = function(params, template, nparams) if not params then return sub(template, 9) end local op = tonumber(sub(template, 1, 8), 16) local n, rs = 1, 26 -- Limit number of section buffer positions used by a single dasm_put(). -- A single opcode needs a maximum of 3 positions (rlwinm). if secpos+3 > maxsecpos then wflush() end local pos = wpos() -- Process each character. for p in gmatch(sub(template, 9), ".") do if p == "R" then rs = rs - 5; op = op + shl(parse_gpr(params[n]), rs); n = n + 1 elseif p == "F" then rs = rs - 5; op = op + shl(parse_fpr(params[n]), rs); n = n + 1 elseif p == "A" then rs = rs - 5; op = op + parse_imm(params[n], 5, rs, 0, false); n = n + 1 elseif p == "S" then rs = rs - 5; op = op + parse_imm(params[n], 5, rs, 0, true); n = n + 1 elseif p == "I" then op = op + parse_imm(params[n], 16, 0, 0, true); n = n + 1 elseif p == "U" then op = op + parse_imm(params[n], 16, 0, 0, false); n = n + 1 elseif p == "D" then op = op + parse_disp(params[n]); n = n + 1 elseif p == "2" then op = op + parse_u5disp(params[n], 1); n = n + 1 elseif p == "4" then op = op + parse_u5disp(params[n], 2); n = n + 1 elseif p == "8" then op = op + parse_u5disp(params[n], 3); n = n + 1 elseif p == "C" then rs = rs - 5; op = op + shl(parse_cond(params[n]), rs); n = n + 1 elseif p == "X" then rs = rs - 5; op = op + shl(parse_cr(params[n]), rs+2); n = n + 1 elseif p == "W" then op = op + parse_cr(params[n]); n = n + 1 elseif p == "G" then op = op + parse_imm(params[n], 8, 12, 0, false); n = n + 1 elseif p == "H" then op = op + parse_shiftmask(params[n], true); n = n + 1 elseif p == "M" then op = op + parse_shiftmask(params[n], false); n = n + 1 elseif p == "J" or p == "K" then local mode, n, s = parse_label(params[n], false) if p == "K" then n = n + 2048 end waction("REL_"..mode, n, s, 1) n = n + 1 elseif p == "0" then if band(shr(op, rs), 31) == 0 then werror("cannot use r0") end elseif p == "=" or p == "%" then local t = band(shr(op, p == "%" and rs+5 or rs), 31) rs = rs - 5 op = op + shl(t, rs) elseif p == "~" then local mm = shl(31, rs) local lo = band(op, mm) local hi = band(op, shl(mm, 5)) op = op - lo - hi + shl(lo, 5) + shr(hi, 5) elseif p == "-" then rs = rs - 5 elseif p == "." then -- Ignored. else assert(false) end end wputpos(pos, op) end ------------------------------------------------------------------------------ -- Pseudo-opcode to mark the position where the action list is to be emitted. map_op[".actionlist_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeactions(out, name) end) end -- Pseudo-opcode to mark the position where the global enum is to be emitted. map_op[".globals_1"] = function(params) if not params then return "prefix" end local prefix = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobals(out, prefix) end) end -- Pseudo-opcode to mark the position where the global names are to be emitted. map_op[".globalnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeglobalnames(out, name) end) end -- Pseudo-opcode to mark the position where the extern names are to be emitted. map_op[".externnames_1"] = function(params) if not params then return "cvar" end local name = params[1] -- No syntax check. You get to keep the pieces. wline(function(out) writeexternnames(out, name) end) end ------------------------------------------------------------------------------ -- Label pseudo-opcode (converted from trailing colon form). map_op[".label_1"] = function(params) if not params then return "[1-9] | ->global | =>pcexpr" end if secpos+1 > maxsecpos then wflush() end local mode, n, s = parse_label(params[1], true) if mode == "EXT" then werror("bad label definition") end waction("LABEL_"..mode, n, s, 1) end ------------------------------------------------------------------------------ -- Pseudo-opcodes for data storage. map_op[".long_*"] = function(params) if not params then return "imm..." end for _,p in ipairs(params) do local n = tonumber(p) if not n then werror("bad immediate `"..p.."'") end if n < 0 then n = n + 2^32 end wputw(n) if secpos+2 > maxsecpos then wflush() end end end -- Alignment pseudo-opcode. map_op[".align_1"] = function(params) if not params then return "numpow2" end if secpos+1 > maxsecpos then wflush() end local align = tonumber(params[1]) if align then local x = align -- Must be a power of 2 in the range (2 ... 256). for i=1,8 do x = x / 2 if x == 1 then waction("ALIGN", align-1, nil, 1) -- Action byte is 2**n-1. return end end end werror("bad alignment") end ------------------------------------------------------------------------------ -- Pseudo-opcode for (primitive) type definitions (map to C types). map_op[".type_3"] = function(params, nparams) if not params then return nparams == 2 and "name, ctype" or "name, ctype, reg" end local name, ctype, reg = params[1], params[2], params[3] if not match(name, "^[%a_][%w_]*$") then werror("bad type name `"..name.."'") end local tp = map_type[name] if tp then werror("duplicate type `"..name.."'") end -- Add #type to defines. A bit unclean to put it in map_archdef. map_archdef["#"..name] = "sizeof("..ctype..")" -- Add new type and emit shortcut define. local num = ctypenum + 1 map_type[name] = { ctype = ctype, ctypefmt = format("Dt%X(%%s)", num), reg = reg, } wline(format("#define Dt%X(_V) (int)(ptrdiff_t)&(((%s *)0)_V)", num, ctype)) ctypenum = num end map_op[".type_2"] = map_op[".type_3"] -- Dump type definitions. local function dumptypes(out, lvl) local t = {} for name in pairs(map_type) do t[#t+1] = name end sort(t) out:write("Type definitions:\n") for _,name in ipairs(t) do local tp = map_type[name] local reg = tp.reg or "" out:write(format(" %-20s %-20s %s\n", name, tp.ctype, reg)) end out:write("\n") end ------------------------------------------------------------------------------ -- Set the current section. function _M.section(num) waction("SECTION", num) wflush(true) -- SECTION is a terminal action. end ------------------------------------------------------------------------------ -- Dump architecture description. function _M.dumparch(out) out:write(format("DynASM %s version %s, released %s\n\n", _info.arch, _info.version, _info.release)) dumpactions(out) end -- Dump all user defined elements. function _M.dumpdef(out, lvl) dumptypes(out, lvl) dumpglobals(out, lvl) dumpexterns(out, lvl) end ------------------------------------------------------------------------------ -- Pass callbacks from/to the DynASM core. function _M.passcb(wl, we, wf, ww) wline, werror, wfatal, wwarn = wl, we, wf, ww return wflush end -- Setup the arch-specific module. function _M.setup(arch, opt) g_arch, g_opt = arch, opt end -- Merge the core maps and the arch-specific maps. function _M.mergemaps(map_coreop, map_def) setmetatable(map_op, { __index = map_coreop }) setmetatable(map_def, { __index = map_archdef }) return map_op, map_def end return _M ------------------------------------------------------------------------------ wcc-0.0.2/src/wsh/luajit-2.0/COPYRIGHT0000644000175000017500000000556413122010155015407 0ustar philphil=============================================================================== LuaJIT -- a Just-In-Time Compiler for Lua. http://luajit.org/ Copyright (C) 2005-2016 Mike Pall. All rights reserved. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. [ MIT license: http://www.opensource.org/licenses/mit-license.php ] =============================================================================== [ LuaJIT includes code from Lua 5.1/5.2, which has this license statement: ] Copyright (C) 1994-2012 Lua.org, PUC-Rio. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =============================================================================== [ LuaJIT includes code from dlmalloc, which has this license statement: ] This is a version (aka dlmalloc) of malloc/free/realloc written by Doug Lea and released to the public domain, as explained at http://creativecommons.org/licenses/publicdomain =============================================================================== wcc-0.0.2/src/wsh/luajit-2.0/etc/0000755000175000017500000000000013122010155014655 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/etc/luajit.10000644000175000017500000000444313122010155016234 0ustar philphil.TH luajit 1 "" "" "LuaJIT documentation" .SH NAME luajit \- Just-In-Time Compiler for the Lua Language \fB .SH SYNOPSIS .B luajit [\fIoptions\fR]... [\fIscript\fR [\fIargs\fR]...] .SH "WEB SITE" .IR http://luajit.org .SH DESCRIPTION .PP This is the command-line program to run Lua programs with \fBLuaJIT\fR. .PP \fBLuaJIT\fR is a just-in-time (JIT) compiler for the Lua language. The virtual machine (VM) is based on a fast interpreter combined with a trace compiler. It can significantly improve the performance of Lua programs. .PP \fBLuaJIT\fR is API\- and ABI-compatible with the VM of the standard Lua\ 5.1 interpreter. When embedding the VM into an application, the built library can be used as a drop-in replacement. .SH OPTIONS .TP .BI "\-e " chunk Run the given chunk of Lua code. .TP .BI "\-l " library Load the named library, just like \fBrequire("\fR\fIlibrary\fR\fB")\fR. .TP .BI "\-b " ... Save or list bytecode. Run without arguments to get help on options. .TP .BI "\-j " command Perform LuaJIT control command (optional space after \fB\-j\fR). .TP .BI "\-O" [opt] Control LuaJIT optimizations. .TP .B "\-i" Run in interactive mode. .TP .B "\-v" Show \fBLuaJIT\fR version. .TP .B "\-E" Ignore environment variables. .TP .B "\-\-" Stop processing options. .TP .B "\-" Read script from stdin instead. .PP After all options are processed, the given \fIscript\fR is run. The arguments are passed in the global \fIarg\fR table. .PP Interactive mode is only entered, if no \fIscript\fR and no \fB\-e\fR option is given. Interactive mode can be left with EOF (\fICtrl\-Z\fB). .SH EXAMPLES .TP luajit hello.lua world Prints "Hello world", assuming \fIhello.lua\fR contains: .br print("Hello", arg[1]) .TP luajit \-e "local x=0; for i=1,1e9 do x=x+i end; print(x)" Calculates the sum of the numbers from 1 to 1000000000. .br And finishes in a reasonable amount of time, too. .TP luajit \-jv \-e "for i=1,10 do for j=1,10 do for k=1,100 do end end end" Runs some nested loops and shows the resulting traces. .SH COPYRIGHT .PP \fBLuaJIT\fR is Copyright \(co 2005-2016 Mike Pall. .br \fBLuaJIT\fR is open source software, released under the MIT license. .SH SEE ALSO .PP More details in the provided HTML docs or at: .IR http://luajit.org .br More about the Lua language can be found at: .IR http://lua.org/docs.html .PP lua(1) wcc-0.0.2/src/wsh/luajit-2.0/etc/luajit.pc0000644000175000017500000000112013122010155016463 0ustar philphil# Package information for LuaJIT to be used by pkg-config. majver=2 minver=0 relver=4 version=${majver}.${minver}.${relver} abiver=5.1 prefix=/usr/local multilib=lib exec_prefix=${prefix} libdir=${exec_prefix}/${multilib} libname=luajit-${abiver} includedir=${prefix}/include/luajit-${majver}.${minver} INSTALL_LMOD=${prefix}/share/lua/${abiver} INSTALL_CMOD=${prefix}/${multilib}/lua/${abiver} Name: LuaJIT Description: Just-in-time compiler for Lua URL: http://luajit.org Version: ${version} Requires: Libs: -L${libdir} -l${libname} Libs.private: -Wl,-E -lm -ldl Cflags: -I${includedir} wcc-0.0.2/src/wsh/luajit-2.0/.gitignore0000644000175000017500000000010713122010155016070 0ustar philphil*.[oa] *.so *.obj *.lib *.exp *.dll *.exe *.manifest *.dmp *.swp .tags wcc-0.0.2/src/wsh/luajit-2.0/.git0000644000175000017500000000006113122010155014663 0ustar philphilgitdir: ../../../.git/modules/src/wsh/luajit-2.0 wcc-0.0.2/src/wsh/luajit-2.0/doc/0000755000175000017500000000000013122010155014647 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/doc/ext_c_api.html0000644000175000017500000001354713122010155017502 0ustar philphil Lua/C API Extensions

LuaJIT adds some extensions to the standard Lua/C API. The LuaJIT include directory must be in the compiler search path (-Ipath) to be able to include the required header for C code:

#include "luajit.h"

Or for C++ code:

#include "lua.hpp"

luaJIT_setmode(L, idx, mode) — Control VM

This is a C API extension to allow control of the VM from C code. The full prototype of LuaJIT_setmode is:

LUA_API int luaJIT_setmode(lua_State *L, int idx, int mode);

The returned status is either success (1) or failure (0). The second argument is either 0 or a stack index (similar to the other Lua/C API functions).

The third argument specifies the mode, which is 'or'ed with a flag. The flag can be LUAJIT_MODE_OFF to turn a feature on, LUAJIT_MODE_ON to turn a feature off, or LUAJIT_MODE_FLUSH to flush cached code.

The following modes are defined:

luaJIT_setmode(L, 0, LUAJIT_MODE_ENGINE|flag)

Turn the whole JIT compiler on or off or flush the whole cache of compiled code.

luaJIT_setmode(L, idx, LUAJIT_MODE_FUNC|flag)
luaJIT_setmode(L, idx, LUAJIT_MODE_ALLFUNC|flag)
luaJIT_setmode(L, idx, LUAJIT_MODE_ALLSUBFUNC|flag)

This sets the mode for the function at the stack index idx or the parent of the calling function (idx = 0). It either enables JIT compilation for a function, disables it and flushes any already compiled code or only flushes already compiled code. This applies recursively to all sub-functions of the function with LUAJIT_MODE_ALLFUNC or only to the sub-functions with LUAJIT_MODE_ALLSUBFUNC.

luaJIT_setmode(L, trace,
  LUAJIT_MODE_TRACE|LUAJIT_MODE_FLUSH)

Flushes the specified root trace and all of its side traces from the cache. The code for the trace will be retained as long as there are any other traces which link to it.

luaJIT_setmode(L, idx, LUAJIT_MODE_WRAPCFUNC|flag)

This mode defines a wrapper function for calls to C functions. If called with LUAJIT_MODE_ON, the stack index at idx must be a lightuserdata object holding a pointer to the wrapper function. From now on all C functions are called through the wrapper function. If called with LUAJIT_MODE_OFF this mode is turned off and all C functions are directly called.

The wrapper function can be used for debugging purposes or to catch and convert foreign exceptions. But please read the section on C++ exception interoperability first. Recommended usage can be seen in this C++ code excerpt:

#include <exception>
#include "lua.hpp"

// Catch C++ exceptions and convert them to Lua error messages.
// Customize as needed for your own exception classes.
static int wrap_exceptions(lua_State *L, lua_CFunction f)
{
  try {
    return f(L);  // Call wrapped function and return result.
  } catch (const char *s) {  // Catch and convert exceptions.
    lua_pushstring(L, s);
  } catch (std::exception& e) {
    lua_pushstring(L, e.what());
  } catch (...) {
    lua_pushliteral(L, "caught (...)");
  }
  return lua_error(L);  // Rethrow as a Lua error.
}

static int myinit(lua_State *L)
{
  ...
  // Define wrapper function and enable it.
  lua_pushlightuserdata(L, (void *)wrap_exceptions);
  luaJIT_setmode(L, -1, LUAJIT_MODE_WRAPCFUNC|LUAJIT_MODE_ON);
  lua_pop(L, 1);
  ...
}

Note that you can only define a single global wrapper function, so be careful when using this mechanism from multiple C++ modules. Also note that this mechanism is not without overhead.


wcc-0.0.2/src/wsh/luajit-2.0/doc/contact.html0000644000175000017500000000531213122010155017171 0ustar philphil Contact

Please send general questions to the » LuaJIT mailing list. You can also send any questions you have directly to me:

Copyright

All documentation is Copyright © 2005-2016 Mike Pall.


wcc-0.0.2/src/wsh/luajit-2.0/doc/faq.html0000644000175000017500000001672213122010155016314 0ustar philphil Frequently Asked Questions (FAQ)
Q: Where can I learn more about LuaJIT and Lua?
Q: Where can I learn more about the compiler technology used by LuaJIT?
I'm planning to write more documentation about the internals of LuaJIT. In the meantime, please use the following Google Scholar searches to find relevant papers:
Search for: » Trace Compiler
Search for: » JIT Compiler
Search for: » Dynamic Language Optimizations
Search for: » SSA Form
Search for: » Linear Scan Register Allocation
Here is a list of the » innovative features in LuaJIT.
And, you know, reading the source is of course the only way to enlightenment. :-)
Q: Why do I get this error: "attempt to index global 'arg' (a nil value)"?
Q: My vararg functions fail after switching to LuaJIT!
LuaJIT is compatible to the Lua 5.1 language standard. It doesn't support the implicit arg parameter for old-style vararg functions from Lua 5.0.
Please convert your code to the » Lua 5.1 vararg syntax.
Q: Why do I get this error: "bad FPU precision"?
Q: I get weird behavior after initializing Direct3D.
Q: Some FPU operations crash after I load a Delphi DLL.
DirectX/Direct3D (up to version 9) sets the x87 FPU to single-precision mode by default. This violates the Windows ABI and interferes with the operation of many programs — LuaJIT is affected, too. Please make sure you always use the D3DCREATE_FPU_PRESERVE flag when initializing Direct3D.
Direct3D version 10 or higher do not show this behavior anymore. Consider testing your application with older versions, too.
Similarly, the Borland/Delphi runtime modifies the FPU control word and enables FP exceptions. Of course this violates the Windows ABI, too. Please check the Delphi docs for the Set8087CW method.
Q: Sometimes Ctrl-C fails to stop my Lua program. Why?
The interrupt signal handler sets a Lua debug hook. But this is currently ignored by compiled code (this will eventually be fixed). If your program is running in a tight loop and never falls back to the interpreter, the debug hook never runs and can't throw the "interrupted!" error.
In the meantime you have to press Ctrl-C twice to get stop your program. That's similar to when it's stuck running inside a C function under the Lua interpreter.
Q: Why doesn't my favorite power-patch for Lua apply against LuaJIT?
Because it's a completely redesigned VM and has very little code in common with Lua anymore. Also, if the patch introduces changes to the Lua semantics, these would need to be reflected everywhere in the VM, from the interpreter up to all stages of the compiler.
Please use only standard Lua language constructs. For many common needs you can use source transformations or use wrapper or proxy functions. The compiler will happily optimize away such indirections.
Q: Lua runs everywhere. Why doesn't LuaJIT support my CPU?
Because it's a compiler — it needs to generate native machine code. This means the code generator must be ported to each architecture. And the fast interpreter is written in assembler and must be ported, too. This is quite an undertaking.
The install documentation shows the supported architectures. Other architectures will follow based on sufficient user demand and/or sponsoring.
Q: When will feature X be added? When will the next version be released?
When it's ready.
C'mon, it's open source — I'm doing it on my own time and you're getting it for free. You can either contribute a patch or sponsor the development of certain features, if they are important to you.

wcc-0.0.2/src/wsh/luajit-2.0/doc/running.html0000644000175000017500000003237713122010155017231 0ustar philphil Running LuaJIT

LuaJIT has only a single stand-alone executable, called luajit on POSIX systems or luajit.exe on Windows. It can be used to run simple Lua statements or whole Lua applications from the command line. It has an interactive mode, too.

Command Line Options

The luajit stand-alone executable is just a slightly modified version of the regular lua stand-alone executable. It supports the same basic options, too. luajit -h prints a short list of the available options. Please have a look at the » Lua manual for details.

LuaJIT has some additional options:

-b[options] input output

This option saves or lists bytecode. The following additional options are accepted:

  • -l — Only list bytecode.
  • -s — Strip debug info (this is the default).
  • -g — Keep debug info.
  • -n name — Set module name (default: auto-detect from input name)
  • -t type — Set output file type (default: auto-detect from output name).
  • -a arch — Override architecture for object files (default: native).
  • -o os — Override OS for object files (default: native).
  • -e chunk — Use chunk string as input.
  • - (a single minus sign) — Use stdin as input and/or stdout as output.

The output file type is auto-detected from the extension of the output file name:

  • c — C source file, exported bytecode data.
  • h — C header file, static bytecode data.
  • obj or o — Object file, exported bytecode data (OS- and architecture-specific).
  • raw or any other extension — Raw bytecode file (portable).

Notes:

  • See also string.dump() for information on bytecode portability and compatibility.
  • A file in raw bytecode format is auto-detected and can be loaded like any Lua source file. E.g. directly from the command line or with loadfile(), dofile() etc.
  • To statically embed the bytecode of a module in your application, generate an object file and just link it with your application.
  • On most ELF-based systems (e.g. Linux) you need to explicitly export the global symbols when linking your application, e.g. with: -Wl,-E
  • require() tries to load embedded bytecode data from exported symbols (in *.exe or lua51.dll on Windows) and from shared libraries in package.cpath.

Typical usage examples:

luajit -b test.lua test.out                 # Save bytecode to test.out
luajit -bg test.lua test.out                # Keep debug info
luajit -be "print('hello world')" test.out  # Save cmdline script

luajit -bl test.lua                         # List to stdout
luajit -bl test.lua test.txt                # List to test.txt
luajit -ble "print('hello world')"          # List cmdline script

luajit -b test.lua test.obj                 # Generate object file
# Link test.obj with your application and load it with require("test")

-j cmd[=arg[,arg...]]

This option performs a LuaJIT control command or activates one of the loadable extension modules. The command is first looked up in the jit.* library. If no matching function is found, a module named jit.<cmd> is loaded and the start() function of the module is called with the specified arguments (if any). The space between -j and cmd is optional.

Here are the available LuaJIT control commands:

  • -jon — Turns the JIT compiler on (default).
  • -joff — Turns the JIT compiler off (only use the interpreter).
  • -jflush — Flushes the whole cache of compiled code.
  • -jv — Shows verbose information about the progress of the JIT compiler.
  • -jdump — Dumps the code and structures used in various compiler stages.

The -jv and -jdump commands are extension modules written in Lua. They are mainly used for debugging the JIT compiler itself. For a description of their options and output format, please read the comment block at the start of their source. They can be found in the lib directory of the source distribution or installed under the jit directory. By default this is /usr/local/share/luajit-2.0.4/jit on POSIX systems.

-O[level]
-O[+]flag   -O-flag
-Oparam=value

This options allows fine-tuned control of the optimizations used by the JIT compiler. This is mainly intended for debugging LuaJIT itself. Please note that the JIT compiler is extremely fast (we are talking about the microsecond to millisecond range). Disabling optimizations doesn't have any visible impact on its overhead, but usually generates code that runs slower.

The first form sets an optimization level — this enables a specific mix of optimization flags. -O0 turns off all optimizations and higher numbers enable more optimizations. Omitting the level (i.e. just -O) sets the default optimization level, which is -O3 in the current version.

The second form adds or removes individual optimization flags. The third form sets a parameter for the VM or the JIT compiler to a specific value.

You can either use this option multiple times (like -Ocse -O-dce -Ohotloop=10) or separate several settings with a comma (like -O+cse,-dce,hotloop=10). The settings are applied from left to right and later settings override earlier ones. You can freely mix the three forms, but note that setting an optimization level overrides all earlier flags.

Here are the available flags and at what optimization levels they are enabled:

Flag -O1 -O2 -O3  
foldConstant Folding, Simplifications and Reassociation
cseCommon-Subexpression Elimination
dceDead-Code Elimination
narrow Narrowing of numbers to integers
loop Loop Optimizations (code hoisting)
fwd  Load Forwarding (L2L) and Store Forwarding (S2L)
dse  Dead-Store Elimination
abc  Array Bounds Check Elimination
sink  Allocation/Store Sinking
fuse  Fusion of operands into instructions

Here are the parameters and their default settings:

Parameter Default  
maxtrace1000Max. number of traces in the cache
maxrecord4000Max. number of recorded IR instructions
maxirconst500Max. number of IR constants of a trace
maxside100Max. number of side traces of a root trace
maxsnap500Max. number of snapshots for a trace
hotloop56Number of iterations to detect a hot loop or hot call
hotexit10Number of taken exits to start a side trace
tryside4Number of attempts to compile a side trace
instunroll4Max. unroll factor for instable loops
loopunroll15Max. unroll factor for loop ops in side traces
callunroll3Max. unroll factor for pseudo-recursive calls
recunroll2Min. unroll factor for true recursion
sizemcode32Size of each machine code area in KBytes (Windows: 64K)
maxmcode512Max. total size of all machine code areas in KBytes

wcc-0.0.2/src/wsh/luajit-2.0/doc/ext_ffi.html0000644000175000017500000002405513122010155017167 0ustar philphil FFI Library

The FFI library allows calling external C functions and using C data structures from pure Lua code.

The FFI library largely obviates the need to write tedious manual Lua/C bindings in C. No need to learn a separate binding language — it parses plain C declarations! These can be cut-n-pasted from C header files or reference manuals. It's up to the task of binding large libraries without the need for dealing with fragile binding generators.

The FFI library is tightly integrated into LuaJIT (it's not available as a separate module). The code generated by the JIT-compiler for accesses to C data structures from Lua code is on par with the code a C compiler would generate. Calls to C functions can be inlined in JIT-compiled code, unlike calls to functions bound via the classic Lua/C API.

This page gives a short introduction to the usage of the FFI library. Please use the FFI sub-topics in the navigation bar to learn more.

Motivating Example: Calling External C Functions

It's really easy to call an external C library function:

①
②


③local ffi = require("ffi")
ffi.cdef[[
int printf(const char *fmt, ...);
]]
ffi.C.printf("Hello %s!", "world")

So, let's pick that apart:

Load the FFI library.

Add a C declaration for the function. The part inside the double-brackets (in green) is just standard C syntax.

Call the named C function — Yes, it's that simple!

Actually, what goes on behind the scenes is far from simple: makes use of the standard C library namespace ffi.C. Indexing this namespace with a symbol name ("printf") automatically binds it to the standard C library. The result is a special kind of object which, when called, runs the printf function. The arguments passed to this function are automatically converted from Lua objects to the corresponding C types.

Ok, so maybe the use of printf() wasn't such a spectacular example. You could have done that with io.write() and string.format(), too. But you get the idea ...

So here's something to pop up a message box on Windows:

local ffi = require("ffi")
ffi.cdef[[
int MessageBoxA(void *w, const char *txt, const char *cap, int type);
]]
ffi.C.MessageBoxA(nil, "Hello world!", "Test", 0)

Bing! Again, that was far too easy, no?

Compare this with the effort required to bind that function using the classic Lua/C API: create an extra C file, add a C function that retrieves and checks the argument types passed from Lua and calls the actual C function, add a list of module functions and their names, add a luaopen_* function and register all module functions, compile and link it into a shared library (DLL), move it to the proper path, add Lua code that loads the module aaaand ... finally call the binding function. Phew!

Motivating Example: Using C Data Structures

The FFI library allows you to create and access C data structures. Of course the main use for this is for interfacing with C functions. But they can be used stand-alone, too.

Lua is built upon high-level data types. They are flexible, extensible and dynamic. That's why we all love Lua so much. Alas, this can be inefficient for certain tasks, where you'd really want a low-level data type. E.g. a large array of a fixed structure needs to be implemented with a big table holding lots of tiny tables. This imposes both a substantial memory overhead as well as a performance overhead.

Here's a sketch of a library that operates on color images plus a simple benchmark. First, the plain Lua version:

local floor = math.floor

local function image_ramp_green(n)
  local img = {}
  local f = 255/(n-1)
  for i=1,n do
    img[i] = { red = 0, green = floor((i-1)*f), blue = 0, alpha = 255 }
  end
  return img
end

local function image_to_grey(img, n)
  for i=1,n do
    local y = floor(0.3*img[i].red + 0.59*img[i].green + 0.11*img[i].blue)
    img[i].red = y; img[i].green = y; img[i].blue = y
  end
end

local N = 400*400
local img = image_ramp_green(N)
for i=1,1000 do
  image_to_grey(img, N)
end

This creates a table with 160.000 pixels, each of which is a table holding four number values in the range of 0-255. First an image with a green ramp is created (1D for simplicity), then the image is converted to greyscale 1000 times. Yes, that's silly, but I was in need of a simple example ...

And here's the FFI version. The modified parts have been marked in bold:

①





②

③
④






③
⑤local ffi = require("ffi")
ffi.cdef[[
typedef struct { uint8_t red, green, blue, alpha; } rgba_pixel;
]]

local function image_ramp_green(n)
  local img = ffi.new("rgba_pixel[?]", n)
  local f = 255/(n-1)
  for i=0,n-1 do
    img[i].green = i*f
    img[i].alpha = 255
  end
  return img
end

local function image_to_grey(img, n)
  for i=0,n-1 do
    local y = 0.3*img[i].red + 0.59*img[i].green + 0.11*img[i].blue
    img[i].red = y; img[i].green = y; img[i].blue = y
  end
end

local N = 400*400
local img = image_ramp_green(N)
for i=1,1000 do
  image_to_grey(img, N)
end

Ok, so that wasn't too difficult:

First, load the FFI library and declare the low-level data type. Here we choose a struct which holds four byte fields, one for each component of a 4x8 bit RGBA pixel.

Creating the data structure with ffi.new() is straightforward — the '?' is a placeholder for the number of elements of a variable-length array.

C arrays are zero-based, so the indexes have to run from 0 to n-1. One might want to allocate one more element instead to simplify converting legacy code.

Since ffi.new() zero-fills the array by default, we only need to set the green and the alpha fields.

The calls to math.floor() can be omitted here, because floating-point numbers are already truncated towards zero when converting them to an integer. This happens implicitly when the number is stored in the fields of each pixel.

Now let's have a look at the impact of the changes: first, memory consumption for the image is down from 22 Megabytes to 640 Kilobytes (400*400*4 bytes). That's a factor of 35x less! So, yes, tables do have a noticeable overhead. BTW: The original program would consume 40 Megabytes in plain Lua (on x64).

Next, performance: the pure Lua version runs in 9.57 seconds (52.9 seconds with the Lua interpreter) and the FFI version runs in 0.48 seconds on my machine (YMMV). That's a factor of 20x faster (110x faster than the Lua interpreter).

The avid reader may notice that converting the pure Lua version over to use array indexes for the colors ([1] instead of .red, [2] instead of .green etc.) ought to be more compact and faster. This is certainly true (by a factor of ~1.7x). Switching to a struct-of-arrays would help, too.

However the resulting code would be less idiomatic and rather error-prone. And it still doesn't get even close to the performance of the FFI version of the code. Also, high-level data structures cannot be easily passed to other C functions, especially I/O functions, without undue conversion penalties.


wcc-0.0.2/src/wsh/luajit-2.0/doc/install.html0000644000175000017500000005523313122010155017213 0ustar philphil Installation

LuaJIT is only distributed as a source package. This page explains how to build and install LuaJIT with different operating systems and C compilers.

For the impatient (on POSIX systems):

make && sudo make install

LuaJIT currently builds out-of-the box on most systems. Here's the compatibility matrix for the supported combinations of operating systems, CPUs and compilers:

CPU / OS Linux or
Android
*BSD, Other OSX 10.4+ or
iOS 3.0+
Windows
XP/Vista/7
x86 (32 bit) GCC 4.x+
GCC 3.4
GCC 4.x+
GCC 3.4
XCode 5.0+
Clang
MSVC, MSVC/EE
WinSDK
MinGW, Cygwin
x64 (64 bit) GCC 4.x+ ORBIS (PS4) XCode 5.0+
Clang
MSVC + SDK v7.0
WinSDK v7.0
ARMv5+
ARM9E+
GCC 4.2+ GCC 4.2+
PSP2 (PS VITA)
XCode 5.0+
Clang
 
PPC GCC 4.3+ GCC 4.3+
GCC 4.1 (PS3)
  XEDK (Xbox 360)
PPC/e500v2 GCC 4.3+ GCC 4.3+    
MIPS GCC 4.3+ GCC 4.3+    

Configuring LuaJIT

The standard configuration should work fine for most installations. Usually there is no need to tweak the settings. The following files hold all user-configurable settings:

  • src/luaconf.h sets some configuration variables.
  • Makefile has settings for installing LuaJIT (POSIX only).
  • src/Makefile has settings for compiling LuaJIT under POSIX, MinGW or Cygwin.
  • src/msvcbuild.bat has settings for compiling LuaJIT with MSVC or WinSDK.

Please read the instructions given in these files, before changing any settings.

POSIX Systems (Linux, OSX, *BSD etc.)

Prerequisites

Depending on your distribution, you may need to install a package for GCC, the development headers and/or a complete SDK. E.g. on a current Debian/Ubuntu, install libc6-dev with the package manager.

Download the current source package of LuaJIT (pick the .tar.gz), if you haven't already done so. Move it to a directory of your choice, open a terminal window and change to this directory. Now unpack the archive and change to the newly created directory:

tar zxf LuaJIT-2.0.4.tar.gz
cd LuaJIT-2.0.4

Building LuaJIT

The supplied Makefiles try to auto-detect the settings needed for your operating system and your compiler. They need to be run with GNU Make, which is probably the default on your system, anyway. Simply run:

make

This always builds a native x86, x64 or PPC binary, depending on the host OS you're running this command on. Check the section on cross-compilation for more options.

By default, modules are only searched under the prefix /usr/local. You can add an extra prefix to the search paths by appending the PREFIX option, e.g.:

make PREFIX=/home/myself/lj2

Note for OSX: if the MACOSX_DEPLOYMENT_TARGET environment variable is not set, then it's forced to 10.4.

Installing LuaJIT

The top-level Makefile installs LuaJIT by default under /usr/local, i.e. the executable ends up in /usr/local/bin and so on. You need root privileges to write to this path. So, assuming sudo is installed on your system, run the following command and enter your sudo password:

sudo make install

Otherwise specify the directory prefix as an absolute path, e.g.:

make install PREFIX=/home/myself/lj2

Obviously the prefixes given during build and installation need to be the same.

Windows Systems

Prerequisites

Either install one of the open source SDKs (» MinGW or » Cygwin), which come with a modified GCC plus the required development headers.

Or install Microsoft's Visual C++ (MSVC). The freely downloadable » Express Edition works just fine, but only contains an x86 compiler.

The freely downloadable » Windows SDK only comes with command line tools, but this is all you need to build LuaJIT. It contains x86 and x64 compilers.

Next, download the source package and unpack it using an archive manager (e.g. the Windows Explorer) to a directory of your choice.

Building with MSVC

Open a "Visual Studio .NET Command Prompt", cd to the directory where you've unpacked the sources and run these commands:

cd src
msvcbuild

Then follow the installation instructions below.

Building with the Windows SDK

Open a "Windows SDK Command Shell" and select the x86 compiler:

setenv /release /x86

Or select the x64 compiler:

setenv /release /x64

Then cd to the directory where you've unpacked the sources and run these commands:

cd src
msvcbuild

Then follow the installation instructions below.

Building with MinGW or Cygwin

Open a command prompt window and make sure the MinGW or Cygwin programs are in your path. Then cd to the directory where you've unpacked the sources and run this command for MinGW:

mingw32-make

Or this command for Cygwin:

make

Then follow the installation instructions below.

Installing LuaJIT

Copy luajit.exe and lua51.dll (built in the src directory) to a newly created directory (any location is ok). Add lua and lua\jit directories below it and copy all Lua files from the src\jit directory of the distribution to the latter directory.

There are no hardcoded absolute path names — all modules are loaded relative to the directory where luajit.exe is installed (see src/luaconf.h).

Cross-compiling LuaJIT

The GNU Makefile-based build system allows cross-compiling on any host for any supported target, as long as both architectures have the same pointer size. If you want to cross-compile to any 32 bit target on an x64 OS, you need to install the multilib development package (e.g. libc6-dev-i386 on Debian/Ubuntu) and build a 32 bit host part (HOST_CC="gcc -m32").

You need to specify TARGET_SYS whenever the host OS and the target OS differ, or you'll get assembler or linker errors. E.g. if you're compiling on a Windows or OSX host for embedded Linux or Android, you need to add TARGET_SYS=Linux to the examples below. For a minimal target OS, you may need to disable the built-in allocator in src/Makefile and use TARGET_SYS=Other. Don't forget to specify the same TARGET_SYS for the install step, too.

The examples below only show some popular targets — please check the comments in src/Makefile for more details.

# Cross-compile to a 32 bit binary on a multilib x64 OS
make CC="gcc -m32"

# Cross-compile on Debian/Ubuntu for Windows (mingw32 package)
make HOST_CC="gcc -m32" CROSS=i586-mingw32msvc- TARGET_SYS=Windows

The CROSS prefix allows specifying a standard GNU cross-compile toolchain (Binutils, GCC and a matching libc). The prefix may vary depending on the --target the toolchain was built for (note the CROSS prefix has a trailing "-"). The examples below use the canonical toolchain triplets for Linux.

Since there's often no easy way to detect CPU features at runtime, it's important to compile with the proper CPU or architecture settings. You can specify these when building the toolchain yourself. Or add -mcpu=... or -march=... to TARGET_CFLAGS. For ARM it's important to have the correct -mfloat-abi=... setting, too. Otherwise LuaJIT may not run at the full performance of your target CPU.

# ARM soft-float
make HOST_CC="gcc -m32" CROSS=arm-linux-gnueabi- \
     TARGET_CFLAGS="-mfloat-abi=soft"

# ARM soft-float ABI with VFP (example for Cortex-A8)
make HOST_CC="gcc -m32" CROSS=arm-linux-gnueabi- \
     TARGET_CFLAGS="-mcpu=cortex-a8 -mfloat-abi=softfp"

# ARM hard-float ABI with VFP (armhf, requires recent toolchain)
make HOST_CC="gcc -m32" CROSS=arm-linux-gnueabihf-

# PPC
make HOST_CC="gcc -m32" CROSS=powerpc-linux-gnu-
# PPC/e500v2 (fast interpreter only)
make HOST_CC="gcc -m32" CROSS=powerpc-e500v2-linux-gnuspe-

# MIPS big-endian
make HOST_CC="gcc -m32" CROSS=mips-linux-
# MIPS little-endian
make HOST_CC="gcc -m32" CROSS=mipsel-linux-

You can cross-compile for Android using the » Android NDK. The environment variables need to match the install locations and the desired target platform. E.g. Android 4.0 corresponds to ABI level 14. For details check the folder docs in the NDK directory.

Only a few common variations for the different CPUs, ABIs and platforms are listed. Please use your own judgement for which combination you want to build/deploy or which lowest common denominator you want to pick:

# Android/ARM, armeabi (ARMv5TE soft-float), Android 2.2+ (Froyo)
NDK=/opt/android/ndk
NDKABI=8
NDKVER=$NDK/toolchains/arm-linux-androideabi-4.6
NDKP=$NDKVER/prebuilt/linux-x86/bin/arm-linux-androideabi-
NDKF="--sysroot $NDK/platforms/android-$NDKABI/arch-arm"
make HOST_CC="gcc -m32" CROSS=$NDKP TARGET_FLAGS="$NDKF"

# Android/ARM, armeabi-v7a (ARMv7 VFP), Android 4.0+ (ICS)
NDK=/opt/android/ndk
NDKABI=14
NDKVER=$NDK/toolchains/arm-linux-androideabi-4.6
NDKP=$NDKVER/prebuilt/linux-x86/bin/arm-linux-androideabi-
NDKF="--sysroot $NDK/platforms/android-$NDKABI/arch-arm"
NDKARCH="-march=armv7-a -mfloat-abi=softfp -Wl,--fix-cortex-a8"
make HOST_CC="gcc -m32" CROSS=$NDKP TARGET_FLAGS="$NDKF $NDKARCH"

# Android/MIPS, mips (MIPS32R1 hard-float), Android 4.0+ (ICS)
NDK=/opt/android/ndk
NDKABI=14
NDKVER=$NDK/toolchains/mipsel-linux-android-4.6
NDKP=$NDKVER/prebuilt/linux-x86/bin/mipsel-linux-android-
NDKF="--sysroot $NDK/platforms/android-$NDKABI/arch-mips"
make HOST_CC="gcc -m32" CROSS=$NDKP TARGET_FLAGS="$NDKF"

# Android/x86, x86 (i686 SSE3), Android 4.0+ (ICS)
NDK=/opt/android/ndk
NDKABI=14
NDKVER=$NDK/toolchains/x86-4.6
NDKP=$NDKVER/prebuilt/linux-x86/bin/i686-linux-android-
NDKF="--sysroot $NDK/platforms/android-$NDKABI/arch-x86"
make HOST_CC="gcc -m32" CROSS=$NDKP TARGET_FLAGS="$NDKF"

You can cross-compile for iOS 3.0+ (iPhone/iPad) using the » iOS SDK:

Note: the JIT compiler is disabled for iOS, because regular iOS Apps are not allowed to generate code at runtime. You'll only get the performance of the LuaJIT interpreter on iOS. This is still faster than plain Lua, but much slower than the JIT compiler. Please complain to Apple, not me. Or use Android. :-p

ISDKP=$(xcrun --sdk iphoneos --show-sdk-path)
ICC=$(xcrun --sdk iphoneos --find clang)
ISDKF="-arch armv7 -isysroot $ISDKP"
make DEFAULT_CC=clang HOST_CC="clang -m32 -arch i386" \
     CROSS="$(dirname $ICC)/" TARGET_FLAGS="$ISDKF" TARGET_SYS=iOS

Cross-compiling for consoles

Building LuaJIT for consoles requires both a supported host compiler (x86 or x64) and a cross-compiler (to PPC or ARM) from the official console SDK.

Due to restrictions on consoles, the JIT compiler is disabled and only the fast interpreter is built. This is still faster than plain Lua, but much slower than the JIT compiler. The FFI is disabled, too, since it's not very useful in such an environment.

The following commands build a static library libluajit.a, which can be linked against your game, just like the Lua library.

To cross-compile for PS3 from a Linux host (requires 32 bit GCC, i.e. multilib Linux/x64) or a Windows host (requires 32 bit MinGW), run this command:

make HOST_CC="gcc -m32" CROSS=ppu-lv2-

To cross-compile for PS4 from a Windows host, open a "Visual Studio .NET Command Prompt" (64 bit host compiler), cd to the directory where you've unpacked the sources and run the following commands:

cd src
ps4build

To cross-compile for PS Vita from a Windows host, open a "Visual Studio .NET Command Prompt" (32 bit host compiler), cd to the directory where you've unpacked the sources and run the following commands:

cd src
psvitabuild

To cross-compile for Xbox 360 from a Windows host, open a "Visual Studio .NET Command Prompt" (32 bit host compiler), cd to the directory where you've unpacked the sources and run the following commands:

cd src
xedkbuild

Embedding LuaJIT

LuaJIT is API-compatible with Lua 5.1. If you've already embedded Lua into your application, you probably don't need to do anything to switch to LuaJIT, except link with a different library:

  • It's strongly suggested to build LuaJIT separately using the supplied build system. Please do not attempt to integrate the individual source files into your build tree. You'll most likely get the internal build dependencies wrong or mess up the compiler flags. Treat LuaJIT like any other external library and link your application with either the dynamic or static library, depending on your needs.
  • If you want to load C modules compiled for plain Lua with require(), you need to make sure the public symbols (e.g. lua_pushnumber) are exported, too:
    • On POSIX systems you can either link to the shared library or link the static library into your application. In the latter case you'll need to export all public symbols from your main executable (e.g. -Wl,-E on Linux) and add the external dependencies (e.g. -lm -ldl on Linux).
    • Since Windows symbols are bound to a specific DLL name, you need to link to the lua51.dll created by the LuaJIT build (do not rename the DLL). You may link LuaJIT statically on Windows only if you don't intend to load Lua/C modules at runtime.
  • If you're building a 64 bit application on OSX which links directly or indirectly against LuaJIT, you need to link your main executable with these flags:
    -pagezero_size 10000 -image_base 100000000
    
    Also, it's recommended to rebase all (self-compiled) shared libraries which are loaded at runtime on OSX/x64 (e.g. C extension modules for Lua). See: man rebase

Additional hints for initializing LuaJIT using the C API functions:

  • Here's a » simple example for embedding Lua or LuaJIT into your application.
  • Make sure you use luaL_newstate. Avoid using lua_newstate, since this uses the (slower) default memory allocator from your system (no support for this on x64).
  • Make sure you use luaL_openlibs and not the old Lua 5.0 style of calling luaopen_base etc. directly.
  • To change or extend the list of standard libraries to load, copy src/lib_init.c to your project and modify it accordingly. Make sure the jit library is loaded or the JIT compiler will not be activated.
  • The bit.* module for bitwise operations is already built-in. There's no need to statically link » Lua BitOp to your application.

Hints for Distribution Maintainers

The LuaJIT build system has extra provisions for the needs of most POSIX-based distributions. If you're a package maintainer for a distribution, please make use of these features and avoid patching, subverting, autotoolizing or messing up the build system in unspeakable ways.

There should be absolutely no need to patch luaconf.h or any of the Makefiles. And please do not hand-pick files for your packages — simply use whatever make install creates. There's a reason for all of the files and directories it creates.

The build system uses GNU make and auto-detects most settings based on the host you're building it on. This should work fine for native builds, even when sandboxed. You may need to pass some of the following flags to both the make and the make install command lines for a regular distribution build:

  • PREFIX overrides the installation path and should usually be set to /usr. Setting this also changes the module paths and the paths needed to locate the shared library.
  • DESTDIR is an absolute path which allows you to install to a shadow tree instead of the root tree of the build system.
  • MULTILIB sets the architecture-specific library path component for multilib systems. The default is lib.
  • Have a look at the top-level Makefile and src/Makefile for additional variables to tweak. The following variables may be overridden, but it's not recommended, except for special needs like cross-builds: BUILDMODE, CC, HOST_CC, STATIC_CC, DYNAMIC_CC, CFLAGS, HOST_CFLAGS, TARGET_CFLAGS, LDFLAGS, HOST_LDFLAGS, TARGET_LDFLAGS, TARGET_SHLDFLAGS, TARGET_FLAGS, LIBS, HOST_LIBS, TARGET_LIBS, CROSS, HOST_SYS, TARGET_SYS

The build system has a special target for an amalgamated build, i.e. make amalg. This compiles the LuaJIT core as one huge C file and allows GCC to generate faster and shorter code. Alas, this requires lots of memory during the build. This may be a problem for some users, that's why it's not enabled by default. But it shouldn't be a problem for most build farms. It's recommended that binary distributions use this target for their LuaJIT builds.

The tl;dr version of the above:

make amalg PREFIX=/usr && \
make install PREFIX=/usr DESTDIR=/tmp/buildroot

Finally, if you encounter any difficulties, please contact me first, instead of releasing a broken package onto unsuspecting users. Because they'll usually gonna complain to me (the upstream) and not you (the package maintainer), anyway.


wcc-0.0.2/src/wsh/luajit-2.0/doc/bluequad.css0000644000175000017500000001270713122010155017172 0ustar philphil/* Copyright (C) 2004-2016 Mike Pall. * * You are welcome to use the general ideas of this design for your own sites. * But please do not steal the stylesheet, the layout or the color scheme. */ /* colorscheme: * * site | head #4162bf/white | #6078bf/#e6ecff * ------+------ ----------------+------------------- * nav | main #bfcfff | #e6ecff/black * * nav: hiback loback #c5d5ff #b9c9f9 * hiborder loborder #e6ecff #97a7d7 * link hover #2142bf #ff0000 * * link: link visited hover #2142bf #8122bf #ff0000 * * main: boxback boxborder #f0f4ff #bfcfff */ body { font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 10pt; margin: 0; padding: 0; border: none; background: #e0e0e0; color: #000000; } a:link { text-decoration: none; background: transparent; color: #2142bf; } a:visited { text-decoration: none; background: transparent; color: #8122bf; } a:hover, a:active { text-decoration: underline; background: transparent; color: #ff0000; } h1, h2, h3 { font-weight: bold; text-align: left; margin: 0.5em 0; padding: 0; background: transparent; } h1 { font-size: 200%; line-height: 3em; /* really 6em relative to body, match #site span */ margin: 0; } h2 { font-size: 150%; color: #606060; } h3 { font-size: 125%; color: #404040; } p { max-width: 600px; margin: 0 0 0.5em 0; padding: 0; } b { color: #404040; } ul, ol { max-width: 600px; margin: 0.5em 0; padding: 0 0 0 2em; } ul { list-style: outside square; } ol { list-style: outside decimal; } li { margin: 0; padding: 0; } dl { max-width: 600px; margin: 1em 0; padding: 1em; border: 1px solid #bfcfff; background: #f0f4ff; } dt { font-weight: bold; margin: 0; padding: 0; } dt sup { float: right; margin-left: 1em; color: #808080; } dt a:visited { text-decoration: none; color: #2142bf; } dt a:hover, dt a:active { text-decoration: none; color: #ff0000; } dd { margin: 0.5em 0 0 2em; padding: 0; } div.tablewrap { /* for IE *sigh* */ max-width: 600px; } table { table-layout: fixed; border-spacing: 0; border-collapse: collapse; max-width: 600px; width: 100%; margin: 1em 0; padding: 0; border: 1px solid #bfcfff; } tr { margin: 0; padding: 0; border: none; } tr.odd { background: #f0f4ff; } tr.separate td { border-top: 1px solid #bfcfff; } td { text-align: left; margin: 0; padding: 0.2em 0.5em; border: none; } tt, code, kbd, samp { font-family: Courier New, Courier, monospace; line-height: 1.2; font-size: 110%; } kbd { font-weight: bolder; } blockquote, pre { max-width: 600px; margin: 1em 2em; padding: 0; } pre { line-height: 1.1; } pre.code { line-height: 1.4; margin: 0.5em 0 1em 0.5em; padding: 0.5em 1em; border: 1px solid #bfcfff; background: #f0f4ff; } pre.mark { padding-left: 2em; } span.codemark { position:absolute; left: 16em; color: #4040c0; } span.mark { color: #4040c0; font-family: Courier New, Courier, monospace; line-height: 1.1; } img { border: none; vertical-align: baseline; margin: 0; padding: 0; } img.left { float: left; margin: 0.5em 1em 0.5em 0; } img.right { float: right; margin: 0.5em 0 0.5em 1em; } .indent { padding-left: 1em; } .flush { clear: both; visibility: hidden; } .hide, .noscreen { display: none !important; } .ext { color: #ff8000; } .new { font-size: 6pt; vertical-align: middle; background: #ff8000; color: #ffffff; } #site { clear: both; float: left; width: 13em; text-align: center; font-weight: bold; margin: 0; padding: 0; background: transparent; color: #ffffff; } #site a { font-size: 200%; } #site a:link, #site a:visited { text-decoration: none; font-weight: bold; background: transparent; color: #ffffff; } #site span { line-height: 3em; /* really 6em relative to body, match h1 */ } #logo { color: #ffb380; } #head { margin: 0; padding: 0 0 0 2em; border-left: solid 13em #4162bf; border-right: solid 3em #6078bf; background: #6078bf; color: #e6ecff; } #nav { clear: both; float: left; overflow: hidden; text-align: left; line-height: 1.5; width: 13em; padding-top: 1em; background: transparent; } #nav ul { list-style: none outside; margin: 0; padding: 0; } #nav li { margin: 0; padding: 0; } #nav a { display: block; text-decoration: none; font-weight: bold; margin: 0; padding: 2px 1em; border-top: 1px solid transparent; border-bottom: 1px solid transparent; background: transparent; color: #2142bf; } #nav a:hover, #nav a:active { text-decoration: none; border-top: 1px solid #97a7d7; border-bottom: 1px solid #e6ecff; background: #b9c9f9; color: #ff0000; } #nav a.current, #nav a.current:hover, #nav a.current:active { border-top: 1px solid #e6ecff; border-bottom: 1px solid #97a7d7; background: #c5d5ff; color: #2142bf; } #nav ul ul a { padding: 0 1em 0 1.7em; } #nav ul ul ul a { padding: 0 0.5em 0 2.4em; } #main { line-height: 1.5; text-align: left; margin: 0; padding: 1em 2em; border-left: solid 13em #bfcfff; border-right: solid 3em #e6ecff; background: #e6ecff; } #foot { clear: both; font-size: 80%; text-align: center; margin: 0; padding: 0.5em; background: #6078bf; color: #ffffff; } #foot a:link, #foot a:visited { text-decoration: underline; background: transparent; color: #ffffff; } #foot a:hover, #foot a:active { text-decoration: underline; background: transparent; color: #bfcfff; } wcc-0.0.2/src/wsh/luajit-2.0/doc/extensions.html0000644000175000017500000003560013122010155017740 0ustar philphil Extensions

LuaJIT is fully upwards-compatible with Lua 5.1. It supports all » standard Lua library functions and the full set of » Lua/C API functions.

LuaJIT is also fully ABI-compatible to Lua 5.1 at the linker/dynamic loader level. This means you can compile a C module against the standard Lua headers and load the same shared library from either Lua or LuaJIT.

LuaJIT extends the standard Lua VM with new functionality and adds several extension modules. Please note this page is only about functional enhancements and not about performance enhancements, such as the optimized VM, the faster interpreter or the JIT compiler.

Extensions Modules

LuaJIT comes with several built-in extension modules:

bit.* — Bitwise operations

LuaJIT supports all bitwise operations as defined by » Lua BitOp:

bit.tobit  bit.tohex  bit.bnot    bit.band bit.bor  bit.bxor
bit.lshift bit.rshift bit.arshift bit.rol  bit.ror  bit.bswap

This module is a LuaJIT built-in — you don't need to download or install Lua BitOp. The Lua BitOp site has full documentation for all » Lua BitOp API functions.

Please make sure to require the module before using any of its functions:

local bit = require("bit")

An already installed Lua BitOp module is ignored by LuaJIT. This way you can use bit operations from both Lua and LuaJIT on a shared installation.

ffi.* — FFI library

The FFI library allows calling external C functions and the use of C data structures from pure Lua code.

jit.* — JIT compiler control

The functions in this module control the behavior of the JIT compiler engine.

C API extensions

LuaJIT adds some extra functions to the Lua/C API.

Enhanced Standard Library Functions

xpcall(f, err [,args...]) passes arguments

Unlike the standard implementation in Lua 5.1, xpcall() passes any arguments after the error function to the function which is called in a protected context.

loadfile() etc. handle UTF-8 source code

Non-ASCII characters are handled transparently by the Lua source code parser. This allows the use of UTF-8 characters in identifiers and strings. A UTF-8 BOM is skipped at the start of the source code.

tostring() etc. canonicalize NaN and ±Inf

All number-to-string conversions consistently convert non-finite numbers to the same strings on all platforms. NaN results in "nan", positive infinity results in "inf" and negative infinity results in "-inf".

tonumber() etc. use builtin string to number conversion

All string-to-number conversions consistently convert integer and floating-point inputs in decimal and hexadecimal on all platforms. strtod() is not used anymore, which avoids numerous problems with poor C library implementations. The builtin conversion function provides full precision according to the IEEE-754 standard, it works independently of the current locale and it supports hex floating-point numbers (e.g. 0x1.5p-3).

string.dump(f [,strip]) generates portable bytecode

An extra argument has been added to string.dump(). If set to true, 'stripped' bytecode without debug information is generated. This speeds up later bytecode loading and reduces memory usage. See also the -b command line option.

The generated bytecode is portable and can be loaded on any architecture that LuaJIT supports, independent of word size or endianess. However the bytecode compatibility versions must match. Bytecode stays compatible for dot releases (x.y.0 → x.y.1), but may change with major or minor releases (2.0 → 2.1) or between any beta release. Foreign bytecode (e.g. from Lua 5.1) is incompatible and cannot be loaded.

Enhanced PRNG for math.random()

LuaJIT uses a Tausworthe PRNG with period 2^223 to implement math.random() and math.randomseed(). The quality of the PRNG results is much superior compared to the standard Lua implementation which uses the platform-specific ANSI rand().

The PRNG generates the same sequences from the same seeds on all platforms and makes use of all bits in the seed argument. math.random() without arguments generates 52 pseudo-random bits for every call. The result is uniformly distributed between 0.0 and 1.0. It's correctly scaled up and rounded for math.random(n [,m]) to preserve uniformity.

io.* functions handle 64 bit file offsets

The file I/O functions in the standard io.* library handle 64 bit file offsets. In particular this means it's possible to open files larger than 2 Gigabytes and to reposition or obtain the current file position for offsets beyond 2 GB (fp:seek() method).

debug.* functions identify metamethods

debug.getinfo() and lua_getinfo() also return information about invoked metamethods. The namewhat field is set to "metamethod" and the name field has the name of the corresponding metamethod (e.g. "__index").

Fully Resumable VM

The LuaJIT VM is fully resumable. This means you can yield from a coroutine even across contexts, where this would not possible with the standard Lua 5.1 VM: e.g. you can yield across pcall() and xpcall(), across iterators and across metamethods.

Extensions from Lua 5.2

LuaJIT supports some language and library extensions from Lua 5.2. Features that are unlikely to break existing code are unconditionally enabled:

  • goto and ::labels::.
  • Hex escapes '\x3F' and '\*' escape in strings.
  • load(string|reader [, chunkname [,mode [,env]]]).
  • loadstring() is an alias for load().
  • loadfile(filename [,mode [,env]]).
  • math.log(x [,base]).
  • string.rep(s, n [,sep]).
  • string.format(): %q reversible. %s checks __tostring. %a and "%A added.
  • String matching pattern %g added.
  • io.read("*L").
  • io.lines() and file:lines() process io.read() options.
  • os.exit(status|true|false [,close]).
  • package.searchpath(name, path [, sep [, rep]]).
  • package.loadlib(name, "*").
  • debug.getinfo() returns nparams and isvararg for option "u".
  • debug.getlocal() accepts function instead of level.
  • debug.getlocal() and debug.setlocal() accept negative indexes for varargs.
  • debug.getupvalue() and debug.setupvalue() handle C functions.
  • debug.upvalueid() and debug.upvaluejoin().
  • Command line option -E.
  • Command line checks __tostring for errors.

Other features are only enabled, if LuaJIT is built with -DLUAJIT_ENABLE_LUA52COMPAT:

  • goto is a keyword and not a valid variable name anymore.
  • break can be placed anywhere. Empty statements (;;) are allowed.
  • __lt, __le are invoked for mixed types.
  • __len for tables. rawlen() library function.
  • pairs() and ipairs() check for __pairs and __ipairs.
  • coroutine.running() returns two results.
  • table.pack() and table.unpack() (same as unpack()).
  • io.write() and file:write() return file handle instead of true.
  • os.execute() and pipe:close() return detailed exit status.
  • debug.setmetatable() returns object.
  • debug.getuservalue() and debug.setuservalue().
  • Remove math.mod(), string.gfind().

Note: this provides only partial compatibility with Lua 5.2 at the language and Lua library level. LuaJIT is API+ABI-compatible with Lua 5.1, which prevents implementing features that would otherwise break the Lua/C API and ABI (e.g. _ENV).

C++ Exception Interoperability

LuaJIT has built-in support for interoperating with C++ exceptions. The available range of features depends on the target platform and the toolchain used to compile LuaJIT:

Platform Compiler Interoperability
POSIX/x64, DWARF2 unwinding GCC 4.3+ Full
Other platforms, DWARF2 unwinding GCC Limited
Windows/x64 MSVC or WinSDK Full
Windows/x86 Any No
Other platforms Other compilers No

Full interoperability means:

  • C++ exceptions can be caught on the Lua side with pcall(), lua_pcall() etc.
  • C++ exceptions will be converted to the generic Lua error "C++ exception", unless you use the C call wrapper feature.
  • It's safe to throw C++ exceptions across non-protected Lua frames on the C stack. The contents of the C++ exception object pass through unmodified.
  • Lua errors can be caught on the C++ side with catch(...). The corresponding Lua error message can be retrieved from the Lua stack.
  • Throwing Lua errors across C++ frames is safe. C++ destructors will be called.

Limited interoperability means:

  • C++ exceptions can be caught on the Lua side with pcall(), lua_pcall() etc.
  • C++ exceptions will be converted to the generic Lua error "C++ exception", unless you use the C call wrapper feature.
  • C++ exceptions will be caught by non-protected Lua frames and are rethrown as a generic Lua error. The C++ exception object will be destroyed.
  • Lua errors cannot be caught on the C++ side.
  • Throwing Lua errors across C++ frames will not call C++ destructors.

No interoperability means:

  • It's not safe to throw C++ exceptions across Lua frames.
  • C++ exceptions cannot be caught on the Lua side.
  • Lua errors cannot be caught on the C++ side.
  • Throwing Lua errors across C++ frames will not call C++ destructors.
  • Additionally, on Windows/x86 with SEH-based C++ exceptions: it's not safe to throw a Lua error across any frames containing a C++ function with any try/catch construct or using variables with (implicit) destructors. This also applies to any functions which may be inlined in such a function. It doesn't matter whether lua_error() is called inside or outside of a try/catch or whether any object actually needs to be destroyed: the SEH chain is corrupted and this will eventually lead to the termination of the process.

wcc-0.0.2/src/wsh/luajit-2.0/doc/status.html0000644000175000017500000000632313122010155017064 0ustar philphil Status

LuaJIT 2.0 is the current stable branch. This branch is in feature-freeze — new features will only be added to LuaJIT 2.1.

Current Status

LuaJIT ought to run all Lua 5.1-compatible source code just fine. It's considered a serious bug if the VM crashes or produces unexpected results — please report this.

Known incompatibilities and issues in LuaJIT 2.0:

  • There are some differences in implementation-defined behavior. These either have a good reason, are arbitrary design choices or are due to quirks in the VM. The latter cases may get fixed if a demonstrable need is shown.
  • The Lua debug API is missing a couple of features (return hooks for non-Lua functions) and shows slightly different behavior in LuaJIT (no per-coroutine hooks, no tail call counting).
  • Currently some out-of-memory errors from on-trace code are not handled correctly. The error may fall through an on-trace pcall or it may be passed on to the function set with lua_atpanic on x64. This issue will be fixed with the new garbage collector.

wcc-0.0.2/src/wsh/luajit-2.0/doc/img/0000755000175000017500000000000013122010155015423 5ustar philphilwcc-0.0.2/src/wsh/luajit-2.0/doc/img/contact.png0000644000175000017500000000247413122010155017573 0ustar philphil‰PNG  IHDRª ±æ(PLTE„‡’‚…€ƒŽiktfiqæìÿäêýKMSâèûIKQÏÔåGIOÍÒãEGM237ÉÎ߯ÌÜ./3²¶Å*+/«°¾”˜¤{~ˆy|†ux‚sv€`bj^`hY\cßå÷WZaÝãõEFLÛáó>@EÄÉÙ<>CÂÇ×)*-ÀÅÕ'(+%&)#$'©­»!"%¥©· ¢§´ Ž‘Œ›‰˜‡‹–ps|nqzjmvWY`SU\×ÜîNQWÕÚìÒØé:;@57;»ÀϹ¾Í·¼Ë"µºÉ³¸Ç ¤±œ ­…ˆ“‚~‚Œ|€ŠgjrehpcfnadlNPVåëþLNTãéüáçúHJPFHNÌÑâ348126ÈÍÞÇÍÝ/04-.2³·Æ+,0±µÄ®³Á¬±¿—›§•™¥‘•¡“Ÿ|‰z}‡x{…vyƒtwack_ai]_gZ]dáæùàæøX[bÞäöÜâôDEKÚàòØÞð?AFÅÊÚ=?DÁÆÖ(),¿ÄÔ½ÂÒ$%(ª®¼¦ª¸ ¤¨¶ ¡¦³ ’žœŠŽ™ˆŒ—†Š•svqt}or{mpyknwVX_ØÝïPRYÖÛíÔÙëÓÙêÑ×èÏÕæ68<½ÁÑ46:º¿Î¸½Ì # ›Ÿ¬ðÓvÏIDATHǽ•û_‹QÇOä=O QÓ°…Ì­H$J“ëÈfI…Gs—H ©…˜aäžM.™þ=?l{Vk]\^¾¿œçœó9çó>ç|Ïyc†1͸Cü©G0"õ> ³Äï‘D ló;r‹ôáÙ¦_ÿfÐ,:?ÆdbtÔ¨º&Ø«ù;T{…ß_ù6ø]òx¬Nost_2=û—¨s¿; ¦\&¯¥æ¬r8áƒL>•f²ô¨^×zú@¬>ájTÕ™é~o^§Ô;\G _K?švF{°E°mÐù:›;:š êMd]­÷®uªKó’=j}°Ù¹U Ô7¼ðØY[WÞù\߃¸òÉY¶@QxôpÓ@R5Т¥ò¹í‹ ÿÃPÔÅpÂr½^[¢Àe…~ÇL¡äj¸ Ñœ1cbx³4FÊ÷¢uÂ4ö·.(¾Ü®SfA5À»‹@ÿI~ÜA’9gi,TsÍ¡“?x«¢³Å•Öšš€cM5uëvwõ©ú§,Ê ADvÕ 7ŸèOWV’ejØb8ªUU ÔPÅF¥\Ä€×Ú}RLÔø«óhJ¯úý‘û°¸?’«mpo%@ç€Ô$ü èžÀ€ƒ! ª¬ìª|á]MÓ€ª×9AÀìYÒ–g"ÆŠ)ñäðÐsxUÞmëI±Krì]¨´“Š‹+òÖ €¢8tù‚ŸSA@Öz[rü ‹°GÝ™ðº í¡\¸Q/mOÃÞÕHù¤ÏjÒÅD•ÝR¶ ¨Òî6,«ëï…’"p´äæîVÛhW/Ovç½U ñìr²/²{ìËk9)/€1Ñ{:gàw~3sÒ“¥‘»Ö1gèªýO¨Üßô=`Ù=BgÕó”ÑGǹ\7þêhÑ`Mé]±m]Þdã/N}È4‰¾ÇIEND®B`‚wcc-0.0.2/src/wsh/luajit-2.0/doc/ext_ffi_api.html0000644000175000017500000005146013122010155020020 0ustar philphil ffi.* API Functions

This page describes the API functions provided by the FFI library in detail. It's recommended to read through the introduction and the FFI tutorial first.

Glossary

  • cdecl — An abstract C type declaration (a Lua string).
  • ctype — A C type object. This is a special kind of cdata returned by ffi.typeof(). It serves as a cdata constructor when called.
  • cdata — A C data object. It holds a value of the corresponding ctype.
  • ct — A C type specification which can be used for most of the API functions. Either a cdecl, a ctype or a cdata serving as a template type.
  • cb — A callback object. This is a C data object holding a special function pointer. Calling this function from C code runs an associated Lua function.
  • VLA — A variable-length array is declared with a ? instead of the number of elements, e.g. "int[?]". The number of elements (nelem) must be given when it's created.
  • VLS — A variable-length struct is a struct C type where the last element is a VLA. The same rules for declaration and creation apply.

Declaring and Accessing External Symbols

External symbols must be declared first and can then be accessed by indexing a C library namespace, which automatically binds the symbol to a specific library.

ffi.cdef(def)

Adds multiple C declarations for types or external symbols (named variables or functions). def must be a Lua string. It's recommended to use the syntactic sugar for string arguments as follows:

ffi.cdef[[
typedef struct foo { int a, b; } foo_t;  // Declare a struct and typedef.
int dofoo(foo_t *f, int n);  /* Declare an external C function. */
]]

The contents of the string (the part in green above) must be a sequence of C declarations, separated by semicolons. The trailing semicolon for a single declaration may be omitted.

Please note that external symbols are only declared, but they are not bound to any specific address, yet. Binding is achieved with C library namespaces (see below).

C declarations are not passed through a C pre-processor, yet. No pre-processor tokens are allowed, except for #pragma pack. Replace #define in existing C header files with enum, static const or typedef and/or pass the files through an external C pre-processor (once). Be careful not to include unneeded or redundant declarations from unrelated header files.

ffi.C

This is the default C library namespace — note the uppercase 'C'. It binds to the default set of symbols or libraries on the target system. These are more or less the same as a C compiler would offer by default, without specifying extra link libraries.

On POSIX systems, this binds to symbols in the default or global namespace. This includes all exported symbols from the executable and any libraries loaded into the global namespace. This includes at least libc, libm, libdl (on Linux), libgcc (if compiled with GCC), as well as any exported symbols from the Lua/C API provided by LuaJIT itself.

On Windows systems, this binds to symbols exported from the *.exe, the lua51.dll (i.e. the Lua/C API provided by LuaJIT itself), the C runtime library LuaJIT was linked with (msvcrt*.dll), kernel32.dll, user32.dll and gdi32.dll.

clib = ffi.load(name [,global])

This loads the dynamic library given by name and returns a new C library namespace which binds to its symbols. On POSIX systems, if global is true, the library symbols are loaded into the global namespace, too.

If name is a path, the library is loaded from this path. Otherwise name is canonicalized in a system-dependent way and searched in the default search path for dynamic libraries:

On POSIX systems, if the name contains no dot, the extension .so is appended. Also, the lib prefix is prepended if necessary. So ffi.load("z") looks for "libz.so" in the default shared library search path.

On Windows systems, if the name contains no dot, the extension .dll is appended. So ffi.load("ws2_32") looks for "ws2_32.dll" in the default DLL search path.

Creating cdata Objects

The following API functions create cdata objects (type() returns "cdata"). All created cdata objects are garbage collected.

cdata = ffi.new(ct [,nelem] [,init...])
cdata = ctype([nelem,] [init...])

Creates a cdata object for the given ct. VLA/VLS types require the nelem argument. The second syntax uses a ctype as a constructor and is otherwise fully equivalent.

The cdata object is initialized according to the rules for initializers, using the optional init arguments. Excess initializers cause an error.

Performance notice: if you want to create many objects of one kind, parse the cdecl only once and get its ctype with ffi.typeof(). Then use the ctype as a constructor repeatedly.

Please note that an anonymous struct declaration implicitly creates a new and distinguished ctype every time you use it for ffi.new(). This is probably not what you want, especially if you create more than one cdata object. Different anonymous structs are not considered assignment-compatible by the C standard, even though they may have the same fields! Also, they are considered different types by the JIT-compiler, which may cause an excessive number of traces. It's strongly suggested to either declare a named struct or typedef with ffi.cdef() or to create a single ctype object for an anonymous struct with ffi.typeof().

ctype = ffi.typeof(ct)

Creates a ctype object for the given ct.

This function is especially useful to parse a cdecl only once and then use the resulting ctype object as a constructor.

cdata = ffi.cast(ct, init)

Creates a scalar cdata object for the given ct. The cdata object is initialized with init using the "cast" variant of the C type conversion rules.

This functions is mainly useful to override the pointer compatibility checks or to convert pointers to addresses or vice versa.

ctype = ffi.metatype(ct, metatable)

Creates a ctype object for the given ct and associates it with a metatable. Only struct/union types, complex numbers and vectors are allowed. Other types may be wrapped in a struct, if needed.

The association with a metatable is permanent and cannot be changed afterwards. Neither the contents of the metatable nor the contents of an __index table (if any) may be modified afterwards. The associated metatable automatically applies to all uses of this type, no matter how the objects are created or where they originate from. Note that pre-defined operations on types have precedence (e.g. declared field names cannot be overriden).

All standard Lua metamethods are implemented. These are called directly, without shortcuts and on any mix of types. For binary operations, the left operand is checked first for a valid ctype metamethod. The __gc metamethod only applies to struct/union types and performs an implicit ffi.gc() call during creation of an instance.

cdata = ffi.gc(cdata, finalizer)

Associates a finalizer with a pointer or aggregate cdata object. The cdata object is returned unchanged.

This function allows safe integration of unmanaged resources into the automatic memory management of the LuaJIT garbage collector. Typical usage:

local p = ffi.gc(ffi.C.malloc(n), ffi.C.free)
...
p = nil -- Last reference to p is gone.
-- GC will eventually run finalizer: ffi.C.free(p)

A cdata finalizer works like the __gc metamethod for userdata objects: when the last reference to a cdata object is gone, the associated finalizer is called with the cdata object as an argument. The finalizer can be a Lua function or a cdata function or cdata function pointer. An existing finalizer can be removed by setting a nil finalizer, e.g. right before explicitly deleting a resource:

ffi.C.free(ffi.gc(p, nil)) -- Manually free the memory.

C Type Information

The following API functions return information about C types. They are most useful for inspecting cdata objects.

size = ffi.sizeof(ct [,nelem])

Returns the size of ct in bytes. Returns nil if the size is not known (e.g. for "void" or function types). Requires nelem for VLA/VLS types, except for cdata objects.

align = ffi.alignof(ct)

Returns the minimum required alignment for ct in bytes.

ofs [,bpos,bsize] = ffi.offsetof(ct, field)

Returns the offset (in bytes) of field relative to the start of ct, which must be a struct. Additionally returns the position and the field size (in bits) for bit fields.

status = ffi.istype(ct, obj)

Returns true if obj has the C type given by ct. Returns false otherwise.

C type qualifiers (const etc.) are ignored. Pointers are checked with the standard pointer compatibility rules, but without any special treatment for void *. If ct specifies a struct/union, then a pointer to this type is accepted, too. Otherwise the types must match exactly.

Note: this function accepts all kinds of Lua objects for the obj argument, but always returns false for non-cdata objects.

Utility Functions

err = ffi.errno([newerr])

Returns the error number set by the last C function call which indicated an error condition. If the optional newerr argument is present, the error number is set to the new value and the previous value is returned.

This function offers a portable and OS-independent way to get and set the error number. Note that only some C functions set the error number. And it's only significant if the function actually indicated an error condition (e.g. with a return value of -1 or NULL). Otherwise, it may or may not contain any previously set value.

You're advised to call this function only when needed and as close as possible after the return of the related C function. The errno value is preserved across hooks, memory allocations, invocations of the JIT compiler and other internal VM activity. The same applies to the value returned by GetLastError() on Windows, but you need to declare and call it yourself.

str = ffi.string(ptr [,len])

Creates an interned Lua string from the data pointed to by ptr.

If the optional argument len is missing, ptr is converted to a "char *" and the data is assumed to be zero-terminated. The length of the string is computed with strlen().

Otherwise ptr is converted to a "void *" and len gives the length of the data. The data may contain embedded zeros and need not be byte-oriented (though this may cause endianess issues).

This function is mainly useful to convert (temporary) "const char *" pointers returned by C functions to Lua strings and store them or pass them to other functions expecting a Lua string. The Lua string is an (interned) copy of the data and bears no relation to the original data area anymore. Lua strings are 8 bit clean and may be used to hold arbitrary, non-character data.

Performance notice: it's faster to pass the length of the string, if it's known. E.g. when the length is returned by a C call like sprintf().

ffi.copy(dst, src, len)
ffi.copy(dst, str)

Copies the data pointed to by src to dst. dst is converted to a "void *" and src is converted to a "const void *".

In the first syntax, len gives the number of bytes to copy. Caveat: if src is a Lua string, then len must not exceed #src+1.

In the second syntax, the source of the copy must be a Lua string. All bytes of the string plus a zero-terminator are copied to dst (i.e. #src+1 bytes).

Performance notice: ffi.copy() may be used as a faster (inlinable) replacement for the C library functions memcpy(), strcpy() and strncpy().

ffi.fill(dst, len [,c])

Fills the data pointed to by dst with len constant bytes, given by c. If c is omitted, the data is zero-filled.

Performance notice: ffi.fill() may be used as a faster (inlinable) replacement for the C library function memset(dst, c, len). Please note the different order of arguments!

Target-specific Information

status = ffi.abi(param)

Returns true if param (a Lua string) applies for the target ABI (Application Binary Interface). Returns false otherwise. The following parameters are currently defined:

Parameter Description
32bit32 bit architecture
64bit64 bit architecture
leLittle-endian architecture
beBig-endian architecture
fpuTarget has a hardware FPU
softfpsoftfp calling conventions
hardfphardfp calling conventions
eabiEABI variant of the standard ABI
winWindows variant of the standard ABI

ffi.os

Contains the target OS name. Same contents as jit.os.

ffi.arch

Contains the target architecture name. Same contents as jit.arch.

Methods for Callbacks

The C types for callbacks have some extra methods:

cb:free()

Free the resources associated with a callback. The associated Lua function is unanchored and may be garbage collected. The callback function pointer is no longer valid and must not be called anymore (it may be reused by a subsequently created callback).

cb:set(func)

Associate a new Lua function with a callback. The C type of the callback and the callback function pointer are unchanged.

This method is useful to dynamically switch the receiver of callbacks without creating a new callback each time and registering it again (e.g. with a GUI library).

Extended Standard Library Functions

The following standard library functions have been extended to work with cdata objects:

n = tonumber(cdata)

Converts a number cdata object to a double and returns it as a Lua number. This is particularly useful for boxed 64 bit integer values. Caveat: this conversion may incur a precision loss.

s = tostring(cdata)

Returns a string representation of the value of 64 bit integers ("nnnLL" or "nnnULL") or complex numbers ("re±imi"). Otherwise returns a string representation of the C type of a ctype object ("ctype<type>") or a cdata object ("cdata<type>: address"), unless you override it with a __tostring metamethod (see ffi.metatype()).

iter, obj, start = pairs(cdata)
iter, obj, start = ipairs(cdata)

Calls the __pairs or __ipairs metamethod of the corresponding ctype.

Extensions to the Lua Parser

The parser for Lua source code treats numeric literals with the suffixes LL or ULL as signed or unsigned 64 bit integers. Case doesn't matter, but uppercase is recommended for readability. It handles both decimal (42LL) and hexadecimal (0x2aLL) literals.

The imaginary part of complex numbers can be specified by suffixing number literals with i or I, e.g. 12.5i. Caveat: you'll need to use 1i to get an imaginary part with the value one, since i itself still refers to a variable named i.


wcc-0.0.2/src/wsh/luajit-2.0/doc/ext_ffi_tutorial.html0000644000175000017500000005375213122010155021120 0ustar philphil FFI Tutorial

This page is intended to give you an overview of the features of the FFI library by presenting a few use cases and guidelines.

This page makes no attempt to explain all of the FFI library, though. You'll want to have a look at the ffi.* API function reference and the FFI semantics to learn more.

Loading the FFI Library

The FFI library is built into LuaJIT by default, but it's not loaded and initialized by default. The suggested way to use the FFI library is to add the following to the start of every Lua file that needs one of its functions:

local ffi = require("ffi")

Please note this doesn't define an ffi variable in the table of globals — you really need to use the local variable. The require function ensures the library is only loaded once.

Note: If you want to experiment with the FFI from the interactive prompt of the command line executable, omit the local, as it doesn't preserve local variables across lines.

Accessing Standard System Functions

The following code explains how to access standard system functions. We slowly print two lines of dots by sleeping for 10 milliseconds after each dot:

 
①





②
③
④



⑤





⑥local ffi = require("ffi")
ffi.cdef[[
void Sleep(int ms);
int poll(struct pollfd *fds, unsigned long nfds, int timeout);
]]

local sleep
if ffi.os == "Windows" then
  function sleep(s)
    ffi.C.Sleep(s*1000)
  end
else
  function sleep(s)
    ffi.C.poll(nil, 0, s*1000)
  end
end

for i=1,160 do
  io.write("."); io.flush()
  sleep(0.01)
end
io.write("\n")

Here's the step-by-step explanation:

This defines the C library functions we're going to use. The part inside the double-brackets (in green) is just standard C syntax. You can usually get this info from the C header files or the documentation provided by each C library or C compiler.

The difficulty we're facing here, is that there are different standards to choose from. Windows has a simple Sleep() function. On other systems there are a variety of functions available to achieve sub-second sleeps, but with no clear consensus. Thankfully poll() can be used for this task, too, and it's present on most non-Windows systems. The check for ffi.os makes sure we use the Windows-specific function only on Windows systems.

Here we're wrapping the call to the C function in a Lua function. This isn't strictly necessary, but it's helpful to deal with system-specific issues only in one part of the code. The way we're wrapping it ensures the check for the OS is only done during initialization and not for every call.

A more subtle point is that we defined our sleep() function (for the sake of this example) as taking the number of seconds, but accepting fractional seconds. Multiplying this by 1000 gets us milliseconds, but that still leaves it a Lua number, which is a floating-point value. Alas, the Sleep() function only accepts an integer value. Luckily for us, the FFI library automatically performs the conversion when calling the function (truncating the FP value towards zero, like in C).

Some readers will notice that Sleep() is part of KERNEL32.DLL and is also a stdcall function. So how can this possibly work? The FFI library provides the ffi.C default C library namespace, which allows calling functions from the default set of libraries, like a C compiler would. Also, the FFI library automatically detects stdcall functions, so you don't need to declare them as such.

The poll() function takes a couple more arguments we're not going to use. You can simply use nil to pass a NULL pointer and 0 for the nfds parameter. Please note that the number 0 does not convert to a pointer value, unlike in C++. You really have to pass pointers to pointer arguments and numbers to number arguments.

The page on FFI semantics has all of the gory details about conversions between Lua objects and C types. For the most part you don't have to deal with this, as it's performed automatically and it's carefully designed to bridge the semantic differences between Lua and C.

Now that we have defined our own sleep() function, we can just call it from plain Lua code. That wasn't so bad, huh? Turning these boring animated dots into a fascinating best-selling game is left as an exercise for the reader. :-)

Accessing the zlib Compression Library

The following code shows how to access the zlib compression library from Lua code. We'll define two convenience wrapper functions that take a string and compress or uncompress it to another string:

 
①






②


③

④


⑤


⑥







⑦local ffi = require("ffi")
ffi.cdef[[
unsigned long compressBound(unsigned long sourceLen);
int compress2(uint8_t *dest, unsigned long *destLen,
	      const uint8_t *source, unsigned long sourceLen, int level);
int uncompress(uint8_t *dest, unsigned long *destLen,
	       const uint8_t *source, unsigned long sourceLen);
]]
local zlib = ffi.load(ffi.os == "Windows" and "zlib1" or "z")

local function compress(txt)
  local n = zlib.compressBound(#txt)
  local buf = ffi.new("uint8_t[?]", n)
  local buflen = ffi.new("unsigned long[1]", n)
  local res = zlib.compress2(buf, buflen, txt, #txt, 9)
  assert(res == 0)
  return ffi.string(buf, buflen[0])
end

local function uncompress(comp, n)
  local buf = ffi.new("uint8_t[?]", n)
  local buflen = ffi.new("unsigned long[1]", n)
  local res = zlib.uncompress(buf, buflen, comp, #comp)
  assert(res == 0)
  return ffi.string(buf, buflen[0])
end

-- Simple test code.
local txt = string.rep("abcd", 1000)
print("Uncompressed size: ", #txt)
local c = compress(txt)
print("Compressed size: ", #c)
local txt2 = uncompress(c, #txt)
assert(txt2 == txt)

Here's the step-by-step explanation:

This defines some of the C functions provided by zlib. For the sake of this example, some type indirections have been reduced and it uses the pre-defined fixed-size integer types, while still adhering to the zlib API/ABI.

This loads the zlib shared library. On POSIX systems it's named libz.so and usually comes pre-installed. Since ffi.load() automatically adds any missing standard prefixes/suffixes, we can simply load the "z" library. On Windows it's named zlib1.dll and you'll have to download it first from the » zlib site. The check for ffi.os makes sure we pass the right name to ffi.load().

First, the maximum size of the compression buffer is obtained by calling the zlib.compressBound function with the length of the uncompressed string. The next line allocates a byte buffer of this size. The [?] in the type specification indicates a variable-length array (VLA). The actual number of elements of this array is given as the 2nd argument to ffi.new().

This may look strange at first, but have a look at the declaration of the compress2 function from zlib: the destination length is defined as a pointer! This is because you pass in the maximum buffer size and get back the actual length that was used.

In C you'd pass in the address of a local variable (&buflen). But since there's no address-of operator in Lua, we'll just pass in a one-element array. Conveniently it can be initialized with the maximum buffer size in one step. Calling the actual zlib.compress2 function is then straightforward.

We want to return the compressed data as a Lua string, so we'll use ffi.string(). It needs a pointer to the start of the data and the actual length. The length has been returned in the buflen array, so we'll just get it from there.

Note that since the function returns now, the buf and buflen variables will eventually be garbage collected. This is fine, because ffi.string() has copied the contents to a newly created (interned) Lua string. If you plan to call this function lots of times, consider reusing the buffers and/or handing back the results in buffers instead of strings. This will reduce the overhead for garbage collection and string interning.

The uncompress functions does the exact opposite of the compress function. The compressed data doesn't include the size of the original string, so this needs to be passed in. Otherwise no surprises here.

The code, that makes use of the functions we just defined, is just plain Lua code. It doesn't need to know anything about the LuaJIT FFI — the convenience wrapper functions completely hide it.

One major advantage of the LuaJIT FFI is that you are now able to write those wrappers in Lua. And at a fraction of the time it would cost you to create an extra C module using the Lua/C API. Many of the simpler C functions can probably be used directly from your Lua code, without any wrappers.

Side note: the zlib API uses the long type for passing lengths and sizes around. But all those zlib functions actually only deal with 32 bit values. This is an unfortunate choice for a public API, but may be explained by zlib's history — we'll just have to deal with it.

First, you should know that a long is a 64 bit type e.g. on POSIX/x64 systems, but a 32 bit type on Windows/x64 and on 32 bit systems. Thus a long result can be either a plain Lua number or a boxed 64 bit integer cdata object, depending on the target system.

Ok, so the ffi.* functions generally accept cdata objects wherever you'd want to use a number. That's why we get a away with passing n to ffi.string() above. But other Lua library functions or modules don't know how to deal with this. So for maximum portability one needs to use tonumber() on returned long results before passing them on. Otherwise the application might work on some systems, but would fail in a POSIX/x64 environment.

Defining Metamethods for a C Type

The following code explains how to define metamethods for a C type. We define a simple point type and add some operations to it:

 
①



②

③

④



⑤

⑥local ffi = require("ffi")
ffi.cdef[[
typedef struct { double x, y; } point_t;
]]

local point
local mt = {
  __add = function(a, b) return point(a.x+b.x, a.y+b.y) end,
  __len = function(a) return math.sqrt(a.x*a.x + a.y*a.y) end,
  __index = {
    area = function(a) return a.x*a.x + a.y*a.y end,
  },
}
point = ffi.metatype("point_t", mt)

local a = point(3, 4)
print(a.x, a.y)  --> 3  4
print(#a)        --> 5
print(a:area())  --> 25
local b = a + point(0.5, 8)
print(#b)        --> 12.5

Here's the step-by-step explanation:

This defines the C type for a two-dimensional point object.

We have to declare the variable holding the point constructor first, because it's used inside of a metamethod.

Let's define an __add metamethod which adds the coordinates of two points and creates a new point object. For simplicity, this function assumes that both arguments are points. But it could be any mix of objects, if at least one operand is of the required type (e.g. adding a point plus a number or vice versa). Our __len metamethod returns the distance of a point to the origin.

If we run out of operators, we can define named methods, too. Here the __index table defines an area function. For custom indexing needs, one might want to define __index and __newindex functions instead.

This associates the metamethods with our C type. This only needs to be done once. For convenience, a constructor is returned by ffi.metatype(). We're not required to use it, though. The original C type can still be used e.g. to create an array of points. The metamethods automatically apply to any and all uses of this type.

Please note that the association with a metatable is permanent and the metatable must not be modified afterwards! Ditto for the __index table.

Here are some simple usage examples for the point type and their expected results. The pre-defined operations (such as a.x) can be freely mixed with the newly defined metamethods. Note that area is a method and must be called with the Lua syntax for methods: a:area(), not a.area().

The C type metamethod mechanism is most useful when used in conjunction with C libraries that are written in an object-oriented style. Creators return a pointer to a new instance and methods take an instance pointer as the first argument. Sometimes you can just point __index to the library namespace and __gc to the destructor and you're done. But often enough you'll want to add convenience wrappers, e.g. to return actual Lua strings or when returning multiple values.

Some C libraries only declare instance pointers as an opaque void * type. In this case you can use a fake type for all declarations, e.g. a pointer to a named (incomplete) struct will do: typedef struct foo_type *foo_handle. The C side doesn't know what you declare with the LuaJIT FFI, but as long as the underlying types are compatible, everything still works.

Translating C Idioms

Here's a list of common C idioms and their translation to the LuaJIT FFI:

Idiom C code Lua code
Pointer dereference
int *p;
x = *p;
*p = y;
x = p[0]
p[0] = y
Pointer indexing
int i, *p;
x = p[i];
p[i+1] = y;
x = p[i]
p[i+1] = y
Array indexing
int i, a[];
x = a[i];
a[i+1] = y;
x = a[i]
a[i+1] = y
struct/union dereference
struct foo s;
x = s.field;
s.field = y;
x = s.field
s.field = y
struct/union pointer deref.
struct foo *sp;
x = sp->field;
sp->field = y;
x = s.field
s.field = y
Pointer arithmetic
int i, *p;
x = p + i;
y = p - i;
x = p + i
y = p - i
Pointer difference
int *p1, *p2;
x = p1 - p2;x = p1 - p2
Array element pointer
int i, a[];
x = &a[i];x = a+i
Cast pointer to address
int *p;
x = (intptr_t)p;x = tonumber(
 ffi.cast("intptr_t",
          p))
Functions with outargs
void foo(int *inoutlen);
int len = x;
foo(&len);
y = len;
local len =
  ffi.new("int[1]", x)
foo(len)
y = len[0]
Vararg conversions
int printf(char *fmt, ...);
printf("%g", 1.0);
printf("%d", 1);
 
printf("%g", 1);
printf("%d",
  ffi.new("int", 1))

To Cache or Not to Cache

It's a common Lua idiom to cache library functions in local variables or upvalues, e.g.:

local byte, char = string.byte, string.char
local function foo(x)
  return char(byte(x)+1)
end

This replaces several hash-table lookups with a (faster) direct use of a local or an upvalue. This is less important with LuaJIT, since the JIT compiler optimizes hash-table lookups a lot and is even able to hoist most of them out of the inner loops. It can't eliminate all of them, though, and it saves some typing for often-used functions. So there's still a place for this, even with LuaJIT.

The situation is a bit different with C function calls via the FFI library. The JIT compiler has special logic to eliminate all of the lookup overhead for functions resolved from a C library namespace! Thus it's not helpful and actually counter-productive to cache individual C functions like this:

local funca, funcb = ffi.C.funca, ffi.C.funcb -- Not helpful!
local function foo(x, n)
  for i=1,n do funcb(funca(x, i), 1) end
end

This turns them into indirect calls and generates bigger and slower machine code. Instead you'll want to cache the namespace itself and rely on the JIT compiler to eliminate the lookups:

local C = ffi.C          -- Instead use this!
local function foo(x, n)
  for i=1,n do C.funcb(C.funca(x, i), 1) end
end

This generates both shorter and faster code. So don't cache C functions, but do cache namespaces! Most often the namespace is already in a local variable at an outer scope, e.g. from local lib = ffi.load(...). Note that copying it to a local variable in the function scope is unnecessary.


wcc-0.0.2/src/wsh/luajit-2.0/doc/ext_jit.html0000644000175000017500000001332413122010155017206 0ustar philphil jit.* Library

The functions in this built-in module control the behavior of the JIT compiler engine. Note that JIT-compilation is fully automatic — you probably won't need to use any of the following functions unless you have special needs.

jit.on()
jit.off()

Turns the whole JIT compiler on (default) or off.

These functions are typically used with the command line options -j on or -j off.

jit.flush()

Flushes the whole cache of compiled code.

jit.on(func|true [,true|false])
jit.off(func|true [,true|false])
jit.flush(func|true [,true|false])

jit.on enables JIT compilation for a Lua function (this is the default).

jit.off disables JIT compilation for a Lua function and flushes any already compiled code from the code cache.

jit.flush flushes the code, but doesn't affect the enable/disable status.

The current function, i.e. the Lua function calling this library function, can also be specified by passing true as the first argument.

If the second argument is true, JIT compilation is also enabled, disabled or flushed recursively for all sub-functions of a function. With false only the sub-functions are affected.

The jit.on and jit.off functions only set a flag which is checked when the function is about to be compiled. They do not trigger immediate compilation.

Typical usage is jit.off(true, true) in the main chunk of a module to turn off JIT compilation for the whole module for debugging purposes.

jit.flush(tr)

Flushes the root trace, specified by its number, and all of its side traces from the cache. The code for the trace will be retained as long as there are any other traces which link to it.

status, ... = jit.status()

Returns the current status of the JIT compiler. The first result is either true or false if the JIT compiler is turned on or off. The remaining results are strings for CPU-specific features and enabled optimizations.

jit.version

Contains the LuaJIT version string.

jit.version_num

Contains the version number of the LuaJIT core. Version xx.yy.zz is represented by the decimal number xxyyzz.

jit.os

Contains the target OS name: "Windows", "Linux", "OSX", "BSD", "POSIX" or "Other".

jit.arch

Contains the target architecture name: "x86", "x64", "arm", "ppc", "ppcspe", or "mips".

jit.opt.* — JIT compiler optimization control

This sub-module provides the backend for the -O command line option.

You can also use it programmatically, e.g.:

jit.opt.start(2) -- same as -O2
jit.opt.start("-dce")
jit.opt.start("hotloop=10", "hotexit=2")

Unlike in LuaJIT 1.x, the module is built-in and optimization is turned on by default! It's no longer necessary to run require("jit.opt").start(), which was one of the ways to enable optimization.

jit.util.* — JIT compiler introspection

This sub-module holds functions to introspect the bytecode, generated traces, the IR and the generated machine code. The functionality provided by this module is still in flux and therefore undocumented.

The debug modules -jbc, -jv and -jdump make extensive use of these functions. Please check out their source code, if you want to know more.


wcc-0.0.2/src/wsh/luajit-2.0/doc/ext_ffi_semantics.html0000644000175000017500000014755413122010155021247 0ustar philphil FFI Semantics

This page describes the detailed semantics underlying the FFI library and its interaction with both Lua and C code.

Given that the FFI library is designed to interface with C code and that declarations can be written in plain C syntax, it closely follows the C language semantics, wherever possible. Some minor concessions are needed for smoother interoperation with Lua language semantics.

Please don't be overwhelmed by the contents of this page — this is a reference and you may need to consult it, if in doubt. It doesn't hurt to skim this page, but most of the semantics "just work" as you'd expect them to work. It should be straightforward to write applications using the LuaJIT FFI for developers with a C or C++ background.

C Language Support

The FFI library has a built-in C parser with a minimal memory footprint. It's used by the ffi.* library functions to declare C types or external symbols.

It's only purpose is to parse C declarations, as found e.g. in C header files. Although it does evaluate constant expressions, it's not a C compiler. The body of inline C function definitions is simply ignored.

Also, this is not a validating C parser. It expects and accepts correctly formed C declarations, but it may choose to ignore bad declarations or show rather generic error messages. If in doubt, please check the input against your favorite C compiler.

The C parser complies to the C99 language standard plus the following extensions:

  • The '\e' escape in character and string literals.
  • The C99/C++ boolean type, declared with the keywords bool or _Bool.
  • Complex numbers, declared with the keywords complex or _Complex.
  • Two complex number types: complex (aka complex double) and complex float.
  • Vector types, declared with the GCC mode or vector_size attribute.
  • Unnamed ('transparent') struct/union fields inside a struct/union.
  • Incomplete enum declarations, handled like incomplete struct declarations.
  • Unnamed enum fields inside a struct/union. This is similar to a scoped C++ enum, except that declared constants are visible in the global namespace, too.
  • Scoped static const declarations inside a struct/union (from C++).
  • Zero-length arrays ([0]), empty struct/union, variable-length arrays (VLA, [?]) and variable-length structs (VLS, with a trailing VLA).
  • C++ reference types (int &x).
  • Alternate GCC keywords with '__', e.g. __const__.
  • GCC __attribute__ with the following attributes: aligned, packed, mode, vector_size, cdecl, fastcall, stdcall, thiscall.
  • The GCC __extension__ keyword and the GCC __alignof__ operator.
  • GCC __asm__("symname") symbol name redirection for function declarations.
  • MSVC keywords for fixed-length types: __int8, __int16, __int32 and __int64.
  • MSVC __cdecl, __fastcall, __stdcall, __thiscall, __ptr32, __ptr64, __declspec(align(n)) and #pragma pack.
  • All other GCC/MSVC-specific attributes are ignored.

The following C types are pre-defined by the C parser (like a typedef, except re-declarations will be ignored):

  • Vararg handling: va_list, __builtin_va_list, __gnuc_va_list.
  • From <stddef.h>: ptrdiff_t, size_t, wchar_t.
  • From <stdint.h>: int8_t, int16_t, int32_t, int64_t, uint8_t, uint16_t, uint32_t, uint64_t, intptr_t, uintptr_t.

You're encouraged to use these types in preference to compiler-specific extensions or target-dependent standard types. E.g. char differs in signedness and long differs in size, depending on the target architecture and platform ABI.

The following C features are not supported:

  • A declaration must always have a type specifier; it doesn't default to an int type.
  • Old-style empty function declarations (K&R) are not allowed. All C functions must have a proper prototype declaration. A function declared without parameters (int foo();) is treated as a function taking zero arguments, like in C++.
  • The long double C type is parsed correctly, but there's no support for the related conversions, accesses or arithmetic operations.
  • Wide character strings and character literals are not supported.
  • See below for features that are currently not implemented.

C Type Conversion Rules

Conversions from C types to Lua objects

These conversion rules apply for read accesses to C types: indexing pointers, arrays or struct/union types; reading external variables or constant values; retrieving return values from C calls:

Input Conversion Output
int8_t, int16_tsign-ext int32_tdoublenumber
uint8_t, uint16_tzero-ext int32_tdoublenumber
int32_t, uint32_tdoublenumber
int64_t, uint64_tboxed value64 bit int cdata
double, floatdoublenumber
bool0 → false, otherwise trueboolean
enumboxed valueenum cdata
Complex numberboxed valuecomplex cdata
Vectorboxed valuevector cdata
Pointerboxed valuepointer cdata
Arrayboxed referencereference cdata
struct/unionboxed referencereference cdata

Bitfields are treated like their underlying type.

Reference types are dereferenced before a conversion can take place — the conversion is applied to the C type pointed to by the reference.

Conversions from Lua objects to C types

These conversion rules apply for write accesses to C types: indexing pointers, arrays or struct/union types; initializing cdata objects; casts to C types; writing to external variables; passing arguments to C calls:

Input Conversion Output
numberdouble
booleanfalse → 0, true → 1bool
nilNULL(void *)
lightuserdatalightuserdata address →(void *)
userdatauserdata payload →(void *)
io.* fileget FILE * handle →(void *)
stringmatch against enum constantenum
stringcopy string data + zero-byteint8_t[], uint8_t[]
stringstring data →const char[]
functioncreate callbackC function type
tabletable initializerArray
tabletable initializerstruct/union
cdatacdata payload →C type

If the result type of this conversion doesn't match the C type of the destination, the conversion rules between C types are applied.

Reference types are immutable after initialization ("no re-seating of references"). For initialization purposes or when passing values to reference parameters, they are treated like pointers. Note that unlike in C++, there's no way to implement automatic reference generation of variables under the Lua language semantics. If you want to call a function with a reference parameter, you need to explicitly pass a one-element array.

Conversions between C types

These conversion rules are more or less the same as the standard C conversion rules. Some rules only apply to casts, or require pointer or type compatibility:

Input Conversion Output
Signed integernarrow or sign-extendInteger
Unsigned integernarrow or zero-extendInteger
Integerrounddouble, float
double, floattrunc int32_tnarrow(u)int8_t, (u)int16_t
double, floattrunc(u)int32_t, (u)int64_t
double, floatroundfloat, double
Numbern == 0 → 0, otherwise 1bool
boolfalse → 0, true → 1Number
Complex numberconvert real partNumber
Numberconvert real part, imag = 0Complex number
Complex numberconvert real and imag partComplex number
Numberconvert scalar and replicateVector
Vectorcopy (same size)Vector
struct/uniontake base address (compat)Pointer
Arraytake base address (compat)Pointer
Functiontake function addressFunction pointer
Numberconvert via uintptr_t (cast)Pointer
Pointerconvert address (compat/cast)Pointer
Pointerconvert address (cast)Integer
Arrayconvert base address (cast)Integer
Arraycopy (compat)Array
struct/unioncopy (identical type)struct/union

Bitfields or enum types are treated like their underlying type.

Conversions not listed above will raise an error. E.g. it's not possible to convert a pointer to a complex number or vice versa.

Conversions for vararg C function arguments

The following default conversion rules apply when passing Lua objects to the variable argument part of vararg C functions:

Input Conversion Output
numberdouble
booleanfalse → 0, true → 1bool
nilNULL(void *)
userdatauserdata payload →(void *)
lightuserdatalightuserdata address →(void *)
stringstring data →const char *
float cdatadouble
Array cdatatake base addressElement pointer
struct/union cdatatake base addressstruct/union pointer
Function cdatatake function addressFunction pointer
Any other cdatano conversionC type

To pass a Lua object, other than a cdata object, as a specific type, you need to override the conversion rules: create a temporary cdata object with a constructor or a cast and initialize it with the value to pass:

Assuming x is a Lua number, here's how to pass it as an integer to a vararg function:

ffi.cdef[[
int printf(const char *fmt, ...);
]]
ffi.C.printf("integer value: %d\n", ffi.new("int", x))

If you don't do this, the default Lua number → double conversion rule applies. A vararg C function expecting an integer will see a garbled or uninitialized value.

Initializers

Creating a cdata object with ffi.new() or the equivalent constructor syntax always initializes its contents, too. Different rules apply, depending on the number of optional initializers and the C types involved:

  • If no initializers are given, the object is filled with zero bytes.
  • Scalar types (numbers and pointers) accept a single initializer. The Lua object is converted to the scalar C type.
  • Valarrays (complex numbers and vectors) are treated like scalars when a single initializer is given. Otherwise they are treated like regular arrays.
  • Aggregate types (arrays and structs) accept either a single cdata initializer of the same type (copy constructor), a single table initializer, or a flat list of initializers.
  • The elements of an array are initialized, starting at index zero. If a single initializer is given for an array, it's repeated for all remaining elements. This doesn't happen if two or more initializers are given: all remaining uninitialized elements are filled with zero bytes.
  • Byte arrays may also be initialized with a Lua string. This copies the whole string plus a terminating zero-byte. The copy stops early only if the array has a known, fixed size.
  • The fields of a struct are initialized in the order of their declaration. Uninitialized fields are filled with zero bytes.
  • Only the first field of a union can be initialized with a flat initializer.
  • Elements or fields which are aggregates themselves are initialized with a single initializer, but this may be a table initializer or a compatible aggregate.
  • Excess initializers cause an error.

Table Initializers

The following rules apply if a Lua table is used to initialize an Array or a struct/union:

  • If the table index [0] is non-nil, then the table is assumed to be zero-based. Otherwise it's assumed to be one-based.
  • Array elements, starting at index zero, are initialized one-by-one with the consecutive table elements, starting at either index [0] or [1]. This process stops at the first nil table element.
  • If exactly one array element was initialized, it's repeated for all the remaining elements. Otherwise all remaining uninitialized elements are filled with zero bytes.
  • The above logic only applies to arrays with a known fixed size. A VLA is only initialized with the element(s) given in the table. Depending on the use case, you may need to explicitly add a NULL or 0 terminator to a VLA.
  • A struct/union can be initialized in the order of the declaration of its fields. Each field is initialized with consecutive table elements, starting at either index [0] or [1]. This process stops at the first nil table element.
  • Otherwise, if neither index [0] nor [1] is present, a struct/union is initialized by looking up each field name (as a string key) in the table. Each non-nil value is used to initialize the corresponding field.
  • Uninitialized fields of a struct are filled with zero bytes, except for the trailing VLA of a VLS.
  • Initialization of a union stops after one field has been initialized. If no field has been initialized, the union is filled with zero bytes.
  • Elements or fields which are aggregates themselves are initialized with a single initializer, but this may be a nested table initializer (or a compatible aggregate).
  • Excess initializers for an array cause an error. Excess initializers for a struct/union are ignored. Unrelated table entries are ignored, too.

Example:

local ffi = require("ffi")

ffi.cdef[[
struct foo { int a, b; };
union bar { int i; double d; };
struct nested { int x; struct foo y; };
]]

ffi.new("int[3]", {})            --> 0, 0, 0
ffi.new("int[3]", {1})           --> 1, 1, 1
ffi.new("int[3]", {1,2})         --> 1, 2, 0
ffi.new("int[3]", {1,2,3})       --> 1, 2, 3
ffi.new("int[3]", {[0]=1})       --> 1, 1, 1
ffi.new("int[3]", {[0]=1,2})     --> 1, 2, 0
ffi.new("int[3]", {[0]=1,2,3})   --> 1, 2, 3
ffi.new("int[3]", {[0]=1,2,3,4}) --> error: too many initializers

ffi.new("struct foo", {})            --> a = 0, b = 0
ffi.new("struct foo", {1})           --> a = 1, b = 0
ffi.new("struct foo", {1,2})         --> a = 1, b = 2
ffi.new("struct foo", {[0]=1,2})     --> a = 1, b = 2
ffi.new("struct foo", {b=2})         --> a = 0, b = 2
ffi.new("struct foo", {a=1,b=2,c=3}) --> a = 1, b = 2  'c' is ignored

ffi.new("union bar", {})        --> i = 0, d = 0.0
ffi.new("union bar", {1})       --> i = 1, d = ?
ffi.new("union bar", {[0]=1,2}) --> i = 1, d = ?    '2' is ignored
ffi.new("union bar", {d=2})     --> i = ?, d = 2.0

ffi.new("struct nested", {1,{2,3}})     --> x = 1, y.a = 2, y.b = 3
ffi.new("struct nested", {x=1,y={2,3}}) --> x = 1, y.a = 2, y.b = 3

Operations on cdata Objects

All of the standard Lua operators can be applied to cdata objects or a mix of a cdata object and another Lua object. The following list shows the pre-defined operations.

Reference types are dereferenced before performing each of the operations below — the operation is applied to the C type pointed to by the reference.

The pre-defined operations are always tried first before deferring to a metamethod or index table (if any) for the corresponding ctype (except for __new). An error is raised if the metamethod lookup or index table lookup fails.

Indexing a cdata object

  • Indexing a pointer/array: a cdata pointer/array can be indexed by a cdata number or a Lua number. The element address is computed as the base address plus the number value multiplied by the element size in bytes. A read access loads the element value and converts it to a Lua object. A write access converts a Lua object to the element type and stores the converted value to the element. An error is raised if the element size is undefined or a write access to a constant element is attempted.
  • Dereferencing a struct/union field: a cdata struct/union or a pointer to a struct/union can be dereferenced by a string key, giving the field name. The field address is computed as the base address plus the relative offset of the field. A read access loads the field value and converts it to a Lua object. A write access converts a Lua object to the field type and stores the converted value to the field. An error is raised if a write access to a constant struct/union or a constant field is attempted. Scoped enum constants or static constants are treated like a constant field.
  • Indexing a complex number: a complex number can be indexed either by a cdata number or a Lua number with the values 0 or 1, or by the strings "re" or "im". A read access loads the real part ([0], .re) or the imaginary part ([1], .im) part of a complex number and converts it to a Lua number. The sub-parts of a complex number are immutable — assigning to an index of a complex number raises an error. Accessing out-of-bound indexes returns unspecified results, but is guaranteed not to trigger memory access violations.
  • Indexing a vector: a vector is treated like an array for indexing purposes, except the vector elements are immutable — assigning to an index of a vector raises an error.

A ctype object can be indexed with a string key, too. The only pre-defined operation is reading scoped constants of struct/union types. All other accesses defer to the corresponding metamethods or index tables (if any).

Note: since there's (deliberately) no address-of operator, a cdata object holding a value type is effectively immutable after initialization. The JIT compiler benefits from this fact when applying certain optimizations.

As a consequence, the elements of complex numbers and vectors are immutable. But the elements of an aggregate holding these types may be modified of course. I.e. you cannot assign to foo.c.im, but you can assign a (newly created) complex number to foo.c.

The JIT compiler implements strict aliasing rules: accesses to different types do not alias, except for differences in signedness (this applies even to char pointers, unlike C99). Type punning through unions is explicitly detected and allowed.

Calling a cdata object

  • Constructor: a ctype object can be called and used as a constructor. This is equivalent to ffi.new(ct, ...), unless a __new metamethod is defined. The __new metamethod is called with the ctype object plus any other arguments passed to the contructor. Note that you have to use ffi.new inside of it, since calling ct(...) would cause infinite recursion.
  • C function call: a cdata function or cdata function pointer can be called. The passed arguments are converted to the C types of the parameters given by the function declaration. Arguments passed to the variable argument part of vararg C function use special conversion rules. This C function is called and the return value (if any) is converted to a Lua object.
    On Windows/x86 systems, __stdcall functions are automatically detected and a function declared as __cdecl (the default) is silently fixed up after the first call.

Arithmetic on cdata objects

  • Pointer arithmetic: a cdata pointer/array and a cdata number or a Lua number can be added or subtracted. The number must be on the right hand side for a subtraction. The result is a pointer of the same type with an address plus or minus the number value multiplied by the element size in bytes. An error is raised if the element size is undefined.
  • Pointer difference: two compatible cdata pointers/arrays can be subtracted. The result is the difference between their addresses, divided by the element size in bytes. An error is raised if the element size is undefined or zero.
  • 64 bit integer arithmetic: the standard arithmetic operators (+ - * / % ^ and unary minus) can be applied to two cdata numbers, or a cdata number and a Lua number. If one of them is an uint64_t, the other side is converted to an uint64_t and an unsigned arithmetic operation is performed. Otherwise both sides are converted to an int64_t and a signed arithmetic operation is performed. The result is a boxed 64 bit cdata object.
    If one of the operands is an enum and the other operand is a string, the string is converted to the value of a matching enum constant before the above conversion.
    These rules ensure that 64 bit integers are "sticky". Any expression involving at least one 64 bit integer operand results in another one. The undefined cases for the division, modulo and power operators return 2LL ^ 63 or 2ULL ^ 63.
    You'll have to explicitly convert a 64 bit integer to a Lua number (e.g. for regular floating-point calculations) with tonumber(). But note this may incur a precision loss.

Comparisons of cdata objects

  • Pointer comparison: two compatible cdata pointers/arrays can be compared. The result is the same as an unsigned comparison of their addresses. nil is treated like a NULL pointer, which is compatible with any other pointer type.
  • 64 bit integer comparison: two cdata numbers, or a cdata number and a Lua number can be compared with each other. If one of them is an uint64_t, the other side is converted to an uint64_t and an unsigned comparison is performed. Otherwise both sides are converted to an int64_t and a signed comparison is performed.
    If one of the operands is an enum and the other operand is a string, the string is converted to the value of a matching enum constant before the above conversion.
  • Comparisons for equality/inequality never raise an error. Even incompatible pointers can be compared for equality by address. Any other incompatible comparison (also with non-cdata objects) treats the two sides as unequal.

cdata objects as table keys

Lua tables may be indexed by cdata objects, but this doesn't provide any useful semantics — cdata objects are unsuitable as table keys!

A cdata object is treated like any other garbage-collected object and is hashed and compared by its address for table indexing. Since there's no interning for cdata value types, the same value may be boxed in different cdata objects with different addresses. Thus t[1LL+1LL] and t[2LL] usually do not point to the same hash slot and they certainly do not point to the same hash slot as t[2].

It would seriously drive up implementation complexity and slow down the common case, if one were to add extra handling for by-value hashing and comparisons to Lua tables. Given the ubiquity of their use inside the VM, this is not acceptable.

There are three viable alternatives, if you really need to use cdata objects as keys:

  • If you can get by with the precision of Lua numbers (52 bits), then use tonumber() on a cdata number or combine multiple fields of a cdata aggregate to a Lua number. Then use the resulting Lua number as a key when indexing tables.
    One obvious benefit: t[tonumber(2LL)] does point to the same slot as t[2].
  • Otherwise use either tostring() on 64 bit integers or complex numbers or combine multiple fields of a cdata aggregate to a Lua string (e.g. with ffi.string()). Then use the resulting Lua string as a key when indexing tables.
  • Create your own specialized hash table implementation using the C types provided by the FFI library, just like you would in C code. Ultimately this may give much better performance than the other alternatives or what a generic by-value hash table could possibly provide.

Parameterized Types

To facilitate some abstractions, the two functions ffi.typeof and ffi.cdef support parameterized types in C declarations. Note: none of the other API functions taking a cdecl allow this.

Any place you can write a typedef name, an identifier or a number in a declaration, you can write $ (the dollar sign) instead. These placeholders are replaced in order of appearance with the arguments following the cdecl string:

-- Declare a struct with a parameterized field type and name:
ffi.cdef([[
typedef struct { $ $; } foo_t;
]], type1, name1)

-- Anonymous struct with dynamic names:
local bar_t = ffi.typeof("struct { int $, $; }", name1, name2)
-- Derived pointer type:
local bar_ptr_t = ffi.typeof("$ *", bar_t)

-- Parameterized dimensions work even where a VLA won't work:
local matrix_t = ffi.typeof("uint8_t[$][$]", width, height)

Caveat: this is not simple text substitution! A passed ctype or cdata object is treated like the underlying type, a passed string is considered an identifier and a number is considered a number. You must not mix this up: e.g. passing "int" as a string doesn't work in place of a type, you'd need to use ffi.typeof("int") instead.

The main use for parameterized types are libraries implementing abstract data types (» example), similar to what can be achieved with C++ template metaprogramming. Another use case are derived types of anonymous structs, which avoids pollution of the global struct namespace.

Please note that parameterized types are a nice tool and indispensable for certain use cases. But you'll want to use them sparingly in regular code, e.g. when all types are actually fixed.

Garbage Collection of cdata Objects

All explicitly (ffi.new(), ffi.cast() etc.) or implicitly (accessors) created cdata objects are garbage collected. You need to ensure to retain valid references to cdata objects somewhere on a Lua stack, an upvalue or in a Lua table while they are still in use. Once the last reference to a cdata object is gone, the garbage collector will automatically free the memory used by it (at the end of the next GC cycle).

Please note that pointers themselves are cdata objects, however they are not followed by the garbage collector. So e.g. if you assign a cdata array to a pointer, you must keep the cdata object holding the array alive as long as the pointer is still in use:

ffi.cdef[[
typedef struct { int *a; } foo_t;
]]

local s = ffi.new("foo_t", ffi.new("int[10]")) -- WRONG!

local a = ffi.new("int[10]") -- OK
local s = ffi.new("foo_t", a)
-- Now do something with 's', but keep 'a' alive until you're done.

Similar rules apply for Lua strings which are implicitly converted to "const char *": the string object itself must be referenced somewhere or it'll be garbage collected eventually. The pointer will then point to stale data, which may have already been overwritten. Note that string literals are automatically kept alive as long as the function containing it (actually its prototype) is not garbage collected.

Objects which are passed as an argument to an external C function are kept alive until the call returns. So it's generally safe to create temporary cdata objects in argument lists. This is a common idiom for passing specific C types to vararg functions.

Memory areas returned by C functions (e.g. from malloc()) must be manually managed, of course (or use ffi.gc()). Pointers to cdata objects are indistinguishable from pointers returned by C functions (which is one of the reasons why the GC cannot follow them).

Callbacks

The LuaJIT FFI automatically generates special callback functions whenever a Lua function is converted to a C function pointer. This associates the generated callback function pointer with the C type of the function pointer and the Lua function object (closure).

This can happen implicitly due to the usual conversions, e.g. when passing a Lua function to a function pointer argument. Or you can use ffi.cast() to explicitly cast a Lua function to a C function pointer.

Currently only certain C function types can be used as callback functions. Neither C vararg functions nor functions with pass-by-value aggregate argument or result types are supported. There are no restrictions for the kind of Lua functions that can be called from the callback — no checks for the proper number of arguments are made. The return value of the Lua function will be converted to the result type and an error will be thrown for invalid conversions.

It's allowed to throw errors across a callback invocation, but it's not advisable in general. Do this only if you know the C function, that called the callback, copes with the forced stack unwinding and doesn't leak resources.

One thing that's not allowed, is to let an FFI call into a C function get JIT-compiled, which in turn calls a callback, calling into Lua again. Usually this attempt is caught by the interpreter first and the C function is blacklisted for compilation.

However, this heuristic may fail under specific circumstances: e.g. a message polling function might not run Lua callbacks right away and the call gets JIT-compiled. If it later happens to call back into Lua (e.g. a rarely invoked error callback), you'll get a VM PANIC with the message "bad callback". Then you'll need to manually turn off JIT-compilation with jit.off() for the surrounding Lua function that invokes such a message polling function (or similar).

Callback resource handling

Callbacks take up resources — you can only have a limited number of them at the same time (500 - 1000, depending on the architecture). The associated Lua functions are anchored to prevent garbage collection, too.

Callbacks due to implicit conversions are permanent! There is no way to guess their lifetime, since the C side might store the function pointer for later use (typical for GUI toolkits). The associated resources cannot be reclaimed until termination:

ffi.cdef[[
typedef int (__stdcall *WNDENUMPROC)(void *hwnd, intptr_t l);
int EnumWindows(WNDENUMPROC func, intptr_t l);
]]

-- Implicit conversion to a callback via function pointer argument.
local count = 0
ffi.C.EnumWindows(function(hwnd, l)
  count = count + 1
  return true
end, 0)
-- The callback is permanent and its resources cannot be reclaimed!
-- Ok, so this may not be a problem, if you do this only once.

Note: this example shows that you must properly declare __stdcall callbacks on Windows/x86 systems. The calling convention cannot be automatically detected, unlike for __stdcall calls to Windows functions.

For some use cases it's necessary to free up the resources or to dynamically redirect callbacks. Use an explicit cast to a C function pointer and keep the resulting cdata object. Then use the cb:free() or cb:set() methods on the cdata object:

-- Explicitly convert to a callback via cast.
local count = 0
local cb = ffi.cast("WNDENUMPROC", function(hwnd, l)
  count = count + 1
  return true
end)

-- Pass it to a C function.
ffi.C.EnumWindows(cb, 0)
-- EnumWindows doesn't need the callback after it returns, so free it.

cb:free()
-- The callback function pointer is no longer valid and its resources
-- will be reclaimed. The created Lua closure will be garbage collected.

Callback performance

Callbacks are slow! First, the C to Lua transition itself has an unavoidable cost, similar to a lua_call() or lua_pcall(). Argument and result marshalling add to that cost. And finally, neither the C compiler nor LuaJIT can inline or optimize across the language barrier and hoist repeated computations out of a callback function.

Do not use callbacks for performance-sensitive work: e.g. consider a numerical integration routine which takes a user-defined function to integrate over. It's a bad idea to call a user-defined Lua function from C code millions of times. The callback overhead will be absolutely detrimental for performance.

It's considerably faster to write the numerical integration routine itself in Lua — the JIT compiler will be able to inline the user-defined function and optimize it together with its calling context, with very competitive performance.

As a general guideline: use callbacks only when you must, because of existing C APIs. E.g. callback performance is irrelevant for a GUI application, which waits for user input most of the time, anyway.

For new designs avoid push-style APIs: a C function repeatedly calling a callback for each result. Instead use pull-style APIs: call a C function repeatedly to get a new result. Calls from Lua to C via the FFI are much faster than the other way round. Most well-designed libraries already use pull-style APIs (read/write, get/put).

C Library Namespaces

A C library namespace is a special kind of object which allows access to the symbols contained in shared libraries or the default symbol namespace. The default ffi.C namespace is automatically created when the FFI library is loaded. C library namespaces for specific shared libraries may be created with the ffi.load() API function.

Indexing a C library namespace object with a symbol name (a Lua string) automatically binds it to the library. First the symbol type is resolved — it must have been declared with ffi.cdef. Then the symbol address is resolved by searching for the symbol name in the associated shared libraries or the default symbol namespace. Finally, the resulting binding between the symbol name, the symbol type and its address is cached. Missing symbol declarations or nonexistent symbol names cause an error.

This is what happens on a read access for the different kinds of symbols:

  • External functions: a cdata object with the type of the function and its address is returned.
  • External variables: the symbol address is dereferenced and the loaded value is converted to a Lua object and returned.
  • Constant values (static const or enum constants): the constant is converted to a Lua object and returned.

This is what happens on a write access:

  • External variables: the value to be written is converted to the C type of the variable and then stored at the symbol address.
  • Writing to constant variables or to any other symbol type causes an error, like any other attempted write to a constant location.

C library namespaces themselves are garbage collected objects. If the last reference to the namespace object is gone, the garbage collector will eventually release the shared library reference and remove all memory associated with the namespace. Since this may trigger the removal of the shared library from the memory of the running process, it's generally not safe to use function cdata objects obtained from a library if the namespace object may be unreferenced.

Performance notice: the JIT compiler specializes to the identity of namespace objects and to the strings used to index it. This effectively turns function cdata objects into constants. It's not useful and actually counter-productive to explicitly cache these function objects, e.g. local strlen = ffi.C.strlen. OTOH it is useful to cache the namespace itself, e.g. local C = ffi.C.

No Hand-holding!

The FFI library has been designed as a low-level library. The goal is to interface with C code and C data types with a minimum of overhead. This means you can do anything you can do from C: access all memory, overwrite anything in memory, call machine code at any memory address and so on.

The FFI library provides no memory safety, unlike regular Lua code. It will happily allow you to dereference a NULL pointer, to access arrays out of bounds or to misdeclare C functions. If you make a mistake, your application might crash, just like equivalent C code would.

This behavior is inevitable, since the goal is to provide full interoperability with C code. Adding extra safety measures, like bounds checks, would be futile. There's no way to detect misdeclarations of C functions, since shared libraries only provide symbol names, but no type information. Likewise there's no way to infer the valid range of indexes for a returned pointer.

Again: the FFI library is a low-level library. This implies it needs to be used with care, but it's flexibility and performance often outweigh this concern. If you're a C or C++ developer, it'll be easy to apply your existing knowledge. OTOH writing code for the FFI library is not for the faint of heart and probably shouldn't be the first exercise for someone with little experience in Lua, C or C++.

As a corollary of the above, the FFI library is not safe for use by untrusted Lua code. If you're sandboxing untrusted Lua code, you definitely don't want to give this code access to the FFI library or to any cdata object (except 64 bit integers or complex numbers). Any properly engineered Lua sandbox needs to provide safety wrappers for many of the standard Lua library functions — similar wrappers need to be written for high-level operations on FFI data types, too.

Current Status

The initial release of the FFI library has some limitations and is missing some features. Most of these will be fixed in future releases.

C language support is currently incomplete:

  • C declarations are not passed through a C pre-processor, yet.
  • The C parser is able to evaluate most constant expressions commonly found in C header files. However it doesn't handle the full range of C expression semantics and may fail for some obscure constructs.
  • static const declarations only work for integer types up to 32 bits. Neither declaring string constants nor floating-point constants is supported.
  • Packed struct bitfields that cross container boundaries are not implemented.
  • Native vector types may be defined with the GCC mode or vector_size attribute. But no operations other than loading, storing and initializing them are supported, yet.
  • The volatile type qualifier is currently ignored by compiled code.
  • ffi.cdef silently ignores most re-declarations. Note: avoid re-declarations which do not conform to C99. The implementation will eventually be changed to perform strict checks.

The JIT compiler already handles a large subset of all FFI operations. It automatically falls back to the interpreter for unimplemented operations (you can check for this with the -jv command line option). The following operations are currently not compiled and may exhibit suboptimal performance, especially when used in inner loops:

  • Bitfield accesses and initializations.
  • Vector operations.
  • Table initializers.
  • Initialization of nested struct/union types.
  • Allocations of variable-length arrays or structs.
  • Allocations of C types with a size > 128 bytes or an alignment > 8 bytes.
  • Conversions from lightuserdata to void *.
  • Pointer differences for element sizes that are not a power of two.
  • Calls to C functions with aggregates passed or returned by value.
  • Calls to ctype metamethods which are not plain functions.
  • ctype __newindex tables and non-string lookups in ctype __index tables.
  • tostring() for cdata types.
  • Calls to ffi.cdef(), ffi.load() and ffi.metatype().

Other missing features:

  • Bit operations for 64 bit types.
  • Arithmetic for complex numbers.
  • Passing structs by value to vararg C functions.
  • C++ exception interoperability does not extend to C functions called via the FFI, if the call is compiled.

wcc-0.0.2/src/wsh/luajit-2.0/doc/changes.html0000644000175000017500000013145213122010155017153 0ustar philphil LuaJIT Change History

This is a list of changes between the released versions of LuaJIT.
The current stable version is LuaJIT 2.0.4.

Please check the » Online Change History to see whether newer versions are available.

LuaJIT 2.0.4 — 2015-05-14

  • Fix stack check in narrowing optimization.
  • Fix Lua/C API typecheck error for special indexes.
  • Fix string to number conversion.
  • Fix lexer error for chunks without tokens.
  • Don't compile IR_RETF after CALLT to ff with-side effects.
  • Fix BC_UCLO/BC_JMP join optimization in Lua parser.
  • Fix corner case in string to number conversion.
  • Gracefully handle lua_error() for a suspended coroutine.
  • Avoid error messages when building with Clang.
  • Fix snapshot #0 handling for traces with a stack check on entry.
  • Fix fused constant loads under high register pressure.
  • Invalidate backpropagation cache after DCE.
  • Fix ABC elimination.
  • Fix debug info for main chunk of stripped bytecode.
  • Fix FOLD rule for string.sub(s, ...) == k.
  • Fix FOLD rule for STRREF of SNEW.
  • Fix frame traversal while searching for error function.
  • Prevent GC estimate miscalculation due to buffer growth.
  • Prevent adding side traces for stack checks.
  • Fix top slot calculation for snapshots with continuations.
  • Fix check for reuse of SCEV results in FORL.
  • Add PS Vita port.
  • Fix compatibility issues with Illumos.
  • Fix DragonFly build (unsupported).
  • OpenBSD/x86: Better executable memory allocation for W^X mode.
  • x86: Fix argument checks for ipairs() iterator.
  • x86: lj_math_random_step() clobbers XMM regs on OSX Clang.
  • x86: Fix code generation for unused result of math.random().
  • x64: Allow building with LUAJIT_USE_SYSMALLOC and LUAJIT_USE_VALGRIND.
  • x86/x64: Fix argument check for bit shifts.
  • x86/x64: Fix code generation for fused test/arith ops.
  • ARM: Fix write barrier check in BC_USETS.
  • PPC: Fix red zone overflow in machine code generation.
  • PPC: Don't use mcrxr on PPE.
  • Various archs: Fix excess stack growth in interpreter.
  • FFI: Fix FOLD rule for TOBIT + CONV num.u32.
  • FFI: Prevent DSE across ffi.string().
  • FFI: No meta fallback when indexing pointer to incomplete struct.
  • FFI: Fix initialization of unions of subtypes.
  • FFI: Fix cdata vs. non-cdata arithmetic and comparisons.
  • FFI: Fix __index/__newindex metamethod resolution for ctypes.
  • FFI: Fix compilation of reference field access.
  • FFI: Fix frame traversal for backtraces with FFI callbacks.
  • FFI: Fix recording of indexing a struct pointer ctype object itself.
  • FFI: Allow non-scalar cdata to be compared for equality by address.
  • FFI: Fix pseudo type conversions for type punning.

LuaJIT 2.0.3 — 2014-03-12

  • Add PS4 port.
  • Add support for multilib distro builds.
  • Fix OSX build.
  • Fix MinGW build.
  • Fix Xbox 360 build.
  • Improve ULOAD forwarding for open upvalues.
  • Fix GC steps threshold handling when called by JIT-compiled code.
  • Fix argument checks for math.deg() and math.rad().
  • Fix jit.flush(func|true).
  • Respect jit.off(func) when returning to a function, too.
  • Fix compilation of string.byte(s, nil, n).
  • Fix line number for relocated bytecode after closure fixup
  • Fix frame traversal for backtraces.
  • Fix ABC elimination.
  • Fix handling of redundant PHIs.
  • Fix snapshot restore for exit to function header.
  • Fix type punning alias analysis for constified pointers
  • Fix call unroll checks in the presence of metamethod frames.
  • Fix initial maxslot for down-recursive traces.
  • Prevent BASE register coalescing if parent uses IR_RETF.
  • Don't purge modified function from stack slots in BC_RET.
  • Fix recording of BC_VARG.
  • Don't access dangling reference to reallocated IR.
  • Fix frame depth display for bytecode dump in -jdump.
  • ARM: Fix register allocation when rematerializing FPRs.
  • x64: Fix store to upvalue for lightuserdata values.
  • FFI: Add missing GC steps for callback argument conversions.
  • FFI: Properly unload loaded DLLs.
  • FFI: Fix argument checks for ffi.string().
  • FFI/x64: Fix passing of vector arguments to calls.
  • FFI: Rehash finalizer table after GC cycle, if needed.
  • FFI: Fix cts->L for cdata unsinking in snapshot restore.

LuaJIT 2.0.2 — 2013-06-03

  • Fix memory access check for fast string interning.
  • Fix MSVC intrinsics for older versions.
  • Add missing GC steps for io.* functions.
  • Fix spurious red zone overflows in machine code generation.
  • Fix jump-range constrained mcode allocation.
  • Inhibit DSE for implicit loads via calls.
  • Fix builtin string to number conversion for overflow digits.
  • Fix optional argument handling while recording builtins.
  • Fix optional argument handling in table.concat().
  • Add partial support for building with MingW64 GCC 4.8-SEH.
  • Add missing PHI barrier to string.sub(str, a, b) == kstr FOLD rule.
  • Fix compatibility issues with Illumos.
  • ARM: Fix cache flush/sync for exit stubs of JIT-compiled code.
  • MIPS: Fix cache flush/sync for JIT-compiled code jump area.
  • PPC: Add plt suffix for external calls from assembler code.
  • FFI: Fix snapshot substitution in SPLIT pass.
  • FFI/x86: Fix register allocation for 64 bit comparisons.
  • FFI: Fix tailcall in lowest frame to C function with bool result.
  • FFI: Ignore long type specifier in ffi.istype().
  • FFI: Fix calling conventions for 32 bit OSX and iOS simulator (struct returns).
  • FFI: Fix calling conventions for ARM hard-float EABI (nested structs).
  • FFI: Improve error messages for arithmetic and comparison operators.
  • FFI: Insert no-op type conversion for pointer to integer cast.
  • FFI: Fix unroll limit for ffi.fill().
  • FFI: Must sink XBAR together with XSTOREs.
  • FFI: Preserve intermediate string for const char * conversion.

LuaJIT 2.0.1 — 2013-02-19

  • Don't clear frame for out-of-memory error.
  • Leave hook when resume catches error thrown from hook.
  • Add missing GC steps for template table creation.
  • Fix discharge order of comparisons in Lua parser.
  • Improve buffer handling for io.read().
  • OSX: Add support for Mach-O object files to -b option.
  • Fix PS3 port.
  • Fix/enable Xbox 360 port.
  • x86/x64: Always mark ref for shift count as non-weak.
  • x64: Don't fuse implicitly 32-to-64 extended operands.
  • ARM: Fix armhf call argument handling.
  • ARM: Fix code generation for integer math.min/math.max.
  • PPC/e500: Fix lj_vm_floor() for Inf/NaN.
  • FFI: Change priority of table initializer variants for structs.
  • FFI: Fix code generation for bool call result check on x86/x64.
  • FFI: Load FFI library on-demand for bytecode with cdata literals.
  • FFI: Fix handling of qualified transparent structs/unions.

LuaJIT 2.0.0 — 2012-11-08

  • Correctness and completeness:
    • Fix Android/x86 build.
    • Fix recording of equality comparisons with __eq metamethods.
    • Fix detection of immutable upvalues.
    • Replace error with PANIC for callbacks from JIT-compiled code.
    • Fix builtin string to number conversion for INT_MIN.
    • Don't create unneeded array part for template tables.
    • Fix CONV.num.int sinking.
    • Don't propagate implicitly widened number to index metamethods.
    • ARM: Fix ordered comparisons of number vs. non-number.
    • FFI: Fix code generation for replay of sunk float fields.
    • FFI: Fix signedness of bool.
    • FFI: Fix recording of bool call result check on x86/x64.
    • FFI: Fix stack-adjustment for __thiscall callbacks.

LuaJIT 2.0.0-beta11 — 2012-10-16

  • New features:
    • Use ARM VFP instructions, if available (build-time detection).
    • Add support for ARM hard-float EABI (armhf).
    • Add PS3 port.
    • Add many features from Lua 5.2, e.g. goto/labels. Refer to this list.
    • FFI: Add parameterized C types.
    • FFI: Add support for copy constructors.
    • FFI: Equality comparisons never raise an error (treat as unequal instead).
    • FFI: Box all accessed or returned enums.
    • FFI: Check for __new metamethod when calling a constructor.
    • FFI: Handle __pairs/__ipairs metamethods for cdata objects.
    • FFI: Convert io.* file handle to FILE * pointer (but as a void *).
    • FFI: Detect and support type punning through unions.
    • FFI: Improve various error messages.
  • Build-system reorganization:
    • Reorganize directory layout:
      lib/*src/jit/*
      src/buildvm_*.dascsrc/vm_*.dasc
      src/buildvm_*.h → removed
      src/buildvm*src/host/*
    • Add minified Lua interpreter plus Lua BitOp (minilua) to run DynASM.
    • Change DynASM bit operations to use Lua BitOp
    • Translate only vm_*.dasc for detected target architecture.
    • Improve target detection for msvcbuild.bat.
    • Fix build issues on Cygwin and MinGW with optional MSys.
    • Handle cross-compiles with FPU/no-FPU or hard-fp/soft-fp ABI mismatch.
    • Remove some library functions for no-JIT/no-FFI builds.
    • Add uninstall target to top-level Makefile.
  • Correctness and completeness:
    • Preserve snapshot #0 PC for all traces.
    • Fix argument checks for coroutine.create().
    • Command line prints version and JIT status to stdout, not stderr.
    • Fix userdata __gc separations at Lua state close.
    • Fix TDUP to HLOAD forwarding for LJ_DUALNUM builds.
    • Fix buffer check in bytecode writer.
    • Make os.date() thread-safe.
    • Add missing declarations for MSVC intrinsics.
    • Fix dispatch table modifications for return hooks.
    • Workaround for MSVC conversion bug (doubleuint32_tint32_t).
    • Fix FOLD rule (i-j)-i => 0-j.
    • Never use DWARF unwinder on Windows.
    • Fix shrinking of direct mapped blocks in builtin allocator.
    • Limit recursion depth in string.match() et al.
    • Fix late despecialization of ITERN after loop has been entered.
    • Fix 'f' and 'L' options for debug.getinfo() and lua_getinfo().
    • Fix package.searchpath().
    • OSX: Change dylib names to be consistent with other platforms.
    • Android: Workaround for broken sprintf("%g", -0.0).
    • x86: Remove support for ancient CPUs without CMOV (before Pentium Pro).
    • x86: Fix register allocation for calls returning register pair.
    • x86/x64: Fix fusion of unsigned byte comparisons with swapped operands.
    • ARM: Fix tonumber() argument check.
    • ARM: Fix modulo operator and math.floor()/math.ceil() for inf/nan.
    • ARM: Invoke SPLIT pass for leftover IR_TOBIT.
    • ARM: Fix BASE register coalescing.
    • PPC: Fix interpreter state setup in callbacks.
    • PPC: Fix string.sub() range check.
    • MIPS: Support generation of MIPS/MIPSEL bytecode object files.
    • MIPS: Fix calls to floor()/ceil()/trunc().
    • ARM/PPC: Detect more target architecture variants.
    • ARM/PPC/e500/MIPS: Fix tailcalls from fast functions, esp. tostring().
    • ARM/PPC/MIPS: Fix rematerialization of FP constants.
    • FFI: Don't call FreeLibrary() on our own EXE/DLL.
    • FFI: Resolve metamethods for constructors, too.
    • FFI: Properly disable callbacks on iOS (would require executable memory).
    • FFI: Fix cdecl string parsing during recording.
    • FFI: Show address pointed to for tostring(ref), too.
    • FFI: Fix alignment of C call argument/return structure.
    • FFI: Initialize all fields of standard types.
    • FFI: Fix callback handling when new C types are declared in callback.
    • FFI: Fix recording of constructors for pointers.
    • FFI: Always resolve metamethods for pointers to structs.
    • FFI: Correctly propagate alignment when interning nested types.
  • Structural and performance enhancements:
    • Add allocation sinking and store sinking optimization.
    • Constify immutable upvalues.
    • Add builtin string to integer or FP number conversion. Improves cross-platform consistency and correctness.
    • Create string hash slots in template tables for non-const values, too. Avoids later table resizes.
    • Eliminate HREFK guard for template table references.
    • Add various new FOLD rules.
    • Don't use stack unwinding for lua_yield() (slow on x64).
    • ARM, PPC, MIPS: Improve XLOAD operand fusion and register hinting.
    • PPC, MIPS: Compile math.sqrt() to sqrt instruction, if available.
    • FFI: Fold KPTR + constant offset in SPLIT pass.
    • FFI: Optimize/inline ffi.copy() and ffi.fill().
    • FFI: Compile and optimize array/struct copies.
    • FFI: Compile ffi.typeof(cdata|ctype), ffi.sizeof(), ffi.alignof(), ffi.offsetof() and ffi.gc().

LuaJIT 2.0.0-beta10 — 2012-05-09

  • New features:
    • The MIPS of LuaJIT is complete. It requires a CPU conforming to the MIPS32 R1 architecture with hardware FPU. O32 hard-fp ABI, little-endian or big-endian.
    • Auto-detect target arch via cross-compiler. No need for TARGET=arch anymore.
    • Make DynASM compatible with Lua 5.2.
    • From Lua 5.2: Try __tostring metamethod on non-string error messages..
  • Correctness and completeness:
    • Fix parsing of hex literals with exponents.
    • Fix bytecode dump for certain number constants.
    • Fix argument type in error message for relative arguments.
    • Fix argument error handling on Lua stacks without a frame.
    • Add missing mcode limit check in assembler backend.
    • Fix compilation on OpenBSD.
    • Avoid recursive GC steps after GC-triggered trace exit.
    • Replace <unwind.h> definitions with our own.
    • Fix OSX build issues. Bump minimum required OSX version to 10.4.
    • Fix discharge order of comparisons in Lua parser.
    • Ensure running __gc of userdata created in __gc at state close.
    • Limit number of userdata __gc separations at state close.
    • Fix bytecode JMP slot range when optimizing and/or with constant LHS.
    • Fix DSE of USTORE.
    • Make lua_concat() work from C hook with partial frame.
    • Add required PHIs for implicit conversions, e.g. via XREF forwarding.
    • Add more comparison variants to Valgrind suppressions file.
    • Disable loading bytecode with an extra header (BOM or #!).
    • Fix PHI stack slot syncing.
    • ARM: Reorder type/value tests to silence Valgrind.
    • ARM: Fix register allocation for ldrd-optimized HREFK.
    • ARM: Fix conditional branch fixup for OBAR.
    • ARM: Invoke SPLIT pass for double args in FFI call.
    • ARM: Handle all CALL* ops with double results in SPLIT pass.
    • ARM: Fix rejoin of POW in SPLIT pass.
    • ARM: Fix compilation of math.sinh, math.cosh, math.tanh.
    • ARM, PPC: Avoid pointless arg clearing in BC_IFUNCF.
    • PPC: Fix resume after yield from hook.
    • PPC: Fix argument checking for rawget().
    • PPC: Fix fusion of floating-point XLOAD/XSTORE.
    • PPC: Fix HREFK code generation for huge tables.
    • PPC: Use builtin D-Cache/I-Cache sync code.
  • FFI library:
    • Ignore empty statements in ffi.cdef().
    • Ignore number parsing errors while skipping definitions.
    • Don't touch frame in callbacks with tailcalls to fast functions.
    • Fix library unloading on POSIX systems.
    • Finalize cdata before userdata when closing the state.
    • Change ffi.load() library name resolution for Cygwin.
    • Fix resolving of function name redirects on Windows/x86.
    • Fix symbol resolving error messages on Windows.
    • Fix blacklisting of C functions calling callbacks.
    • Fix result type of pointer difference.
    • Use correct PC in FFI metamethod error message.
    • Allow 'typedef _Bool int BOOL;' for the Windows API.
    • Don't record test for bool result of call, if ignored.

LuaJIT 2.0.0-beta9 — 2011-12-14

  • New features:
    • PPC port of LuaJIT is complete. Default is the dual-number port (usually faster). Single-number port selectable via src/Makefile at build time.
    • Add FFI callback support.
    • Extend -b to generate .c, .h or .obj/.o files with embedded bytecode.
    • Allow loading embedded bytecode with require().
    • From Lua 5.2: Change to '\z' escape. Reject undefined escape sequences.
  • Correctness and completeness:
    • Fix OSX 10.7 build. Fix install_name and versioning on OSX.
    • Fix iOS build.
    • Install dis_arm.lua, too.
    • Mark installed shared library as executable.
    • Add debug option to msvcbuild.bat and improve error handling.
    • Fix data-flow analysis for iterators.
    • Fix forced unwinding triggered by external unwinder.
    • Record missing for loop slot loads (return to lower frame).
    • Always use ANSI variants of Windows system functions.
    • Fix GC barrier for multi-result table constructor (TSETM).
    • Fix/add various FOLD rules.
    • Add potential PHI for number conversions due to type instability.
    • Do not eliminate PHIs only referenced from other PHIs.
    • Correctly anchor implicit number to string conversions in Lua/C API.
    • Fix various stack limit checks.
    • x64: Use thread-safe exceptions for external unwinding (GCC platforms).
    • x64: Fix result type of cdata index conversions.
    • x64: Fix math.random() and bit.bswap() code generation.
    • x64: Fix lightuserdata comparisons.
    • x64: Always extend stack-passed arguments to pointer size.
    • ARM: Many fixes to code generation backend.
    • PPC/e500: Fix dispatch for binop metamethods.
    • PPC/e500: Save/restore condition registers when entering/leaving the VM.
    • PPC/e500: Fix write barrier in stores of strings to upvalues.
  • FFI library:
    • Fix C comment parsing.
    • Fix snapshot optimization for cdata comparisons.
    • Fix recording of const/enum lookups in namespaces.
    • Fix call argument and return handling for I8/U8/I16/U16 types.
    • Fix unfused loads of float fields.
    • Fix ffi.string() recording.
    • Save GetLastError() around ffi.load() and symbol resolving, too.
    • Improve ld script detection in ffi.load().
    • Record loads/stores to external variables in namespaces.
    • Compile calls to stdcall, fastcall and vararg functions.
    • Treat function ctypes like pointers in comparisons.
    • Resolve __call metamethod for pointers, too.
    • Record C function calls with bool return values.
    • Record ffi.errno().
    • x86: Fix number to uint32_t conversion rounding.
    • x86: Fix 64 bit arithmetic in assembler backend.
    • x64: Fix struct-by-value calling conventions.
    • ARM: Ensure invocation of SPLIT pass for float conversions.
  • Structural and performance enhancements:
    • Display trace types with -jv and -jdump.
    • Record isolated calls. But prefer recording loops over calls.
    • Specialize to prototype for non-monomorphic functions. Solves the trace-explosion problem for closure-heavy programming styles.
    • Always generate a portable vmdef.lua. Easier for distros.

LuaJIT 2.0.0-beta8 — 2011-06-23

  • New features:
    • Soft-float ARM port of LuaJIT is complete.
    • Add support for bytecode loading/saving and -b command line option.
    • From Lua 5.2: __len metamethod for tables (disabled by default).
  • Correctness and completeness:
    • ARM: Misc. fixes for interpreter.
    • x86/x64: Fix bit.* argument checking in interpreter.
    • Catch early out-of-memory in memory allocator initialization.
    • Fix data-flow analysis for paths leading to an upvalue close.
    • Fix check for missing arguments in string.format().
    • Fix Solaris/x86 build (note: not a supported target).
    • Fix recording of loops with instable directions in side traces.
    • x86/x64: Fix fusion of comparisons with u8/u16 XLOAD.
    • x86/x64: Fix register allocation for variable shifts.
  • FFI library:
    • Add ffi.errno(). Save errno/GetLastError() around allocations etc.
    • Fix __gc for VLA/VLS cdata objects.
    • Fix recording of casts from 32 bit cdata pointers to integers.
    • tonumber(cdata) returns nil for non-numbers.
    • Show address pointed to for tostring(pointer).
    • Print NULL pointers as "cdata<... *>: NULL".
    • Support __tostring metamethod for pointers to structs, too.
  • Structural and performance enhancements:
    • More tuning for loop unrolling heuristics.
    • Flatten and compress in-memory debug info (saves ~70%).

LuaJIT 2.0.0-beta7 — 2011-05-05

  • New features:
    • ARM port of the LuaJIT interpreter is complete.
    • FFI library: Add ffi.gc(), ffi.metatype(), ffi.istype().
    • FFI library: Resolve ld script redirection in ffi.load().
    • From Lua 5.2: package.searchpath(), fp:read("*L"), load(string).
    • From Lua 5.2, disabled by default: empty statement, table.unpack(), modified coroutine.running().
  • Correctness and completeness:
    • FFI library: numerous fixes.
    • Fix type mismatches in store-to-load forwarding.
    • Fix error handling within metamethods.
    • Fix table.maxn().
    • Improve accuracy of x^-k on x64.
    • Fix code generation for Intel Atom in x64 mode.
    • Fix narrowing of POW.
    • Fix recording of retried fast functions.
    • Fix code generation for bit.bnot() and multiplies.
    • Fix error location within cpcall frames.
    • Add workaround for old libgcc unwind bug.
    • Fix lua_yield() and getmetatable(lightuserdata) on x64.
    • Misc. fixes for PPC/e500 interpreter.
    • Fix stack slot updates for down-recursion.
  • Structural and performance enhancements:
    • Add dual-number mode (int/double) for the VM. Enabled for ARM.
    • Improve narrowing of arithmetic operators and for loops.
    • Tune loop unrolling heuristics and increase trace recorder limits.
    • Eliminate dead slots in snapshots using bytecode data-flow analysis.
    • Avoid phantom stores to proxy tables.
    • Optimize lookups in empty proxy tables.
    • Improve bytecode optimization of and/or operators.

LuaJIT 2.0.0-beta6 — 2011-02-11

  • New features:
    • PowerPC/e500v2 port of the LuaJIT interpreter is complete.
    • Various minor features from Lua 5.2: Hex escapes in literals, '\*' escape, reversible string.format("%q",s), "%g" pattern, table.sort checks callbacks, os.exit(status|true|false[,close]).
    • Lua 5.2 __pairs and __ipairs metamethods (disabled by default).
    • Initial release of the FFI library.
  • Correctness and completeness:
    • Fix string.format() for non-finite numbers.
    • Fix memory leak when compiled to use the built-in allocator.
    • x86/x64: Fix unnecessary resize in TSETM bytecode.
    • Fix various GC issues with traces and jit.flush().
    • x64: Fix fusion of indexes for array references.
    • x86/x64: Fix stack overflow handling for coroutine results.
    • Enable low-2GB memory allocation on FreeBSD/x64.
    • Fix collectgarbage("count") result if more than 2GB is in use.
    • Fix parsing of hex floats.
    • x86/x64: Fix loop branch inversion with trailing HREF+NE/EQ.
    • Add jit.os string.
    • coroutine.create() permits running C functions, too.
    • Fix OSX build to work with newer ld64 versions.
    • Fix bytecode optimization of and/or operators.
  • Structural and performance enhancements:
    • Emit specialized bytecode for pairs()/next().
    • Improve bytecode coalescing of nil constants.
    • Compile calls to vararg functions.
    • Compile select().
    • Improve alias analysis, esp. for loads from allocations.
    • Tuning of various compiler heuristics.
    • Refactor and extend IR conversion instructions.
    • x86/x64: Various backend enhancements related to the FFI.
    • Add SPLIT pass to split 64 bit IR instructions for 32 bit CPUs.

LuaJIT 2.0.0-beta5 — 2010-08-24

  • Correctness and completeness:
    • Fix trace exit dispatch to function headers.
    • Fix Windows and OSX builds with LUAJIT_DISABLE_JIT.
    • Reorganize and fix placement of generated machine code on x64.
    • Fix TNEW in x64 interpreter.
    • Do not eliminate PHIs for values only referenced from side exits.
    • OS-independent canonicalization of strings for non-finite numbers.
    • Fix string.char() range check on x64.
    • Fix tostring() resolving within print().
    • Fix error handling for next().
    • Fix passing of constant arguments to external calls on x64.
    • Fix interpreter argument check for two-argument SSE math functions.
    • Fix C frame chain corruption caused by lua_cpcall().
    • Fix return from pcall() within active hook.
  • Structural and performance enhancements:
    • Replace on-trace GC frame syncing with interpreter exit.
    • Improve hash lookup specialization by not removing dead keys during GC.
    • Turn traces into true GC objects.
    • Avoid starting a GC cycle immediately after library init.
    • Add weak guards to improve dead-code elimination.
    • Speed up string interning.

LuaJIT 2.0.0-beta4 — 2010-03-28

  • Correctness and completeness:
    • Fix precondition for on-trace creation of table keys.
    • Fix {f()} on x64 when table is resized.
    • Fix folding of ordered comparisons with same references.
    • Fix snapshot restores for multi-result bytecodes.
    • Fix potential hang when recording bytecode with nested closures.
    • Fix recording of getmetatable(), tonumber() and bad argument types.
    • Fix SLOAD fusion across returns to lower frames.
  • Structural and performance enhancements:
    • Add array bounds check elimination. -Oabc is enabled by default.
    • More tuning for x64, e.g. smaller table objects.

LuaJIT 2.0.0-beta3 — 2010-03-07

  • LuaJIT x64 port:
    • Port integrated memory allocator to Linux/x64, Windows/x64 and OSX/x64.
    • Port interpreter and JIT compiler to x64.
    • Port DynASM to x64.
    • Many 32/64 bit cleanups in the VM.
    • Allow building the interpreter with either x87 or SSE2 arithmetics.
    • Add external unwinding and C++ exception interop (default on x64).
  • Correctness and completeness:
    • Fix constructor bytecode generation for certain conditional values.
    • Fix some cases of ordered string comparisons.
    • Fix lua_tocfunction().
    • Fix cutoff register in JMP bytecode for some conditional expressions.
    • Fix PHI marking algorithm for references from variant slots.
    • Fix package.cpath for non-default PREFIX.
    • Fix DWARF2 frame unwind information for interpreter on OSX.
    • Drive the GC forward on string allocations in the parser.
    • Implement call/return hooks (zero-cost if disabled).
    • Implement yield from C hooks.
    • Disable JIT compiler on older non-SSE2 CPUs instead of aborting.
  • Structural and performance enhancements:
    • Compile recursive code (tail-, up- and down-recursion).
    • Improve heuristics for bytecode penalties and blacklisting.
    • Split CALL/FUNC recording and clean up fast function call semantics.
    • Major redesign of internal function call handling.
    • Improve FOR loop const specialization and integerness checks.
    • Switch to pre-initialized stacks. Avoid frame-clearing.
    • Colocation of prototypes and related data: bytecode, constants, debug info.
    • Cleanup parser and streamline bytecode generation.
    • Add support for weak IR references to register allocator.
    • Switch to compressed, extensible snapshots.
    • Compile returns to frames below the start frame.
    • Improve alias analysis of upvalues using a disambiguation hash value.
    • Compile floor/ceil/trunc to SSE2 helper calls or SSE4.1 instructions.
    • Add generic C call handling to IR and backend.
    • Improve KNUM fuse vs. load heuristics.
    • Compile various io.*() functions.
    • Compile math.sinh(), math.cosh(), math.tanh() and math.random().

LuaJIT 2.0.0-beta2 — 2009-11-09

  • Reorganize build system. Build static+shared library on POSIX.
  • Allow C++ exception conversion on all platforms using a wrapper function.
  • Automatically catch C++ exceptions and rethrow Lua error (DWARF2 only).
  • Check for the correct x87 FPU precision at strategic points.
  • Always use wrappers for libm functions.
  • Resurrect metamethod name strings before copying them.
  • Mark current trace, even if compiler is idle.
  • Ensure FILE metatable is created only once.
  • Fix type comparisons when different integer types are involved.
  • Fix getmetatable() recording.
  • Fix TDUP with dead keys in template table.
  • jit.flush(tr) returns status. Prevent manual flush of a trace that's still linked.
  • Improve register allocation heuristics for invariant references.
  • Compile the push/pop variants of table.insert() and table.remove().
  • Compatibility with MSVC link /debug.
  • Fix lua_iscfunction().
  • Fix math.random() when compiled with -fpic (OSX).
  • Fix table.maxn().
  • Bump MACOSX_DEPLOYMENT_TARGET to 10.4
  • luaL_check*() and luaL_opt*() now support negative arguments, too.
    This matches the behavior of Lua 5.1, but not the specification.

LuaJIT 2.0.0-beta1 — 2009-10-31

  • This is the first public release of LuaJIT 2.0.
  • The whole VM has been rewritten from the ground up, so there's no point in listing differences over earlier versions.

LuaJIT 1.1.8 — 2012-04-16

LuaJIT 1.1.7 — 2011-05-05

LuaJIT 1.1.6 — 2010-03-28

  • Added fixes for the » currently known bugs in Lua 5.1.4.
  • Removed wrong GC check in jit_createstate(). Thanks to Tim Mensch.
  • Fixed bad assertions while compiling table.insert() and table.remove().

LuaJIT 1.1.5 — 2008-10-25

LuaJIT 1.1.4 — 2008-02-05

  • Merged with Lua 5.1.3. Fixes all » known bugs in Lua 5.1.2.
  • Fixed possible (but unlikely) stack corruption while compiling k^x expressions.
  • Fixed DynASM template for cmpss instruction.

LuaJIT 1.1.3 — 2007-05-24

  • Merged with Lua 5.1.2. Fixes all » known bugs in Lua 5.1.1.
  • Merged pending Lua 5.1.x fixes: "return -nil" bug, spurious count hook call.
  • Remove a (sometimes) wrong assertion in luaJIT_findpc().
  • DynASM now allows labels for displacements and .aword.
  • Fix some compiler warnings for DynASM glue (internal API change).
  • Correct naming for SSSE3 (temporarily known as SSE4) in DynASM and x86 disassembler.
  • The loadable debug modules now handle redirection to stdout (e.g. -j trace=-).

LuaJIT 1.1.2 — 2006-06-24

  • Fix MSVC inline assembly: use only local variables with lua_number2int().
  • Fix "attempt to call a thread value" bug on Mac OS X: make values of consts used as lightuserdata keys unique to avoid joining by the compiler/linker.

LuaJIT 1.1.1 — 2006-06-20

  • Merged with Lua 5.1.1. Fixes all » known bugs in Lua 5.1.
  • Enforce (dynamic) linker error for EXE/DLL version mismatches.
  • Minor changes to DynASM: faster pre-processing, smaller encoding for some immediates.

This release is in sync with Coco 1.1.1 (see the » Coco Change History).

LuaJIT 1.1.0 — 2006-03-13

  • Merged with Lua 5.1 (final).
  • New JIT call frame setup:
    • The C stack is kept 16 byte aligned (faster). Mandatory for Mac OS X on Intel, too.
    • Faster calling conventions for internal C helper functions.
    • Better instruction scheduling for function prologue, OP_CALL and OP_RETURN.
  • Miscellaneous optimizations:
    • Faster loads of FP constants. Remove narrow-to-wide store-to-load forwarding stalls.
    • Use (scalar) SSE2 ops (if the CPU supports it) to speed up slot moves and FP to integer conversions.
    • Optimized the two-argument form of OP_CONCAT (a..b).
    • Inlined OP_MOD (a%b). With better accuracy than the C variant, too.
    • Inlined OP_POW (a^b). Unroll x^k or use k^x = 2^(log2(k)*x) or call pow().
  • Changes in the optimizer:
    • Improved hinting for table keys derived from table values (t1[t2[x]]).
    • Lookup hinting now works with arbitrary object types and supports index chains, too.
    • Generate type hints for arithmetic and comparison operators, OP_LEN, OP_CONCAT and OP_FORPREP.
    • Remove several hint definitions in favour of a generic COMBINE hint.
    • Complete rewrite of jit.opt_inline module (ex jit.opt_lib).
  • Use adaptive deoptimization:
    • If runtime verification of a contract fails, the affected instruction is recompiled and patched on-the-fly. Regular programs will trigger deoptimization only occasionally.
    • This avoids generating code for uncommon fallback cases most of the time. Generated code is up to 30% smaller compared to LuaJIT 1.0.3.
    • Deoptimization is used for many opcodes and contracts:
      • OP_CALL, OP_TAILCALL: type mismatch for callable.
      • Inlined calls: closure mismatch, parameter number and type mismatches.
      • OP_GETTABLE, OP_SETTABLE: table or key type and range mismatches.
      • All arithmetic and comparison operators, OP_LEN, OP_CONCAT, OP_FORPREP: operand type and range mismatches.
    • Complete redesign of the debug and traceback info (bytecode ↔ mcode) to support deoptimization. Much more flexible and needs only 50% of the space.
    • The modules jit.trace, jit.dumphints and jit.dump handle deoptimization.
  • Inlined many popular library functions (for commonly used arguments only):
    • Most math.* functions (the 18 most used ones) [2x-10x faster].
    • string.len, string.sub and string.char [2x-10x faster].
    • table.insert, table.remove and table.getn [3x-5x faster].
    • coroutine.yield and coroutine.resume [3x-5x faster].
    • pairs, ipairs and the corresponding iterators [8x-15x faster].
  • Changes in the core and loadable modules and the stand-alone executable:
    • Added jit.version, jit.version_num and jit.arch.
    • Reorganized some internal API functions (jit.util.*mcode*).
    • The -j dump output now shows JSUB names, too.
    • New x86 disassembler module written in pure Lua. No dependency on ndisasm anymore. Flexible API, very compact (500 lines) and complete (x87, MMX, SSE, SSE2, SSE3, SSSE3, privileged instructions).
    • luajit -v prints the LuaJIT version and copyright on a separate line.
  • Added SSE, SSE2, SSE3 and SSSE3 support to DynASM.
  • Miscellaneous doc changes. Added a section about embedding LuaJIT.

This release is in sync with Coco 1.1.0 (see the » Coco Change History).

LuaJIT 1.0.3 — 2005-09-08

  • Even more docs.
  • Unified closure checks in jit.*.
  • Fixed some range checks in jit.util.*.
  • Fixed __newindex call originating from jit_settable_str().
  • Merged with Lua 5.1 alpha (including early bug fixes).

This is the first public release of LuaJIT.

LuaJIT 1.0.2 — 2005-09-02

  • Add support for flushing the Valgrind translation cache
    (MYCFLAGS= -DUSE_VALGRIND).
  • Add support for freeing executable mcode memory to the mmap()-based variant for POSIX systems.
  • Reorganized the C function signature handling in jit.opt_lib.
  • Changed to index-based hints for inlining C functions. Still no support in the backend for inlining.
  • Hardcode HEAP_CREATE_ENABLE_EXECUTE value if undefined.
  • Misc. changes to the jit.* modules.
  • Misc. changes to the Makefiles.
  • Lots of new docs.
  • Complete doc reorg.

Not released because Lua 5.1 alpha came out today.

LuaJIT 1.0.1 — 2005-08-31

  • Missing GC step in OP_CONCAT.
  • Fix result handling for C –> JIT calls.
  • Detect CPU feature bits.
  • Encode conditional moves (fucomip) only when supported.
  • Add fallback instructions for FP compares.
  • Add support for LUA_COMPAT_VARARG. Still disabled by default.
  • MSVC needs a specific place for the CALLBACK attribute (David Burgess).
  • Misc. doc updates.

Interim non-public release. Special thanks to Adam D. Moss for reporting most of the bugs.

LuaJIT 1.0.0 — 2005-08-29

This is the initial non-public release of LuaJIT.


wcc-0.0.2/src/wsh/luajit-2.0/doc/bluequad-print.css0000644000175000017500000000472213122010155020322 0ustar philphil/* Copyright (C) 2004-2016 Mike Pall. * * You are welcome to use the general ideas of this design for your own sites. * But please do not steal the stylesheet, the layout or the color scheme. */ body { font-family: serif; font-size: 11pt; margin: 0 3em; padding: 0; border: none; } a:link, a:visited, a:hover, a:active { text-decoration: none; background: transparent; color: #0000ff; } h1, h2, h3 { font-family: sans-serif; font-weight: bold; text-align: left; margin: 0.5em 0; padding: 0; } h1 { font-size: 200%; } h2 { font-size: 150%; } h3 { font-size: 125%; } p { margin: 0 0 0.5em 0; padding: 0; } ul, ol { margin: 0.5em 0; padding: 0 0 0 2em; } ul { list-style: outside square; } ol { list-style: outside decimal; } li { margin: 0; padding: 0; } dl { margin: 1em 0; padding: 1em; border: 1px solid black; } dt { font-weight: bold; margin: 0; padding: 0; } dt sup { float: right; margin-left: 1em; } dd { margin: 0.5em 0 0 2em; padding: 0; } table { table-layout: fixed; width: 100%; margin: 1em 0; padding: 0; border: 1px solid black; border-spacing: 0; border-collapse: collapse; } tr { margin: 0; padding: 0; border: none; } td { text-align: left; margin: 0; padding: 0.2em 0.5em; border-top: 1px solid black; border-bottom: 1px solid black; } tr.separate td { border-top: double; } tt, pre, code, kbd, samp { font-family: monospace; font-size: 75%; } kbd { font-weight: bolder; } blockquote, pre { margin: 1em 2em; padding: 0; } img { border: none; vertical-align: baseline; margin: 0; padding: 0; } img.left { float: left; margin: 0.5em 1em 0.5em 0; } img.right { float: right; margin: 0.5em 0 0.5em 1em; } .flush { clear: both; visibility: hidden; } .hide, .noprint, #nav { display: none !important; } .pagebreak { page-break-before: always; } #site { text-align: right; font-family: sans-serif; font-weight: bold; margin: 0 1em; border-bottom: 1pt solid black; } #site a { font-size: 1.2em; } #site a:link, #site a:visited { text-decoration: none; font-weight: bold; background: transparent; color: #ffffff; } #logo { color: #ff8000; } #head { clear: both; margin: 0 1em; } #main { line-height: 1.3; text-align: justify; margin: 1em; } #foot { clear: both; font-size: 80%; text-align: center; margin: 0 1.25em; padding: 0.5em 0 0 0; border-top: 1pt solid black; page-break-before: avoid; page-break-after: avoid; } wcc-0.0.2/src/wsh/luajit-2.0/doc/luajit.html0000644000175000017500000001751313122010155017034 0ustar philphil LuaJIT

LuaJIT is a Just-In-Time Compiler (JIT) for the » Lua programming language. Lua is a powerful, dynamic and light-weight programming language. It may be embedded or used as a general-purpose, stand-alone language.

LuaJIT is Copyright © 2005-2016 Mike Pall, released under the » MIT open source license.

Compatibility

WindowsLinuxBSDOSXPOSIX
EmbeddedAndroidiOS
PS3PS4PS VitaXbox 360
GCCCLANG
LLVM
MSVC
x86x64ARMPPCe500MIPS
Lua 5.1
API+ABI
+ JIT+ BitOp+ FFIDrop-in
DLL/.so

Overview

3x
-  100x
115 KB
VM
90 KB
JIT
63 KLOC
C
24 KLOC
ASM
11 KLOC
Lua

LuaJIT has been successfully used as a scripting middleware in games, appliances, network and graphics apps, numerical simulations, trading platforms and many other specialty applications. It scales from embedded devices, smartphones, desktops up to server farms. It combines high flexibility with » high performance and an unmatched low memory footprint.

LuaJIT has been in continuous development since 2005. It's widely considered to be one of the fastest dynamic language implementations. It has outperformed other dynamic languages on many cross-language benchmarks since its first release — often by a substantial margin.

For LuaJIT 2.0, the whole VM has been rewritten from the ground up and relentlessly optimized for performance. It combines a high-speed interpreter, written in assembler, with a state-of-the-art JIT compiler.

An innovative trace compiler is integrated with advanced, SSA-based optimizations and highly tuned code generation backends. A substantial reduction of the overhead associated with dynamic languages allows it to break into the performance range traditionally reserved for offline, static language compilers.

More ...

Please select a sub-topic in the navigation bar to learn more about LuaJIT.


wcc-0.0.2/src/wsh/script.lds0000644000175000017500000002114613110675433014346 0ustar philphil/* Script for -z combreloc: combine and sort reloc sections */ /* Copyright (C) 2014-2015 Free Software Foundation, Inc. Copying and distribution of this script, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. */ OUTPUT_FORMAT("elf64-x86-64", "elf64-x86-64", "elf64-x86-64") OUTPUT_ARCH(i386:x86-64) ENTRY(_start) SEARCH_DIR("=/usr/x86_64-linux-gnu/lib64"); SEARCH_DIR("=/usr/local/lib64"); SEARCH_DIR("=/lib64"); SEARCH_DIR("=/usr/lib64"); SEARCH_DIR("=/usr/x86_64-linux-gnu/lib"); SEARCH_DIR("=/usr/local/lib"); SEARCH_DIR("=/lib"); SEARCH_DIR("=/usr/lib"); SECTIONS { /* Read-only sections, merged into text segment: */ PROVIDE (__executable_start = SEGMENT_START("text-segment", 0x42000000)); . = SEGMENT_START("text-segment", 0x42000000) + SIZEOF_HEADERS; .interp : { *(.interp) } .note.gnu.build-id : { *(.note.gnu.build-id) } .hash : { *(.hash) } .gnu.hash : { *(.gnu.hash) } .dynsym : { *(.dynsym) } .dynstr : { *(.dynstr) } .gnu.version : { *(.gnu.version) } .gnu.version_d : { *(.gnu.version_d) } .gnu.version_r : { *(.gnu.version_r) } .rela.dyn : { *(.rela.init) *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*) *(.rela.fini) *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*) *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*) *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*) *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*) *(.rela.ctors) *(.rela.dtors) *(.rela.got) *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*) *(.rela.ldata .rela.ldata.* .rela.gnu.linkonce.l.*) *(.rela.lbss .rela.lbss.* .rela.gnu.linkonce.lb.*) *(.rela.lrodata .rela.lrodata.* .rela.gnu.linkonce.lr.*) *(.rela.ifunc) } .rela.plt : { *(.rela.plt) PROVIDE_HIDDEN (__rela_iplt_start = .); *(.rela.iplt) PROVIDE_HIDDEN (__rela_iplt_end = .); } .init : { KEEP (*(SORT_NONE(.init))) } .plt : { *(.plt) *(.iplt) } .plt.got : { *(.plt.got) } .plt.bnd : { *(.plt.bnd) } .text : { *(.text.unlikely .text.*_unlikely .text.unlikely.*) *(.text.exit .text.exit.*) *(.text.startup .text.startup.*) *(.text.hot .text.hot.*) *(.text .stub .text.* .gnu.linkonce.t.*) /* .gnu.warning sections are handled specially by elf32.em. */ *(.gnu.warning) } .fini : { KEEP (*(SORT_NONE(.fini))) } PROVIDE (__etext = .); PROVIDE (_etext = .); PROVIDE (etext = .); .rodata : { *(.rodata .rodata.* .gnu.linkonce.r.*) } .rodata1 : { *(.rodata1) } .eh_frame_hdr : { *(.eh_frame_hdr) *(.eh_frame_entry .eh_frame_entry.*) } .eh_frame : ONLY_IF_RO { KEEP (*(.eh_frame)) *(.eh_frame.*) } .gcc_except_table : ONLY_IF_RO { *(.gcc_except_table .gcc_except_table.*) } .gnu_extab : ONLY_IF_RO { *(.gnu_extab*) } /* These sections are generated by the Sun/Oracle C++ compiler. */ .exception_ranges : ONLY_IF_RO { *(.exception_ranges .exception_ranges*) } /* Adjust the address for the data segment. We want to adjust up to the same address within the page on the next page up. */ . = DATA_SEGMENT_ALIGN (CONSTANT (MAXPAGESIZE), CONSTANT (COMMONPAGESIZE)); /* Exception handling */ .eh_frame : ONLY_IF_RW { KEEP (*(.eh_frame)) *(.eh_frame.*) } .gnu_extab : ONLY_IF_RW { *(.gnu_extab) } .gcc_except_table : ONLY_IF_RW { *(.gcc_except_table .gcc_except_table.*) } .exception_ranges : ONLY_IF_RW { *(.exception_ranges .exception_ranges*) } /* Thread Local Storage sections */ .tdata : { *(.tdata .tdata.* .gnu.linkonce.td.*) } .tbss : { *(.tbss .tbss.* .gnu.linkonce.tb.*) *(.tcommon) } .preinit_array : { PROVIDE_HIDDEN (__preinit_array_start = .); KEEP (*(.preinit_array)) PROVIDE_HIDDEN (__preinit_array_end = .); } .init_array : { PROVIDE_HIDDEN (__init_array_start = .); KEEP (*(SORT_BY_INIT_PRIORITY(.init_array.*) SORT_BY_INIT_PRIORITY(.ctors.*))) KEEP (*(.init_array EXCLUDE_FILE (*crtbegin.o *crtbegin?.o *crtend.o *crtend?.o ) .ctors)) PROVIDE_HIDDEN (__init_array_end = .); } .fini_array : { PROVIDE_HIDDEN (__fini_array_start = .); KEEP (*(SORT_BY_INIT_PRIORITY(.fini_array.*) SORT_BY_INIT_PRIORITY(.dtors.*))) KEEP (*(.fini_array EXCLUDE_FILE (*crtbegin.o *crtbegin?.o *crtend.o *crtend?.o ) .dtors)) PROVIDE_HIDDEN (__fini_array_end = .); } .ctors : { /* gcc uses crtbegin.o to find the start of the constructors, so we make sure it is first. Because this is a wildcard, it doesn't matter if the user does not actually link against crtbegin.o; the linker won't look for a file to match a wildcard. The wildcard also means that it doesn't matter which directory crtbegin.o is in. */ KEEP (*crtbegin.o(.ctors)) KEEP (*crtbegin?.o(.ctors)) /* We don't want to include the .ctor section from the crtend.o file until after the sorted ctors. The .ctor section from the crtend file contains the end of ctors marker and it must be last */ KEEP (*(EXCLUDE_FILE (*crtend.o *crtend?.o ) .ctors)) KEEP (*(SORT(.ctors.*))) KEEP (*(.ctors)) } .dtors : { KEEP (*crtbegin.o(.dtors)) KEEP (*crtbegin?.o(.dtors)) KEEP (*(EXCLUDE_FILE (*crtend.o *crtend?.o ) .dtors)) KEEP (*(SORT(.dtors.*))) KEEP (*(.dtors)) } .jcr : { KEEP (*(.jcr)) } .data.rel.ro : { *(.data.rel.ro.local* .gnu.linkonce.d.rel.ro.local.*) *(.data.rel.ro .data.rel.ro.* .gnu.linkonce.d.rel.ro.*) } .dynamic : { *(.dynamic) } .got : { *(.got) *(.igot) } . = DATA_SEGMENT_RELRO_END (SIZEOF (.got.plt) >= 24 ? 24 : 0, .); .got.plt : { *(.got.plt) *(.igot.plt) } .data : { *(.data .data.* .gnu.linkonce.d.*) SORT(CONSTRUCTORS) } .data1 : { *(.data1) } _edata = .; PROVIDE (edata = .); . = .; __bss_start = .; .bss : { *(.dynbss) *(.bss .bss.* .gnu.linkonce.b.*) *(COMMON) /* Align here to ensure that the .bss section occupies space up to _end. Align after .bss to ensure correct alignment even if the .bss section disappears because there are no input sections. FIXME: Why do we need it? When there is no .bss section, we don't pad the .data section. */ . = ALIGN(. != 0 ? 64 / 8 : 1); } .lbss : { *(.dynlbss) *(.lbss .lbss.* .gnu.linkonce.lb.*) *(LARGE_COMMON) } . = ALIGN(64 / 8); . = SEGMENT_START("ldata-segment", .); .lrodata ALIGN(CONSTANT (MAXPAGESIZE)) + (. & (CONSTANT (MAXPAGESIZE) - 1)) : { *(.lrodata .lrodata.* .gnu.linkonce.lr.*) } .ldata ALIGN(CONSTANT (MAXPAGESIZE)) + (. & (CONSTANT (MAXPAGESIZE) - 1)) : { *(.ldata .ldata.* .gnu.linkonce.l.*) . = ALIGN(. != 0 ? 64 / 8 : 1); } . = ALIGN(64 / 8); _end = .; PROVIDE (end = .); . = DATA_SEGMENT_END (.); /* Stabs debugging sections. */ .stab 0 : { *(.stab) } .stabstr 0 : { *(.stabstr) } .stab.excl 0 : { *(.stab.excl) } .stab.exclstr 0 : { *(.stab.exclstr) } .stab.index 0 : { *(.stab.index) } .stab.indexstr 0 : { *(.stab.indexstr) } .comment 0 : { *(.comment) } /* DWARF debug sections. Symbols in the DWARF debugging sections are relative to the beginning of the section so we begin them at 0. */ /* DWARF 1 */ .debug 0 : { *(.debug) } .line 0 : { *(.line) } /* GNU DWARF 1 extensions */ .debug_srcinfo 0 : { *(.debug_srcinfo) } .debug_sfnames 0 : { *(.debug_sfnames) } /* DWARF 1.1 and DWARF 2 */ .debug_aranges 0 : { *(.debug_aranges) } .debug_pubnames 0 : { *(.debug_pubnames) } /* DWARF 2 */ .debug_info 0 : { *(.debug_info .gnu.linkonce.wi.*) } .debug_abbrev 0 : { *(.debug_abbrev) } .debug_line 0 : { *(.debug_line .debug_line.* .debug_line_end ) } .debug_frame 0 : { *(.debug_frame) } .debug_str 0 : { *(.debug_str) } .debug_loc 0 : { *(.debug_loc) } .debug_macinfo 0 : { *(.debug_macinfo) } /* SGI/MIPS DWARF 2 extensions */ .debug_weaknames 0 : { *(.debug_weaknames) } .debug_funcnames 0 : { *(.debug_funcnames) } .debug_typenames 0 : { *(.debug_typenames) } .debug_varnames 0 : { *(.debug_varnames) } /* DWARF 3 */ .debug_pubtypes 0 : { *(.debug_pubtypes) } .debug_ranges 0 : { *(.debug_ranges) } /* DWARF Extension. */ .debug_macro 0 : { *(.debug_macro) } .gnu.attributes 0 : { KEEP (*(.gnu.attributes)) } /DISCARD/ : { *(.note.GNU-stack) *(.gnu_debuglink) *(.gnu.lto_*) } } wcc-0.0.2/src/wsh/include/0000755000175000017500000000000013110675433013755 5ustar philphilwcc-0.0.2/src/wsh/include/luaconf.h0000644000175000017500000005110113110675433015553 0ustar philphil/* ** $Id: luaconf.h,v 1.254 2015/10/21 18:17:40 roberto Exp $ ** Configuration file for Lua ** See Copyright Notice in lua.h */ #ifndef luaconf_h #define luaconf_h #include #include /* ** =================================================================== ** Search for "@@" to find all configurable definitions. ** =================================================================== */ /* ** {==================================================================== ** System Configuration: macros to adapt (if needed) Lua to some ** particular platform, for instance compiling it with 32-bit numbers or ** restricting it to C89. ** ===================================================================== */ /* @@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats. You ** can also define LUA_32BITS in the make file, but changing here you ** ensure that all software connected to Lua will be compiled with the ** same configuration. */ /* #define LUA_32BITS */ /* @@ LUA_USE_C89 controls the use of non-ISO-C89 features. ** Define it if you want Lua to avoid the use of a few C99 features ** or Windows-specific features on Windows. */ /* #define LUA_USE_C89 */ /* ** By default, Lua on Windows use (some) specific Windows features */ #if !defined(LUA_USE_C89) && defined(_WIN32) && !defined(_WIN32_WCE) #define LUA_USE_WINDOWS /* enable goodies for regular Windows */ #endif #if defined(LUA_USE_WINDOWS) #define LUA_DL_DLL /* enable support for DLL */ #define LUA_USE_C89 /* broadly, Windows is C89 */ #endif #if defined(LUA_USE_LINUX) #define LUA_USE_POSIX #define LUA_USE_DLOPEN /* needs an extra library: -ldl */ #define LUA_USE_READLINE /* needs some extra libraries */ #endif #if defined(LUA_USE_MACOSX) #define LUA_USE_POSIX #define LUA_USE_DLOPEN /* MacOS does not need -ldl */ #define LUA_USE_READLINE /* needs an extra library: -lreadline */ #endif /* @@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for ** C89 ('long' and 'double'); Windows always has '__int64', so it does ** not need to use this case. */ #if defined(LUA_USE_C89) && !defined(LUA_USE_WINDOWS) #define LUA_C89_NUMBERS #endif /* @@ LUAI_BITSINT defines the (minimum) number of bits in an 'int'. */ /* avoid undefined shifts */ #if ((INT_MAX >> 15) >> 15) >= 1 #define LUAI_BITSINT 32 #else /* 'int' always must have at least 16 bits */ #define LUAI_BITSINT 16 #endif /* @@ LUA_INT_TYPE defines the type for Lua integers. @@ LUA_FLOAT_TYPE defines the type for Lua floats. ** Lua should work fine with any mix of these options (if supported ** by your C compiler). The usual configurations are 64-bit integers ** and 'double' (the default), 32-bit integers and 'float' (for ** restricted platforms), and 'long'/'double' (for C compilers not ** compliant with C99, which may not have support for 'long long'). */ /* predefined options for LUA_INT_TYPE */ #define LUA_INT_INT 1 #define LUA_INT_LONG 2 #define LUA_INT_LONGLONG 3 /* predefined options for LUA_FLOAT_TYPE */ #define LUA_FLOAT_FLOAT 1 #define LUA_FLOAT_DOUBLE 2 #define LUA_FLOAT_LONGDOUBLE 3 #if defined(LUA_32BITS) /* { */ /* ** 32-bit integers and 'float' */ #if LUAI_BITSINT >= 32 /* use 'int' if big enough */ #define LUA_INT_TYPE LUA_INT_INT #else /* otherwise use 'long' */ #define LUA_INT_TYPE LUA_INT_LONG #endif #define LUA_FLOAT_TYPE LUA_FLOAT_FLOAT #elif defined(LUA_C89_NUMBERS) /* }{ */ /* ** largest types available for C89 ('long' and 'double') */ #define LUA_INT_TYPE LUA_INT_LONG #define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE #endif /* } */ /* ** default configuration for 64-bit Lua ('long long' and 'double') */ #if !defined(LUA_INT_TYPE) #define LUA_INT_TYPE LUA_INT_LONGLONG #endif #if !defined(LUA_FLOAT_TYPE) #define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE #endif /* }================================================================== */ /* ** {================================================================== ** Configuration for Paths. ** =================================================================== */ /* @@ LUA_PATH_DEFAULT is the default path that Lua uses to look for ** Lua libraries. @@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for ** C libraries. ** CHANGE them if your machine has a non-conventional directory ** hierarchy or if you want to install your libraries in ** non-conventional directories. */ #define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR #if defined(_WIN32) /* { */ /* ** In Windows, any exclamation mark ('!') in the path is replaced by the ** path of the directory of the executable file of the current process. */ #define LUA_LDIR "!\\lua\\" #define LUA_CDIR "!\\" #define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\" #define LUA_PATH_DEFAULT \ LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \ LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" \ LUA_SHRDIR"?.lua;" LUA_SHRDIR"?\\init.lua;" \ ".\\?.lua;" ".\\?\\init.lua" #define LUA_CPATH_DEFAULT \ LUA_CDIR"?.dll;" \ LUA_CDIR"..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \ LUA_CDIR"loadall.dll;" ".\\?.dll" #else /* }{ */ #define LUA_ROOT "/usr/local/" #define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/" #define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/" #define LUA_PATH_DEFAULT \ LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \ LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" \ "./?.lua;" "./?/init.lua" #define LUA_CPATH_DEFAULT \ LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so" #endif /* } */ /* @@ LUA_DIRSEP is the directory separator (for submodules). ** CHANGE it if your machine does not use "/" as the directory separator ** and is not Windows. (On Windows Lua automatically uses "\".) */ #if defined(_WIN32) #define LUA_DIRSEP "\\" #else #define LUA_DIRSEP "/" #endif /* }================================================================== */ /* ** {================================================================== ** Marks for exported symbols in the C code ** =================================================================== */ /* @@ LUA_API is a mark for all core API functions. @@ LUALIB_API is a mark for all auxiliary library functions. @@ LUAMOD_API is a mark for all standard library opening functions. ** CHANGE them if you need to define those functions in some special way. ** For instance, if you want to create one Windows DLL with the core and ** the libraries, you may want to use the following definition (define ** LUA_BUILD_AS_DLL to get it). */ #if defined(LUA_BUILD_AS_DLL) /* { */ #if defined(LUA_CORE) || defined(LUA_LIB) /* { */ #define LUA_API __declspec(dllexport) #else /* }{ */ #define LUA_API __declspec(dllimport) #endif /* } */ #else /* }{ */ #define LUA_API extern #endif /* } */ /* more often than not the libs go together with the core */ #define LUALIB_API LUA_API #define LUAMOD_API LUALIB_API /* @@ LUAI_FUNC is a mark for all extern functions that are not to be ** exported to outside modules. @@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables ** that are not to be exported to outside modules (LUAI_DDEF for ** definitions and LUAI_DDEC for declarations). ** CHANGE them if you need to mark them in some special way. Elf/gcc ** (versions 3.2 and later) mark them as "hidden" to optimize access ** when Lua is compiled as a shared library. Not all elf targets support ** this attribute. Unfortunately, gcc does not offer a way to check ** whether the target offers that support, and those without support ** give a warning about it. To avoid these warnings, change to the ** default definition. */ #if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \ defined(__ELF__) /* { */ #define LUAI_FUNC __attribute__((visibility("hidden"))) extern #else /* }{ */ #define LUAI_FUNC extern #endif /* } */ #define LUAI_DDEC LUAI_FUNC #define LUAI_DDEF /* empty */ /* }================================================================== */ /* ** {================================================================== ** Compatibility with previous versions ** =================================================================== */ /* @@ LUA_COMPAT_5_2 controls other macros for compatibility with Lua 5.2. @@ LUA_COMPAT_5_1 controls other macros for compatibility with Lua 5.1. ** You can define it to get all options, or change specific options ** to fit your specific needs. */ #if defined(LUA_COMPAT_5_2) /* { */ /* @@ LUA_COMPAT_MATHLIB controls the presence of several deprecated ** functions in the mathematical library. */ #define LUA_COMPAT_MATHLIB /* @@ LUA_COMPAT_BITLIB controls the presence of library 'bit32'. */ #define LUA_COMPAT_BITLIB /* @@ LUA_COMPAT_IPAIRS controls the effectiveness of the __ipairs metamethod. */ #define LUA_COMPAT_IPAIRS /* @@ LUA_COMPAT_APIINTCASTS controls the presence of macros for ** manipulating other integer types (lua_pushunsigned, lua_tounsigned, ** luaL_checkint, luaL_checklong, etc.) */ #define LUA_COMPAT_APIINTCASTS #endif /* } */ #if defined(LUA_COMPAT_5_1) /* { */ /* Incompatibilities from 5.2 -> 5.3 */ #define LUA_COMPAT_MATHLIB #define LUA_COMPAT_APIINTCASTS /* @@ LUA_COMPAT_UNPACK controls the presence of global 'unpack'. ** You can replace it with 'table.unpack'. */ #define LUA_COMPAT_UNPACK /* @@ LUA_COMPAT_LOADERS controls the presence of table 'package.loaders'. ** You can replace it with 'package.searchers'. */ #define LUA_COMPAT_LOADERS /* @@ macro 'lua_cpcall' emulates deprecated function lua_cpcall. ** You can call your C function directly (with light C functions). */ #define lua_cpcall(L,f,u) \ (lua_pushcfunction(L, (f)), \ lua_pushlightuserdata(L,(u)), \ lua_pcall(L,1,0,0)) /* @@ LUA_COMPAT_LOG10 defines the function 'log10' in the math library. ** You can rewrite 'log10(x)' as 'log(x, 10)'. */ #define LUA_COMPAT_LOG10 /* @@ LUA_COMPAT_LOADSTRING defines the function 'loadstring' in the base ** library. You can rewrite 'loadstring(s)' as 'load(s)'. */ #define LUA_COMPAT_LOADSTRING /* @@ LUA_COMPAT_MAXN defines the function 'maxn' in the table library. */ #define LUA_COMPAT_MAXN /* @@ The following macros supply trivial compatibility for some ** changes in the API. The macros themselves document how to ** change your code to avoid using them. */ #define lua_strlen(L,i) lua_rawlen(L, (i)) #define lua_objlen(L,i) lua_rawlen(L, (i)) #define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ) #define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT) /* @@ LUA_COMPAT_MODULE controls compatibility with previous ** module functions 'module' (Lua) and 'luaL_register' (C). */ #define LUA_COMPAT_MODULE #endif /* } */ /* @@ LUA_COMPAT_FLOATSTRING makes Lua format integral floats without a @@ a float mark ('.0'). ** This macro is not on by default even in compatibility mode, ** because this is not really an incompatibility. */ /* #define LUA_COMPAT_FLOATSTRING */ /* }================================================================== */ /* ** {================================================================== ** Configuration for Numbers. ** Change these definitions if no predefined LUA_FLOAT_* / LUA_INT_* ** satisfy your needs. ** =================================================================== */ /* @@ LUA_NUMBER is the floating-point type used by Lua. @@ LUAI_UACNUMBER is the result of an 'usual argument conversion' @@ over a floating number. @@ l_mathlim(x) corrects limit name 'x' to the proper float type ** by prefixing it with one of FLT/DBL/LDBL. @@ LUA_NUMBER_FRMLEN is the length modifier for writing floats. @@ LUA_NUMBER_FMT is the format for writing floats. @@ lua_number2str converts a float to a string. @@ l_mathop allows the addition of an 'l' or 'f' to all math operations. @@ l_floor takes the floor of a float. @@ lua_str2number converts a decimal numeric string to a number. */ /* The following definitions are good for most cases here */ #define l_floor(x) (l_mathop(floor)(x)) #define lua_number2str(s,sz,n) l_sprintf((s), sz, LUA_NUMBER_FMT, (n)) /* @@ lua_numbertointeger converts a float number to an integer, or ** returns 0 if float is not within the range of a lua_Integer. ** (The range comparisons are tricky because of rounding. The tests ** here assume a two-complement representation, where MININTEGER always ** has an exact representation as a float; MAXINTEGER may not have one, ** and therefore its conversion to float may have an ill-defined value.) */ #define lua_numbertointeger(n,p) \ ((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \ (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \ (*(p) = (LUA_INTEGER)(n), 1)) /* now the variable definitions */ #if LUA_FLOAT_TYPE == LUA_FLOAT_FLOAT /* { single float */ #define LUA_NUMBER float #define l_mathlim(n) (FLT_##n) #define LUAI_UACNUMBER double #define LUA_NUMBER_FRMLEN "" #define LUA_NUMBER_FMT "%.7g" #define l_mathop(op) op##f #define lua_str2number(s,p) strtof((s), (p)) #elif LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE /* }{ long double */ #define LUA_NUMBER long double #define l_mathlim(n) (LDBL_##n) #define LUAI_UACNUMBER long double #define LUA_NUMBER_FRMLEN "L" #define LUA_NUMBER_FMT "%.19Lg" #define l_mathop(op) op##l #define lua_str2number(s,p) strtold((s), (p)) #elif LUA_FLOAT_TYPE == LUA_FLOAT_DOUBLE /* }{ double */ #define LUA_NUMBER double #define l_mathlim(n) (DBL_##n) #define LUAI_UACNUMBER double #define LUA_NUMBER_FRMLEN "" #define LUA_NUMBER_FMT "%.14g" #define l_mathop(op) op #define lua_str2number(s,p) strtod((s), (p)) #else /* }{ */ #error "numeric float type not defined" #endif /* } */ /* @@ LUA_INTEGER is the integer type used by Lua. ** @@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER. ** @@ LUAI_UACINT is the result of an 'usual argument conversion' @@ over a lUA_INTEGER. @@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers. @@ LUA_INTEGER_FMT is the format for writing integers. @@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER. @@ LUA_MININTEGER is the minimum value for a LUA_INTEGER. @@ lua_integer2str converts an integer to a string. */ /* The following definitions are good for most cases here */ #define LUA_INTEGER_FMT "%" LUA_INTEGER_FRMLEN "d" #define lua_integer2str(s,sz,n) l_sprintf((s), sz, LUA_INTEGER_FMT, (n)) #define LUAI_UACINT LUA_INTEGER /* ** use LUAI_UACINT here to avoid problems with promotions (which ** can turn a comparison between unsigneds into a signed comparison) */ #define LUA_UNSIGNED unsigned LUAI_UACINT /* now the variable definitions */ #if LUA_INT_TYPE == LUA_INT_INT /* { int */ #define LUA_INTEGER int #define LUA_INTEGER_FRMLEN "" #define LUA_MAXINTEGER INT_MAX #define LUA_MININTEGER INT_MIN #elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */ #define LUA_INTEGER long #define LUA_INTEGER_FRMLEN "l" #define LUA_MAXINTEGER LONG_MAX #define LUA_MININTEGER LONG_MIN #elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */ /* use presence of macro LLONG_MAX as proxy for C99 compliance */ #if defined(LLONG_MAX) /* { */ /* use ISO C99 stuff */ #define LUA_INTEGER long long #define LUA_INTEGER_FRMLEN "ll" #define LUA_MAXINTEGER LLONG_MAX #define LUA_MININTEGER LLONG_MIN #elif defined(LUA_USE_WINDOWS) /* }{ */ /* in Windows, can use specific Windows types */ #define LUA_INTEGER __int64 #define LUA_INTEGER_FRMLEN "I64" #define LUA_MAXINTEGER _I64_MAX #define LUA_MININTEGER _I64_MIN #else /* }{ */ #error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \ or '-DLUA_C89_NUMBERS' (see file 'luaconf.h' for details)" #endif /* } */ #else /* }{ */ #error "numeric integer type not defined" #endif /* } */ /* }================================================================== */ /* ** {================================================================== ** Dependencies with C99 and other C details ** =================================================================== */ /* @@ l_sprintf is equivalent to 'snprintf' or 'sprintf' in C89. ** (All uses in Lua have only one format item.) */ #if !defined(LUA_USE_C89) #define l_sprintf(s,sz,f,i) snprintf(s,sz,f,i) #else #define l_sprintf(s,sz,f,i) ((void)(sz), sprintf(s,f,i)) #endif /* @@ lua_strx2number converts an hexadecimal numeric string to a number. ** In C99, 'strtod' does that conversion. Otherwise, you can ** leave 'lua_strx2number' undefined and Lua will provide its own ** implementation. */ #if !defined(LUA_USE_C89) #define lua_strx2number(s,p) lua_str2number(s,p) #endif /* @@ lua_number2strx converts a float to an hexadecimal numeric string. ** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that. ** Otherwise, you can leave 'lua_number2strx' undefined and Lua will ** provide its own implementation. */ #if !defined(LUA_USE_C89) #define lua_number2strx(L,b,sz,f,n) l_sprintf(b,sz,f,n) #endif /* ** 'strtof' and 'opf' variants for math functions are not valid in ** C89. Otherwise, the macro 'HUGE_VALF' is a good proxy for testing the ** availability of these variants. ('math.h' is already included in ** all files that use these macros.) */ #if defined(LUA_USE_C89) || (defined(HUGE_VAL) && !defined(HUGE_VALF)) #undef l_mathop /* variants not available */ #undef lua_str2number #define l_mathop(op) (lua_Number)op /* no variant */ #define lua_str2number(s,p) ((lua_Number)strtod((s), (p))) #endif /* @@ LUA_KCONTEXT is the type of the context ('ctx') for continuation ** functions. It must be a numerical type; Lua will use 'intptr_t' if ** available, otherwise it will use 'ptrdiff_t' (the nearest thing to ** 'intptr_t' in C89) */ #define LUA_KCONTEXT ptrdiff_t #if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \ __STDC_VERSION__ >= 199901L #include #if defined(INTPTR_MAX) /* even in C99 this type is optional */ #undef LUA_KCONTEXT #define LUA_KCONTEXT intptr_t #endif #endif /* @@ lua_getlocaledecpoint gets the locale "radix character" (decimal point). ** Change that if you do not want to use C locales. (Code using this ** macro must include header 'locale.h'.) */ #if !defined(lua_getlocaledecpoint) #define lua_getlocaledecpoint() (localeconv()->decimal_point[0]) #endif /* }================================================================== */ /* ** {================================================================== ** Language Variations ** ===================================================================== */ /* @@ LUA_NOCVTN2S/LUA_NOCVTS2N control how Lua performs some ** coercions. Define LUA_NOCVTN2S to turn off automatic coercion from ** numbers to strings. Define LUA_NOCVTS2N to turn off automatic ** coercion from strings to numbers. */ /* #define LUA_NOCVTN2S */ /* #define LUA_NOCVTS2N */ /* @@ LUA_USE_APICHECK turns on several consistency checks on the C API. ** Define it as a help when debugging C code. */ #if defined(LUA_USE_APICHECK) #include #define luai_apicheck(l,e) assert(e) #endif /* }================================================================== */ /* ** {================================================================== ** Macros that affect the API and must be stable (that is, must be the ** same when you compile Lua and when you compile code that links to ** Lua). You probably do not want/need to change them. ** ===================================================================== */ /* @@ LUAI_MAXSTACK limits the size of the Lua stack. ** CHANGE it if you need a different limit. This limit is arbitrary; ** its only purpose is to stop Lua from consuming unlimited stack ** space (and to reserve some numbers for pseudo-indices). */ #if LUAI_BITSINT >= 32 #define LUAI_MAXSTACK 1000000 #else #define LUAI_MAXSTACK 15000 #endif /* @@ LUA_EXTRASPACE defines the size of a raw memory area associated with ** a Lua state with very fast access. ** CHANGE it if you need a different size. */ #define LUA_EXTRASPACE (sizeof(void *)) /* @@ LUA_IDSIZE gives the maximum size for the description of the source @@ of a function in debug information. ** CHANGE it if you want a different size. */ #define LUA_IDSIZE 60 /* @@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system. ** CHANGE it if it uses too much C-stack space. (For long double, ** 'string.format("%.99f", 1e4932)' needs ~5030 bytes, so a ** smaller buffer would force a memory allocation for each call to ** 'string.format'.) */ #if defined(LUA_FLOAT_LONGDOUBLE) #define LUAL_BUFFERSIZE 8192 #else #define LUAL_BUFFERSIZE ((int)(0x80 * sizeof(void*) * sizeof(lua_Integer))) #endif /* }================================================================== */ /* @@ LUA_QL describes how error messages quote program elements. ** Lua does not use these macros anymore; they are here for ** compatibility only. */ #define LUA_QL(x) "'" x "'" #define LUA_QS LUA_QL("%s") /* =================================================================== */ /* ** Local configuration. You can use this space to add your redefinitions ** without modifying the main part of the file. */ #endif wcc-0.0.2/src/wsh/include/lauxlib.h0000644000175000017500000002036013110675433015567 0ustar philphil/* ** $Id: lauxlib.h,v 1.129 2015/11/23 11:29:43 roberto Exp $ ** Auxiliary functions for building Lua libraries ** See Copyright Notice in lua.h */ #ifndef lauxlib_h #define lauxlib_h #include #include #include "lua.h" /* extra error code for 'luaL_load' */ #define LUA_ERRFILE (LUA_ERRERR+1) typedef struct luaL_Reg { const char *name; lua_CFunction func; } luaL_Reg; #define LUAL_NUMSIZES (sizeof(lua_Integer)*16 + sizeof(lua_Number)) LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver, size_t sz); #define luaL_checkversion(L) \ luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES) LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e); LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e); LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len); LUALIB_API int (luaL_argerror) (lua_State *L, int arg, const char *extramsg); LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg, size_t *l); LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg, const char *def, size_t *l); LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int arg); LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int arg, lua_Number def); LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int arg); LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int arg, lua_Integer def); LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg); LUALIB_API void (luaL_checktype) (lua_State *L, int arg, int t); LUALIB_API void (luaL_checkany) (lua_State *L, int arg); LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname); LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname); LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname); LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname); LUALIB_API void (luaL_where) (lua_State *L, int lvl); LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...); LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def, const char *const lst[]); LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname); LUALIB_API int (luaL_execresult) (lua_State *L, int stat); /* predefined references */ #define LUA_NOREF (-2) #define LUA_REFNIL (-1) LUALIB_API int (luaL_ref) (lua_State *L, int t); LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref); LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename, const char *mode); #define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL) LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz, const char *name, const char *mode); LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s); LUALIB_API lua_State *(luaL_newstate) (void); LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx); LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p, const char *r); LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup); LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname); LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1, const char *msg, int level); LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname, lua_CFunction openf, int glb); /* ** =============================================================== ** some useful macros ** =============================================================== */ #define luaL_newlibtable(L,l) \ lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1) #define luaL_newlib(L,l) \ (luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0)) #define luaL_argcheck(L, cond,arg,extramsg) \ ((void)((cond) || luaL_argerror(L, (arg), (extramsg)))) #define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL)) #define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL)) #define luaL_typename(L,i) lua_typename(L, lua_type(L,(i))) #define luaL_dofile(L, fn) \ (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_dostring(L, s) \ (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n))) #define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) #define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL) /* ** {====================================================== ** Generic Buffer manipulation ** ======================================================= */ typedef struct luaL_Buffer { char *b; /* buffer address */ size_t size; /* buffer size */ size_t n; /* number of characters in buffer */ lua_State *L; char initb[LUAL_BUFFERSIZE]; /* initial buffer */ } luaL_Buffer; #define luaL_addchar(B,c) \ ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \ ((B)->b[(B)->n++] = (c))) #define luaL_addsize(B,s) ((B)->n += (s)) LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B); LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz); LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l); LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s); LUALIB_API void (luaL_addvalue) (luaL_Buffer *B); LUALIB_API void (luaL_pushresult) (luaL_Buffer *B); LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz); LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz); #define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE) /* }====================================================== */ /* ** {====================================================== ** File handles for IO library ** ======================================================= */ /* ** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and ** initial structure 'luaL_Stream' (it may contain other fields ** after that initial structure). */ #define LUA_FILEHANDLE "FILE*" typedef struct luaL_Stream { FILE *f; /* stream (NULL for incompletely created streams) */ lua_CFunction closef; /* to close stream (NULL for closed streams) */ } luaL_Stream; /* }====================================================== */ /* compatibility with old module system */ #if defined(LUA_COMPAT_MODULE) LUALIB_API void (luaL_pushmodule) (lua_State *L, const char *modname, int sizehint); LUALIB_API void (luaL_openlib) (lua_State *L, const char *libname, const luaL_Reg *l, int nup); #define luaL_register(L,n,l) (luaL_openlib(L,(n),(l),0)) #endif /* ** {================================================================== ** "Abstraction Layer" for basic report of messages and errors ** =================================================================== */ /* print a string */ #if !defined(lua_writestring) #define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout) #endif /* print a newline and flush the output */ #if !defined(lua_writeline) #define lua_writeline() (lua_writestring("\n", 1), fflush(stdout)) #endif /* print an error message */ #if !defined(lua_writestringerror) #define lua_writestringerror(s,p) \ (fprintf(stderr, (s), (p)), fflush(stderr)) #endif /* }================================================================== */ /* ** {============================================================ ** Compatibility with deprecated conversions ** ============================================================= */ #if defined(LUA_COMPAT_APIINTCASTS) #define luaL_checkunsigned(L,a) ((lua_Unsigned)luaL_checkinteger(L,a)) #define luaL_optunsigned(L,a,d) \ ((lua_Unsigned)luaL_optinteger(L,a,(lua_Integer)(d))) #define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n))) #define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d))) #define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n))) #define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d))) #endif /* }============================================================ */ #endif wcc-0.0.2/src/wsh/include/linenoise.h0000644000175000017500000000476013110675433016122 0ustar philphil/* linenoise.h -- VERSION 1.0 * * Guerrilla line editing library against the idea that a line editing lib * needs to be 20,000 lines of C code. * * See linenoise.c for more information. * * ------------------------------------------------------------------------ * * Copyright (c) 2010-2014, Salvatore Sanfilippo * Copyright (c) 2010-2013, Pieter Noordhuis * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef __LINENOISE_H #define __LINENOISE_H #ifdef __cplusplus extern "C" { #endif typedef struct linenoiseCompletions { size_t len; char **cvec; } linenoiseCompletions; typedef void(linenoiseCompletionCallback)(const char *, linenoiseCompletions *); void linenoiseSetCompletionCallback(linenoiseCompletionCallback *); void linenoiseAddCompletion(linenoiseCompletions *, const char *); char *linenoise(const char *prompt); int linenoiseHistoryAdd(const char *line); int linenoiseHistorySetMaxLen(int len); int linenoiseHistorySave(const char *filename); int linenoiseHistoryLoad(const char *filename); void linenoiseClearScreen(void); void linenoiseSetMultiLine(int ml); void linenoisePrintKeyCodes(void); #ifdef __cplusplus } #endif #endif /* __LINENOISE_H */ wcc-0.0.2/src/wsh/include/lualib.h0000644000175000017500000000222513110675433015377 0ustar philphil/* ** $Id: lualib.h,v 1.44 2014/02/06 17:32:33 roberto Exp $ ** Lua standard libraries ** See Copyright Notice in lua.h */ #ifndef lualib_h #define lualib_h #include "lua.h" LUAMOD_API int (luaopen_base) (lua_State *L); #define LUA_COLIBNAME "coroutine" LUAMOD_API int (luaopen_coroutine) (lua_State *L); #define LUA_TABLIBNAME "table" LUAMOD_API int (luaopen_table) (lua_State *L); #define LUA_IOLIBNAME "io" LUAMOD_API int (luaopen_io) (lua_State *L); #define LUA_OSLIBNAME "os" LUAMOD_API int (luaopen_os) (lua_State *L); #define LUA_STRLIBNAME "string" LUAMOD_API int (luaopen_string) (lua_State *L); #define LUA_UTF8LIBNAME "utf8" LUAMOD_API int (luaopen_utf8) (lua_State *L); #define LUA_BITLIBNAME "bit32" LUAMOD_API int (luaopen_bit32) (lua_State *L); #define LUA_MATHLIBNAME "math" LUAMOD_API int (luaopen_math) (lua_State *L); #define LUA_DBLIBNAME "debug" LUAMOD_API int (luaopen_debug) (lua_State *L); #define LUA_LOADLIBNAME "package" LUAMOD_API int (luaopen_package) (lua_State *L); /* open all previous libraries */ LUALIB_API void (luaL_openlibs) (lua_State *L); #if !defined(lua_assert) #define lua_assert(x) ((void)0) #endif #endif wcc-0.0.2/src/wsh/include/colors.h0000644000175000017500000000403513110675433015431 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ // Bold + color #define RED "\033[1;31m" #define CYAN "\033[1;36m" #define GREEN "\033[1;32m" #define BLUE "\033[1;34m" #define BLACK "\033[1;30m" #define BROWN "\033[1;33m" #define MAGENTA "\033[1;35m" #define GRAY "\033[1;37m" #define DARKGRAY "\033[1;30m" #define YELLOW "\033[1;33m" // Normal text #define NORMAL "\033[0m" /* flush the previous properties */ #define CLEAR "\033[2J" /* such as printf("\033[8;5Hhello"); // Move to (8, 5) and output hello other commands: printf("\033[XA"); // Move up X lines; printf("\033[XB"); // Move down X lines; printf("\033[XC"); // Move right X column; printf("\033[XD"); // Move left X column; printf("\033[2J"); // Clear screen */ wcc-0.0.2/src/wsh/include/lua.h0000644000175000017500000003475113110675433014721 0ustar philphil/* ** $Id: lua.h,v 1.329 2015/11/13 17:18:42 roberto Exp $ ** Lua - A Scripting Language ** Lua.org, PUC-Rio, Brazil (http://www.lua.org) ** See Copyright Notice at the end of this file */ #ifndef lua_h #define lua_h #include #include #include "luaconf.h" #define LUA_VERSION_MAJOR "5" #define LUA_VERSION_MINOR "3" #define LUA_VERSION_NUM 503 #define LUA_VERSION_RELEASE "2" #define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR #define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE #define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2015 Lua.org, PUC-Rio" #define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes" /* mark for precompiled code ('Lua') */ #define LUA_SIGNATURE "\x1bLua" /* option for multiple returns in 'lua_pcall' and 'lua_call' */ #define LUA_MULTRET (-1) /* ** Pseudo-indices ** (-LUAI_MAXSTACK is the minimum valid index; we keep some free empty ** space after that to help overflow detection) */ #define LUA_REGISTRYINDEX (-LUAI_MAXSTACK - 1000) #define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i)) /* thread status */ #define LUA_OK 0 #define LUA_YIELD 1 #define LUA_ERRRUN 2 #define LUA_ERRSYNTAX 3 #define LUA_ERRMEM 4 #define LUA_ERRGCMM 5 #define LUA_ERRERR 6 typedef struct lua_State lua_State; /* ** basic types */ #define LUA_TNONE (-1) #define LUA_TNIL 0 #define LUA_TBOOLEAN 1 #define LUA_TLIGHTUSERDATA 2 #define LUA_TNUMBER 3 #define LUA_TSTRING 4 #define LUA_TTABLE 5 #define LUA_TFUNCTION 6 #define LUA_TUSERDATA 7 #define LUA_TTHREAD 8 #define LUA_NUMTAGS 9 /* minimum Lua stack available to a C function */ #define LUA_MINSTACK 20 /* predefined values in the registry */ #define LUA_RIDX_MAINTHREAD 1 #define LUA_RIDX_GLOBALS 2 #define LUA_RIDX_LAST LUA_RIDX_GLOBALS /* type of numbers in Lua */ typedef LUA_NUMBER lua_Number; /* type for integer functions */ typedef LUA_INTEGER lua_Integer; /* unsigned integer type */ typedef LUA_UNSIGNED lua_Unsigned; /* type for continuation-function contexts */ typedef LUA_KCONTEXT lua_KContext; /* ** Type for C functions registered with Lua */ typedef int (*lua_CFunction) (lua_State *L); /* ** Type for continuation functions */ typedef int (*lua_KFunction) (lua_State *L, int status, lua_KContext ctx); /* ** Type for functions that read/write blocks when loading/dumping Lua chunks */ typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz); typedef int (*lua_Writer) (lua_State *L, const void *p, size_t sz, void *ud); /* ** Type for memory-allocation functions */ typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize); /* ** generic extra include file */ #if defined(LUA_USER_H) #include LUA_USER_H #endif /* ** RCS ident string */ extern const char lua_ident[]; /* ** state manipulation */ LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud); LUA_API void (lua_close) (lua_State *L); LUA_API lua_State *(lua_newthread) (lua_State *L); LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf); LUA_API const lua_Number *(lua_version) (lua_State *L); /* ** basic stack manipulation */ LUA_API int (lua_absindex) (lua_State *L, int idx); LUA_API int (lua_gettop) (lua_State *L); LUA_API void (lua_settop) (lua_State *L, int idx); LUA_API void (lua_pushvalue) (lua_State *L, int idx); LUA_API void (lua_rotate) (lua_State *L, int idx, int n); LUA_API void (lua_copy) (lua_State *L, int fromidx, int toidx); LUA_API int (lua_checkstack) (lua_State *L, int n); LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n); /* ** access functions (stack -> C) */ LUA_API int (lua_isnumber) (lua_State *L, int idx); LUA_API int (lua_isstring) (lua_State *L, int idx); LUA_API int (lua_iscfunction) (lua_State *L, int idx); LUA_API int (lua_isinteger) (lua_State *L, int idx); LUA_API int (lua_isuserdata) (lua_State *L, int idx); LUA_API int (lua_type) (lua_State *L, int idx); LUA_API const char *(lua_typename) (lua_State *L, int tp); LUA_API lua_Number (lua_tonumberx) (lua_State *L, int idx, int *isnum); LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum); LUA_API int (lua_toboolean) (lua_State *L, int idx); LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len); LUA_API size_t (lua_rawlen) (lua_State *L, int idx); LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx); LUA_API void *(lua_touserdata) (lua_State *L, int idx); LUA_API lua_State *(lua_tothread) (lua_State *L, int idx); LUA_API const void *(lua_topointer) (lua_State *L, int idx); /* ** Comparison and arithmetic functions */ #define LUA_OPADD 0 /* ORDER TM, ORDER OP */ #define LUA_OPSUB 1 #define LUA_OPMUL 2 #define LUA_OPMOD 3 #define LUA_OPPOW 4 #define LUA_OPDIV 5 #define LUA_OPIDIV 6 #define LUA_OPBAND 7 #define LUA_OPBOR 8 #define LUA_OPBXOR 9 #define LUA_OPSHL 10 #define LUA_OPSHR 11 #define LUA_OPUNM 12 #define LUA_OPBNOT 13 LUA_API void (lua_arith) (lua_State *L, int op); #define LUA_OPEQ 0 #define LUA_OPLT 1 #define LUA_OPLE 2 LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2); LUA_API int (lua_compare) (lua_State *L, int idx1, int idx2, int op); /* ** push functions (C -> stack) */ LUA_API void (lua_pushnil) (lua_State *L); LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n); LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n); LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t len); LUA_API const char *(lua_pushstring) (lua_State *L, const char *s); LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt, va_list argp); LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...); LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n); LUA_API void (lua_pushboolean) (lua_State *L, int b); LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p); LUA_API int (lua_pushthread) (lua_State *L); /* ** get functions (Lua -> stack) */ LUA_API int (lua_getglobal) (lua_State *L, const char *name); LUA_API int (lua_gettable) (lua_State *L, int idx); LUA_API int (lua_getfield) (lua_State *L, int idx, const char *k); LUA_API int (lua_geti) (lua_State *L, int idx, lua_Integer n); LUA_API int (lua_rawget) (lua_State *L, int idx); LUA_API int (lua_rawgeti) (lua_State *L, int idx, lua_Integer n); LUA_API int (lua_rawgetp) (lua_State *L, int idx, const void *p); LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec); LUA_API void *(lua_newuserdata) (lua_State *L, size_t sz); LUA_API int (lua_getmetatable) (lua_State *L, int objindex); LUA_API int (lua_getuservalue) (lua_State *L, int idx); /* ** set functions (stack -> Lua) */ LUA_API void (lua_setglobal) (lua_State *L, const char *name); LUA_API void (lua_settable) (lua_State *L, int idx); LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k); LUA_API void (lua_seti) (lua_State *L, int idx, lua_Integer n); LUA_API void (lua_rawset) (lua_State *L, int idx); LUA_API void (lua_rawseti) (lua_State *L, int idx, lua_Integer n); LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p); LUA_API int (lua_setmetatable) (lua_State *L, int objindex); LUA_API void (lua_setuservalue) (lua_State *L, int idx); /* ** 'load' and 'call' functions (load and run Lua code) */ LUA_API void (lua_callk) (lua_State *L, int nargs, int nresults, lua_KContext ctx, lua_KFunction k); #define lua_call(L,n,r) lua_callk(L, (n), (r), 0, NULL) LUA_API int (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc, lua_KContext ctx, lua_KFunction k); #define lua_pcall(L,n,r,f) lua_pcallk(L, (n), (r), (f), 0, NULL) LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt, const char *chunkname, const char *mode); LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data, int strip); /* ** coroutine functions */ LUA_API int (lua_yieldk) (lua_State *L, int nresults, lua_KContext ctx, lua_KFunction k); LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg); LUA_API int (lua_status) (lua_State *L); LUA_API int (lua_isyieldable) (lua_State *L); #define lua_yield(L,n) lua_yieldk(L, (n), 0, NULL) /* ** garbage-collection function and options */ #define LUA_GCSTOP 0 #define LUA_GCRESTART 1 #define LUA_GCCOLLECT 2 #define LUA_GCCOUNT 3 #define LUA_GCCOUNTB 4 #define LUA_GCSTEP 5 #define LUA_GCSETPAUSE 6 #define LUA_GCSETSTEPMUL 7 #define LUA_GCISRUNNING 9 LUA_API int (lua_gc) (lua_State *L, int what, int data); /* ** miscellaneous functions */ LUA_API int (lua_error) (lua_State *L); LUA_API int (lua_next) (lua_State *L, int idx); LUA_API void (lua_concat) (lua_State *L, int n); LUA_API void (lua_len) (lua_State *L, int idx); LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s); LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud); LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud); /* ** {============================================================== ** some useful macros ** =============================================================== */ #define lua_getextraspace(L) ((void *)((char *)(L) - LUA_EXTRASPACE)) #define lua_tonumber(L,i) lua_tonumberx(L,(i),NULL) #define lua_tointeger(L,i) lua_tointegerx(L,(i),NULL) #define lua_pop(L,n) lua_settop(L, -(n)-1) #define lua_newtable(L) lua_createtable(L, 0, 0) #define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n))) #define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0) #define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION) #define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE) #define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA) #define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL) #define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN) #define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD) #define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE) #define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0) #define lua_pushliteral(L, s) lua_pushstring(L, "" s) #define lua_pushglobaltable(L) \ lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS) #define lua_tostring(L,i) lua_tolstring(L, (i), NULL) #define lua_insert(L,idx) lua_rotate(L, (idx), 1) #define lua_remove(L,idx) (lua_rotate(L, (idx), -1), lua_pop(L, 1)) #define lua_replace(L,idx) (lua_copy(L, -1, (idx)), lua_pop(L, 1)) /* }============================================================== */ /* ** {============================================================== ** compatibility macros for unsigned conversions ** =============================================================== */ #if defined(LUA_COMPAT_APIINTCASTS) #define lua_pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n)) #define lua_tounsignedx(L,i,is) ((lua_Unsigned)lua_tointegerx(L,i,is)) #define lua_tounsigned(L,i) lua_tounsignedx(L,(i),NULL) #endif /* }============================================================== */ /* ** {====================================================================== ** Debug API ** ======================================================================= */ /* ** Event codes */ #define LUA_HOOKCALL 0 #define LUA_HOOKRET 1 #define LUA_HOOKLINE 2 #define LUA_HOOKCOUNT 3 #define LUA_HOOKTAILCALL 4 /* ** Event masks */ #define LUA_MASKCALL (1 << LUA_HOOKCALL) #define LUA_MASKRET (1 << LUA_HOOKRET) #define LUA_MASKLINE (1 << LUA_HOOKLINE) #define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT) typedef struct lua_Debug lua_Debug; /* activation record */ /* Functions to be called by the debugger in specific events */ typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar); LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar); LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar); LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n); LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n); LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n); LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n); LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n); LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1, int fidx2, int n2); LUA_API void (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count); LUA_API lua_Hook (lua_gethook) (lua_State *L); LUA_API int (lua_gethookmask) (lua_State *L); LUA_API int (lua_gethookcount) (lua_State *L); struct lua_Debug { int event; const char *name; /* (n) */ const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */ const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */ const char *source; /* (S) */ int currentline; /* (l) */ int linedefined; /* (S) */ int lastlinedefined; /* (S) */ unsigned char nups; /* (u) number of upvalues */ unsigned char nparams;/* (u) number of parameters */ char isvararg; /* (u) */ char istailcall; /* (t) */ char short_src[LUA_IDSIZE]; /* (S) */ /* private part */ struct CallInfo *i_ci; /* active function */ }; /* }====================================================================== */ /****************************************************************************** * Copyright (C) 1994-2015 Lua.org, PUC-Rio. * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ******************************************************************************/ #endif wcc-0.0.2/src/wsh/include/libwitch/0000755000175000017500000000000013110675433015562 5ustar philphilwcc-0.0.2/src/wsh/include/libwitch/mylaux.h0000644000175000017500000000210713110675433017252 0ustar philphil /* ** =============================================================== ** some useful macros ** =============================================================== */ #define luaL_newlibtable(L,l) \ lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1) #define luaL_newlib(L,l) \ (luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0)) #define luaL_argcheck(L, cond,arg,extramsg) \ ((void)((cond) || luaL_argerror(L, (arg), (extramsg)))) #define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL)) #define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL)) #define luaL_typename(L,i) lua_typename(L, lua_type(L,(i))) #define luaL_dofile(L, fn) \ (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_dostring(L, s) \ (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n))) #define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) #define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL) wcc-0.0.2/src/wsh/include/libwitch/sigs.h0000644000175000017500000000415713110675433016707 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ typedef struct signame_t{ int signal; char *name; } signame_t; signame_t signames[] = { {SIGHUP, "SIGHUP"}, {SIGINT, "SIGINT"}, {SIGQUIT, "SIGQUIT"}, {SIGILL, "SIGILL"}, {SIGTRAP, "SIGTRAP"}, {SIGABRT, "SIGABRT"}, {SIGIOT, "SIGIOT"}, {SIGBUS, "SIGBUS"}, {SIGFPE, "SIGFPE"}, {SIGKILL, "SIGKILL"}, {SIGUSR1, "SIGUSR1"}, {SIGSEGV, "SIGSEGV"}, {SIGUSR2, "SIGUSR2"}, {SIGPIPE, "SIGPIPE"}, {SIGALRM, "SIGALRM"}, {SIGTERM, "SIGTERM"}, {SIGSTKFLT, "SIGSTKFLT"}, {SIGCHLD, "SIGCHLD"}, {SIGCONT, "SIGCONT"}, {SIGSTOP, "SIGSTOP"}, {SIGTSTP, "SIGTSTP"}, {SIGTTIN, "SIGTTIN"}, {SIGTTOU, "SIGTTOU"}, {SIGURG, "SIGURG"}, {SIGXCPU, "SIGXCPU"}, {SIGXFSZ, "SIGXFSZ"}, {SIGVTALRM, "SIGVTALRM"}, {SIGPROF, "SIGPROF"}, {SIGWINCH, "SIGWINCH"}, {SIGIO, "SIGIO"} }; wcc-0.0.2/src/wsh/include/libwitch/wsh.h0000644000175000017500000003735013110675433016544 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #define _GNU_SOURCE #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define USE_LUA 1 // Use either lua or luajit #ifdef USE_LUA #include #include #include #else #include "mylaux.h" #include "luajit.h" #endif #include #include #include #include #include #include #include #include #include #include #include #include #include #include "helper.h" #include #include #include #include #include #define DEFAULT_SCRIPT "/usr/share/wcc/scripts/debug" #define DEFAULT_SCRIPT_INDEX "/usr/share/wcc/scripts/INDEX" #define DEFAULT_WSHRC ".wshrc" #define DEFAULT_WSH_PROFILE ".wsh_profile" #define PROC_ASLR_PATH "/proc/sys/kernel/randomize_va_space" #define DEFAULT_LEARN_FILE "./learnwitch.log" #define MAX_SIGNALS 2000000 #define MY_CPU 1 // Which CPU to set affinity to #define BIND_FLAGS RTLD_NOW /* #define save_context(c){ \ memset(c, 0x00, sizeof(ucontext_t)); \ kill(getpid(),42); \ } \ */ #define DMGL_PARAMS (1 << 0) #define DMGL_ANSI (1 << 1) #define DMGL_ARM (1 << 11) #ifdef __x86_64__ #define Elf_Dyn Elf64_Dyn #define Elf_Ehdr Elf64_Ehdr #define Elf_Phdr Elf64_Phdr #define Elf_Shdr Elf64_Shdr #define Elf_Sym Elf64_Sym #else #define Elf_Dyn Elf32_Dyn #define Elf_Ehdr Elf32_Ehdr #define Elf_Phdr Elf32_Phdr #define Elf_Shdr Elf32_Shdr #define Elf_Sym Elf32_Sym #endif #define HPERMSMAX 5 #define ELF32_ST_BIND(val) (((unsigned char) (val)) >> 4) #define ELF32_ST_TYPE(val) ((val) & 0xf) #define ELF32_ST_INFO(bind, type) (((bind) << 4) + ((type) & 0xf)) #define ELF64_ST_BIND(val) ELF32_ST_BIND (val) #define ELF64_ST_TYPE(val) ELF32_ST_TYPE (val) #define ELF64_ST_INFO(bind, type) ELF32_ST_INFO ((bind), (type)) #define STB_LOCAL 0 #define STB_GLOBAL 1 #define STB_WEAK 2 #define STB_GNU_UNIQUE 10 #define STB_GNU_SECONDARY 11 #define STT_NOTYPE 0 #define STT_OBJECT 1 #define STT_FUNC 2 #define STT_SECTION 3 #define STT_FILE 4 #define STT_COMMON 5 #define STT_TLS 6 #define LINES_MAX 50 /** * Read arg1 */ #define read_arg1(arg1){ \ if (lua_isnil(L, 1)) { \ arg1 = 0; \ } else if (lua_isnumber(L, 1)) { \ arg1 = (unsigned long) lua_tonumber(L, 1); \ } else if (lua_isstring(L, 1)) { \ arg1 = luaL_checkstring(L, 1); \ } else if (lua_istable(L, 1)) { \ } else if (lua_isfunction(L, 1)) { \ arg1 = lua_tocfunction(L, 1); \ } else if (lua_iscfunction(L, 1)) { \ arg1 = lua_touserdata(L, 1); \ } else if (lua_isuserdata(L, 1)) { \ arg1 = lua_touserdata(L, 1); \ } else { \ arg1 = 0; \ } \ } /** * Read arg2 */ #define read_arg2(arg2){ \ if (lua_isnil(L, 2)) { \ arg2 = 0; \ } else if (lua_isnumber(L, 2)) { \ arg2 = (unsigned long) lua_tonumber(L, 2); \ } else if (lua_isstring(L, 2)) { \ arg2 = luaL_checkstring(L, 2); \ } else if (lua_istable(L, 2)) { \ } else if (lua_isfunction(L, 2)) { \ arg2 = lua_tocfunction(L, 2); \ } else if (lua_iscfunction(L, 2)) { \ arg2 = lua_touserdata(L, 2); \ } else if (lua_isuserdata(L, 2)) { \ arg2 = lua_touserdata(L, 2); \ } else { \ arg2 = 0; \ } \ } /** * Read arg3 */ #define read_arg3(arg3){ \ if (lua_isnil(L, 3)) { \ arg3 = 0; \ } else if (lua_isnumber(L, 3)) { \ arg3 = (unsigned long) lua_tonumber(L, 3); \ } else if (lua_isstring(L, 3)) { \ arg3 = luaL_checkstring(L, 3); \ } else if (lua_istable(L, 3)) { \ } else if (lua_isfunction(L, 3)) { \ arg3 = lua_tocfunction(L, 3); \ } else if (lua_iscfunction(L, 3)) { \ arg3 = lua_touserdata(L, 3); \ } else if (lua_isuserdata(L, 3)) { \ arg3 = lua_touserdata(L, 3); \ } else { \ arg3 = 0; \ } \ } /** * Read arg4 */ #define read_arg4(arg4){ \ if (lua_isnil(L, 4)) { \ arg4 = 0; \ } else if (lua_isnumber(L, 4)) { \ arg4 = (unsigned long) lua_tonumber(L, 4); \ } else if (lua_isstring(L, 4)) { \ arg4 = luaL_checkstring(L, 4); \ } else if (lua_istable(L, 4)) { \ } else if (lua_isfunction(L, 4)) { \ arg4 = lua_tocfunction(L, 4); \ } else if (lua_iscfunction(L, 4)) { \ arg4 = lua_touserdata(L, 4); \ } else if (lua_isuserdata(L, 4)) { \ arg4 = lua_touserdata(L, 4); \ } else { \ arg4 = 0; \ } \ } /** * Read argument number j */ #define read_arg(arg, j){ \ if (lua_isnil(L, j)) { \ arg = 0; \ } else if (lua_isnumber(L, j)) { \ arg = (unsigned long) lua_tonumber(L, j); \ } else if (lua_isstring(L, j)) { \ arg = luaL_checkstring(L, j); \ } else if (lua_istable(L, j)) { \ } else if (lua_isfunction(L, j)) { \ arg = lua_tocfunction(L, j); \ } else if (lua_iscfunction(L, j)) { \ arg = lua_touserdata(L, j); \ } else if (lua_isuserdata(L, j)) { \ arg = lua_touserdata(L, j); \ } else { \ arg = 0; \ } \ } #define SHELL_HISTORY_NAME ".wsh_history" #define luaL_reg luaL_Reg #define MIN_BIN_SIZE 10 #define FAULT_READ 1 #define FAULT_WRITE 2 #define FAULT_EXEC 4 #define default_poison 0x61 /** * Backtrace parameters */ #ifdef DEBUG #define SKIP_INIT 0 // for developpment #define SKIP_BOTTOM 0 #else #define SKIP_INIT 3 #define SKIP_BOTTOM 13 #endif /** * Imported declarations prototypes */ char *cplus_demangle(const char *mangled, int options); /** * Imported globals */ extern char *__progname_full; /** * Forward prototypes declarations */ static struct link_map *do_loadlib(char *libname); static int empty_phdrs(void); static int wsh_appear(lua_State * L); static int wsh_hide(lua_State * L); static int empty_shdrs(void); //int getarray(lua_State * L); static int getsize(lua_State * L); static int newarray(lua_State * L); static int print_functions(lua_State * L); static int print_libs(lua_State * L); static int print_objects(lua_State * L); static int print_phdrs(void); static int print_shdrs(void); static int entrypoints(lua_State * L); static int print_symbols(lua_State * L); static int print_version(void); static int setarray(lua_State * L); static int usage(char *name); static void set_align_flag(void); static void set_branch_flag(void); static void set_trace_flag(void); static void singlebranch(lua_State * L); static void singlestep(lua_State * L); static void traceunaligned(lua_State * L); static void unset_align_flag(void); static void unset_branch_flag(void); static void unset_trace_flag(void); static void unsinglebranch(lua_State * L); static void unsinglestep(lua_State * L); static void untraceunaligned(lua_State * L); static void unverbosetrace(lua_State * L); static void verbosetrace(lua_State * L); static void xfree(lua_State * L); static void systrace(lua_State * L); static void rtrace(lua_State * L); static void unsystrace(lua_State * L); static void unrtrace(lua_State * L); static int add_symbol(char *symbol, char *libname, char *htype, char *hbind, unsigned long value, unsigned int size, unsigned long int addr); static void segment_add(unsigned long int addr, unsigned long int size, char *perms, char *fname, char *ptype, int flags); static int alloccharbuf(lua_State * L); static int bfmap(lua_State * L); static int teletype(lua_State * L); static int breakpoint(lua_State * L); static int execlib(lua_State * L); static int getcharbuf(lua_State * L); static int grep(lua_State * L); static int grepptr(lua_State * L); static int help(lua_State * L); static int hollywood(lua_State * L); static int info(lua_State * L); static int libcall(lua_State * L); static int loadbin(lua_State * L); static int man(lua_State * L); static int map(lua_State * L); static int phdrs(lua_State * L); static int priv_memcpy(lua_State * L); static int priv_strcat(lua_State * L); static int priv_strcpy(lua_State * L); static int rdnum(lua_State * L); static int rdstr(lua_State * L); static int setcharbuf(lua_State * L); static int shdrs(lua_State * L); static int verbose(lua_State * L); static int xalloc(lua_State * L); static int ralloc(lua_State * L); static int headers(lua_State * L); static int prototypes(lua_State * L); static int bsspolute(lua_State * L); static unsigned int ltrace(void); static int procmap_lua(void); static void rescan(void); static void hexdump(uint8_t * data, size_t size, size_t colorstart, size_t color_len); static int disable_aslr(void); static int enable_aslr(void); static int run_script(char *name); static int enable_core(lua_State * L); static int disable_core(lua_State * L); static int gencore(lua_State * L); static char *signaltoname(int signal); static char *sicode_strerror(int signal, siginfo_t * s); /* int memmap (lua_State *L); int newmemmap(lua_State * L); int getmemmap(lua_State * L); int setmemmap(lua_State * L); int memmapsize(lua_State * L); */ static int rawmemread (lua_State *L); static int rawmemwrite (lua_State *L); static int rawmemstr (lua_State *L); static int rawmemusage (lua_State *L); static int rawmemaddr (lua_State *L); static int rawmemstrlen(lua_State *L); static char *lua_strerror(int err); /** * Internal representation of an ELF */ typedef struct { bool et_dyn; Elf_Dyn *dyns; Elf_Ehdr *ehdr; Elf_Phdr *phdrs; uint32_t dyn_index; uintptr_t base, limit; uintptr_t *p_pltgot; struct r_debug *r_debug; struct link_map *link_map; } elfdata_t; /** * Memory ranges */ typedef struct range_t { unsigned long long int min; unsigned long long int max; } range_t; /** * Breakpoint structure */ typedef struct breakpoint_t { char *ptr; // Pointer to location in memory char backup; // Backup bytes unsigned int weight; // Weight (optional) } breakpoint_t; /** * Libraries to be preloaded * (before shell/script execution) */ typedef struct preload_t { char *name; struct preload_t *prev; // utlist.h struct preload_t *next; // utlist.h } preload_t; /** * Scripts to be executed */ typedef struct script_t { char *name; struct preload_t *prev; // utlist.h struct preload_t *next; // utlist.h } script_t; /** * Representation of ELF Sections */ typedef struct sections_t { unsigned long int addr; unsigned long int size; char *libname; char *name; char *perms; int flags; struct sections_t *prev; // utlist.h struct sections_t *next; // utlist.h } sections_t; /** * Representation of ELF Segments */ typedef struct segments_t { unsigned long int addr; unsigned long int size; char *libname; char *type; char *perms; int flags; struct segments_t *prev; // utlist.h struct segments_t *next; // utlist.h } segments_t; /** * Representation of ELF Symbols */ typedef struct symbols_t { unsigned long int addr; unsigned long int size; char *symbol; char *libname; char *htype; char *hbind; unsigned long int value; struct symbols_t *prev; // utlist.h struct symbols_t *next; // utlist.h } symbols_t; typedef struct eps_t { unsigned long long int addr; char *name; struct eps_t *prev; // utlist.h struct eps_t *next; // utlist.h } eps_t; /** * wsh context */ typedef struct wsh_t { // State lua_State *L; char *luabuff; unsigned int luabuffsz; char *selflib; char *learnlog; FILE *learnfile; unsigned long long int mainhandle; // This is really a struct link_map * unsigned int opt_verbose; unsigned int opt_quiet; unsigned int opt_hollywood; // Default = 1; unsigned int opt_rescan; unsigned int opt_verbosetrace; // Display verbose trace unsigned int opt_appear; // Display ourselves or hide ourselves ? unsigned int firsterrno; unsigned int firstsicode; unsigned int firstsignal; unsigned int totsignals; // Per libcall unsigned int globalsignals; // Never reset unsigned long int faultaddr; void *firstcontext; unsigned int reason; //unsigned int lastret; unsigned int is_stdinscript; unsigned int bp_points; void *pltgot; unsigned int pltsz; ucontext_t *errcontext; // ucontext_t *initcontext; unsigned long int btcaller; unsigned int libified; breakpoint_t *bp_array; unsigned int bp_num; unsigned int opt_argc; char *opt_argv; char **script_args; unsigned int script_argnum; unsigned int trace_unaligned; unsigned int trace_singlestep; unsigned int trace_singlebranch; unsigned int trace_rtrace; unsigned int trace_strace; unsigned int singlestep_count; unsigned int singlebranch_count; unsigned int sigbus_count; unsigned long long int singlestep_hash; unsigned long long int singlebranch_hash; unsigned long long int sigbus_hash; jmp_buf longjmp_ptr_high; jmp_buf longjmp_ptr; unsigned int interrupted; unsigned int longjmp_ptr_high_cnt; struct sections_t *shdrs; struct segments_t *phdrs; struct symbols_t *symbols; struct eps_t *eps; struct preload_t *preload; // Libraries/binaries to preload struct script_t *scripts; // Queue of scripts to execute } wsh_t; /** * The next structure define * how prototypes are learned * by analysing runtime experiences */ typedef struct tuple_t{ void *addr; char *name; } tuple_t; typedef struct learn_key_t{ char ttype[10]; char tlib[200]; char tfunction[200]; char targ[20]; char tvalue[200]; }learn_key_t; typedef struct learn_t{ learn_key_t key; char toffset[20]; UT_hash_handle hh; } learn_t; int wsh_init(void); int wsh_getopt(int argc, char **argv); int wsh_loadlibs(void); int reload_elfs(void); int wsh_run(void); /* int newarray(lua_State * L); int setarray(lua_State * L); int getarray(lua_State * L); int getsize(lua_State * L); */ wcc-0.0.2/src/wsh/include/libwitch/wsh_functions.h0000644000175000017500000001533413110675433020632 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #ifndef WCC_DEFAULT_FUNCS #define WCC_DEFAULT_FUNCS 1 char *default_options[] = { "0x", // Shell commands "help", "quit", "exit", "shell", "exec", "clear", // Core WCC functions "help", "info", "memory", "memory:addr", "memory:hex", "memory:read", "memory:strlen", "memory:tostring", "memory:usage", "memory:write", "man", "bfmap", "teletype", "appear", "autoscan", "bsspolute", "dumptable", "dt", "symbols", "functions", "utrace", "unutrace", "systrace", "rtrace", "unsystrace", "unrtrace", "sstrace", "unsstrace", "btrace", "unbtrace", "vtrace", "unvtrace", "unappear", "unhide", "objects", "hex", "hexdump", "hex_dump", "verbose", "hide", "hollywood", "libs", "libcall", "loadbin", "breakpoint", "bp", "headers", "search", "searchobj", "map", "phdrs", "shdrs", "entrypoints", "rescan", "procmap", "prototypes", "testlib", "testfunc", "grep", "grepptr", "enableaslr", "disableaslr", "balloc", "bset", "bget", "rdstr", "memcpy", "ralloc", "strcpy", "strcat", "xalloc", "xfree", "script", "enablecore", "disablecore", "gencore" }; // All lua 5.3 Functions and global variables char *lua_default_functions[] = { "_G", "_VERSION", "assert", "collectgarbage", "dofile", "error", "getmetatable", "ipairs", "load", "loadfile", "next", "pairs", "pcall", "print", "rawequal", "rawget", "rawlen", "rawset", "require", "select", "setmetatable", "tonumber", "tostring", "type", "xpcall", "coroutine", "coroutine.create", "coroutine.isyieldable", "coroutine.resume", "coroutine.running", "coroutine.status", "coroutine.wrap", "coroutine.yield", "debug", "debug.debug", "debug.gethook", "debug.getinfo", "debug.getlocal", "debug.getmetatable", "debug.getregistry", "debug.getupvalue", "debug.getuservalue", "debug.sethook", "debug.setlocal", "debug.setmetatable", "debug.setupvalue", "debug.setuservalue", "debug.traceback", "debug.upvalueid", "debug.upvaluejoin", "io", "io.close", "io.flush", "io.input", "io.lines", "io.open", "io.output", "io.popen", "io.read", "io.stderr", "io.stdin", "io.stdout", "io.tmpfile", "io.type", "io.write", "file:close", "file:flush", "file:lines", "file:read", "file:seek", "file:setvbuf", "file:write", "math", "math.abs", "math.acos", "math.asin", "math.atan", "math.ceil", "math.cos", "math.deg", "math.exp", "math.floor", "math.fmod", "math.huge", "math.log", "math.max", "math.maxinteger", "math.min", "math.mininteger", "math.modf", "math.pi", "math.rad", "math.random", "math.randomseed", "math.sin", "math.sqrt", "math.tan", "math.tointeger", "math.type", "math.ult", "os", "os.clock", "os.date", "os.difftime", "os.execute", "os.exit", "os.getenv", "os.remove", "os.rename", "os.setlocale", "os.time", "os.tmpname", "package", "package.config", "package.cpath", "package.loaded", "package.loadlib", "package.path", "package.preload", "package.searchers", "package.searchpath", "string", "string.byte", "string.char", "string.dump", "string.find", "string.format", "string.gmatch", "string.gsub", "string.len", "string.lower", "string.match", "string.pack", "string.packsize", "string.rep", "string.reverse", "string.sub", "string.unpack", "string.upper", "table", "table.concat", "table.insert", "table.move", "table.pack", "table.remove", "table.sort", "table.unpack", "utf8", "utf8.char", "utf8.charpattern", "utf8.codepoint", "utf8.codes", "utf8.len", "utf8.offset", "LUA_CPATH", "LUA_CPATH_5_3", "LUA_INIT", "LUA_INIT_5_3", "LUA_PATH", "LUA_PATH_5_3" }; // Function names blacklisted in lua char *lua_blacklist[] = { "and", "break", "do", "else", "elseif", "end", "false", "for", "function", "if", "in", "local", "nil", "not", "or", "repeat", "return", "then", "true", "until", "while" }; tuple_t exposed[] = { {libcall, "libcall"}, {map, "map"}, {ltrace,"ltrace"}, {procmap_lua,"procmap"}, {rescan,"rescan"}, {grep,"grep"}, {grepptr,"grepptr"}, {hexdump,"lhexdump"}, {bfmap,"bfmap"}, {teletype, "teletype"}, {phdrs,"phdrs"}, {shdrs,"shdrs"}, {entrypoints, "entrypoints"}, {alloccharbuf,"balloc"}, {setcharbuf,"bset"}, {getcharbuf,"bget"}, {execlib,"lexeclib"}, {help,"help"}, {headers,"headers"}, {info,"info"}, {man,"man"}, {disable_aslr,"disableaslr"}, {enable_aslr,"enableaslr"}, {breakpoint,"breakpoint"}, {breakpoint,"bp"}, {verbose,"verbose"}, {hollywood,"hollywood"}, {print_symbols,"symbols"}, {print_functions,"functions"}, {print_objects,"objects"}, {print_libs,"libs"}, {loadbin,"loadbin"}, {ralloc,"ralloc"}, {xalloc,"xalloc"}, {xfree,"xfree"}, {prototypes,"prototypes"}, {traceunaligned,"utrace"}, {untraceunaligned,"unutrace"}, {singlestep,"sstrace"}, {systrace,"systrace"}, {rtrace,"rtrace"}, {unsystrace,"unsystrace"}, {unrtrace,"unrtrace"}, {unsinglestep,"unsstrace"}, {singlebranch,"btrace"}, {unsinglebranch,"unbtrace"}, {verbosetrace,"vtrace"}, {unverbosetrace,"unvtrace"}, {bsspolute,"bsspolute"}, {priv_memcpy,"memcpy"}, {priv_strcpy,"strcpy"}, {priv_strcat,"strcat"}, {rdstr,"rdstr"}, {rdnum,"rdnum"}, {run_script,"lscript"}, {enable_core,"enablecore"}, {disable_core,"disablecore"}, {rawmemread, "rawmemread"}, {rawmemwrite, "rawmemwrite"}, {rawmemstr, "rawmemstr"}, {rawmemusage, "rawmemusage"}, {rawmemaddr, "rawmemaddr"}, {rawmemstrlen, "rawmemstrlen"}, {gencore,"gencore"}, {wsh_appear, "appear"}, {wsh_hide, "hide"}, {wsh_appear, "unhide"}, {wsh_hide, "unappear"} }; range_t ranges[] = { {0x00000000, 0x100000000}, #ifdef __amd64__ {0x7f0000000000, 0x800000000000}, {0xffffffffff600000, 0xffffffffff610000}, {0x000000000000, 0x000000000000} #endif }; unsigned int global_xalloc = 0; #endif /* WCC_DEFAULT_FUNCS */ wcc-0.0.2/src/wsh/include/libwitch/wsh_help.h0000644000175000017500000001440013110675433017543 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ /** * Internal help datastructure */ typedef struct help_t{ char *name; char *proto; char *descr; char *protoprefix; char *retval; }help_t; /** * Internal help : wsh commands */ help_t cmdhelp[] ={ // {"help", "[topic]","Display general help."}, {"quit", "", "Exit wsh.", "", "Does not return : exit wsh\n"}, {"exit", "", "Exit wsh.", "", "Does not return : exit wsh\n"}, {"shell", "[command]", "Run a /bin/sh shell.", "", "None. Returns uppon shell termination."}, {"exec", "", "Run via the system() library call.", "", "None. Returns uppon termination."}, {"clear", "", "Clear terminal.", "", "None."}, }; /** * Internal help : wsh functions */ help_t fcnhelp[] ={ {"help", "[topic]","Display help on [topic]. If [topic] is ommitted, display general help.", "", "None"}, {"man", "[page]", "Display system manual page for [page].", "", "None"}, {"hexdump", "
, ", "Display bytes from memory
in enhanced hexadecimal form.", "", "None"}, {"hex", "", "Display lua in enhanced hexadecimal form.", "", "None"}, {"phdrs", "", "Display ELF program headers from all binaries loaded in address space.", "", "None"}, {"shdrs", "", "Display ELF section headers from all binaries loaded in address space.", "", "None"}, {"map", "", "Display a table of all the memory ranges mapped in memory in the address space.", "", "None"}, {"procmap", "", "Display a table of all the memory ranges mapped in memory in the address space as displayed in /proc//maps.", "", "None"}, {"bfmap", "", "Bruteforce valid mapped memory ranges in address space.", "", "None"}, {"symbols", "[sympattern], [libpattern], [mode]", "Display all the symbols in memory matching [sympattern], from library [libpattern]. If [mode] is set to 1 or 2, do not wait user input between pagers. [mode] = 2 provides a shorter output.", "", "None"}, {"functions","[sympattern], [libpattern], [mode]", "Display all the functions in memory matching [sympattern], from library [libpattern]. If [mode] is set to 1 or 2, do not wait user input between pagers. [mode] = 2 provides a shorter output.", "table func = ", "Return 1 lua table _func_ whose keys are valid function names in address space, and values are pointers to them in memory."}, {"objects","[pattern]", "Display all the functions in memory matching [sympattern]", "", "None"}, {"info", "[address] | [name]", "Display various informations about the [address] or [name] provided : if it is mapped, and if so from which library and in which section if available.", "", "None"}, {"search", "", "Search all object names matching in address space.", "", "None"}, {"headers", "", "Display C headers suitable for linking against the API loaded in address space.", "", "None"}, {"grep", ", [patternlen], [dumplen], [before]","Search in all ELF sections in memory. Match [patternlen] bytes, then display [dumplen] bytes, optionally including [before] bytes before the match. Results are displayed in enhanced decimal form", "table match = ", "Returns 1 lua table containing matching memory addresses."}, {"grepptr", ", [patternlen], [dumplen], [before]","Search pointer in all ELF sections in memory. Match [patternlen] bytes, then display [dumplen] bytes, optionally including [before] bytes before the match. Results are displayed in enhanced decimal form", "table match = ", "Returns 1 lua table containing matching memory addresses."}, {"loadbin","","Load binary to memory from .", "", "None"}, {"libs", "", "Display all libraries loaded in address space.", "table libraries = ", "Returns 1 value: a lua table _libraries_ whose values contain valid binary names (executable/libraries) mapped in memory."}, {"entrypoints", "", "Display entry points for each binary loaded in address space.", "", "None"}, {"rescan", "", "Re-perform address space scan.", "", "None"}, {"libcall", ", [arg1], [arg2], ... arg[6]", "Call binary with provided arguments.", "void *ret, table ctx = ", "Returns 2 return values: _ret_ is the return value of the binary function (nill if none), _ctx_ a lua table representing the execution context of the library call.\n"}, {"enableaslr", "", "Enable Address Space Layout Randomization (requires root privileges).", "", "None"}, {"disableaslr", "", "Disable Address Space Layout Randomization (requires root privileges).", "", "None"}, {"verbose", "", "Change verbosity setting to .", "", "None"}, {"breakpoint", "
, [weight]", "Set a breakpoint at memory
. Optionally add a to breakpoint score if hit.", "", "None"}, {"bp", "
, [weight]", "Set a breakpoint at memory
. Optionally add a to breakpoint score if hit. Alias for breakpoint() function.", "", "None"}, {"hollywood", "", "Change hollywood (fun) display setting to , impacting color display (enable/disable).", "", "None"}, }; wcc-0.0.2/src/wsh/include/libwitch/helper.h0000644000175000017500000000370513110675433017217 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ int read_maps(int pid); int is_mapped(unsigned long int addr); extern struct section *zfirst; extern int nsections; /* * Data structures */ // section struct section { unsigned long long int init; // start address unsigned long long int end; // end address int size; // size int perms; // permissions char name[255]; // name char hperms[10];// permissions in human readable form void *next; // ptr to next section int num; // section number in memory mapping int proba; // aslr stuff (highest probability of a given mapping) int probableval;// aslr stuff (address of most probable mapping) }; wcc-0.0.2/src/wsh/Makefile-i3860000644000175000017500000000340513110675433014463 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # CFLAGS := -masm=intel -W -Wall -Wextra -O0 -mpreferred-stack-boundary=12 -mstackrealign -ggdb -g3 -Wno-unused-but-set-variable -Wno-unused-parameter -I./include/sflib/ -I./include -I../../include/ -rdynamic -Wl,-E -Wl,-z,now -m32 #--sanitize=address all:: cd openlibm && make CFLAGS="-pie -fpie -fPIC -m32" ARCH=i386 cd lua && make linux CFLAGS="-march=i386 -m32" CC="$(CC)" $(CC) $(CFLAGS) wsh.c -o wsh.o -c -ldl -lreadline -pie -fpie -fPIC $(CC) $(CFLAGS) wshmain.c -o wshmain.o -c -ldl -lreadline -pie -fpie -fPIC $(CC) $(CFLAGS) helper.c -o helper.o -c -pie -fpie -fPIC $(CC) $(CFLAGS) linenoise/linenoise.c -o linenoise.o -c -pie -fpie -fPIC $(CC) $(CFLAGS) wsh.o helper.o linenoise.o -shared -fPIC -o libwitch.so ar cr libwitch.a wsh.o helper.o linenoise.o $(CC) $(CFLAGS) wsh.o helper.o linenoise.o wshmain.o -o wsh-i386 ./lua/src/liblua.a -lgsl -lgslcblas /usr/lib32/libc.so -lm -ldl /usr/lib/i386-linux-gnu/libiberty.a cp wsh-i386 ../../bin/ dep:: sudo apt-get install libreadline6:i386 libreadline6-dev:i386 --reinstall clean:: rm wsh-i386 helper.o wsh.o wshmain.o libwitch.so libwitch.a linenoise.o -f cd openlibm && make clean cd lua && make clean requirements:: sudo apt-get install libreadline-dev:i386 sudo apt-get install libiberty-dev:i386 sudo apt-get install libgsl-dev:i386 deepclean: cd openlibm && make clean cd lua && make clean make clean install:: mkdir -p $(DESTDIR)/usr/share/wcc/ cp -r ./scripts $(DESTDIR)/usr/share/wcc/ cp wsh-i386 $(DESTDIR)/usr/bin/wsh-i386 uninstall:: rm -rf $(DESTDIR)/usr/share/wcc/ rm -f $(DESTDIR)/usr/bin/wsh-i386 wcc-0.0.2/src/wsh/tests/0000755000175000017500000000000013110675433013474 5ustar philphilwcc-0.0.2/src/wsh/tests/Makefile0000644000175000017500000000052313110675433015134 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # all:: cd apache2 && make cd sshd && make cd sshd2 && make clean: cd apache2 && make clean cd sshd && make clean cd sshd2 && make clean wcc-0.0.2/src/wsh/tests/sshd/0000755000175000017500000000000013110675433014435 5ustar philphilwcc-0.0.2/src/wsh/tests/sshd/Makefile0000644000175000017500000000050413110675433016074 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # CC := gcc CFLAGS := -W -Wall -Wextra LDFLAGS := /usr/sbin/sshd all:: $(CC) $(CFLAGS) $(LDFLAGS) ssh.c -o ssh clean: rm -rf ssh wcc-0.0.2/src/wsh/tests/sshd/ssh.h0000644000175000017500000000755013110675433015412 0ustar philphil/** * * Automatically generated by the Whitchcraft Compiler Collection 0.0.1 * * 07:20:25 Jul 1 2016 * */ /** * Imported objects: **/ extern void *version; extern void *method_gsskeyex; extern void *client_version_string; extern void *session_id; extern void *method_none; extern void *pmonitor; extern void *mon_dispatch_postauth20; extern void *test_flag; extern void *options; extern void *devices; extern void *no_port_forwarding_flag; extern void *custom_environment; extern void *readonly; extern void *roaming_enabled; extern void *dispatch; extern void *num_listen_socks; extern void *log_level; extern void *pw; extern void *mon_dispatch_proto15; extern void *BSDopterr; extern void *channel_pre; extern void *ciphers; extern void *authorized_principals; extern void *oqueue; extern void *oom_adjust; extern void *method_hostbased; extern void *mm_sshpam_device; extern void *sensitive_data; extern void *mon_dispatch; extern void *outgoing_stream; extern void *listen_socks; extern void *resume_in_progress; extern void *saved_argc; extern void *deny_severity; extern void *auth_debug_init; extern void *handles; extern void *log_stderr; extern void *startup_pipes; extern void *macs; extern void *BSDoptind; extern void *allow_severity; extern void *umac_ctx; extern void *config_file_name; extern void *use_privsep; extern void *child_state; extern void *mon_dispatch_proto20; extern void *saved_argv; extern void *auth1_methods; extern void *no_user_rc; extern void *compat13; extern void *session_id2_len; extern void *method_passwd; extern void *original_command; extern void *iqueue; extern void *authmethods; extern void *loginmsg; extern void *datafellows; extern void *rexeced_flag; extern void *channel_post; extern void *rexec_argc; extern void *key_is_cert_authority; extern void *forced_command; extern void *first_unused_handle; extern void *privsep_pw; extern void *xxx_kex; extern void *_IO_stdin_used; extern void *method_pubkey; extern void *no_pty_flag; extern void *utmp_len; extern void *compat20; extern void *rexec_argv; extern void *no_daemon_flag; extern void *gssapi_kerberos_mech; extern void *server_version_string; extern void *method_kbdint; extern void *cfg; extern void *current_keys; extern void *sshpam_device; extern void *the_authctxt; extern void *inetd_flag; extern void *no_agent_forwarding_flag; extern void *incoming_stream; extern void *num_handles; extern void *BSDoptreset; extern void *debug_flag; extern void *mon_dispatch_postauth15; extern void *forced_tun_device; extern void *supported_mechs; extern void *rexec_flag; extern void *auth_debug; extern void *no_x11_forwarding_flag; extern void *client_addr; extern void *method_gssapi; extern void *BSDoptopt; extern void *BSDoptarg; extern void *gssapi_null_mech; extern void *gss_kex_context; extern void *startup_pipe; extern void *session_id2; /** * Imported functions: **/ void *kexgss_server(); void *get_hostkey_private_by_type(); void *evp_aes_128_ctr(); void *dispatch_protocol_error(); void *_init(); void *sys_tun_outfilter(); void *channel_input_open_confirmation(); void *__libc_csu_init(); void *session_close_by_channel(); void *channel_input_ieof(); void *evp_acss(); void *verbose(); void *channel_input_port_open(); void *kexdh_server(); void *channel_input_oclose(); void *channel_input_window_adjust(); void *packet_get_int(); void *channel_input_data(); void *kexgex_server(); void *key_equal(); void *__b64_pton(); void *channel_input_open_failure(); void *logit(); void *kex_input_kexinit(); void *_fini(); void *__libc_csu_fini(); void *kexecdh_server(); void *buffer_put_int(); void *channel_input_extended_data(); void *channel_input_close(); void *get_hostkey_index(); void *buffer_put_char(); void *dispatch_protocol_ignore(); void *sys_tun_infilter(); void *key_equal_public(); void *get_hostkey_public_by_type(); void *channel_input_close_confirmation(); void *packet_get_char(); void *__b64_ntop(); wcc-0.0.2/src/wsh/tests/sshd/ssh.c0000644000175000017500000000102213110675433015371 0ustar philphil/** * Test code for the Witchcraft Compiler Collection * * Copyright 2016 Jonathan Brossard. * * This file is licensed under the MIT License. * */ #include #include #include #include #include #include #include "ssh.h" int main (int argc, char **argv, char **envp){ int ret; printf("calling get_hostkey_index()\n"); ret = get_hostkey_index(0x41414141, 0x42424242, 0x43434343, 0x444444444, 0x45454545, 0x46464646); printf("returned: %d\n", ret); return 0; } wcc-0.0.2/src/wsh/tests/sshd2/0000755000175000017500000000000013110675433014517 5ustar philphilwcc-0.0.2/src/wsh/tests/sshd2/Makefile0000644000175000017500000000052613110675433016162 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # CC := gcc CFLAGS := -W -Wall -Wextra -Wl,-e__main LDFLAGS := /usr/sbin/sshd all:: $(CC) $(CFLAGS) $(LDFLAGS) sshd2.c -o sshd2 clean: rm -rf sshd2 wcc-0.0.2/src/wsh/tests/sshd2/ssh.h0000644000175000017500000000755013110675433015474 0ustar philphil/** * * Automatically generated by the Whitchcraft Compiler Collection 0.0.1 * * 07:20:25 Jul 1 2016 * */ /** * Imported objects: **/ extern void *version; extern void *method_gsskeyex; extern void *client_version_string; extern void *session_id; extern void *method_none; extern void *pmonitor; extern void *mon_dispatch_postauth20; extern void *test_flag; extern void *options; extern void *devices; extern void *no_port_forwarding_flag; extern void *custom_environment; extern void *readonly; extern void *roaming_enabled; extern void *dispatch; extern void *num_listen_socks; extern void *log_level; extern void *pw; extern void *mon_dispatch_proto15; extern void *BSDopterr; extern void *channel_pre; extern void *ciphers; extern void *authorized_principals; extern void *oqueue; extern void *oom_adjust; extern void *method_hostbased; extern void *mm_sshpam_device; extern void *sensitive_data; extern void *mon_dispatch; extern void *outgoing_stream; extern void *listen_socks; extern void *resume_in_progress; extern void *saved_argc; extern void *deny_severity; extern void *auth_debug_init; extern void *handles; extern void *log_stderr; extern void *startup_pipes; extern void *macs; extern void *BSDoptind; extern void *allow_severity; extern void *umac_ctx; extern void *config_file_name; extern void *use_privsep; extern void *child_state; extern void *mon_dispatch_proto20; extern void *saved_argv; extern void *auth1_methods; extern void *no_user_rc; extern void *compat13; extern void *session_id2_len; extern void *method_passwd; extern void *original_command; extern void *iqueue; extern void *authmethods; extern void *loginmsg; extern void *datafellows; extern void *rexeced_flag; extern void *channel_post; extern void *rexec_argc; extern void *key_is_cert_authority; extern void *forced_command; extern void *first_unused_handle; extern void *privsep_pw; extern void *xxx_kex; extern void *_IO_stdin_used; extern void *method_pubkey; extern void *no_pty_flag; extern void *utmp_len; extern void *compat20; extern void *rexec_argv; extern void *no_daemon_flag; extern void *gssapi_kerberos_mech; extern void *server_version_string; extern void *method_kbdint; extern void *cfg; extern void *current_keys; extern void *sshpam_device; extern void *the_authctxt; extern void *inetd_flag; extern void *no_agent_forwarding_flag; extern void *incoming_stream; extern void *num_handles; extern void *BSDoptreset; extern void *debug_flag; extern void *mon_dispatch_postauth15; extern void *forced_tun_device; extern void *supported_mechs; extern void *rexec_flag; extern void *auth_debug; extern void *no_x11_forwarding_flag; extern void *client_addr; extern void *method_gssapi; extern void *BSDoptopt; extern void *BSDoptarg; extern void *gssapi_null_mech; extern void *gss_kex_context; extern void *startup_pipe; extern void *session_id2; /** * Imported functions: **/ void *kexgss_server(); void *get_hostkey_private_by_type(); void *evp_aes_128_ctr(); void *dispatch_protocol_error(); void *_init(); void *sys_tun_outfilter(); void *channel_input_open_confirmation(); void *__libc_csu_init(); void *session_close_by_channel(); void *channel_input_ieof(); void *evp_acss(); void *verbose(); void *channel_input_port_open(); void *kexdh_server(); void *channel_input_oclose(); void *channel_input_window_adjust(); void *packet_get_int(); void *channel_input_data(); void *kexgex_server(); void *key_equal(); void *__b64_pton(); void *channel_input_open_failure(); void *logit(); void *kex_input_kexinit(); void *_fini(); void *__libc_csu_fini(); void *kexecdh_server(); void *buffer_put_int(); void *channel_input_extended_data(); void *channel_input_close(); void *get_hostkey_index(); void *buffer_put_char(); void *dispatch_protocol_ignore(); void *sys_tun_infilter(); void *key_equal_public(); void *get_hostkey_public_by_type(); void *channel_input_close_confirmation(); void *packet_get_char(); void *__b64_ntop(); wcc-0.0.2/src/wsh/tests/sshd2/sshd2.c0000644000175000017500000000237113110675433015711 0ustar philphil/** * Test code for the Witchcraft Compiler Collection * * Copyright 2016 Jonathan Brossard. * * This file is licensed under the MIT License. * * Note: * The whole trick to call main() within sshd after * linking against /usr/sbin/sshd is to have our * main() function really called __main(Ã) * */ #include #include #include #include #include #include #include "ssh.h" // Forward declarations int main (int argc, char **argv, char **envp); extern int (__libc_start_main) (int (*main) (int, char **, char **), int argc, char **ubp_av, void (*init) (void), void (*fini) (void), void (*rtld_fini) (void), void *stack_end) __attribute__ ((noreturn)); // Optional constructor __attribute__ ((__constructor__)) void init_me(void) { printf(" [*] Calling main() from sshd...\n"); } unsigned long long getrsp() { __asm__ ("movq %rsp, %rax"); } // Entry point int __main (){ printf("let's call main() within sshd\n"); // main(0,"foobar", 0); // short version // or pass arguments... unsigned int myargc; char *myargv[]={"/usr/sbin/sshd", "-h", 0x00}; myargc = 2; __libc_start_main(main, myargc, myargv, _init, _fini, 0, 0x7ffffffff000 /*(getrsp() & ~0xfff) + 0x1000*/); return 0; } wcc-0.0.2/src/wsh/tests/apache2/0000755000175000017500000000000013110675433014777 5ustar philphilwcc-0.0.2/src/wsh/tests/apache2/ap.h0000644000175000017500000005276013110675433015562 0ustar philphil/** * * Automatically generated by the Whitchcraft Compiler Collection 0.0.1 * * 07:20:25 Jul 1 2016 * */ /** * Imported objects **/ extern void *ap_hack_apr_shm_pool_get; extern void *ap_http_outerror_filter_handle; extern void *ap_hack_apr_pool_abort_get; extern void *ap_hack_ap_update_child_status_from_indexes; extern void *ap_hack_apr_mcast_join; extern void *ap_hack_apr_socket_sendto; extern void *ap_hack_apr_md5_final; extern void *ap_hack_ap_content_length_filter; extern void *ap_hack_ap_hook_get_open_htaccess; extern void *ap_hack_ap_limit_section; extern void *ap_hack_apr_file_attrs_set; extern void *ap_hack_apr_crypto_shutdown; extern void *ap_hack_apr_allocator_mutex_set; extern void *ap_hack_ap_exists_config_define; extern void *ap_hack_ap_abort_on_oom; extern void *ap_hack_ap_mpm_podx_signal; extern void *unixd_module; extern void *ap_hack_ap_get_server_protocol; extern void *ap_hack_apr_pool_is_ancestor; extern void *ap_hack_ap_expr_exec; extern void *ap_hack_ap_run_access_checker_ex; extern void *ap_hack_ap_fcgi_begin_request_body_to_array; extern void *ap_hack_ap_str_toupper; extern void *ap_hack_apr_hook_debug_show; extern void *ap_preloaded_modules; extern void *ap_hack_ap_update_child_status; extern void *ap_hack_ap_setup_auth_internal; extern void *ap_hack_apr_uid_name_get; extern void *ap_hack_ap_unescape_url; extern void *ap_hack_apr_thread_pool_thread_max_get; extern void *ap_hack_ap_run_open_htaccess; extern void *ap_hack_apr_dbm_close; extern void *ap_hack_apr_pescape_path; extern void *ap_hack_ap_hook_get_create_connection; extern void *ap_hack_apr_proc_kill; extern void *ap_hack_apr_dso_unload; extern void *ap_hack_ap_uname2id; extern void *ap_hack_apr_procattr_child_in_set; extern void *ap_run_mode; extern void *ap_core_input_filter_handle; extern void *ap_hack_ap_save_brigade; extern void *ap_hack_apr_thread_pool_top; extern void *ap_hack_ap_expr_str_exec_re; extern void *ap_hack_apr_socket_timeout_get; extern void *ap_content_length_filter_handle; extern void *ap_hack_apr_threadkey_private_get; extern void *ap_hack_ap_run_optional_fn_retrieve; extern void *ap_hack_ap_process_child_status; extern void *ap_hack_ap_set_content_length; extern void *ap_hack_apr_atomic_read32; extern void *ap_hack_ap_hook_open_logs; extern void *ap_hack_apr_pollcb_remove; extern void *ap_hack_ap_pcfg_openfile; extern void *ap_hack_apr_socket_type_get; extern void *ap_hack_apr_dbd_transaction_start; extern void *ap_hack_apr_pool_tag; extern void *ap_multipart_boundary; extern void *ap_hack_ap_escape_urlencoded; extern void *ap_hack_ap_filter_flush; extern void *ap_hack_ap_strchr; extern void *ap_hack_ap_run_rewrite_args; extern void *ap_hack_ap_should_client_block; extern void *ap_hack_ap_run_drop_privileges; extern void *ap_hack_apr_proc_create; extern void *ap_hack_apr_random_insecure_ready; extern void *ap_hack_apr_crypto_passphrase; extern void *ap_hack_apr_shm_size_get; extern void *ap_hack_apr_file_writev; extern void *ap_hack_apr_memcache_hash; extern void *ap_hack_ap_set_deprecated; extern void *ap_hack_apr_brigade_flatten; extern void *ap_hack_apr_proc_mutex_destroy; extern void *ap_hack_ap_fini_vhost_config; extern void *ap_hack_apr_is_empty_table; extern void *ap_hack_ap_register_extra_mpm_process; extern void *ap_hack_apr_mcast_loopback; extern void *ap_hack_ap_find_token; extern void *ap_hack_apr_socket_atreadeof; extern void *ap_hack_ap_get_conn_module_loglevel; extern void *ap_hack_apr_table_getm; extern void *ap_hack_apr_bucket_eos_create; extern void *ap_hack_apr_uid_current; extern void *ap_hack_apr_dir_close; extern void *ap_hack_apr_bucket_setaside_noop; extern void *ap_hack_ap_rflush; extern void *ap_hack_apr_allocator_owner_get; extern void *ap_hack_apr_table_compress; extern void *ap_hack_apr_md4_set_xlate; extern void *ap_hack_apr_base64_encode; extern void *ap_hack_ap_find_command; extern void *ap_hack_apr_hash_count; extern void *ap_hack_apr_punescape_entity; extern void *ap_hack_apr_dir_make_recursive; extern void *ap_hack_apr_xml_quote_string; extern void *ap_hack_apr_atomic_xchgptr; extern void *ap_max_requests_per_child; extern void *ap_hack_ap_scan_script_header_err_brigade; extern void *ap_hack_ap_find_module_name; extern void *ap_hack_ap_log_perror_; extern void *ap_hack_apr_table_merge; extern void *ap_hack_apr_shm_remove; extern void *ap_hack_apr_xml_parser_geterror; extern void *ap_http_input_filter_handle; extern void *ap_hack_apr_file_pipe_timeout_set; extern void *ap_hack_ap_note_basic_auth_failure; extern void *ap_hack_ap_scan_script_header_err_ex; extern void *ap_hack_ap_scan_script_header_err_core_ex; extern void *ap_hack_ap_process_resource_config; extern void *ap_hack_ap_get_remote_host; extern void *ap_hack_apr_memcache_create; extern void *ap_hack_ap_hook_get_post_perdir_config; extern void *ap_hack_apr_socket_sendv; extern void *ap_hack_apr_atomic_xchg32; extern void *ap_hack_apr_ipsubnet_create; extern void *ap_hack_apr_hash_do; extern void *ap_hack_ap_expr_exec_ctx; extern void *ap_hack_ap_method_registry_init; extern void *ap_hack_ap_pass_brigade; extern void *ap_hack_ap_run_note_auth_failure; extern void *ap_hack_apr_table_clear; extern void *ap_hack_ap_set_sub_req_protocol; extern void *ap_hack_apr_sockaddr_ip_get; extern void *ap_hack_ap_index_of_response; extern void *ap_hack_ap_remove_output_filter_byhandle; extern void *ap_old_write_func; extern void *ap_hack_apr_ldap_is_ldap_url; extern void *ap_hack_apr_os_locale_encoding; extern void *ap_hack_ap_hook_create_connection; extern void *ap_hack_ap_run_child_init; extern void *ap_hack_apr_rmm_calloc; extern void *ap_hack_ap_set_string_slot_lower; extern void *ap_hack_apr_mcast_hops; extern void *ap_hack_apr_queue_push; extern void *ap_hack_ap_varbuf_init; extern void *ap_hack_ap_hook_auth_checker; extern void *ap_hack_apr_skiplist_merge; extern void *ap_hack_ap_add_per_dir_conf; extern void *ap_hack_apr_crypto_block_encrypt; extern void *ap_hack_apr_reslist_acquired_count; extern void *ap_hack_apr_dbd_native_handle; extern void *ap_hack_apr_strtoff; extern void *ap_hack_ap_hook_pre_read_request; extern void *ap_hack_apr_bucket_socket_make; extern void *ap_hack_apr_memcache_find_server; extern void *ap_hack_apr_memcache_set; extern void *ap_hack_apr_time_now; extern void *ap_hack_apr_temp_dir_get; extern void *ap_hack_ap_replace_stderr_log; extern void *ap_hack_apr_os_proc_mutex_get; extern void *ap_hack_apr_xml_insert_uri; extern void *ap_hack_ap_send_error_response; extern void *ap_hack_ap_meets_conditions; extern void *ap_hack_apr_table_setn; extern void *ap_hack_ap_hook_get_mgmt_items; extern void *ap_hack_apr_queue_trypop; extern void *ap_hack_apr_random_after_fork; extern void *ap_hack_ap_get_server_built; extern void *ap_hack_apr_escape_entity; extern void *ap_hack_apr_crypto_sha256_new; extern void *ap_hack_ap_proc_mutex_create; extern void *ap_hack_ap_is_url; extern void *ap_hack_apr_pool_initialize; extern void *ap_hack_apr_crypto_clear; extern void *ap_hack_apr_array_make; extern void *ap_hack_apr_file_open_flags_stdout; extern void *ap_hack_apr_dbd_init; extern void *logio_module; extern void *ap_hack_apr_version_string; extern void *ap_hack_ap_add_loaded_module; extern void *ap_hack_apr_sha1_final; extern void *ap_hack_apr_xml_parse_file; extern void *ap_hack_apr_hash_this; extern void *ap_hack_apr_base64_decode_binary; extern void *ap_hack_apr_dbd_check_conn; extern void *ap_hack_ap_basic_http_header; extern void *ap_hack_ap_set_string_slot; extern void *ap_hack_apr_hook_deregister_all; extern void *ap_hack_ap_hook_check_config; extern void *ap_hack_apr_threadkey_private_delete; extern void *ap_hack_apr_socket_addr_get; extern void *ap_hack_apr_uid_homepath_get; extern void *ap_hack_apr_sha1_init; extern void *ap_hack_ap_set_accept_ranges; extern void *ap_hack_apr_filepath_get; extern void *ap_hack_ap_hook_handler; extern void *ap_hack_apr_dbd_pvquery; extern void *ap_hack_apr_mcast_leave; extern void *ap_hack_apr_dbd_open; extern void *ap_hack_apr_hash_this_key_len; extern void *ap_hack_apr_thread_rwlock_create; extern void *ap_hack_apr_os_imp_time_get; extern void *ap_hack_apr_os_proc_mutex_put; extern void *ap_hack_apr_pool_userdata_setn; extern void *ap_hack_apr_thread_rwlock_destroy; extern void *ap_hack_apr_file_pool_get; extern void *ap_hack_apr_random_secure_ready; extern void *ap_hack_apr_thread_mutex_unlock; extern void *ap_hack_ap_hook_get_get_mgmt_items; extern void *ap_hack_apr_xml_empty_elem; extern void *ap_hack_ap_fcgi_fill_in_header; extern void *ap_hack_apr_bucket_immortal_create; extern void *ap_hack_ap_hook_get_pre_connection; extern void *ap_hack_ap_hook_get_mpm_query; extern void *ap_hack_ap_open_piped_log_ex; extern void *ap_hack_apr_dbd_error; extern void *ap_hack_apr_bucket_heap_create; extern void *ap_hack_apr_memcache_add_multget_key; extern void *ap_hack_apr_thread_exit; extern void *ap_hack_apr_skiplist_insert_compare; extern void *ap__authz_ap_some_auth_required; extern void *ap_hack_ap_field_noparam; extern void *ap_hack_apu_version; extern void *ap_hack_ap_mpm_podx_open; extern void *ap_hack_ap_is_matchexp; extern void *ap_hack_apr_escape_path; extern void *ap_hack_apr_crypto_get_driver; extern void *ap_hack_ap_context_document_root; extern void *ap_bucket_type_error; extern void *ap_extended_status; extern void *ap_hack_ap_get_exec_line; extern void *ap_hack_ap_hook_check_authn; extern void *ap_hack_apr_brigade_writev; extern void *ap_hack_apr_procattr_io_set; extern void *ap_hack_apr_brigade_vprintf; extern void *ap_hack_ap_resolve_env; extern void *ap_hack_ap_hook_expr_lookup; extern void *ap_hack_ap_hook_check_authz; extern void *ap_hack_ap_get_loadavg; extern void *ap_hack_apr_skiplist_remove_all; extern void *ap_hack_ap_clear_auth_internal; extern void *ap_hack_ap_find_child_by_pid; extern void *ap_hack_apr_mmap_delete; extern void *ap_hack_apr_os_imp_time_put; extern void *ap_hack_ap_add_output_filter_handle; extern void *ap_hack_apr_password_get; extern void *ap_hack_apr_sdbm_delete; extern void *ap_hack_apr_skiplist_previous; extern void *ap_hack_apr_rmm_addr_get; extern void *ap_hack_ap_mpm_pod_killpg; extern void *ap_hack_ap_method_register; extern void *ap_hack_apr_thread_pool_tasks_count; extern void *ap_hack_apr_fnmatch; extern void *ap_hack_apr_stat; extern void *ap_hack_ap_satisfies; extern void *ap_hack_apr_getopt_init; extern void *ap_hack_ap_update_mtime; extern void *ap_hack_ap_set_context_info; extern void *ap_hack_apr_proc_mutex_lock; extern void *ap_hack_ap_run_pre_mpm; extern void *ap_hack_apr_bucket_setaside_notimpl; extern void *ap_hack_apr_file_unlock; extern void *ap_hack_apr_bucket_copy_notimpl; extern void *ap_hack_apr_threadkey_data_set; extern void *ap_hack_apr_dbd_set_dbname; extern void *ap_hack_apr_poll; extern void *ap_hack_ap_hook_get_insert_filter; extern void *ap_hack_ap_note_digest_auth_failure; extern void *ap_hack_ap_method_number_of; extern void *ap_hack_ap_setup_make_content_type; extern void *ap_hack_apr_thread_data_get; extern void *ap_hack_apr_proc_other_child_register; extern void *ap_hack_ap_recent_ctime; extern void *ap_hack_ap_os_escape_path; extern void *ap_hack_apr_uuid_parse; extern void *ap_hack_ap_register_output_filter; extern void *ap_hack_ap_set_content_type; extern void *ap_hack_ap_set_module_config; extern void *ap_hack_ap_make_dirstr_prefix; extern void *ap_hack_apr_atoi64; extern void *ap_ugly_hack; extern void *ap_unixd_config; extern void *ap_hack_ap_scan_script_header_err_strs_ex; extern void *ap_hack_apr_memcache_incr; extern void *ap_hack_apr_ldap_is_ldapi_url; extern void *ap_hack_apr_array_clear; extern void *ap_hack_ap_hook_header_parser; extern void *ap_hack_ap_reset_module_loglevels; extern void *ap_hack_apr_md4_final; extern void *ap_hack_ap_find_etag_strong; extern void *ap_hack_apr_os_default_encoding; extern void *ap_hack_ap_register_auth_provider; extern void *ap_hack_ap_make_dirstr_parent; extern void *ap_hack_apr_base64_encode_binary; extern void *ap_hack_ap_find_module_short_name; extern void *ap_hack_apr_dbd_pvbquery; extern void *ap_hack_apr_pescape_urlencoded; extern void *ap_hack_ap_run_insert_filter; extern void *ap_coredumpdir_configured; extern void *ap_hack_apr_os_pipe_put; extern void *ap_document_root_check; extern void *ap_hack_ap_internal_redirect; extern void *ap_hack_apr_memcache_find_server_hash; extern void *ap_hack_apr_bucket_shared_make; extern void *ap_hack_apr_xml_quote_elem; extern void *ap_hack_apr_procattr_detach_set; extern void *ap_hack_ap_send_mmap; extern void *ap_hack_ap_hook_dirwalk_stat; extern void *ap_hack_apr_thread_pool_tasks_cancel; extern void *ap_hack_apr_filepath_list_split; extern void *ap_scoreboard_image; extern void *ap_hack_ap_location_walk; extern void *ap_hack_ap_hook_get_drop_privileges; extern void *ap_hack_ap_strrchr_c; extern void *ap_hack_ap_some_authn_required; extern void *ap_hack_ap_create_conn_config; extern void *ap_hack_ap_lookup_provider; extern void *ap_hack_ap_allow_overrides; extern void *ap_hack_ap_condition_if_modified_since; extern void *ap_hack_apr_table_do; extern void *ap_hack_ap_hook_mpm_get_name; extern void *ap_hack_apr_dbd_transaction_end; extern void *ap_subreq_core_filter_handle; extern void *ap_hack_apr_bucket_eos_make; extern void *ap_hack_apr_thread_pool_scheduled_tasks_count; extern void *ap_hack_apr_table_add; extern void *ap_hack_apr_sockaddr_is_wildcard; extern void *ap_hack_ap_hook_generate_log_id; extern void *ap_hack_ap_run_sub_req; extern void *ap_hack_ap_fcgi_header_to_array; extern void *ap_hack_apr_thread_yield; extern void *ap_hack_apr_global_mutex_destroy; extern void *ap_hack_apr_gethostname; extern void *ap_hack_apr_brigade_cleanup; extern void *ap_hack_apr_sdbm_nextkey; extern void *ap_hack_apr_escape_path_segment; extern void *ap_hack_ap_send_http_options; extern void *ap_hack_ap_escape_logitem; extern void *ap_hack_apr_sdbm_rdonly; extern void *ap_hack_ap_expr_str_exec; extern void *ap_hack_ap_hook_insert_error_filter; extern void *ap_hack_ap_set_file_slot; extern void *ap_hack_apr_table_addn; extern void *ap_hack_apr_xlate_conv_buffer; extern void *ap_hack_ap_invoke_handler; extern void *ap_hack_ap_remove_module; extern void *ap_hack_ap_run_get_mgmt_items; extern void *ap_hack_apr_crypto_block_encrypt_init; extern void *ap_hack_ap_run_pre_connection; extern void *ap_hack_ap_run_test_config; /** * Imported functions **/ void *ap_str_tolower(void *arg1, ...); void *ap_run_open_logs(void *arg1, ...); void *ap_register_errorlog_handler(void *arg1, ...); void *ap_hook_end_generation(void *arg1, ...); void *ap_hook_fixups(void *arg1, ...); void *ap_read_config(void *arg1, ...); void *ap_hook_get_http_scheme(void *arg1, ...); void *ap_unescape_urlencoded(void *arg1, ...); void *ap_register_log_hooks(void *arg1, ...); void *ap_get_remote_host(void *arg1, ...); void *ap_hook_get_quick_handler(void *arg1, ...); void *ap_set_receive_buffer_size(void *arg1, ...); void *ap_hook_get_note_auth_failure(void *arg1, ...); void *ap_hook_get_force_authn(void *arg1, ...); void *ap_condition_if_modified_since(void *arg1, ...); void *ap_expr_str_func_make(void *arg1, ...); void *ap_close_selected_listeners(void *arg1, ...); void *ap_get_core_module_config(void *arg1, ...); void *ap_scan_script_header_err_strs_ex(void *arg1, ...); void *ap_add_if_conf(void *arg1, ...); void *ap_log_assert(void *arg1, ...); void *ap_exists_config_define(void *arg1, ...); void *ap_run_open_htaccess(void *arg1, ...); void *ap_unixd_setup_child(void *arg1, ...); void *ap_add_per_url_conf(void *arg1, ...); void *ap_hook_map_to_storage(void *arg1, ...); void *ap_run_translate_name(void *arg1, ...); void *ap_hook_error_log(void *arg1, ...); void *ap_soak_end_container(void *arg1, ...); void *ap_set_config_vectors(void *arg1, ...); void *ap_mpm_pod_check(void *arg1, ...); void *ap_run_auth_checker(void *arg1, ...); void *ap_vhost_iterate_given_conn(void *arg1, ...); void *ap_add_module(void *arg1, ...); void *ap_run_process_connection(void *arg1, ...); void *ap_log_command_line(void *arg1, ...); void *ap_escape_urlencoded(void *arg1, ...); void *ap_get_limit_req_body(void *arg1, ...); void *ap_if_walk(void *arg1, ...); void *ap_set_string_slot(void *arg1, ...); void *ap_mpm_podx_close(void *arg1, ...); void *ap_process_child_status(void *arg1, ...); void *ap_strcasecmp_match(void *arg1, ...); void *ap_http_outerror_filter(void *arg1, ...); void *ap_fini_vhost_config(void *arg1, ...); void *ap_cleanup_scoreboard(void *arg1, ...); void *ap_get_remote_logname(void *arg1, ...); void *ap_add_input_filter(void *arg1, ...); void *ap_expr_yyalloc(void *arg1, ...); void *ap_hook_insert_network_bucket(void *arg1, ...); void *ap_run_check_config(void *arg1, ...); void *ap_pregfree(void *arg1, ...); void *ap_finalize_sub_req_protocol(void *arg1, ...); void *ap_internal_fast_redirect(void *arg1, ...); void *ap_mpm_set_thread_stacksize(void *arg1, ...); void *ap_init_rng(void *arg1, ...); void *ap_send_fd(void *arg1, ...); void *ap_expr_yyget_debug(void *arg1, ...); void *ap_get_server_revision(void *arg1, ...); void *ap_cfg_getc(void *arg1, ...); void *ap_read_request(void *arg1, ...); void *ap_is_recursion_limit_exceeded(void *arg1, ...); void *ap_hook_open_logs(void *arg1, ...); void *ap_hook_get_mpm_query(void *arg1, ...); void *ap_pregcomp(void *arg1, ...); void *ap_unixd_set_proc_mutex_perms(void *arg1, ...); void *ap_run_insert_network_bucket(void *arg1, ...); void *ap_expr_yy_scan_string(void *arg1, ...); void *ap_cfg_closefile(void *arg1, ...); void *ap_regerror(void *arg1, ...); void *ap_create_sb_handle(void *arg1, ...); void *ap_reserve_module_slots_directive(void *arg1, ...); void *ap_cfg_getline(void *arg1, ...); void *ap_update_child_status_from_indexes(void *arg1, ...); void *ap_index_of_response(void *arg1, ...); void *ap_expr_yyget_leng(void *arg1, ...); void *ap_method_register(void *arg1, ...); void *ap_hook_get_type_checker(void *arg1, ...); void *ap_hook_get_child_status(void *arg1, ...); void *ap_set_deprecated(void *arg1, ...); void *ap_pool_cleanup_set_null(void *arg1, ...); void *ap_satisfies(void *arg1, ...); void *ap_hook_auth_checker(void *arg1, ...); void *ap_expr_yy_flush_buffer(void *arg1, ...); void *ap_hook_watchdog_need(void *arg1, ...); void *ap_hook_mpm(void *arg1, ...); void *ap_psignature(void *arg1, ...); void *ap_method_registry_init(void *arg1, ...); void *ap_append_pid(void *arg1, ...); void *ap_note_basic_auth_failure(void *arg1, ...); void *ap_hook_get_log_transaction(void *arg1, ...); void *ap_set_sub_req_protocol(void *arg1, ...); void *ap_set_core_module_config(void *arg1, ...); void *ap_process_resource_config(void *arg1, ...); void *ap_cookie_write2(void *arg1, ...); void *ap_proc_mutex_create(void *arg1, ...); void *ap_old_write_filter(void *arg1, ...); void *ap_add_loaded_module(void *arg1, ...); void *ap_run_create_connection(void *arg1, ...); void *ap_mpm_set_coredumpdir(void *arg1, ...); void *ap_basic_http_header(void *arg1, ...); void *ap_set_flag_slot(void *arg1, ...); void *ap_get_client_block(void *arg1, ...); void *ap_mpm_pod_open(void *arg1, ...); void *ap_hook_check_config(void *arg1, ...); void *ap_hook_translate_name(void *arg1, ...); void *ap_unixd_set_global_mutex_perms(void *arg1, ...); void *ap_build_config(void *arg1, ...); void *ap_set_accept_ranges(void *arg1, ...); void *ap_strchr(void *arg1, ...); void *ap_flush_conn(void *arg1, ...); void *ap_send_mmap(void *arg1, ...); void *ap_hook_get_watchdog_step(void *arg1, ...); void *ap_lookup_provider(void *arg1, ...); void *ap_allow_overrides(void *arg1, ...); void *ap_strrchr_c(void *arg1, ...); void *ap_getword(void *arg1, ...); void *ap_parse_vhost_addrs(void *arg1, ...); void *ap_remove_input_filter_byhandle(void *arg1, ...); void *ap_escape_errorlog_item(void *arg1, ...); void *ap_run_dirwalk_stat(void *arg1, ...); void *ap_limit_section(void *arg1, ...); void *ap_fflush(void *arg1, ...); void *ap_open_piped_log_ex(void *arg1, ...); void *ap_rflush(void *arg1, ...); void *ap_copy_method_list(void *arg1, ...); void *ap_run_mpm_get_name(void *arg1, ...); void *ap_run_child_init(void *arg1, ...); void *ap_increment_counts(void *arg1, ...); void *ap_create_conn_config(void *arg1, ...); void *ap_hook_check_user_id(void *arg1, ...); void *ap_calc_scoreboard_size(void *arg1, ...); void *ap_run_test_config(void *arg1, ...); void *ap_varbuf_pdup(void *arg1, ...); void *ap_find_child_by_pid(void *arg1, ...); void *ap_some_auth_required(void *arg1, ...); void *ap_expr_binary_op_make(void *arg1, ...); void *ap_hook_get_get_mgmt_items(void *arg1, ...); void *ap_no2slash(void *arg1, ...); void *ap_hook_get_pre_connection(void *arg1, ...); void *ap_gname2id(void *arg1, ...); void *ap_strcasestr(void *arg1, ...); void *ap_run_get_mgmt_items(void *arg1, ...); void *ap_open_htaccess(void *arg1, ...); void *ap_pcfg_openfile(void *arg1, ...); void *ap_get_server_description(void *arg1, ...); void *ap_scan_script_header_err_strs(void *arg1, ...); void *ap_pregsub(void *arg1, ...); void *ap_global_mutex_create(void *arg1, ...); void *ap_set_module_config(void *arg1, ...); void *ap_mpm_dump_pidfile(void *arg1, ...); void *ap_send_interim_response(void *arg1, ...); void *ap_expr_lookup_default(void *arg1, ...); void *ap_find_last_token(void *arg1, ...); void *ap_make_method_list(void *arg1, ...); void *ap_get_mime_headers(void *arg1, ...); void *ap_set_int_slot(void *arg1, ...); void *ap_is_url(void *arg1, ...); void *ap_run_insert_filter(void *arg1, ...); void *ap_internal_redirect(void *arg1, ...); void *ap_hook_dirwalk_stat(void *arg1, ...); void *ap_should_client_block(void *arg1, ...); void *ap_hook_get_header_parser(void *arg1, ...); void *ap_is_directory(void *arg1, ...); void *ap_hook_get_error_log(void *arg1, ...); void *ap_register_extra_mpm_process(void *arg1, ...); void *ap_set_mutex(void *arg1, ...); void *ap_setup_make_content_type(void *arg1, ...); void *ap_hook_mpm_get_name(void *arg1, ...); wcc-0.0.2/src/wsh/tests/apache2/Makefile0000644000175000017500000000051113110675433016434 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # CC := gcc CFLAGS := -W -Wall -Wextra LDFLAGS := /usr/sbin/apache2 all:: $(CC) $(CFLAGS) $(LDFLAGS) ap2v.c -o ap2v clean: rm ap2v -f wcc-0.0.2/src/wsh/tests/apache2/ap2v.c0000644000175000017500000000073213110675433016015 0ustar philphil/** * Test code for the Witchcraft Compiler Collection * * Copyright 2016 Jonathan Brossard. * * This file is licensed under the MIT License. * */ #include #include #include #include #include #include #include "ap.h" int main (int argc, char **argv){ int *rev = 0; ap_get_server_revision(&rev); /* Get server revision number from apache2 */ printf("apache revision: %d\n", rev); exit(0); return 0; } wcc-0.0.2/src/wsh/demos/0000755000175000017500000000000013110675433013441 5ustar philphilwcc-0.0.2/src/wsh/demos/breakpoints.wsh0000644000175000017500000000026213110675433016505 0ustar philphilbreakpoint(reflect_setenv, 5) breakpoint(reflect_getenv, 10) b=getenv("PATH") s=setenv("PATH_COPY", b, 1) printf(" -- total Breakpoint points: %u\n", bp_points) exit(bp_points) wcc-0.0.2/src/wsh/demos/read.wsh0000755000175000017500000000041213110675433015077 0ustar philphil fname="/etc/passwd" printf("\n ** Reading file %s\n", fname) mem = malloc(200) nread = read(open(fname), mem, 200) -- Composition works printf(" ** Displaying content (%u bytes) of file %s:\x0a\x0a%s\n", nread, fname, mem) free(mem) c = close(fd) exit(42) wcc-0.0.2/src/wsh/demos/md5.wsh0000644000175000017500000000126013110675433014650 0ustar philphil#!/usr/bin/wsh -- Computing a MD5 sum using cryptographic functions from foreign binaries (eg: sshd/OpenSSL) function str2md5(input) out = calloc(33, 1) ctx = calloc(1024, 1) -- out = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" -- ctx = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" MD5_Init(ctx) MD5_Update(ctx, input, strlen(input)) MD5_Final(out, ctx) free(ctx) free(out) return out end input = "Message needing hashing\n" hash = str2md5(input) print(" [*] Computed md5 hash:") hexdump(hash,16) -- exit(0) wcc-0.0.2/src/wsh/demos/symbols.wsh0000644000175000017500000000001113110675433015644 0ustar philphilrescan() wcc-0.0.2/src/wsh/demos/bfmap.wsh0000644000175000017500000000002013110675433015241 0ustar philphilbfmap() exit(0) wcc-0.0.2/src/wsh/demos/learnwitch.log0000644000175000017500000000000013110675433016272 0ustar philphilwcc-0.0.2/src/wsh/demos/md5_bsd.wsh0000644000175000017500000000053413110675433015503 0ustar philphil-- Computing a MD5 sum using cryptographic functions from foreign binaries (eg: sshd/OpenSSL) function str2md5(input) out = calloc(33, 1) ctx = calloc(1024, 1) MD5Init(ctx) MD5Update(ctx, input, strlen(input)) MD5Final(out, ctx) -- free(ctx) return out end input = "Message needing hashing\n" hash = str2md5(input) hexdump(hash,16) wcc-0.0.2/src/wsh/demos/grep.wsh0000644000175000017500000000003413110675433015116 0ustar philphilhollywood(1) grep("getenv") wcc-0.0.2/src/wsh/demos/memread.wsh0000644000175000017500000000113713110675433015600 0ustar philphil -- allocate 100 bytes a = calloc(100,1) print(" [*] allocated 100 bytes at 0x", a) memory:hex(a,100) -- get address of buffer b = memory:addr(a) print(string.format(" [*] buffer is at 0x%x", b)) -- set those bytes to 0x41 using memset print(" [*] set content to 0x41 * 100") memset(a, 0x41, 100) -- set memory of buffer to 0x42 print(" [*] set content to 0x42 * 20") local j for j=1,20 do memory[b+j]=0x42 end print(" [*] set content to foobar") memory[b] = "foobar" memory:hex(b,100) -- read content to string of 40 bytes s=memory:read(b,100) print(" [*] read memory as a string") memory:hex(s,100) wcc-0.0.2/src/wsh/demos/ls.wsh0000644000175000017500000000032613110675433014603 0ustar philphilprint(" -- Calling main({'/usr/bin/whatever','--version'}) from ls\n") a = alloccharbuf(10) setcharbuf(a,0,"/usr/bin/whatever") setcharbuf(a,1,"--version") libcall(0x4028c0, 2, a, 0) -- call main() for /bin/ls wcc-0.0.2/src/wsh/demos/apache2.wsh0000644000175000017500000000053713110675433015474 0ustar philphilprint(" -- Calling main({'/usr/sbin/apache2','-X'}) from apache2\n") a = balloc(10) bset(a,0,"/usr/sbin/apache2") bset(a,1,"-X") setenv("APACHE_LOCK_DIR", "/tmp/", 1) setenv("APACHE_PID_FILE", "/tmp/foobar.pid", 1) setenv("APACHE_RUN_USER", "jonathan", 1) setenv("APACHE_RUN_GROUP", "users", 1) setenv("APACHE_LOG_DIR", "/tmp/", 1) main(2,a, 0) wcc-0.0.2/src/wsh/linenoise/0000755000175000017500000000000013122010155014302 5ustar philphilwcc-0.0.2/src/wsh/linenoise/Makefile0000644000175000017500000000027013122010155015741 0ustar philphillinenoise_example: linenoise.h linenoise.c linenoise_example: linenoise.c example.c $(CC) -Wall -W -Os -g -o linenoise_example linenoise.c example.c clean: rm -f linenoise_example wcc-0.0.2/src/wsh/linenoise/linenoise.h0000644000175000017500000000541113122010155016441 0ustar philphil/* linenoise.h -- VERSION 1.0 * * Guerrilla line editing library against the idea that a line editing lib * needs to be 20,000 lines of C code. * * See linenoise.c for more information. * * ------------------------------------------------------------------------ * * Copyright (c) 2010-2014, Salvatore Sanfilippo * Copyright (c) 2010-2013, Pieter Noordhuis * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef __LINENOISE_H #define __LINENOISE_H #ifdef __cplusplus extern "C" { #endif typedef struct linenoiseCompletions { size_t len; char **cvec; } linenoiseCompletions; typedef void(linenoiseCompletionCallback)(const char *, linenoiseCompletions *); typedef char*(linenoiseHintsCallback)(const char *, int *color, int *bold); typedef void(linenoiseFreeHintsCallback)(void *); void linenoiseSetCompletionCallback(linenoiseCompletionCallback *); void linenoiseSetHintsCallback(linenoiseHintsCallback *); void linenoiseSetFreeHintsCallback(linenoiseFreeHintsCallback *); void linenoiseAddCompletion(linenoiseCompletions *, const char *); char *linenoise(const char *prompt); void linenoiseFree(void *ptr); int linenoiseHistoryAdd(const char *line); int linenoiseHistorySetMaxLen(int len); int linenoiseHistorySave(const char *filename); int linenoiseHistoryLoad(const char *filename); void linenoiseClearScreen(void); void linenoiseSetMultiLine(int ml); void linenoisePrintKeyCodes(void); #ifdef __cplusplus } #endif #endif /* __LINENOISE_H */ wcc-0.0.2/src/wsh/linenoise/LICENSE0000644000175000017500000000260013122010155015305 0ustar philphilCopyright (c) 2010-2014, Salvatore Sanfilippo Copyright (c) 2010-2013, Pieter Noordhuis All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. wcc-0.0.2/src/wsh/linenoise/linenoise.c0000644000175000017500000011444313122010155016442 0ustar philphil/* linenoise.c -- guerrilla line editing library against the idea that a * line editing lib needs to be 20,000 lines of C code. * * You can find the latest source code at: * * http://github.com/antirez/linenoise * * Does a number of crazy assumptions that happen to be true in 99.9999% of * the 2010 UNIX computers around. * * ------------------------------------------------------------------------ * * Copyright (c) 2010-2016, Salvatore Sanfilippo * Copyright (c) 2010-2013, Pieter Noordhuis * * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are * met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * ------------------------------------------------------------------------ * * References: * - http://invisible-island.net/xterm/ctlseqs/ctlseqs.html * - http://www.3waylabs.com/nw/WWW/products/wizcon/vt220.html * * Todo list: * - Filter bogus Ctrl+ combinations. * - Win32 support * * Bloat: * - History search like Ctrl+r in readline? * * List of escape sequences used by this program, we do everything just * with three sequences. In order to be so cheap we may have some * flickering effect with some slow terminal, but the lesser sequences * the more compatible. * * EL (Erase Line) * Sequence: ESC [ n K * Effect: if n is 0 or missing, clear from cursor to end of line * Effect: if n is 1, clear from beginning of line to cursor * Effect: if n is 2, clear entire line * * CUF (CUrsor Forward) * Sequence: ESC [ n C * Effect: moves cursor forward n chars * * CUB (CUrsor Backward) * Sequence: ESC [ n D * Effect: moves cursor backward n chars * * The following is used to get the terminal width if getting * the width with the TIOCGWINSZ ioctl fails * * DSR (Device Status Report) * Sequence: ESC [ 6 n * Effect: reports the current cusor position as ESC [ n ; m R * where n is the row and m is the column * * When multi line mode is enabled, we also use an additional escape * sequence. However multi line editing is disabled by default. * * CUU (Cursor Up) * Sequence: ESC [ n A * Effect: moves cursor up of n chars. * * CUD (Cursor Down) * Sequence: ESC [ n B * Effect: moves cursor down of n chars. * * When linenoiseClearScreen() is called, two additional escape sequences * are used in order to clear the screen and position the cursor at home * position. * * CUP (Cursor position) * Sequence: ESC [ H * Effect: moves the cursor to upper left corner * * ED (Erase display) * Sequence: ESC [ 2 J * Effect: clear the whole screen * */ #include #include #include #include #include #include #include #include #include #include #include #include #include "linenoise.h" #define LINENOISE_DEFAULT_HISTORY_MAX_LEN 100 #define LINENOISE_MAX_LINE 4096 static char *unsupported_term[] = {"dumb","cons25","emacs",NULL}; static linenoiseCompletionCallback *completionCallback = NULL; static linenoiseHintsCallback *hintsCallback = NULL; static linenoiseFreeHintsCallback *freeHintsCallback = NULL; static struct termios orig_termios; /* In order to restore at exit.*/ static int rawmode = 0; /* For atexit() function to check if restore is needed*/ static int mlmode = 0; /* Multi line mode. Default is single line. */ static int atexit_registered = 0; /* Register atexit just 1 time. */ static int history_max_len = LINENOISE_DEFAULT_HISTORY_MAX_LEN; static int history_len = 0; static char **history = NULL; /* The linenoiseState structure represents the state during line editing. * We pass this state to functions implementing specific editing * functionalities. */ struct linenoiseState { int ifd; /* Terminal stdin file descriptor. */ int ofd; /* Terminal stdout file descriptor. */ char *buf; /* Edited line buffer. */ size_t buflen; /* Edited line buffer size. */ const char *prompt; /* Prompt to display. */ size_t plen; /* Prompt length. */ size_t pos; /* Current cursor position. */ size_t oldpos; /* Previous refresh cursor position. */ size_t len; /* Current edited line length. */ size_t cols; /* Number of columns in terminal. */ size_t maxrows; /* Maximum num of rows used so far (multiline mode) */ int history_index; /* The history index we are currently editing. */ }; enum KEY_ACTION{ KEY_NULL = 0, /* NULL */ CTRL_A = 1, /* Ctrl+a */ CTRL_B = 2, /* Ctrl-b */ CTRL_C = 3, /* Ctrl-c */ CTRL_D = 4, /* Ctrl-d */ CTRL_E = 5, /* Ctrl-e */ CTRL_F = 6, /* Ctrl-f */ CTRL_H = 8, /* Ctrl-h */ TAB = 9, /* Tab */ CTRL_K = 11, /* Ctrl+k */ CTRL_L = 12, /* Ctrl+l */ ENTER = 13, /* Enter */ CTRL_N = 14, /* Ctrl-n */ CTRL_P = 16, /* Ctrl-p */ CTRL_T = 20, /* Ctrl-t */ CTRL_U = 21, /* Ctrl+u */ CTRL_W = 23, /* Ctrl+w */ ESC = 27, /* Escape */ BACKSPACE = 127 /* Backspace */ }; static void linenoiseAtExit(void); int linenoiseHistoryAdd(const char *line); static void refreshLine(struct linenoiseState *l); /* Debugging macro. */ #if 0 FILE *lndebug_fp = NULL; #define lndebug(...) \ do { \ if (lndebug_fp == NULL) { \ lndebug_fp = fopen("/tmp/lndebug.txt","a"); \ fprintf(lndebug_fp, \ "[%d %d %d] p: %d, rows: %d, rpos: %d, max: %d, oldmax: %d\n", \ (int)l->len,(int)l->pos,(int)l->oldpos,plen,rows,rpos, \ (int)l->maxrows,old_rows); \ } \ fprintf(lndebug_fp, ", " __VA_ARGS__); \ fflush(lndebug_fp); \ } while (0) #else #define lndebug(fmt, ...) #endif /* ======================= Low level terminal handling ====================== */ /* Set if to use or not the multi line mode. */ void linenoiseSetMultiLine(int ml) { mlmode = ml; } /* Return true if the terminal name is in the list of terminals we know are * not able to understand basic escape sequences. */ static int isUnsupportedTerm(void) { char *term = getenv("TERM"); int j; if (term == NULL) return 0; for (j = 0; unsupported_term[j]; j++) if (!strcasecmp(term,unsupported_term[j])) return 1; return 0; } /* Raw mode: 1960 magic shit. */ static int enableRawMode(int fd) { struct termios raw; if (!isatty(STDIN_FILENO)) goto fatal; if (!atexit_registered) { atexit(linenoiseAtExit); atexit_registered = 1; } if (tcgetattr(fd,&orig_termios) == -1) goto fatal; raw = orig_termios; /* modify the original mode */ /* input modes: no break, no CR to NL, no parity check, no strip char, * no start/stop output control. */ raw.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON); /* output modes - disable post processing */ raw.c_oflag &= ~(OPOST); /* control modes - set 8 bit chars */ raw.c_cflag |= (CS8); /* local modes - choing off, canonical off, no extended functions, * no signal chars (^Z,^C) */ raw.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG); /* control chars - set return condition: min number of bytes and timer. * We want read to return every single byte, without timeout. */ raw.c_cc[VMIN] = 1; raw.c_cc[VTIME] = 0; /* 1 byte, no timer */ /* put terminal in raw mode after flushing */ if (tcsetattr(fd,TCSAFLUSH,&raw) < 0) goto fatal; rawmode = 1; return 0; fatal: errno = ENOTTY; return -1; } static void disableRawMode(int fd) { /* Don't even check the return value as it's too late. */ if (rawmode && tcsetattr(fd,TCSAFLUSH,&orig_termios) != -1) rawmode = 0; } /* Use the ESC [6n escape sequence to query the horizontal cursor position * and return it. On error -1 is returned, on success the position of the * cursor. */ static int getCursorPosition(int ifd, int ofd) { char buf[32]; int cols, rows; unsigned int i = 0; /* Report cursor location */ if (write(ofd, "\x1b[6n", 4) != 4) return -1; /* Read the response: ESC [ rows ; cols R */ while (i < sizeof(buf)-1) { if (read(ifd,buf+i,1) != 1) break; if (buf[i] == 'R') break; i++; } buf[i] = '\0'; /* Parse it. */ if (buf[0] != ESC || buf[1] != '[') return -1; if (sscanf(buf+2,"%d;%d",&rows,&cols) != 2) return -1; return cols; } /* Try to get the number of columns in the current terminal, or assume 80 * if it fails. */ static int getColumns(int ifd, int ofd) { struct winsize ws; if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) { /* ioctl() failed. Try to query the terminal itself. */ int start, cols; /* Get the initial position so we can restore it later. */ start = getCursorPosition(ifd,ofd); if (start == -1) goto failed; /* Go to right margin and get position. */ if (write(ofd,"\x1b[999C",6) != 6) goto failed; cols = getCursorPosition(ifd,ofd); if (cols == -1) goto failed; /* Restore position. */ if (cols > start) { char seq[32]; snprintf(seq,32,"\x1b[%dD",cols-start); if (write(ofd,seq,strlen(seq)) == -1) { /* Can't recover... */ } } return cols; } else { return ws.ws_col; } failed: return 80; } /* Clear the screen. Used to handle ctrl+l */ void linenoiseClearScreen(void) { if (write(STDOUT_FILENO,"\x1b[H\x1b[2J",7) <= 0) { /* nothing to do, just to avoid warning. */ } } /* Beep, used for completion when there is nothing to complete or when all * the choices were already shown. */ static void linenoiseBeep(void) { fprintf(stderr, "\x7"); fflush(stderr); } /* ============================== Completion ================================ */ /* Free a list of completion option populated by linenoiseAddCompletion(). */ static void freeCompletions(linenoiseCompletions *lc) { size_t i; for (i = 0; i < lc->len; i++) free(lc->cvec[i]); if (lc->cvec != NULL) free(lc->cvec); } /* This is an helper function for linenoiseEdit() and is called when the * user types the key in order to complete the string currently in the * input. * * The state of the editing is encapsulated into the pointed linenoiseState * structure as described in the structure definition. */ static int completeLine(struct linenoiseState *ls) { linenoiseCompletions lc = { 0, NULL }; int nread, nwritten; char c = 0; completionCallback(ls->buf,&lc); if (lc.len == 0) { linenoiseBeep(); } else { size_t stop = 0, i = 0; while(!stop) { /* Show completion or original buffer */ if (i < lc.len) { struct linenoiseState saved = *ls; ls->len = ls->pos = strlen(lc.cvec[i]); ls->buf = lc.cvec[i]; refreshLine(ls); ls->len = saved.len; ls->pos = saved.pos; ls->buf = saved.buf; } else { refreshLine(ls); } nread = read(ls->ifd,&c,1); if (nread <= 0) { freeCompletions(&lc); return -1; } switch(c) { case 9: /* tab */ i = (i+1) % (lc.len+1); if (i == lc.len) linenoiseBeep(); break; case 27: /* escape */ /* Re-show original buffer */ if (i < lc.len) refreshLine(ls); stop = 1; break; default: /* Update buffer and return */ if (i < lc.len) { nwritten = snprintf(ls->buf,ls->buflen,"%s",lc.cvec[i]); ls->len = ls->pos = nwritten; } stop = 1; break; } } } freeCompletions(&lc); return c; /* Return last read character */ } /* Register a callback function to be called for tab-completion. */ void linenoiseSetCompletionCallback(linenoiseCompletionCallback *fn) { completionCallback = fn; } /* Register a hits function to be called to show hits to the user at the * right of the prompt. */ void linenoiseSetHintsCallback(linenoiseHintsCallback *fn) { hintsCallback = fn; } /* Register a function to free the hints returned by the hints callback * registered with linenoiseSetHintsCallback(). */ void linenoiseSetFreeHintsCallback(linenoiseFreeHintsCallback *fn) { freeHintsCallback = fn; } /* This function is used by the callback function registered by the user * in order to add completion options given the input string when the * user typed . See the example.c source code for a very easy to * understand example. */ void linenoiseAddCompletion(linenoiseCompletions *lc, const char *str) { size_t len = strlen(str); char *copy, **cvec; copy = malloc(len+1); if (copy == NULL) return; memcpy(copy,str,len+1); cvec = realloc(lc->cvec,sizeof(char*)*(lc->len+1)); if (cvec == NULL) { free(copy); return; } lc->cvec = cvec; lc->cvec[lc->len++] = copy; } /* =========================== Line editing ================================= */ /* We define a very simple "append buffer" structure, that is an heap * allocated string where we can append to. This is useful in order to * write all the escape sequences in a buffer and flush them to the standard * output in a single call, to avoid flickering effects. */ struct abuf { char *b; int len; }; static void abInit(struct abuf *ab) { ab->b = NULL; ab->len = 0; } static void abAppend(struct abuf *ab, const char *s, int len) { char *new = realloc(ab->b,ab->len+len); if (new == NULL) return; memcpy(new+ab->len,s,len); ab->b = new; ab->len += len; } static void abFree(struct abuf *ab) { free(ab->b); } /* Helper of refreshSingleLine() and refreshMultiLine() to show hints * to the right of the prompt. */ void refreshShowHints(struct abuf *ab, struct linenoiseState *l, int plen) { char seq[64]; if (hintsCallback && plen+l->len < l->cols) { int color = -1, bold = 0; char *hint = hintsCallback(l->buf,&color,&bold); if (hint) { int hintlen = strlen(hint); int hintmaxlen = l->cols-(plen+l->len); if (hintlen > hintmaxlen) hintlen = hintmaxlen; if (bold == 1 && color == -1) color = 37; if (color != -1 || bold != 0) snprintf(seq,64,"\033[%d;%d;49m",bold,color); abAppend(ab,seq,strlen(seq)); abAppend(ab,hint,hintlen); if (color != -1 || bold != 0) abAppend(ab,"\033[0m",4); /* Call the function to free the hint returned. */ if (freeHintsCallback) freeHintsCallback(hint); } } } /* Single line low level line refresh. * * Rewrite the currently edited line accordingly to the buffer content, * cursor position, and number of columns of the terminal. */ static void refreshSingleLine(struct linenoiseState *l) { char seq[64]; size_t plen = strlen(l->prompt); int fd = l->ofd; char *buf = l->buf; size_t len = l->len; size_t pos = l->pos; struct abuf ab; while((plen+pos) >= l->cols) { buf++; len--; pos--; } while (plen+len > l->cols) { len--; } abInit(&ab); /* Cursor to left edge */ snprintf(seq,64,"\r"); abAppend(&ab,seq,strlen(seq)); /* Write the prompt and the current buffer content */ abAppend(&ab,l->prompt,strlen(l->prompt)); abAppend(&ab,buf,len); /* Show hits if any. */ refreshShowHints(&ab,l,plen); /* Erase to right */ snprintf(seq,64,"\x1b[0K"); abAppend(&ab,seq,strlen(seq)); /* Move cursor to original position. */ snprintf(seq,64,"\r\x1b[%dC", (int)(pos+plen)); abAppend(&ab,seq,strlen(seq)); if (write(fd,ab.b,ab.len) == -1) {} /* Can't recover from write error. */ abFree(&ab); } /* Multi line low level line refresh. * * Rewrite the currently edited line accordingly to the buffer content, * cursor position, and number of columns of the terminal. */ static void refreshMultiLine(struct linenoiseState *l) { char seq[64]; int plen = strlen(l->prompt); int rows = (plen+l->len+l->cols-1)/l->cols; /* rows used by current buf. */ int rpos = (plen+l->oldpos+l->cols)/l->cols; /* cursor relative row. */ int rpos2; /* rpos after refresh. */ int col; /* colum position, zero-based. */ int old_rows = l->maxrows; int fd = l->ofd, j; struct abuf ab; /* Update maxrows if needed. */ if (rows > (int)l->maxrows) l->maxrows = rows; /* First step: clear all the lines used before. To do so start by * going to the last row. */ abInit(&ab); if (old_rows-rpos > 0) { lndebug("go down %d", old_rows-rpos); snprintf(seq,64,"\x1b[%dB", old_rows-rpos); abAppend(&ab,seq,strlen(seq)); } /* Now for every row clear it, go up. */ for (j = 0; j < old_rows-1; j++) { lndebug("clear+up"); snprintf(seq,64,"\r\x1b[0K\x1b[1A"); abAppend(&ab,seq,strlen(seq)); } /* Clean the top line. */ lndebug("clear"); snprintf(seq,64,"\r\x1b[0K"); abAppend(&ab,seq,strlen(seq)); /* Write the prompt and the current buffer content */ abAppend(&ab,l->prompt,strlen(l->prompt)); abAppend(&ab,l->buf,l->len); /* Show hits if any. */ refreshShowHints(&ab,l,plen); /* If we are at the very end of the screen with our prompt, we need to * emit a newline and move the prompt to the first column. */ if (l->pos && l->pos == l->len && (l->pos+plen) % l->cols == 0) { lndebug(""); abAppend(&ab,"\n",1); snprintf(seq,64,"\r"); abAppend(&ab,seq,strlen(seq)); rows++; if (rows > (int)l->maxrows) l->maxrows = rows; } /* Move cursor to right position. */ rpos2 = (plen+l->pos+l->cols)/l->cols; /* current cursor relative row. */ lndebug("rpos2 %d", rpos2); /* Go up till we reach the expected positon. */ if (rows-rpos2 > 0) { lndebug("go-up %d", rows-rpos2); snprintf(seq,64,"\x1b[%dA", rows-rpos2); abAppend(&ab,seq,strlen(seq)); } /* Set column. */ col = (plen+(int)l->pos) % (int)l->cols; lndebug("set col %d", 1+col); if (col) snprintf(seq,64,"\r\x1b[%dC", col); else snprintf(seq,64,"\r"); abAppend(&ab,seq,strlen(seq)); lndebug("\n"); l->oldpos = l->pos; if (write(fd,ab.b,ab.len) == -1) {} /* Can't recover from write error. */ abFree(&ab); } /* Calls the two low level functions refreshSingleLine() or * refreshMultiLine() according to the selected mode. */ static void refreshLine(struct linenoiseState *l) { if (mlmode) refreshMultiLine(l); else refreshSingleLine(l); } /* Insert the character 'c' at cursor current position. * * On error writing to the terminal -1 is returned, otherwise 0. */ int linenoiseEditInsert(struct linenoiseState *l, char c) { if (l->len < l->buflen) { if (l->len == l->pos) { l->buf[l->pos] = c; l->pos++; l->len++; l->buf[l->len] = '\0'; if ((!mlmode && l->plen+l->len < l->cols && !hintsCallback)) { /* Avoid a full update of the line in the * trivial case. */ if (write(l->ofd,&c,1) == -1) return -1; } else { refreshLine(l); } } else { memmove(l->buf+l->pos+1,l->buf+l->pos,l->len-l->pos); l->buf[l->pos] = c; l->len++; l->pos++; l->buf[l->len] = '\0'; refreshLine(l); } } return 0; } /* Move cursor on the left. */ void linenoiseEditMoveLeft(struct linenoiseState *l) { if (l->pos > 0) { l->pos--; refreshLine(l); } } /* Move cursor on the right. */ void linenoiseEditMoveRight(struct linenoiseState *l) { if (l->pos != l->len) { l->pos++; refreshLine(l); } } /* Move cursor to the start of the line. */ void linenoiseEditMoveHome(struct linenoiseState *l) { if (l->pos != 0) { l->pos = 0; refreshLine(l); } } /* Move cursor to the end of the line. */ void linenoiseEditMoveEnd(struct linenoiseState *l) { if (l->pos != l->len) { l->pos = l->len; refreshLine(l); } } /* Substitute the currently edited line with the next or previous history * entry as specified by 'dir'. */ #define LINENOISE_HISTORY_NEXT 0 #define LINENOISE_HISTORY_PREV 1 void linenoiseEditHistoryNext(struct linenoiseState *l, int dir) { if (history_len > 1) { /* Update the current history entry before to * overwrite it with the next one. */ free(history[history_len - 1 - l->history_index]); history[history_len - 1 - l->history_index] = strdup(l->buf); /* Show the new entry */ l->history_index += (dir == LINENOISE_HISTORY_PREV) ? 1 : -1; if (l->history_index < 0) { l->history_index = 0; return; } else if (l->history_index >= history_len) { l->history_index = history_len-1; return; } strncpy(l->buf,history[history_len - 1 - l->history_index],l->buflen); l->buf[l->buflen-1] = '\0'; l->len = l->pos = strlen(l->buf); refreshLine(l); } } /* Delete the character at the right of the cursor without altering the cursor * position. Basically this is what happens with the "Delete" keyboard key. */ void linenoiseEditDelete(struct linenoiseState *l) { if (l->len > 0 && l->pos < l->len) { memmove(l->buf+l->pos,l->buf+l->pos+1,l->len-l->pos-1); l->len--; l->buf[l->len] = '\0'; refreshLine(l); } } /* Backspace implementation. */ void linenoiseEditBackspace(struct linenoiseState *l) { if (l->pos > 0 && l->len > 0) { memmove(l->buf+l->pos-1,l->buf+l->pos,l->len-l->pos); l->pos--; l->len--; l->buf[l->len] = '\0'; refreshLine(l); } } /* Delete the previosu word, maintaining the cursor at the start of the * current word. */ void linenoiseEditDeletePrevWord(struct linenoiseState *l) { size_t old_pos = l->pos; size_t diff; while (l->pos > 0 && l->buf[l->pos-1] == ' ') l->pos--; while (l->pos > 0 && l->buf[l->pos-1] != ' ') l->pos--; diff = old_pos - l->pos; memmove(l->buf+l->pos,l->buf+old_pos,l->len-old_pos+1); l->len -= diff; refreshLine(l); } /* This function is the core of the line editing capability of linenoise. * It expects 'fd' to be already in "raw mode" so that every key pressed * will be returned ASAP to read(). * * The resulting string is put into 'buf' when the user type enter, or * when ctrl+d is typed. * * The function returns the length of the current buffer. */ static int linenoiseEdit(int stdin_fd, int stdout_fd, char *buf, size_t buflen, const char *prompt) { struct linenoiseState l; /* Populate the linenoise state that we pass to functions implementing * specific editing functionalities. */ l.ifd = stdin_fd; l.ofd = stdout_fd; l.buf = buf; l.buflen = buflen; l.prompt = prompt; l.plen = strlen(prompt); l.oldpos = l.pos = 0; l.len = 0; l.cols = getColumns(stdin_fd, stdout_fd); l.maxrows = 0; l.history_index = 0; /* Buffer starts empty. */ l.buf[0] = '\0'; l.buflen--; /* Make sure there is always space for the nulterm */ /* The latest history entry is always our current buffer, that * initially is just an empty string. */ linenoiseHistoryAdd(""); if (write(l.ofd,prompt,l.plen) == -1) return -1; while(1) { char c; int nread; char seq[3]; nread = read(l.ifd,&c,1); if (nread <= 0) return l.len; /* Only autocomplete when the callback is set. It returns < 0 when * there was an error reading from fd. Otherwise it will return the * character that should be handled next. */ if (c == 9 && completionCallback != NULL) { c = completeLine(&l); /* Return on errors */ if (c < 0) return l.len; /* Read next character when 0 */ if (c == 0) continue; } switch(c) { case ENTER: /* enter */ history_len--; free(history[history_len]); if (mlmode) linenoiseEditMoveEnd(&l); if (hintsCallback) { /* Force a refresh without hints to leave the previous * line as the user typed it after a newline. */ linenoiseHintsCallback *hc = hintsCallback; hintsCallback = NULL; refreshLine(&l); hintsCallback = hc; } return (int)l.len; case CTRL_C: /* ctrl-c */ errno = EAGAIN; return -1; case BACKSPACE: /* backspace */ case 8: /* ctrl-h */ linenoiseEditBackspace(&l); break; case CTRL_D: /* ctrl-d, remove char at right of cursor, or if the line is empty, act as end-of-file. */ if (l.len > 0) { linenoiseEditDelete(&l); } else { history_len--; free(history[history_len]); return -1; } break; case CTRL_T: /* ctrl-t, swaps current character with previous. */ if (l.pos > 0 && l.pos < l.len) { int aux = buf[l.pos-1]; buf[l.pos-1] = buf[l.pos]; buf[l.pos] = aux; if (l.pos != l.len-1) l.pos++; refreshLine(&l); } break; case CTRL_B: /* ctrl-b */ linenoiseEditMoveLeft(&l); break; case CTRL_F: /* ctrl-f */ linenoiseEditMoveRight(&l); break; case CTRL_P: /* ctrl-p */ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_PREV); break; case CTRL_N: /* ctrl-n */ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_NEXT); break; case ESC: /* escape sequence */ /* Read the next two bytes representing the escape sequence. * Use two calls to handle slow terminals returning the two * chars at different times. */ if (read(l.ifd,seq,1) == -1) break; if (read(l.ifd,seq+1,1) == -1) break; /* ESC [ sequences. */ if (seq[0] == '[') { if (seq[1] >= '0' && seq[1] <= '9') { /* Extended escape, read additional byte. */ if (read(l.ifd,seq+2,1) == -1) break; if (seq[2] == '~') { switch(seq[1]) { case '3': /* Delete key. */ linenoiseEditDelete(&l); break; } } } else { switch(seq[1]) { case 'A': /* Up */ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_PREV); break; case 'B': /* Down */ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_NEXT); break; case 'C': /* Right */ linenoiseEditMoveRight(&l); break; case 'D': /* Left */ linenoiseEditMoveLeft(&l); break; case 'H': /* Home */ linenoiseEditMoveHome(&l); break; case 'F': /* End*/ linenoiseEditMoveEnd(&l); break; } } } /* ESC O sequences. */ else if (seq[0] == 'O') { switch(seq[1]) { case 'H': /* Home */ linenoiseEditMoveHome(&l); break; case 'F': /* End*/ linenoiseEditMoveEnd(&l); break; } } break; default: if (linenoiseEditInsert(&l,c)) return -1; break; case CTRL_U: /* Ctrl+u, delete the whole line. */ buf[0] = '\0'; l.pos = l.len = 0; refreshLine(&l); break; case CTRL_K: /* Ctrl+k, delete from current to end of line. */ buf[l.pos] = '\0'; l.len = l.pos; refreshLine(&l); break; case CTRL_A: /* Ctrl+a, go to the start of the line */ linenoiseEditMoveHome(&l); break; case CTRL_E: /* ctrl+e, go to the end of the line */ linenoiseEditMoveEnd(&l); break; case CTRL_L: /* ctrl+l, clear screen */ linenoiseClearScreen(); refreshLine(&l); break; case CTRL_W: /* ctrl+w, delete previous word */ linenoiseEditDeletePrevWord(&l); break; } } return l.len; } /* This special mode is used by linenoise in order to print scan codes * on screen for debugging / development purposes. It is implemented * by the linenoise_example program using the --keycodes option. */ void linenoisePrintKeyCodes(void) { char quit[4]; printf("Linenoise key codes debugging mode.\n" "Press keys to see scan codes. Type 'quit' at any time to exit.\n"); if (enableRawMode(STDIN_FILENO) == -1) return; memset(quit,' ',4); while(1) { char c; int nread; nread = read(STDIN_FILENO,&c,1); if (nread <= 0) continue; memmove(quit,quit+1,sizeof(quit)-1); /* shift string to left. */ quit[sizeof(quit)-1] = c; /* Insert current char on the right. */ if (memcmp(quit,"quit",sizeof(quit)) == 0) break; printf("'%c' %02x (%d) (type quit to exit)\n", isprint(c) ? c : '?', (int)c, (int)c); printf("\r"); /* Go left edge manually, we are in raw mode. */ fflush(stdout); } disableRawMode(STDIN_FILENO); } /* This function calls the line editing function linenoiseEdit() using * the STDIN file descriptor set in raw mode. */ static int linenoiseRaw(char *buf, size_t buflen, const char *prompt) { int count; if (buflen == 0) { errno = EINVAL; return -1; } if (enableRawMode(STDIN_FILENO) == -1) return -1; count = linenoiseEdit(STDIN_FILENO, STDOUT_FILENO, buf, buflen, prompt); disableRawMode(STDIN_FILENO); printf("\n"); return count; } /* This function is called when linenoise() is called with the standard * input file descriptor not attached to a TTY. So for example when the * program using linenoise is called in pipe or with a file redirected * to its standard input. In this case, we want to be able to return the * line regardless of its length (by default we are limited to 4k). */ static char *linenoiseNoTTY(void) { char *line = NULL; size_t len = 0, maxlen = 0; while(1) { if (len == maxlen) { if (maxlen == 0) maxlen = 16; maxlen *= 2; char *oldval = line; line = realloc(line,maxlen); if (line == NULL) { if (oldval) free(oldval); return NULL; } } int c = fgetc(stdin); if (c == EOF || c == '\n') { if (c == EOF && len == 0) { free(line); return NULL; } else { line[len] = '\0'; return line; } } else { line[len] = c; len++; } } } /* The high level function that is the main API of the linenoise library. * This function checks if the terminal has basic capabilities, just checking * for a blacklist of stupid terminals, and later either calls the line * editing function or uses dummy fgets() so that you will be able to type * something even in the most desperate of the conditions. */ char *linenoise(const char *prompt) { char buf[LINENOISE_MAX_LINE]; int count; if (!isatty(STDIN_FILENO)) { /* Not a tty: read from file / pipe. In this mode we don't want any * limit to the line size, so we call a function to handle that. */ return linenoiseNoTTY(); } else if (isUnsupportedTerm()) { size_t len; printf("%s",prompt); fflush(stdout); if (fgets(buf,LINENOISE_MAX_LINE,stdin) == NULL) return NULL; len = strlen(buf); while(len && (buf[len-1] == '\n' || buf[len-1] == '\r')) { len--; buf[len] = '\0'; } return strdup(buf); } else { count = linenoiseRaw(buf,LINENOISE_MAX_LINE,prompt); if (count == -1) return NULL; return strdup(buf); } } /* This is just a wrapper the user may want to call in order to make sure * the linenoise returned buffer is freed with the same allocator it was * created with. Useful when the main program is using an alternative * allocator. */ void linenoiseFree(void *ptr) { free(ptr); } /* ================================ History ================================= */ /* Free the history, but does not reset it. Only used when we have to * exit() to avoid memory leaks are reported by valgrind & co. */ static void freeHistory(void) { if (history) { int j; for (j = 0; j < history_len; j++) free(history[j]); free(history); } } /* At exit we'll try to fix the terminal to the initial conditions. */ static void linenoiseAtExit(void) { disableRawMode(STDIN_FILENO); freeHistory(); } /* This is the API call to add a new entry in the linenoise history. * It uses a fixed array of char pointers that are shifted (memmoved) * when the history max length is reached in order to remove the older * entry and make room for the new one, so it is not exactly suitable for huge * histories, but will work well for a few hundred of entries. * * Using a circular buffer is smarter, but a bit more complex to handle. */ int linenoiseHistoryAdd(const char *line) { char *linecopy; if (history_max_len == 0) return 0; /* Initialization on first call. */ if (history == NULL) { history = malloc(sizeof(char*)*history_max_len); if (history == NULL) return 0; memset(history,0,(sizeof(char*)*history_max_len)); } /* Don't add duplicated lines. */ if (history_len && !strcmp(history[history_len-1], line)) return 0; /* Add an heap allocated copy of the line in the history. * If we reached the max length, remove the older line. */ linecopy = strdup(line); if (!linecopy) return 0; if (history_len == history_max_len) { free(history[0]); memmove(history,history+1,sizeof(char*)*(history_max_len-1)); history_len--; } history[history_len] = linecopy; history_len++; return 1; } /* Set the maximum length for the history. This function can be called even * if there is already some history, the function will make sure to retain * just the latest 'len' elements if the new history length value is smaller * than the amount of items already inside the history. */ int linenoiseHistorySetMaxLen(int len) { char **new; if (len < 1) return 0; if (history) { int tocopy = history_len; new = malloc(sizeof(char*)*len); if (new == NULL) return 0; /* If we can't copy everything, free the elements we'll not use. */ if (len < tocopy) { int j; for (j = 0; j < tocopy-len; j++) free(history[j]); tocopy = len; } memset(new,0,sizeof(char*)*len); memcpy(new,history+(history_len-tocopy), sizeof(char*)*tocopy); free(history); history = new; } history_max_len = len; if (history_len > history_max_len) history_len = history_max_len; return 1; } /* Save the history in the specified file. On success 0 is returned * otherwise -1 is returned. */ int linenoiseHistorySave(const char *filename) { mode_t old_umask = umask(S_IXUSR|S_IRWXG|S_IRWXO); FILE *fp; int j; fp = fopen(filename,"w"); umask(old_umask); if (fp == NULL) return -1; chmod(filename,S_IRUSR|S_IWUSR); for (j = 0; j < history_len; j++) fprintf(fp,"%s\n",history[j]); fclose(fp); return 0; } /* Load the history from the specified file. If the file does not exist * zero is returned and no operation is performed. * * If the file exists and the operation succeeded 0 is returned, otherwise * on error -1 is returned. */ int linenoiseHistoryLoad(const char *filename) { FILE *fp = fopen(filename,"r"); char buf[LINENOISE_MAX_LINE]; if (fp == NULL) return -1; while (fgets(buf,LINENOISE_MAX_LINE,fp) != NULL) { char *p; p = strchr(buf,'\r'); if (!p) p = strchr(buf,'\n'); if (p) *p = '\0'; linenoiseHistoryAdd(buf); } fclose(fp); return 0; } wcc-0.0.2/src/wsh/linenoise/.gitignore0000644000175000017500000000004513122010155016271 0ustar philphillinenoise_example *.dSYM history.txt wcc-0.0.2/src/wsh/linenoise/README.markdown0000644000175000017500000002276313122010155017015 0ustar philphil# Linenoise A minimal, zero-config, BSD licensed, readline replacement used in Redis, MongoDB, and Android. * Single and multi line editing mode with the usual key bindings implemented. * History handling. * Completion. * Hints (suggestions at the right of the prompt as you type). * About 1,100 lines of BSD license source code. * Only uses a subset of VT100 escapes (ANSI.SYS compatible). ## Can a line editing library be 20k lines of code? Line editing with some support for history is a really important feature for command line utilities. Instead of retyping almost the same stuff again and again it's just much better to hit the up arrow and edit on syntax errors, or in order to try a slightly different command. But apparently code dealing with terminals is some sort of Black Magic: readline is 30k lines of code, libedit 20k. Is it reasonable to link small utilities to huge libraries just to get a minimal support for line editing? So what usually happens is either: * Large programs with configure scripts disabling line editing if readline is not present in the system, or not supporting it at all since readline is GPL licensed and libedit (the BSD clone) is not as known and available as readline is (Real world example of this problem: Tclsh). * Smaller programs not using a configure script not supporting line editing at all (A problem we had with Redis-cli for instance). The result is a pollution of binaries without line editing support. So I spent more or less two hours doing a reality check resulting in this little library: is it *really* needed for a line editing library to be 20k lines of code? Apparently not, it is possibe to get a very small, zero configuration, trivial to embed library, that solves the problem. Smaller programs will just include this, supporing line editing out of the box. Larger programs may use this little library or just checking with configure if readline/libedit is available and resorting to Linenoise if not. ## Terminals, in 2010. Apparently almost every terminal you can happen to use today has some kind of support for basic VT100 escape sequences. So I tried to write a lib using just very basic VT100 features. The resulting library appears to work everywhere I tried to use it, and now can work even on ANSI.SYS compatible terminals, since no VT220 specific sequences are used anymore. The library is currently about 1100 lines of code. In order to use it in your project just look at the *example.c* file in the source distribution, it is trivial. Linenoise is BSD code, so you can use both in free software and commercial software. ## Tested with... * Linux text only console ($TERM = linux) * Linux KDE terminal application ($TERM = xterm) * Linux xterm ($TERM = xterm) * Linux Buildroot ($TERM = vt100) * Mac OS X iTerm ($TERM = xterm) * Mac OS X default Terminal.app ($TERM = xterm) * OpenBSD 4.5 through an OSX Terminal.app ($TERM = screen) * IBM AIX 6.1 * FreeBSD xterm ($TERM = xterm) * ANSI.SYS * Emacs comint mode ($TERM = dumb) Please test it everywhere you can and report back! ## Let's push this forward! Patches should be provided in the respect of Linenoise sensibility for small easy to understand code. Send feedbacks to antirez at gmail # The API Linenoise is very easy to use, and reading the example shipped with the library should get you up to speed ASAP. Here is a list of API calls and how to use them. char *linenoise(const char *prompt); This is the main Linenoise call: it shows the user a prompt with line editing and history capabilities. The prompt you specify is used as a prompt, that is, it will be printed to the left of the cursor. The library returns a buffer with the line composed by the user, or NULL on end of file or when there is an out of memory condition. When a tty is detected (the user is actually typing into a terminal session) the maximum editable line length is `LINENOISE_MAX_LINE`. When instead the standard input is not a tty, which happens every time you redirect a file to a program, or use it in an Unix pipeline, there are no limits to the length of the line that can be returned. The returned line should be freed with the `free()` standard system call. However sometimes it could happen that your program uses a different dynamic allocation library, so you may also used `linenoiseFree` to make sure the line is freed with the same allocator it was created. The canonical loop used by a program using Linenoise will be something like this: while((line = linenoise("hello> ")) != NULL) { printf("You wrote: %s\n", line); linenoiseFree(line); /* Or just free(line) if you use libc malloc. */ } ## Single line VS multi line editing By default, Linenoise uses single line editing, that is, a single row on the screen will be used, and as the user types more, the text will scroll towards left to make room. This works if your program is one where the user is unlikely to write a lot of text, otherwise multi line editing, where multiple screens rows are used, can be a lot more comfortable. In order to enable multi line editing use the following API call: linenoiseSetMultiLine(1); You can disable it using `0` as argument. ## History Linenoise supporst history, so that the user does not have to retype again and again the same things, but can use the down and up arrows in order to search and re-edit already inserted lines of text. The followings are the history API calls: int linenoiseHistoryAdd(const char *line); int linenoiseHistorySetMaxLen(int len); int linenoiseHistorySave(const char *filename); int linenoiseHistoryLoad(const char *filename); Use `linenoiseHistoryAdd` every time you want to add a new element to the top of the history (it will be the first the user will see when using the up arrow). Note that for history to work, you have to set a length for the history (which is zero by default, so history will be disabled if you don't set a proper one). This is accomplished using the `linenoiseHistorySetMaxLen` function. Linenoise has direct support for persisting the history into an history file. The functions `linenoiseHistorySave` and `linenoiseHistoryLoad` do just that. Both functions return -1 on error and 0 on success. ## Completion Linenoise supports completion, which is the ability to complete the user input when she or he presses the `` key. In order to use completion, you need to register a completion callback, which is called every time the user presses ``. Your callback will return a list of items that are completions for the current string. The following is an example of registering a completion callback: linenoiseSetCompletionCallback(completion); The completion must be a function returning `void` and getting as input a `const char` pointer, which is the line the user has typed so far, and a `linenoiseCompletions` object pointer, which is used as argument of `linenoiseAddCompletion` in order to add completions inside the callback. An example will make it more clear: void completion(const char *buf, linenoiseCompletions *lc) { if (buf[0] == 'h') { linenoiseAddCompletion(lc,"hello"); linenoiseAddCompletion(lc,"hello there"); } } Basically in your completion callback, you inspect the input, and return a list of items that are good completions by using `linenoiseAddCompletion`. If you want to test the completion feature, compile the example program with `make`, run it, type `h` and press ``. ## Hints Linenoise has a feature called *hints* which is very useful when you use Linenoise in order to implement a REPL (Read Eval Print Loop) for a program that accepts commands and arguments, but may also be useful in other conditions. The feature shows, on the right of the cursor, as the user types, hints that may be useful. The hints can be displayed using a different color compared to the color the user is typing, and can also be bold. For example as the user starts to type `"git remote add"`, with hints it's possible to show on the right of the prompt a string ` `. The feature works similarly to the history feature, using a callback. To register the callback we use: linenoiseSetHintsCallback(hints); The callback itself is implemented like this: char *hints(const char *buf, int *color, int *bold) { if (!strcasecmp(buf,"git remote add")) { *color = 35; *bold = 0; return " "; } return NULL; } The callback function returns the string that should be displayed or NULL if no hint is available for the text the user currently typed. The returned string will be trimmed as needed depending on the number of columns available on the screen. It is possible to return a string allocated in dynamic way, by also registering a function to deallocate the hint string once used: void linenoiseSetFreeHintsCallback(linenoiseFreeHintsCallback *); The free hint callback will just receive the pointer and free the string as needed (depending on how the hits callback allocated it). As you can see in the example above, a `color` (in xterm color terminal codes) can be provided together with a `bold` attribute. If no color is set, the current terminal foreground color is used. If no bold attribute is set, non-bold text is printed. Color codes are: red = 31 green = 32 yellow = 33 blue = 34 magenta = 35 cyan = 36 white = 37; ## Screen handling Sometimes you may want to clear the screen as a result of something the user typed. You can do this by calling the following function: void linenoiseClearScreen(void); wcc-0.0.2/src/wsh/linenoise/.git0000644000175000017500000000006013122010155015062 0ustar philphilgitdir: ../../../.git/modules/src/wsh/linenoise wcc-0.0.2/src/wsh/linenoise/example.c0000644000175000017500000000457113122010155016110 0ustar philphil#include #include #include #include "linenoise.h" void completion(const char *buf, linenoiseCompletions *lc) { if (buf[0] == 'h') { linenoiseAddCompletion(lc,"hello"); linenoiseAddCompletion(lc,"hello there"); } } char *hints(const char *buf, int *color, int *bold) { if (!strcasecmp(buf,"hello")) { *color = 35; *bold = 0; return " World"; } return NULL; } int main(int argc, char **argv) { char *line; char *prgname = argv[0]; /* Parse options, with --multiline we enable multi line editing. */ while(argc > 1) { argc--; argv++; if (!strcmp(*argv,"--multiline")) { linenoiseSetMultiLine(1); printf("Multi-line mode enabled.\n"); } else if (!strcmp(*argv,"--keycodes")) { linenoisePrintKeyCodes(); exit(0); } else { fprintf(stderr, "Usage: %s [--multiline] [--keycodes]\n", prgname); exit(1); } } /* Set the completion callback. This will be called every time the * user uses the key. */ linenoiseSetCompletionCallback(completion); linenoiseSetHintsCallback(hints); /* Load history from file. The history file is just a plain text file * where entries are separated by newlines. */ linenoiseHistoryLoad("history.txt"); /* Load the history at startup */ /* Now this is the main loop of the typical linenoise-based application. * The call to linenoise() will block as long as the user types something * and presses enter. * * The typed string is returned as a malloc() allocated string by * linenoise, so the user needs to free() it. */ while((line = linenoise("hello> ")) != NULL) { /* Do something with the string. */ if (line[0] != '\0' && line[0] != '/') { printf("echo: '%s'\n", line); linenoiseHistoryAdd(line); /* Add to the history. */ linenoiseHistorySave("history.txt"); /* Save the history on disk. */ } else if (!strncmp(line,"/historylen",11)) { /* The "/historylen" command will change the history len. */ int len = atoi(line+11); linenoiseHistorySetMaxLen(len); } else if (line[0] == '/') { printf("Unreconized command: %s\n", line); } free(line); } return 0; } wcc-0.0.2/src/wsh/wshmain.c0000644000175000017500000000313313110675433014144 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #include /** * Main wsh context */ wsh_t *wsh; /** * Application entry point */ int main(int argc, char **argv, char **envp) { wsh_init(); wsh_getopt(argc, argv); wsh_loadlibs(); reload_elfs(); wsh_run(); return 42; } wcc-0.0.2/src/wsh/lua/0000755000175000017500000000000013110675433013113 5ustar philphilwcc-0.0.2/src/wsh/lua/Makefile0000644000175000017500000000631113110675433014554 0ustar philphil# Makefile for installing Lua # See doc/readme.html for installation and customization instructions. # == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT ======================= # Your platform. See PLATS for possible values. PLAT= none # Where to install. The installation starts in the src and doc directories, # so take care if INSTALL_TOP is not an absolute path. See the local target. # You may want to make INSTALL_LMOD and INSTALL_CMOD consistent with # LUA_ROOT, LUA_LDIR, and LUA_CDIR in luaconf.h. INSTALL_TOP= /usr/local INSTALL_BIN= $(INSTALL_TOP)/bin INSTALL_INC= $(INSTALL_TOP)/include INSTALL_LIB= $(INSTALL_TOP)/lib INSTALL_MAN= $(INSTALL_TOP)/man/man1 INSTALL_LMOD= $(INSTALL_TOP)/share/lua/$V INSTALL_CMOD= $(INSTALL_TOP)/lib/lua/$V # How to install. If your install program does not support "-p", then # you may have to run ranlib on the installed liblua.a. INSTALL= install -p INSTALL_EXEC= $(INSTALL) -m 0755 INSTALL_DATA= $(INSTALL) -m 0644 # # If you don't have "install" you can use "cp" instead. # INSTALL= cp -p # INSTALL_EXEC= $(INSTALL) # INSTALL_DATA= $(INSTALL) # Other utilities. MKDIR= mkdir -p RM= rm -f # == END OF USER SETTINGS -- NO NEED TO CHANGE ANYTHING BELOW THIS LINE ======= # Convenience platforms targets. PLATS= aix bsd c89 freebsd generic linux macosx mingw posix solaris # What to install. TO_BIN= lua luac TO_INC= lua.h luaconf.h lualib.h lauxlib.h lua.hpp TO_LIB= liblua.a TO_MAN= lua.1 luac.1 # Lua version and release. V= 5.3 R= $V.2 # Targets start here. all: $(PLAT) $(PLATS) clean: cd src && $(MAKE) $@ test: dummy src/lua -v install: dummy cd src && $(MKDIR) $(INSTALL_BIN) $(INSTALL_INC) $(INSTALL_LIB) $(INSTALL_MAN) $(INSTALL_LMOD) $(INSTALL_CMOD) cd src && $(INSTALL_EXEC) $(TO_BIN) $(INSTALL_BIN) cd src && $(INSTALL_DATA) $(TO_INC) $(INSTALL_INC) cd src && $(INSTALL_DATA) $(TO_LIB) $(INSTALL_LIB) cd doc && $(INSTALL_DATA) $(TO_MAN) $(INSTALL_MAN) uninstall: cd src && cd $(INSTALL_BIN) && $(RM) $(TO_BIN) cd src && cd $(INSTALL_INC) && $(RM) $(TO_INC) cd src && cd $(INSTALL_LIB) && $(RM) $(TO_LIB) cd doc && cd $(INSTALL_MAN) && $(RM) $(TO_MAN) local: $(MAKE) install INSTALL_TOP=../install none: @echo "Please do 'make PLATFORM' where PLATFORM is one of these:" @echo " $(PLATS)" @echo "See doc/readme.html for complete instructions." # make may get confused with test/ and install/ dummy: # echo config parameters echo: @cd src && $(MAKE) -s echo @echo "PLAT= $(PLAT)" @echo "V= $V" @echo "R= $R" @echo "TO_BIN= $(TO_BIN)" @echo "TO_INC= $(TO_INC)" @echo "TO_LIB= $(TO_LIB)" @echo "TO_MAN= $(TO_MAN)" @echo "INSTALL_TOP= $(INSTALL_TOP)" @echo "INSTALL_BIN= $(INSTALL_BIN)" @echo "INSTALL_INC= $(INSTALL_INC)" @echo "INSTALL_LIB= $(INSTALL_LIB)" @echo "INSTALL_MAN= $(INSTALL_MAN)" @echo "INSTALL_LMOD= $(INSTALL_LMOD)" @echo "INSTALL_CMOD= $(INSTALL_CMOD)" @echo "INSTALL_EXEC= $(INSTALL_EXEC)" @echo "INSTALL_DATA= $(INSTALL_DATA)" # echo pkg-config data pc: @echo "version=$R" @echo "prefix=$(INSTALL_TOP)" @echo "libdir=$(INSTALL_LIB)" @echo "includedir=$(INSTALL_INC)" # list targets that do not create files (but not all makes understand .PHONY) .PHONY: all $(PLATS) clean test install local none dummy echo pecho lecho # (end of Makefile) wcc-0.0.2/src/wsh/lua/src/0000755000175000017500000000000013110675433013702 5ustar philphilwcc-0.0.2/src/wsh/lua/src/ltablib.c0000644000175000017500000003270413110675433015465 0ustar philphil/* ** $Id: ltablib.c,v 1.90 2015/11/25 12:48:57 roberto Exp $ ** Library for Table Manipulation ** See Copyright Notice in lua.h */ #define ltablib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" /* ** Operations that an object must define to mimic a table ** (some functions only need some of them) */ #define TAB_R 1 /* read */ #define TAB_W 2 /* write */ #define TAB_L 4 /* length */ #define TAB_RW (TAB_R | TAB_W) /* read/write */ #define aux_getn(L,n,w) (checktab(L, n, (w) | TAB_L), luaL_len(L, n)) static int checkfield (lua_State *L, const char *key, int n) { lua_pushstring(L, key); return (lua_rawget(L, -n) != LUA_TNIL); } /* ** Check that 'arg' either is a table or can behave like one (that is, ** has a metatable with the required metamethods) */ static void checktab (lua_State *L, int arg, int what) { if (lua_type(L, arg) != LUA_TTABLE) { /* is it not a table? */ int n = 1; /* number of elements to pop */ if (lua_getmetatable(L, arg) && /* must have metatable */ (!(what & TAB_R) || checkfield(L, "__index", ++n)) && (!(what & TAB_W) || checkfield(L, "__newindex", ++n)) && (!(what & TAB_L) || checkfield(L, "__len", ++n))) { lua_pop(L, n); /* pop metatable and tested metamethods */ } else luaL_argerror(L, arg, "table expected"); /* force an error */ } } #if defined(LUA_COMPAT_MAXN) static int maxn (lua_State *L) { lua_Number max = 0; luaL_checktype(L, 1, LUA_TTABLE); lua_pushnil(L); /* first key */ while (lua_next(L, 1)) { lua_pop(L, 1); /* remove value */ if (lua_type(L, -1) == LUA_TNUMBER) { lua_Number v = lua_tonumber(L, -1); if (v > max) max = v; } } lua_pushnumber(L, max); return 1; } #endif static int tinsert (lua_State *L) { lua_Integer e = aux_getn(L, 1, TAB_RW) + 1; /* first empty element */ lua_Integer pos; /* where to insert new element */ switch (lua_gettop(L)) { case 2: { /* called with only 2 arguments */ pos = e; /* insert new element at the end */ break; } case 3: { lua_Integer i; pos = luaL_checkinteger(L, 2); /* 2nd argument is the position */ luaL_argcheck(L, 1 <= pos && pos <= e, 2, "position out of bounds"); for (i = e; i > pos; i--) { /* move up elements */ lua_geti(L, 1, i - 1); lua_seti(L, 1, i); /* t[i] = t[i - 1] */ } break; } default: { return luaL_error(L, "wrong number of arguments to 'insert'"); } } lua_seti(L, 1, pos); /* t[pos] = v */ return 0; } static int tremove (lua_State *L) { lua_Integer size = aux_getn(L, 1, TAB_RW); lua_Integer pos = luaL_optinteger(L, 2, size); if (pos != size) /* validate 'pos' if given */ luaL_argcheck(L, 1 <= pos && pos <= size + 1, 1, "position out of bounds"); lua_geti(L, 1, pos); /* result = t[pos] */ for ( ; pos < size; pos++) { lua_geti(L, 1, pos + 1); lua_seti(L, 1, pos); /* t[pos] = t[pos + 1] */ } lua_pushnil(L); lua_seti(L, 1, pos); /* t[pos] = nil */ return 1; } /* ** Copy elements (1[f], ..., 1[e]) into (tt[t], tt[t+1], ...). Whenever ** possible, copy in increasing order, which is better for rehashing. ** "possible" means destination after original range, or smaller ** than origin, or copying to another table. */ static int tmove (lua_State *L) { lua_Integer f = luaL_checkinteger(L, 2); lua_Integer e = luaL_checkinteger(L, 3); lua_Integer t = luaL_checkinteger(L, 4); int tt = !lua_isnoneornil(L, 5) ? 5 : 1; /* destination table */ checktab(L, 1, TAB_R); checktab(L, tt, TAB_W); if (e >= f) { /* otherwise, nothing to move */ lua_Integer n, i; luaL_argcheck(L, f > 0 || e < LUA_MAXINTEGER + f, 3, "too many elements to move"); n = e - f + 1; /* number of elements to move */ luaL_argcheck(L, t <= LUA_MAXINTEGER - n + 1, 4, "destination wrap around"); if (t > e || t <= f || tt != 1) { for (i = 0; i < n; i++) { lua_geti(L, 1, f + i); lua_seti(L, tt, t + i); } } else { for (i = n - 1; i >= 0; i--) { lua_geti(L, 1, f + i); lua_seti(L, tt, t + i); } } } lua_pushvalue(L, tt); /* return "to table" */ return 1; } static void addfield (lua_State *L, luaL_Buffer *b, lua_Integer i) { lua_geti(L, 1, i); if (!lua_isstring(L, -1)) luaL_error(L, "invalid value (%s) at index %d in table for 'concat'", luaL_typename(L, -1), i); luaL_addvalue(b); } static int tconcat (lua_State *L) { luaL_Buffer b; lua_Integer last = aux_getn(L, 1, TAB_R); size_t lsep; const char *sep = luaL_optlstring(L, 2, "", &lsep); lua_Integer i = luaL_optinteger(L, 3, 1); last = luaL_opt(L, luaL_checkinteger, 4, last); luaL_buffinit(L, &b); for (; i < last; i++) { addfield(L, &b, i); luaL_addlstring(&b, sep, lsep); } if (i == last) /* add last value (if interval was not empty) */ addfield(L, &b, i); luaL_pushresult(&b); return 1; } /* ** {====================================================== ** Pack/unpack ** ======================================================= */ static int pack (lua_State *L) { int i; int n = lua_gettop(L); /* number of elements to pack */ lua_createtable(L, n, 1); /* create result table */ lua_insert(L, 1); /* put it at index 1 */ for (i = n; i >= 1; i--) /* assign elements */ lua_seti(L, 1, i); lua_pushinteger(L, n); lua_setfield(L, 1, "n"); /* t.n = number of elements */ return 1; /* return table */ } static int unpack (lua_State *L) { lua_Unsigned n; lua_Integer i = luaL_optinteger(L, 2, 1); lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, luaL_len(L, 1)); if (i > e) return 0; /* empty range */ n = (lua_Unsigned)e - i; /* number of elements minus 1 (avoid overflows) */ if (n >= (unsigned int)INT_MAX || !lua_checkstack(L, (int)(++n))) return luaL_error(L, "too many results to unpack"); for (; i < e; i++) { /* push arg[i..e - 1] (to avoid overflows) */ lua_geti(L, 1, i); } lua_geti(L, 1, e); /* push last element */ return (int)n; } /* }====================================================== */ /* ** {====================================================== ** Quicksort ** (based on 'Algorithms in MODULA-3', Robert Sedgewick; ** Addison-Wesley, 1993.) ** ======================================================= */ /* ** Produce a "random" 'unsigned int' to randomize pivot choice. This ** macro is used only when 'sort' detects a big imbalance in the result ** of a partition. (If you don't want/need this "randomness", ~0 is a ** good choice.) */ #if !defined(l_randomizePivot) /* { */ #include /* size of 'e' measured in number of 'unsigned int's */ #define sof(e) (sizeof(e) / sizeof(unsigned int)) /* ** Use 'time' and 'clock' as sources of "randomness". Because we don't ** know the types 'clock_t' and 'time_t', we cannot cast them to ** anything without risking overflows. A safe way to use their values ** is to copy them to an array of a known type and use the array values. */ static unsigned int l_randomizePivot (void) { clock_t c = clock(); time_t t = time(NULL); unsigned int buff[sof(c) + sof(t)]; unsigned int i, rnd = 0; memcpy(buff, &c, sof(c) * sizeof(unsigned int)); memcpy(buff + sof(c), &t, sof(t) * sizeof(unsigned int)); for (i = 0; i < sof(buff); i++) rnd += buff[i]; return rnd; } #endif /* } */ /* arrays larger than 'RANLIMIT' may use randomized pivots */ #define RANLIMIT 100u static void set2 (lua_State *L, unsigned int i, unsigned int j) { lua_seti(L, 1, i); lua_seti(L, 1, j); } /* ** Return true iff value at stack index 'a' is less than the value at ** index 'b' (according to the order of the sort). */ static int sort_comp (lua_State *L, int a, int b) { if (lua_isnil(L, 2)) /* no function? */ return lua_compare(L, a, b, LUA_OPLT); /* a < b */ else { /* function */ int res; lua_pushvalue(L, 2); /* push function */ lua_pushvalue(L, a-1); /* -1 to compensate function */ lua_pushvalue(L, b-2); /* -2 to compensate function and 'a' */ lua_call(L, 2, 1); /* call function */ res = lua_toboolean(L, -1); /* get result */ lua_pop(L, 1); /* pop result */ return res; } } /* ** Does the partition: Pivot P is at the top of the stack. ** precondition: a[lo] <= P == a[up-1] <= a[up], ** so it only needs to do the partition from lo + 1 to up - 2. ** Pos-condition: a[lo .. i - 1] <= a[i] == P <= a[i + 1 .. up] ** returns 'i'. */ static unsigned int partition (lua_State *L, unsigned int lo, unsigned int up) { unsigned int i = lo; /* will be incremented before first use */ unsigned int j = up - 1; /* will be decremented before first use */ /* loop invariant: a[lo .. i] <= P <= a[j .. up] */ for (;;) { /* next loop: repeat ++i while a[i] < P */ while (lua_geti(L, 1, ++i), sort_comp(L, -1, -2)) { if (i == up - 1) /* a[i] < P but a[up - 1] == P ?? */ luaL_error(L, "invalid order function for sorting"); lua_pop(L, 1); /* remove a[i] */ } /* after the loop, a[i] >= P and a[lo .. i - 1] < P */ /* next loop: repeat --j while P < a[j] */ while (lua_geti(L, 1, --j), sort_comp(L, -3, -1)) { if (j < i) /* j < i but a[j] > P ?? */ luaL_error(L, "invalid order function for sorting"); lua_pop(L, 1); /* remove a[j] */ } /* after the loop, a[j] <= P and a[j + 1 .. up] >= P */ if (j < i) { /* no elements out of place? */ /* a[lo .. i - 1] <= P <= a[j + 1 .. i .. up] */ lua_pop(L, 1); /* pop a[j] */ /* swap pivot (a[up - 1]) with a[i] to satisfy pos-condition */ set2(L, up - 1, i); return i; } /* otherwise, swap a[i] - a[j] to restore invariant and repeat */ set2(L, i, j); } } /* ** Choose an element in the middle (2nd-3th quarters) of [lo,up] ** "randomized" by 'rnd' */ static unsigned int choosePivot (unsigned int lo, unsigned int up, unsigned int rnd) { unsigned int r4 = (unsigned int)(up - lo) / 4u; /* range/4 */ unsigned int p = rnd % (r4 * 2) + (lo + r4); lua_assert(lo + r4 <= p && p <= up - r4); return p; } /* ** QuickSort algorithm (recursive function) */ static void auxsort (lua_State *L, unsigned int lo, unsigned int up, unsigned int rnd) { while (lo < up) { /* loop for tail recursion */ unsigned int p; /* Pivot index */ unsigned int n; /* to be used later */ /* sort elements 'lo', 'p', and 'up' */ lua_geti(L, 1, lo); lua_geti(L, 1, up); if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */ set2(L, lo, up); /* swap a[lo] - a[up] */ else lua_pop(L, 2); /* remove both values */ if (up - lo == 1) /* only 2 elements? */ return; /* already sorted */ if (up - lo < RANLIMIT || rnd == 0) /* small interval or no randomize? */ p = (lo + up)/2; /* middle element is a good pivot */ else /* for larger intervals, it is worth a random pivot */ p = choosePivot(lo, up, rnd); lua_geti(L, 1, p); lua_geti(L, 1, lo); if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */ set2(L, p, lo); /* swap a[p] - a[lo] */ else { lua_pop(L, 1); /* remove a[lo] */ lua_geti(L, 1, up); if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */ set2(L, p, up); /* swap a[up] - a[p] */ else lua_pop(L, 2); } if (up - lo == 2) /* only 3 elements? */ return; /* already sorted */ lua_geti(L, 1, p); /* get middle element (Pivot) */ lua_pushvalue(L, -1); /* push Pivot */ lua_geti(L, 1, up - 1); /* push a[up - 1] */ set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */ p = partition(L, lo, up); /* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */ if (p - lo < up - p) { /* lower interval is smaller? */ auxsort(L, lo, p - 1, rnd); /* call recursively for lower interval */ n = p - lo; /* size of smaller interval */ lo = p + 1; /* tail call for [p + 1 .. up] (upper interval) */ } else { auxsort(L, p + 1, up, rnd); /* call recursively for upper interval */ n = up - p; /* size of smaller interval */ up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */ } if ((up - lo) / 128u > n) /* partition too imbalanced? */ rnd = l_randomizePivot(); /* try a new randomization */ } /* tail call auxsort(L, lo, up, rnd) */ } static int sort (lua_State *L) { lua_Integer n = aux_getn(L, 1, TAB_RW); if (n > 1) { /* non-trivial interval? */ luaL_argcheck(L, n < INT_MAX, 1, "array too big"); luaL_checkstack(L, 40, ""); /* assume array is smaller than 2^40 */ if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */ luaL_checktype(L, 2, LUA_TFUNCTION); /* must be a function */ lua_settop(L, 2); /* make sure there are two arguments */ auxsort(L, 1, (unsigned int)n, 0u); } return 0; } /* }====================================================== */ static const luaL_Reg tab_funcs[] = { {"concat", tconcat}, #if defined(LUA_COMPAT_MAXN) {"maxn", maxn}, #endif {"insert", tinsert}, {"pack", pack}, {"unpack", unpack}, {"remove", tremove}, {"move", tmove}, {"sort", sort}, {NULL, NULL} }; LUAMOD_API int luaopen_table (lua_State *L) { luaL_newlib(L, tab_funcs); #if defined(LUA_COMPAT_UNPACK) /* _G.unpack = table.unpack */ lua_getfield(L, -1, "unpack"); lua_setglobal(L, "unpack"); #endif return 1; } wcc-0.0.2/src/wsh/lua/src/lparser.h0000644000175000017500000000644213110675433015531 0ustar philphil/* ** $Id: lparser.h,v 1.74 2014/10/25 11:50:46 roberto Exp $ ** Lua Parser ** See Copyright Notice in lua.h */ #ifndef lparser_h #define lparser_h #include "llimits.h" #include "lobject.h" #include "lzio.h" /* ** Expression descriptor */ typedef enum { VVOID, /* no value */ VNIL, VTRUE, VFALSE, VK, /* info = index of constant in 'k' */ VKFLT, /* nval = numerical float value */ VKINT, /* nval = numerical integer value */ VNONRELOC, /* info = result register */ VLOCAL, /* info = local register */ VUPVAL, /* info = index of upvalue in 'upvalues' */ VINDEXED, /* t = table register/upvalue; idx = index R/K */ VJMP, /* info = instruction pc */ VRELOCABLE, /* info = instruction pc */ VCALL, /* info = instruction pc */ VVARARG /* info = instruction pc */ } expkind; #define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXED) #define vkisinreg(k) ((k) == VNONRELOC || (k) == VLOCAL) typedef struct expdesc { expkind k; union { struct { /* for indexed variables (VINDEXED) */ short idx; /* index (R/K) */ lu_byte t; /* table (register or upvalue) */ lu_byte vt; /* whether 't' is register (VLOCAL) or upvalue (VUPVAL) */ } ind; int info; /* for generic use */ lua_Number nval; /* for VKFLT */ lua_Integer ival; /* for VKINT */ } u; int t; /* patch list of 'exit when true' */ int f; /* patch list of 'exit when false' */ } expdesc; /* description of active local variable */ typedef struct Vardesc { short idx; /* variable index in stack */ } Vardesc; /* description of pending goto statements and label statements */ typedef struct Labeldesc { TString *name; /* label identifier */ int pc; /* position in code */ int line; /* line where it appeared */ lu_byte nactvar; /* local level where it appears in current block */ } Labeldesc; /* list of labels or gotos */ typedef struct Labellist { Labeldesc *arr; /* array */ int n; /* number of entries in use */ int size; /* array size */ } Labellist; /* dynamic structures used by the parser */ typedef struct Dyndata { struct { /* list of active local variables */ Vardesc *arr; int n; int size; } actvar; Labellist gt; /* list of pending gotos */ Labellist label; /* list of active labels */ } Dyndata; /* control of blocks */ struct BlockCnt; /* defined in lparser.c */ /* state needed to generate code for a given function */ typedef struct FuncState { Proto *f; /* current function header */ struct FuncState *prev; /* enclosing function */ struct LexState *ls; /* lexical state */ struct BlockCnt *bl; /* chain of current blocks */ int pc; /* next position to code (equivalent to 'ncode') */ int lasttarget; /* 'label' of last 'jump label' */ int jpc; /* list of pending jumps to 'pc' */ int nk; /* number of elements in 'k' */ int np; /* number of elements in 'p' */ int firstlocal; /* index of first local var (in Dyndata array) */ short nlocvars; /* number of elements in 'f->locvars' */ lu_byte nactvar; /* number of active local variables */ lu_byte nups; /* number of upvalues */ lu_byte freereg; /* first free register */ } FuncState; LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, Dyndata *dyd, const char *name, int firstchar); #endif wcc-0.0.2/src/wsh/lua/src/luaconf.h0000644000175000017500000005110113110675433015500 0ustar philphil/* ** $Id: luaconf.h,v 1.254 2015/10/21 18:17:40 roberto Exp $ ** Configuration file for Lua ** See Copyright Notice in lua.h */ #ifndef luaconf_h #define luaconf_h #include #include /* ** =================================================================== ** Search for "@@" to find all configurable definitions. ** =================================================================== */ /* ** {==================================================================== ** System Configuration: macros to adapt (if needed) Lua to some ** particular platform, for instance compiling it with 32-bit numbers or ** restricting it to C89. ** ===================================================================== */ /* @@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats. You ** can also define LUA_32BITS in the make file, but changing here you ** ensure that all software connected to Lua will be compiled with the ** same configuration. */ /* #define LUA_32BITS */ /* @@ LUA_USE_C89 controls the use of non-ISO-C89 features. ** Define it if you want Lua to avoid the use of a few C99 features ** or Windows-specific features on Windows. */ /* #define LUA_USE_C89 */ /* ** By default, Lua on Windows use (some) specific Windows features */ #if !defined(LUA_USE_C89) && defined(_WIN32) && !defined(_WIN32_WCE) #define LUA_USE_WINDOWS /* enable goodies for regular Windows */ #endif #if defined(LUA_USE_WINDOWS) #define LUA_DL_DLL /* enable support for DLL */ #define LUA_USE_C89 /* broadly, Windows is C89 */ #endif #if defined(LUA_USE_LINUX) #define LUA_USE_POSIX #define LUA_USE_DLOPEN /* needs an extra library: -ldl */ #define LUA_USE_READLINE /* needs some extra libraries */ #endif #if defined(LUA_USE_MACOSX) #define LUA_USE_POSIX #define LUA_USE_DLOPEN /* MacOS does not need -ldl */ #define LUA_USE_READLINE /* needs an extra library: -lreadline */ #endif /* @@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for ** C89 ('long' and 'double'); Windows always has '__int64', so it does ** not need to use this case. */ #if defined(LUA_USE_C89) && !defined(LUA_USE_WINDOWS) #define LUA_C89_NUMBERS #endif /* @@ LUAI_BITSINT defines the (minimum) number of bits in an 'int'. */ /* avoid undefined shifts */ #if ((INT_MAX >> 15) >> 15) >= 1 #define LUAI_BITSINT 32 #else /* 'int' always must have at least 16 bits */ #define LUAI_BITSINT 16 #endif /* @@ LUA_INT_TYPE defines the type for Lua integers. @@ LUA_FLOAT_TYPE defines the type for Lua floats. ** Lua should work fine with any mix of these options (if supported ** by your C compiler). The usual configurations are 64-bit integers ** and 'double' (the default), 32-bit integers and 'float' (for ** restricted platforms), and 'long'/'double' (for C compilers not ** compliant with C99, which may not have support for 'long long'). */ /* predefined options for LUA_INT_TYPE */ #define LUA_INT_INT 1 #define LUA_INT_LONG 2 #define LUA_INT_LONGLONG 3 /* predefined options for LUA_FLOAT_TYPE */ #define LUA_FLOAT_FLOAT 1 #define LUA_FLOAT_DOUBLE 2 #define LUA_FLOAT_LONGDOUBLE 3 #if defined(LUA_32BITS) /* { */ /* ** 32-bit integers and 'float' */ #if LUAI_BITSINT >= 32 /* use 'int' if big enough */ #define LUA_INT_TYPE LUA_INT_INT #else /* otherwise use 'long' */ #define LUA_INT_TYPE LUA_INT_LONG #endif #define LUA_FLOAT_TYPE LUA_FLOAT_FLOAT #elif defined(LUA_C89_NUMBERS) /* }{ */ /* ** largest types available for C89 ('long' and 'double') */ #define LUA_INT_TYPE LUA_INT_LONG #define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE #endif /* } */ /* ** default configuration for 64-bit Lua ('long long' and 'double') */ #if !defined(LUA_INT_TYPE) #define LUA_INT_TYPE LUA_INT_LONGLONG #endif #if !defined(LUA_FLOAT_TYPE) #define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE #endif /* }================================================================== */ /* ** {================================================================== ** Configuration for Paths. ** =================================================================== */ /* @@ LUA_PATH_DEFAULT is the default path that Lua uses to look for ** Lua libraries. @@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for ** C libraries. ** CHANGE them if your machine has a non-conventional directory ** hierarchy or if you want to install your libraries in ** non-conventional directories. */ #define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR #if defined(_WIN32) /* { */ /* ** In Windows, any exclamation mark ('!') in the path is replaced by the ** path of the directory of the executable file of the current process. */ #define LUA_LDIR "!\\lua\\" #define LUA_CDIR "!\\" #define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\" #define LUA_PATH_DEFAULT \ LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \ LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua;" \ LUA_SHRDIR"?.lua;" LUA_SHRDIR"?\\init.lua;" \ ".\\?.lua;" ".\\?\\init.lua" #define LUA_CPATH_DEFAULT \ LUA_CDIR"?.dll;" \ LUA_CDIR"..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \ LUA_CDIR"loadall.dll;" ".\\?.dll" #else /* }{ */ #define LUA_ROOT "/usr/local/" #define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/" #define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/" #define LUA_PATH_DEFAULT \ LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \ LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua;" \ "./?.lua;" "./?/init.lua" #define LUA_CPATH_DEFAULT \ LUA_CDIR"?.so;" LUA_CDIR"loadall.so;" "./?.so" #endif /* } */ /* @@ LUA_DIRSEP is the directory separator (for submodules). ** CHANGE it if your machine does not use "/" as the directory separator ** and is not Windows. (On Windows Lua automatically uses "\".) */ #if defined(_WIN32) #define LUA_DIRSEP "\\" #else #define LUA_DIRSEP "/" #endif /* }================================================================== */ /* ** {================================================================== ** Marks for exported symbols in the C code ** =================================================================== */ /* @@ LUA_API is a mark for all core API functions. @@ LUALIB_API is a mark for all auxiliary library functions. @@ LUAMOD_API is a mark for all standard library opening functions. ** CHANGE them if you need to define those functions in some special way. ** For instance, if you want to create one Windows DLL with the core and ** the libraries, you may want to use the following definition (define ** LUA_BUILD_AS_DLL to get it). */ #if defined(LUA_BUILD_AS_DLL) /* { */ #if defined(LUA_CORE) || defined(LUA_LIB) /* { */ #define LUA_API __declspec(dllexport) #else /* }{ */ #define LUA_API __declspec(dllimport) #endif /* } */ #else /* }{ */ #define LUA_API extern #endif /* } */ /* more often than not the libs go together with the core */ #define LUALIB_API LUA_API #define LUAMOD_API LUALIB_API /* @@ LUAI_FUNC is a mark for all extern functions that are not to be ** exported to outside modules. @@ LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables ** that are not to be exported to outside modules (LUAI_DDEF for ** definitions and LUAI_DDEC for declarations). ** CHANGE them if you need to mark them in some special way. Elf/gcc ** (versions 3.2 and later) mark them as "hidden" to optimize access ** when Lua is compiled as a shared library. Not all elf targets support ** this attribute. Unfortunately, gcc does not offer a way to check ** whether the target offers that support, and those without support ** give a warning about it. To avoid these warnings, change to the ** default definition. */ #if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \ defined(__ELF__) /* { */ #define LUAI_FUNC __attribute__((visibility("hidden"))) extern #else /* }{ */ #define LUAI_FUNC extern #endif /* } */ #define LUAI_DDEC LUAI_FUNC #define LUAI_DDEF /* empty */ /* }================================================================== */ /* ** {================================================================== ** Compatibility with previous versions ** =================================================================== */ /* @@ LUA_COMPAT_5_2 controls other macros for compatibility with Lua 5.2. @@ LUA_COMPAT_5_1 controls other macros for compatibility with Lua 5.1. ** You can define it to get all options, or change specific options ** to fit your specific needs. */ #if defined(LUA_COMPAT_5_2) /* { */ /* @@ LUA_COMPAT_MATHLIB controls the presence of several deprecated ** functions in the mathematical library. */ #define LUA_COMPAT_MATHLIB /* @@ LUA_COMPAT_BITLIB controls the presence of library 'bit32'. */ #define LUA_COMPAT_BITLIB /* @@ LUA_COMPAT_IPAIRS controls the effectiveness of the __ipairs metamethod. */ #define LUA_COMPAT_IPAIRS /* @@ LUA_COMPAT_APIINTCASTS controls the presence of macros for ** manipulating other integer types (lua_pushunsigned, lua_tounsigned, ** luaL_checkint, luaL_checklong, etc.) */ #define LUA_COMPAT_APIINTCASTS #endif /* } */ #if defined(LUA_COMPAT_5_1) /* { */ /* Incompatibilities from 5.2 -> 5.3 */ #define LUA_COMPAT_MATHLIB #define LUA_COMPAT_APIINTCASTS /* @@ LUA_COMPAT_UNPACK controls the presence of global 'unpack'. ** You can replace it with 'table.unpack'. */ #define LUA_COMPAT_UNPACK /* @@ LUA_COMPAT_LOADERS controls the presence of table 'package.loaders'. ** You can replace it with 'package.searchers'. */ #define LUA_COMPAT_LOADERS /* @@ macro 'lua_cpcall' emulates deprecated function lua_cpcall. ** You can call your C function directly (with light C functions). */ #define lua_cpcall(L,f,u) \ (lua_pushcfunction(L, (f)), \ lua_pushlightuserdata(L,(u)), \ lua_pcall(L,1,0,0)) /* @@ LUA_COMPAT_LOG10 defines the function 'log10' in the math library. ** You can rewrite 'log10(x)' as 'log(x, 10)'. */ #define LUA_COMPAT_LOG10 /* @@ LUA_COMPAT_LOADSTRING defines the function 'loadstring' in the base ** library. You can rewrite 'loadstring(s)' as 'load(s)'. */ #define LUA_COMPAT_LOADSTRING /* @@ LUA_COMPAT_MAXN defines the function 'maxn' in the table library. */ #define LUA_COMPAT_MAXN /* @@ The following macros supply trivial compatibility for some ** changes in the API. The macros themselves document how to ** change your code to avoid using them. */ #define lua_strlen(L,i) lua_rawlen(L, (i)) #define lua_objlen(L,i) lua_rawlen(L, (i)) #define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ) #define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT) /* @@ LUA_COMPAT_MODULE controls compatibility with previous ** module functions 'module' (Lua) and 'luaL_register' (C). */ #define LUA_COMPAT_MODULE #endif /* } */ /* @@ LUA_COMPAT_FLOATSTRING makes Lua format integral floats without a @@ a float mark ('.0'). ** This macro is not on by default even in compatibility mode, ** because this is not really an incompatibility. */ /* #define LUA_COMPAT_FLOATSTRING */ /* }================================================================== */ /* ** {================================================================== ** Configuration for Numbers. ** Change these definitions if no predefined LUA_FLOAT_* / LUA_INT_* ** satisfy your needs. ** =================================================================== */ /* @@ LUA_NUMBER is the floating-point type used by Lua. @@ LUAI_UACNUMBER is the result of an 'usual argument conversion' @@ over a floating number. @@ l_mathlim(x) corrects limit name 'x' to the proper float type ** by prefixing it with one of FLT/DBL/LDBL. @@ LUA_NUMBER_FRMLEN is the length modifier for writing floats. @@ LUA_NUMBER_FMT is the format for writing floats. @@ lua_number2str converts a float to a string. @@ l_mathop allows the addition of an 'l' or 'f' to all math operations. @@ l_floor takes the floor of a float. @@ lua_str2number converts a decimal numeric string to a number. */ /* The following definitions are good for most cases here */ #define l_floor(x) (l_mathop(floor)(x)) #define lua_number2str(s,sz,n) l_sprintf((s), sz, LUA_NUMBER_FMT, (n)) /* @@ lua_numbertointeger converts a float number to an integer, or ** returns 0 if float is not within the range of a lua_Integer. ** (The range comparisons are tricky because of rounding. The tests ** here assume a two-complement representation, where MININTEGER always ** has an exact representation as a float; MAXINTEGER may not have one, ** and therefore its conversion to float may have an ill-defined value.) */ #define lua_numbertointeger(n,p) \ ((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \ (n) < -(LUA_NUMBER)(LUA_MININTEGER) && \ (*(p) = (LUA_INTEGER)(n), 1)) /* now the variable definitions */ #if LUA_FLOAT_TYPE == LUA_FLOAT_FLOAT /* { single float */ #define LUA_NUMBER float #define l_mathlim(n) (FLT_##n) #define LUAI_UACNUMBER double #define LUA_NUMBER_FRMLEN "" #define LUA_NUMBER_FMT "%.7g" #define l_mathop(op) op##f #define lua_str2number(s,p) strtof((s), (p)) #elif LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE /* }{ long double */ #define LUA_NUMBER long double #define l_mathlim(n) (LDBL_##n) #define LUAI_UACNUMBER long double #define LUA_NUMBER_FRMLEN "L" #define LUA_NUMBER_FMT "%.19Lg" #define l_mathop(op) op##l #define lua_str2number(s,p) strtold((s), (p)) #elif LUA_FLOAT_TYPE == LUA_FLOAT_DOUBLE /* }{ double */ #define LUA_NUMBER double #define l_mathlim(n) (DBL_##n) #define LUAI_UACNUMBER double #define LUA_NUMBER_FRMLEN "" #define LUA_NUMBER_FMT "%.14g" #define l_mathop(op) op #define lua_str2number(s,p) strtod((s), (p)) #else /* }{ */ #error "numeric float type not defined" #endif /* } */ /* @@ LUA_INTEGER is the integer type used by Lua. ** @@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER. ** @@ LUAI_UACINT is the result of an 'usual argument conversion' @@ over a lUA_INTEGER. @@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers. @@ LUA_INTEGER_FMT is the format for writing integers. @@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER. @@ LUA_MININTEGER is the minimum value for a LUA_INTEGER. @@ lua_integer2str converts an integer to a string. */ /* The following definitions are good for most cases here */ #define LUA_INTEGER_FMT "%" LUA_INTEGER_FRMLEN "d" #define lua_integer2str(s,sz,n) l_sprintf((s), sz, LUA_INTEGER_FMT, (n)) #define LUAI_UACINT LUA_INTEGER /* ** use LUAI_UACINT here to avoid problems with promotions (which ** can turn a comparison between unsigneds into a signed comparison) */ #define LUA_UNSIGNED unsigned LUAI_UACINT /* now the variable definitions */ #if LUA_INT_TYPE == LUA_INT_INT /* { int */ #define LUA_INTEGER int #define LUA_INTEGER_FRMLEN "" #define LUA_MAXINTEGER INT_MAX #define LUA_MININTEGER INT_MIN #elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */ #define LUA_INTEGER long #define LUA_INTEGER_FRMLEN "l" #define LUA_MAXINTEGER LONG_MAX #define LUA_MININTEGER LONG_MIN #elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */ /* use presence of macro LLONG_MAX as proxy for C99 compliance */ #if defined(LLONG_MAX) /* { */ /* use ISO C99 stuff */ #define LUA_INTEGER long long #define LUA_INTEGER_FRMLEN "ll" #define LUA_MAXINTEGER LLONG_MAX #define LUA_MININTEGER LLONG_MIN #elif defined(LUA_USE_WINDOWS) /* }{ */ /* in Windows, can use specific Windows types */ #define LUA_INTEGER __int64 #define LUA_INTEGER_FRMLEN "I64" #define LUA_MAXINTEGER _I64_MAX #define LUA_MININTEGER _I64_MIN #else /* }{ */ #error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \ or '-DLUA_C89_NUMBERS' (see file 'luaconf.h' for details)" #endif /* } */ #else /* }{ */ #error "numeric integer type not defined" #endif /* } */ /* }================================================================== */ /* ** {================================================================== ** Dependencies with C99 and other C details ** =================================================================== */ /* @@ l_sprintf is equivalent to 'snprintf' or 'sprintf' in C89. ** (All uses in Lua have only one format item.) */ #if !defined(LUA_USE_C89) #define l_sprintf(s,sz,f,i) snprintf(s,sz,f,i) #else #define l_sprintf(s,sz,f,i) ((void)(sz), sprintf(s,f,i)) #endif /* @@ lua_strx2number converts an hexadecimal numeric string to a number. ** In C99, 'strtod' does that conversion. Otherwise, you can ** leave 'lua_strx2number' undefined and Lua will provide its own ** implementation. */ #if !defined(LUA_USE_C89) #define lua_strx2number(s,p) lua_str2number(s,p) #endif /* @@ lua_number2strx converts a float to an hexadecimal numeric string. ** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that. ** Otherwise, you can leave 'lua_number2strx' undefined and Lua will ** provide its own implementation. */ #if !defined(LUA_USE_C89) #define lua_number2strx(L,b,sz,f,n) l_sprintf(b,sz,f,n) #endif /* ** 'strtof' and 'opf' variants for math functions are not valid in ** C89. Otherwise, the macro 'HUGE_VALF' is a good proxy for testing the ** availability of these variants. ('math.h' is already included in ** all files that use these macros.) */ #if defined(LUA_USE_C89) || (defined(HUGE_VAL) && !defined(HUGE_VALF)) #undef l_mathop /* variants not available */ #undef lua_str2number #define l_mathop(op) (lua_Number)op /* no variant */ #define lua_str2number(s,p) ((lua_Number)strtod((s), (p))) #endif /* @@ LUA_KCONTEXT is the type of the context ('ctx') for continuation ** functions. It must be a numerical type; Lua will use 'intptr_t' if ** available, otherwise it will use 'ptrdiff_t' (the nearest thing to ** 'intptr_t' in C89) */ #define LUA_KCONTEXT ptrdiff_t #if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \ __STDC_VERSION__ >= 199901L #include #if defined(INTPTR_MAX) /* even in C99 this type is optional */ #undef LUA_KCONTEXT #define LUA_KCONTEXT intptr_t #endif #endif /* @@ lua_getlocaledecpoint gets the locale "radix character" (decimal point). ** Change that if you do not want to use C locales. (Code using this ** macro must include header 'locale.h'.) */ #if !defined(lua_getlocaledecpoint) #define lua_getlocaledecpoint() (localeconv()->decimal_point[0]) #endif /* }================================================================== */ /* ** {================================================================== ** Language Variations ** ===================================================================== */ /* @@ LUA_NOCVTN2S/LUA_NOCVTS2N control how Lua performs some ** coercions. Define LUA_NOCVTN2S to turn off automatic coercion from ** numbers to strings. Define LUA_NOCVTS2N to turn off automatic ** coercion from strings to numbers. */ /* #define LUA_NOCVTN2S */ /* #define LUA_NOCVTS2N */ /* @@ LUA_USE_APICHECK turns on several consistency checks on the C API. ** Define it as a help when debugging C code. */ #if defined(LUA_USE_APICHECK) #include #define luai_apicheck(l,e) assert(e) #endif /* }================================================================== */ /* ** {================================================================== ** Macros that affect the API and must be stable (that is, must be the ** same when you compile Lua and when you compile code that links to ** Lua). You probably do not want/need to change them. ** ===================================================================== */ /* @@ LUAI_MAXSTACK limits the size of the Lua stack. ** CHANGE it if you need a different limit. This limit is arbitrary; ** its only purpose is to stop Lua from consuming unlimited stack ** space (and to reserve some numbers for pseudo-indices). */ #if LUAI_BITSINT >= 32 #define LUAI_MAXSTACK 1000000 #else #define LUAI_MAXSTACK 15000 #endif /* @@ LUA_EXTRASPACE defines the size of a raw memory area associated with ** a Lua state with very fast access. ** CHANGE it if you need a different size. */ #define LUA_EXTRASPACE (sizeof(void *)) /* @@ LUA_IDSIZE gives the maximum size for the description of the source @@ of a function in debug information. ** CHANGE it if you want a different size. */ #define LUA_IDSIZE 60 /* @@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system. ** CHANGE it if it uses too much C-stack space. (For long double, ** 'string.format("%.99f", 1e4932)' needs ~5030 bytes, so a ** smaller buffer would force a memory allocation for each call to ** 'string.format'.) */ #if defined(LUA_FLOAT_LONGDOUBLE) #define LUAL_BUFFERSIZE 8192 #else #define LUAL_BUFFERSIZE ((int)(0x80 * sizeof(void*) * sizeof(lua_Integer))) #endif /* }================================================================== */ /* @@ LUA_QL describes how error messages quote program elements. ** Lua does not use these macros anymore; they are here for ** compatibility only. */ #define LUA_QL(x) "'" x "'" #define LUA_QS LUA_QL("%s") /* =================================================================== */ /* ** Local configuration. You can use this space to add your redefinitions ** without modifying the main part of the file. */ #endif wcc-0.0.2/src/wsh/lua/src/ldebug.h0000644000175000017500000000265413110675433015324 0ustar philphil/* ** $Id: ldebug.h,v 2.14 2015/05/22 17:45:56 roberto Exp $ ** Auxiliary functions from Debug Interface module ** See Copyright Notice in lua.h */ #ifndef ldebug_h #define ldebug_h #include "lstate.h" #define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1) #define getfuncline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : -1) #define resethookcount(L) (L->hookcount = L->basehookcount) LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *opname); LUAI_FUNC l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2); LUAI_FUNC l_noret luaG_opinterror (lua_State *L, const TValue *p1, const TValue *p2, const char *msg); LUAI_FUNC l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2); LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2); LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...); LUAI_FUNC const char *luaG_addinfo (lua_State *L, const char *msg, TString *src, int line); LUAI_FUNC l_noret luaG_errormsg (lua_State *L); LUAI_FUNC void luaG_traceexec (lua_State *L); #endif wcc-0.0.2/src/wsh/lua/src/loadlib.c0000644000175000017500000005576313110675433015474 0ustar philphil/* ** $Id: loadlib.c,v 1.127 2015/11/23 11:30:45 roberto Exp $ ** Dynamic library loader for Lua ** See Copyright Notice in lua.h ** ** This module contains an implementation of loadlib for Unix systems ** that have dlfcn, an implementation for Windows, and a stub for other ** systems. */ #define loadlib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" /* ** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment ** variables that Lua check to set its paths. */ #if !defined(LUA_PATH_VAR) #define LUA_PATH_VAR "LUA_PATH" #endif #if !defined(LUA_CPATH_VAR) #define LUA_CPATH_VAR "LUA_CPATH" #endif #define LUA_PATHSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR #define LUA_PATHVARVERSION LUA_PATH_VAR LUA_PATHSUFFIX #define LUA_CPATHVARVERSION LUA_CPATH_VAR LUA_PATHSUFFIX /* ** LUA_PATH_SEP is the character that separates templates in a path. ** LUA_PATH_MARK is the string that marks the substitution points in a ** template. ** LUA_EXEC_DIR in a Windows path is replaced by the executable's ** directory. ** LUA_IGMARK is a mark to ignore all before it when building the ** luaopen_ function name. */ #if !defined (LUA_PATH_SEP) #define LUA_PATH_SEP ";" #endif #if !defined (LUA_PATH_MARK) #define LUA_PATH_MARK "?" #endif #if !defined (LUA_EXEC_DIR) #define LUA_EXEC_DIR "!" #endif #if !defined (LUA_IGMARK) #define LUA_IGMARK "-" #endif /* ** LUA_CSUBSEP is the character that replaces dots in submodule names ** when searching for a C loader. ** LUA_LSUBSEP is the character that replaces dots in submodule names ** when searching for a Lua loader. */ #if !defined(LUA_CSUBSEP) #define LUA_CSUBSEP LUA_DIRSEP #endif #if !defined(LUA_LSUBSEP) #define LUA_LSUBSEP LUA_DIRSEP #endif /* prefix for open functions in C libraries */ #define LUA_POF "luaopen_" /* separator for open functions in C libraries */ #define LUA_OFSEP "_" /* ** unique key for table in the registry that keeps handles ** for all loaded C libraries */ static const int CLIBS = 0; #define LIB_FAIL "open" #define setprogdir(L) ((void)0) /* ** system-dependent functions */ /* ** unload library 'lib' */ static void lsys_unloadlib (void *lib); /* ** load C library in file 'path'. If 'seeglb', load with all names in ** the library global. ** Returns the library; in case of error, returns NULL plus an ** error string in the stack. */ static void *lsys_load (lua_State *L, const char *path, int seeglb); /* ** Try to find a function named 'sym' in library 'lib'. ** Returns the function; in case of error, returns NULL plus an ** error string in the stack. */ static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym); #if defined(LUA_USE_DLOPEN) /* { */ /* ** {======================================================================== ** This is an implementation of loadlib based on the dlfcn interface. ** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD, ** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least ** as an emulation layer on top of native functions. ** ========================================================================= */ #include /* ** Macro to convert pointer-to-void* to pointer-to-function. This cast ** is undefined according to ISO C, but POSIX assumes that it works. ** (The '__extension__' in gnu compilers is only to avoid warnings.) */ #if defined(__GNUC__) #define cast_func(p) (__extension__ (lua_CFunction)(p)) #else #define cast_func(p) ((lua_CFunction)(p)) #endif static void lsys_unloadlib (void *lib) { dlclose(lib); } static void *lsys_load (lua_State *L, const char *path, int seeglb) { void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL)); if (lib == NULL) lua_pushstring(L, dlerror()); return lib; } static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) { lua_CFunction f = cast_func(dlsym(lib, sym)); if (f == NULL) lua_pushstring(L, dlerror()); return f; } /* }====================================================== */ #elif defined(LUA_DL_DLL) /* }{ */ /* ** {====================================================================== ** This is an implementation of loadlib for Windows using native functions. ** ======================================================================= */ #include #undef setprogdir /* ** optional flags for LoadLibraryEx */ #if !defined(LUA_LLE_FLAGS) #define LUA_LLE_FLAGS 0 #endif static void setprogdir (lua_State *L) { char buff[MAX_PATH + 1]; char *lb; DWORD nsize = sizeof(buff)/sizeof(char); DWORD n = GetModuleFileNameA(NULL, buff, nsize); if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL) luaL_error(L, "unable to get ModuleFileName"); else { *lb = '\0'; luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff); lua_remove(L, -2); /* remove original string */ } } static void pusherror (lua_State *L) { int error = GetLastError(); char buffer[128]; if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM, NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL)) lua_pushstring(L, buffer); else lua_pushfstring(L, "system error %d\n", error); } static void lsys_unloadlib (void *lib) { FreeLibrary((HMODULE)lib); } static void *lsys_load (lua_State *L, const char *path, int seeglb) { HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS); (void)(seeglb); /* not used: symbols are 'global' by default */ if (lib == NULL) pusherror(L); return lib; } static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) { lua_CFunction f = (lua_CFunction)GetProcAddress((HMODULE)lib, sym); if (f == NULL) pusherror(L); return f; } /* }====================================================== */ #else /* }{ */ /* ** {====================================================== ** Fallback for other systems ** ======================================================= */ #undef LIB_FAIL #define LIB_FAIL "absent" #define DLMSG "dynamic libraries not enabled; check your Lua installation" static void lsys_unloadlib (void *lib) { (void)(lib); /* not used */ } static void *lsys_load (lua_State *L, const char *path, int seeglb) { (void)(path); (void)(seeglb); /* not used */ lua_pushliteral(L, DLMSG); return NULL; } static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) { (void)(lib); (void)(sym); /* not used */ lua_pushliteral(L, DLMSG); return NULL; } /* }====================================================== */ #endif /* } */ /* ** return registry.CLIBS[path] */ static void *checkclib (lua_State *L, const char *path) { void *plib; lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS); lua_getfield(L, -1, path); plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */ lua_pop(L, 2); /* pop CLIBS table and 'plib' */ return plib; } /* ** registry.CLIBS[path] = plib -- for queries ** registry.CLIBS[#CLIBS + 1] = plib -- also keep a list of all libraries */ static void addtoclib (lua_State *L, const char *path, void *plib) { lua_rawgetp(L, LUA_REGISTRYINDEX, &CLIBS); lua_pushlightuserdata(L, plib); lua_pushvalue(L, -1); lua_setfield(L, -3, path); /* CLIBS[path] = plib */ lua_rawseti(L, -2, luaL_len(L, -2) + 1); /* CLIBS[#CLIBS + 1] = plib */ lua_pop(L, 1); /* pop CLIBS table */ } /* ** __gc tag method for CLIBS table: calls 'lsys_unloadlib' for all lib ** handles in list CLIBS */ static int gctm (lua_State *L) { lua_Integer n = luaL_len(L, 1); for (; n >= 1; n--) { /* for each handle, in reverse order */ lua_rawgeti(L, 1, n); /* get handle CLIBS[n] */ lsys_unloadlib(lua_touserdata(L, -1)); lua_pop(L, 1); /* pop handle */ } return 0; } /* error codes for 'lookforfunc' */ #define ERRLIB 1 #define ERRFUNC 2 /* ** Look for a C function named 'sym' in a dynamically loaded library ** 'path'. ** First, check whether the library is already loaded; if not, try ** to load it. ** Then, if 'sym' is '*', return true (as library has been loaded). ** Otherwise, look for symbol 'sym' in the library and push a ** C function with that symbol. ** Return 0 and 'true' or a function in the stack; in case of ** errors, return an error code and an error message in the stack. */ static int lookforfunc (lua_State *L, const char *path, const char *sym) { void *reg = checkclib(L, path); /* check loaded C libraries */ if (reg == NULL) { /* must load library? */ reg = lsys_load(L, path, *sym == '*'); /* global symbols if 'sym'=='*' */ if (reg == NULL) return ERRLIB; /* unable to load library */ addtoclib(L, path, reg); } if (*sym == '*') { /* loading only library (no function)? */ lua_pushboolean(L, 1); /* return 'true' */ return 0; /* no errors */ } else { lua_CFunction f = lsys_sym(L, reg, sym); if (f == NULL) return ERRFUNC; /* unable to find function */ lua_pushcfunction(L, f); /* else create new function */ return 0; /* no errors */ } } static int ll_loadlib (lua_State *L) { const char *path = luaL_checkstring(L, 1); const char *init = luaL_checkstring(L, 2); int stat = lookforfunc(L, path, init); if (stat == 0) /* no errors? */ return 1; /* return the loaded function */ else { /* error; error message is on stack top */ lua_pushnil(L); lua_insert(L, -2); lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init"); return 3; /* return nil, error message, and where */ } } /* ** {====================================================== ** 'require' function ** ======================================================= */ static int readable (const char *filename) { FILE *f = fopen(filename, "r"); /* try to open file */ if (f == NULL) return 0; /* open failed */ fclose(f); return 1; } static const char *pushnexttemplate (lua_State *L, const char *path) { const char *l; while (*path == *LUA_PATH_SEP) path++; /* skip separators */ if (*path == '\0') return NULL; /* no more templates */ l = strchr(path, *LUA_PATH_SEP); /* find next separator */ if (l == NULL) l = path + strlen(path); lua_pushlstring(L, path, l - path); /* template */ return l; } static const char *searchpath (lua_State *L, const char *name, const char *path, const char *sep, const char *dirsep) { luaL_Buffer msg; /* to build error message */ luaL_buffinit(L, &msg); if (*sep != '\0') /* non-empty separator? */ name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */ while ((path = pushnexttemplate(L, path)) != NULL) { const char *filename = luaL_gsub(L, lua_tostring(L, -1), LUA_PATH_MARK, name); lua_remove(L, -2); /* remove path template */ if (readable(filename)) /* does file exist and is readable? */ return filename; /* return that file name */ lua_pushfstring(L, "\n\tno file '%s'", filename); lua_remove(L, -2); /* remove file name */ luaL_addvalue(&msg); /* concatenate error msg. entry */ } luaL_pushresult(&msg); /* create error message */ return NULL; /* not found */ } static int ll_searchpath (lua_State *L) { const char *f = searchpath(L, luaL_checkstring(L, 1), luaL_checkstring(L, 2), luaL_optstring(L, 3, "."), luaL_optstring(L, 4, LUA_DIRSEP)); if (f != NULL) return 1; else { /* error message is on top of the stack */ lua_pushnil(L); lua_insert(L, -2); return 2; /* return nil + error message */ } } static const char *findfile (lua_State *L, const char *name, const char *pname, const char *dirsep) { const char *path; lua_getfield(L, lua_upvalueindex(1), pname); path = lua_tostring(L, -1); if (path == NULL) luaL_error(L, "'package.%s' must be a string", pname); return searchpath(L, name, path, ".", dirsep); } static int checkload (lua_State *L, int stat, const char *filename) { if (stat) { /* module loaded successfully? */ lua_pushstring(L, filename); /* will be 2nd argument to module */ return 2; /* return open function and file name */ } else return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s", lua_tostring(L, 1), filename, lua_tostring(L, -1)); } static int searcher_Lua (lua_State *L) { const char *filename; const char *name = luaL_checkstring(L, 1); filename = findfile(L, name, "path", LUA_LSUBSEP); if (filename == NULL) return 1; /* module not found in this path */ return checkload(L, (luaL_loadfile(L, filename) == LUA_OK), filename); } /* ** Try to find a load function for module 'modname' at file 'filename'. ** First, change '.' to '_' in 'modname'; then, if 'modname' has ** the form X-Y (that is, it has an "ignore mark"), build a function ** name "luaopen_X" and look for it. (For compatibility, if that ** fails, it also tries "luaopen_Y".) If there is no ignore mark, ** look for a function named "luaopen_modname". */ static int loadfunc (lua_State *L, const char *filename, const char *modname) { const char *openfunc; const char *mark; modname = luaL_gsub(L, modname, ".", LUA_OFSEP); mark = strchr(modname, *LUA_IGMARK); if (mark) { int stat; openfunc = lua_pushlstring(L, modname, mark - modname); openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc); stat = lookforfunc(L, filename, openfunc); if (stat != ERRFUNC) return stat; modname = mark + 1; /* else go ahead and try old-style name */ } openfunc = lua_pushfstring(L, LUA_POF"%s", modname); return lookforfunc(L, filename, openfunc); } static int searcher_C (lua_State *L) { const char *name = luaL_checkstring(L, 1); const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP); if (filename == NULL) return 1; /* module not found in this path */ return checkload(L, (loadfunc(L, filename, name) == 0), filename); } static int searcher_Croot (lua_State *L) { const char *filename; const char *name = luaL_checkstring(L, 1); const char *p = strchr(name, '.'); int stat; if (p == NULL) return 0; /* is root */ lua_pushlstring(L, name, p - name); filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP); if (filename == NULL) return 1; /* root not found */ if ((stat = loadfunc(L, filename, name)) != 0) { if (stat != ERRFUNC) return checkload(L, 0, filename); /* real error */ else { /* open function not found */ lua_pushfstring(L, "\n\tno module '%s' in file '%s'", name, filename); return 1; } } lua_pushstring(L, filename); /* will be 2nd argument to module */ return 2; } static int searcher_preload (lua_State *L) { const char *name = luaL_checkstring(L, 1); lua_getfield(L, LUA_REGISTRYINDEX, "_PRELOAD"); if (lua_getfield(L, -1, name) == LUA_TNIL) /* not found? */ lua_pushfstring(L, "\n\tno field package.preload['%s']", name); return 1; } static void findloader (lua_State *L, const char *name) { int i; luaL_Buffer msg; /* to build error message */ luaL_buffinit(L, &msg); /* push 'package.searchers' to index 3 in the stack */ if (lua_getfield(L, lua_upvalueindex(1), "searchers") != LUA_TTABLE) luaL_error(L, "'package.searchers' must be a table"); /* iterate over available searchers to find a loader */ for (i = 1; ; i++) { if (lua_rawgeti(L, 3, i) == LUA_TNIL) { /* no more searchers? */ lua_pop(L, 1); /* remove nil */ luaL_pushresult(&msg); /* create error message */ luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1)); } lua_pushstring(L, name); lua_call(L, 1, 2); /* call it */ if (lua_isfunction(L, -2)) /* did it find a loader? */ return; /* module loader found */ else if (lua_isstring(L, -2)) { /* searcher returned error message? */ lua_pop(L, 1); /* remove extra return */ luaL_addvalue(&msg); /* concatenate error message */ } else lua_pop(L, 2); /* remove both returns */ } } static int ll_require (lua_State *L) { const char *name = luaL_checkstring(L, 1); lua_settop(L, 1); /* _LOADED table will be at index 2 */ lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); lua_getfield(L, 2, name); /* _LOADED[name] */ if (lua_toboolean(L, -1)) /* is it there? */ return 1; /* package is already loaded */ /* else must load package */ lua_pop(L, 1); /* remove 'getfield' result */ findloader(L, name); lua_pushstring(L, name); /* pass name as argument to module loader */ lua_insert(L, -2); /* name is 1st argument (before search data) */ lua_call(L, 2, 1); /* run loader to load module */ if (!lua_isnil(L, -1)) /* non-nil return? */ lua_setfield(L, 2, name); /* _LOADED[name] = returned value */ if (lua_getfield(L, 2, name) == LUA_TNIL) { /* module set no value? */ lua_pushboolean(L, 1); /* use true as result */ lua_pushvalue(L, -1); /* extra copy to be returned */ lua_setfield(L, 2, name); /* _LOADED[name] = true */ } return 1; } /* }====================================================== */ /* ** {====================================================== ** 'module' function ** ======================================================= */ #if defined(LUA_COMPAT_MODULE) /* ** changes the environment variable of calling function */ static void set_env (lua_State *L) { lua_Debug ar; if (lua_getstack(L, 1, &ar) == 0 || lua_getinfo(L, "f", &ar) == 0 || /* get calling function */ lua_iscfunction(L, -1)) luaL_error(L, "'module' not called from a Lua function"); lua_pushvalue(L, -2); /* copy new environment table to top */ lua_setupvalue(L, -2, 1); lua_pop(L, 1); /* remove function */ } static void dooptions (lua_State *L, int n) { int i; for (i = 2; i <= n; i++) { if (lua_isfunction(L, i)) { /* avoid 'calling' extra info. */ lua_pushvalue(L, i); /* get option (a function) */ lua_pushvalue(L, -2); /* module */ lua_call(L, 1, 0); } } } static void modinit (lua_State *L, const char *modname) { const char *dot; lua_pushvalue(L, -1); lua_setfield(L, -2, "_M"); /* module._M = module */ lua_pushstring(L, modname); lua_setfield(L, -2, "_NAME"); dot = strrchr(modname, '.'); /* look for last dot in module name */ if (dot == NULL) dot = modname; else dot++; /* set _PACKAGE as package name (full module name minus last part) */ lua_pushlstring(L, modname, dot - modname); lua_setfield(L, -2, "_PACKAGE"); } static int ll_module (lua_State *L) { const char *modname = luaL_checkstring(L, 1); int lastarg = lua_gettop(L); /* last parameter */ luaL_pushmodule(L, modname, 1); /* get/create module table */ /* check whether table already has a _NAME field */ if (lua_getfield(L, -1, "_NAME") != LUA_TNIL) lua_pop(L, 1); /* table is an initialized module */ else { /* no; initialize it */ lua_pop(L, 1); modinit(L, modname); } lua_pushvalue(L, -1); set_env(L); dooptions(L, lastarg); return 1; } static int ll_seeall (lua_State *L) { luaL_checktype(L, 1, LUA_TTABLE); if (!lua_getmetatable(L, 1)) { lua_createtable(L, 0, 1); /* create new metatable */ lua_pushvalue(L, -1); lua_setmetatable(L, 1); } lua_pushglobaltable(L); lua_setfield(L, -2, "__index"); /* mt.__index = _G */ return 0; } #endif /* }====================================================== */ /* auxiliary mark (for internal use) */ #define AUXMARK "\1" /* ** return registry.LUA_NOENV as a boolean */ static int noenv (lua_State *L) { int b; lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV"); b = lua_toboolean(L, -1); lua_pop(L, 1); /* remove value */ return b; } static void setpath (lua_State *L, const char *fieldname, const char *envname1, const char *envname2, const char *def) { const char *path = getenv(envname1); if (path == NULL) /* no environment variable? */ path = getenv(envname2); /* try alternative name */ if (path == NULL || noenv(L)) /* no environment variable? */ lua_pushstring(L, def); /* use default */ else { /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */ path = luaL_gsub(L, path, LUA_PATH_SEP LUA_PATH_SEP, LUA_PATH_SEP AUXMARK LUA_PATH_SEP); luaL_gsub(L, path, AUXMARK, def); lua_remove(L, -2); } setprogdir(L); lua_setfield(L, -2, fieldname); } static const luaL_Reg pk_funcs[] = { {"loadlib", ll_loadlib}, {"searchpath", ll_searchpath}, #if defined(LUA_COMPAT_MODULE) {"seeall", ll_seeall}, #endif /* placeholders */ {"preload", NULL}, {"cpath", NULL}, {"path", NULL}, {"searchers", NULL}, {"loaded", NULL}, {NULL, NULL} }; static const luaL_Reg ll_funcs[] = { #if defined(LUA_COMPAT_MODULE) {"module", ll_module}, #endif {"require", ll_require}, {NULL, NULL} }; static void createsearcherstable (lua_State *L) { static const lua_CFunction searchers[] = {searcher_preload, searcher_Lua, searcher_C, searcher_Croot, NULL}; int i; /* create 'searchers' table */ lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0); /* fill it with predefined searchers */ for (i=0; searchers[i] != NULL; i++) { lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */ lua_pushcclosure(L, searchers[i], 1); lua_rawseti(L, -2, i+1); } #if defined(LUA_COMPAT_LOADERS) lua_pushvalue(L, -1); /* make a copy of 'searchers' table */ lua_setfield(L, -3, "loaders"); /* put it in field 'loaders' */ #endif lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */ } /* ** create table CLIBS to keep track of loaded C libraries, ** setting a finalizer to close all libraries when closing state. */ static void createclibstable (lua_State *L) { lua_newtable(L); /* create CLIBS table */ lua_createtable(L, 0, 1); /* create metatable for CLIBS */ lua_pushcfunction(L, gctm); lua_setfield(L, -2, "__gc"); /* set finalizer for CLIBS table */ lua_setmetatable(L, -2); lua_rawsetp(L, LUA_REGISTRYINDEX, &CLIBS); /* set CLIBS table in registry */ } LUAMOD_API int luaopen_package (lua_State *L) { createclibstable(L); luaL_newlib(L, pk_funcs); /* create 'package' table */ createsearcherstable(L); /* set field 'path' */ setpath(L, "path", LUA_PATHVARVERSION, LUA_PATH_VAR, LUA_PATH_DEFAULT); /* set field 'cpath' */ setpath(L, "cpath", LUA_CPATHVARVERSION, LUA_CPATH_VAR, LUA_CPATH_DEFAULT); /* store config information */ lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n" LUA_EXEC_DIR "\n" LUA_IGMARK "\n"); lua_setfield(L, -2, "config"); /* set field 'loaded' */ luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED"); lua_setfield(L, -2, "loaded"); /* set field 'preload' */ luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD"); lua_setfield(L, -2, "preload"); lua_pushglobaltable(L); lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */ luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */ lua_pop(L, 1); /* pop global table */ return 1; /* return 'package' table */ } wcc-0.0.2/src/wsh/lua/src/lmathlib.c0000644000175000017500000002322513110675433015646 0ustar philphil/* ** $Id: lmathlib.c,v 1.117 2015/10/02 15:39:23 roberto Exp $ ** Standard mathematical library ** See Copyright Notice in lua.h */ #define lmathlib_c #define LUA_LIB #include "lprefix.h" #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" #undef PI #define PI (l_mathop(3.141592653589793238462643383279502884)) #if !defined(l_rand) /* { */ #if defined(LUA_USE_POSIX) #define l_rand() random() #define l_srand(x) srandom(x) #define L_RANDMAX 2147483647 /* (2^31 - 1), following POSIX */ #else #define l_rand() rand() #define l_srand(x) srand(x) #define L_RANDMAX RAND_MAX #endif #endif /* } */ static int math_abs (lua_State *L) { if (lua_isinteger(L, 1)) { lua_Integer n = lua_tointeger(L, 1); if (n < 0) n = (lua_Integer)(0u - (lua_Unsigned)n); lua_pushinteger(L, n); } else lua_pushnumber(L, l_mathop(fabs)(luaL_checknumber(L, 1))); return 1; } static int math_sin (lua_State *L) { lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1))); return 1; } static int math_cos (lua_State *L) { lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1))); return 1; } static int math_tan (lua_State *L) { lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1))); return 1; } static int math_asin (lua_State *L) { lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1))); return 1; } static int math_acos (lua_State *L) { lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1))); return 1; } static int math_atan (lua_State *L) { lua_Number y = luaL_checknumber(L, 1); lua_Number x = luaL_optnumber(L, 2, 1); lua_pushnumber(L, l_mathop(atan2)(y, x)); return 1; } static int math_toint (lua_State *L) { int valid; lua_Integer n = lua_tointegerx(L, 1, &valid); if (valid) lua_pushinteger(L, n); else { luaL_checkany(L, 1); lua_pushnil(L); /* value is not convertible to integer */ } return 1; } static void pushnumint (lua_State *L, lua_Number d) { lua_Integer n; if (lua_numbertointeger(d, &n)) /* does 'd' fit in an integer? */ lua_pushinteger(L, n); /* result is integer */ else lua_pushnumber(L, d); /* result is float */ } static int math_floor (lua_State *L) { if (lua_isinteger(L, 1)) lua_settop(L, 1); /* integer is its own floor */ else { lua_Number d = l_mathop(floor)(luaL_checknumber(L, 1)); pushnumint(L, d); } return 1; } static int math_ceil (lua_State *L) { if (lua_isinteger(L, 1)) lua_settop(L, 1); /* integer is its own ceil */ else { lua_Number d = l_mathop(ceil)(luaL_checknumber(L, 1)); pushnumint(L, d); } return 1; } static int math_fmod (lua_State *L) { if (lua_isinteger(L, 1) && lua_isinteger(L, 2)) { lua_Integer d = lua_tointeger(L, 2); if ((lua_Unsigned)d + 1u <= 1u) { /* special cases: -1 or 0 */ luaL_argcheck(L, d != 0, 2, "zero"); lua_pushinteger(L, 0); /* avoid overflow with 0x80000... / -1 */ } else lua_pushinteger(L, lua_tointeger(L, 1) % d); } else lua_pushnumber(L, l_mathop(fmod)(luaL_checknumber(L, 1), luaL_checknumber(L, 2))); return 1; } /* ** next function does not use 'modf', avoiding problems with 'double*' ** (which is not compatible with 'float*') when lua_Number is not ** 'double'. */ static int math_modf (lua_State *L) { if (lua_isinteger(L ,1)) { lua_settop(L, 1); /* number is its own integer part */ lua_pushnumber(L, 0); /* no fractional part */ } else { lua_Number n = luaL_checknumber(L, 1); /* integer part (rounds toward zero) */ lua_Number ip = (n < 0) ? l_mathop(ceil)(n) : l_mathop(floor)(n); pushnumint(L, ip); /* fractional part (test needed for inf/-inf) */ lua_pushnumber(L, (n == ip) ? l_mathop(0.0) : (n - ip)); } return 2; } static int math_sqrt (lua_State *L) { lua_pushnumber(L, l_mathop(sqrt)(luaL_checknumber(L, 1))); return 1; } static int math_ult (lua_State *L) { lua_Integer a = luaL_checkinteger(L, 1); lua_Integer b = luaL_checkinteger(L, 2); lua_pushboolean(L, (lua_Unsigned)a < (lua_Unsigned)b); return 1; } static int math_log (lua_State *L) { lua_Number x = luaL_checknumber(L, 1); lua_Number res; if (lua_isnoneornil(L, 2)) res = l_mathop(log)(x); else { lua_Number base = luaL_checknumber(L, 2); #if !defined(LUA_USE_C89) if (base == 2.0) res = l_mathop(log2)(x); else #endif if (base == 10.0) res = l_mathop(log10)(x); else res = l_mathop(log)(x)/l_mathop(log)(base); } lua_pushnumber(L, res); return 1; } static int math_exp (lua_State *L) { lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1))); return 1; } static int math_deg (lua_State *L) { lua_pushnumber(L, luaL_checknumber(L, 1) * (l_mathop(180.0) / PI)); return 1; } static int math_rad (lua_State *L) { lua_pushnumber(L, luaL_checknumber(L, 1) * (PI / l_mathop(180.0))); return 1; } static int math_min (lua_State *L) { int n = lua_gettop(L); /* number of arguments */ int imin = 1; /* index of current minimum value */ int i; luaL_argcheck(L, n >= 1, 1, "value expected"); for (i = 2; i <= n; i++) { if (lua_compare(L, i, imin, LUA_OPLT)) imin = i; } lua_pushvalue(L, imin); return 1; } static int math_max (lua_State *L) { int n = lua_gettop(L); /* number of arguments */ int imax = 1; /* index of current maximum value */ int i; luaL_argcheck(L, n >= 1, 1, "value expected"); for (i = 2; i <= n; i++) { if (lua_compare(L, imax, i, LUA_OPLT)) imax = i; } lua_pushvalue(L, imax); return 1; } /* ** This function uses 'double' (instead of 'lua_Number') to ensure that ** all bits from 'l_rand' can be represented, and that 'RANDMAX + 1.0' ** will keep full precision (ensuring that 'r' is always less than 1.0.) */ static int math_random (lua_State *L) { lua_Integer low, up; double r = (double)l_rand() * (1.0 / ((double)L_RANDMAX + 1.0)); switch (lua_gettop(L)) { /* check number of arguments */ case 0: { /* no arguments */ lua_pushnumber(L, (lua_Number)r); /* Number between 0 and 1 */ return 1; } case 1: { /* only upper limit */ low = 1; up = luaL_checkinteger(L, 1); break; } case 2: { /* lower and upper limits */ low = luaL_checkinteger(L, 1); up = luaL_checkinteger(L, 2); break; } default: return luaL_error(L, "wrong number of arguments"); } /* random integer in the interval [low, up] */ luaL_argcheck(L, low <= up, 1, "interval is empty"); luaL_argcheck(L, low >= 0 || up <= LUA_MAXINTEGER + low, 1, "interval too large"); r *= (double)(up - low) + 1.0; lua_pushinteger(L, (lua_Integer)r + low); return 1; } static int math_randomseed (lua_State *L) { l_srand((unsigned int)(lua_Integer)luaL_checknumber(L, 1)); (void)l_rand(); /* discard first value to avoid undesirable correlations */ return 0; } static int math_type (lua_State *L) { if (lua_type(L, 1) == LUA_TNUMBER) { if (lua_isinteger(L, 1)) lua_pushliteral(L, "integer"); else lua_pushliteral(L, "float"); } else { luaL_checkany(L, 1); lua_pushnil(L); } return 1; } /* ** {================================================================== ** Deprecated functions (for compatibility only) ** =================================================================== */ #if defined(LUA_COMPAT_MATHLIB) static int math_cosh (lua_State *L) { lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1))); return 1; } static int math_sinh (lua_State *L) { lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1))); return 1; } static int math_tanh (lua_State *L) { lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1))); return 1; } static int math_pow (lua_State *L) { lua_Number x = luaL_checknumber(L, 1); lua_Number y = luaL_checknumber(L, 2); lua_pushnumber(L, l_mathop(pow)(x, y)); return 1; } static int math_frexp (lua_State *L) { int e; lua_pushnumber(L, l_mathop(frexp)(luaL_checknumber(L, 1), &e)); lua_pushinteger(L, e); return 2; } static int math_ldexp (lua_State *L) { lua_Number x = luaL_checknumber(L, 1); int ep = (int)luaL_checkinteger(L, 2); lua_pushnumber(L, l_mathop(ldexp)(x, ep)); return 1; } static int math_log10 (lua_State *L) { lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1))); return 1; } #endif /* }================================================================== */ static const luaL_Reg mathlib[] = { {"abs", math_abs}, {"acos", math_acos}, {"asin", math_asin}, {"atan", math_atan}, {"ceil", math_ceil}, {"cos", math_cos}, {"deg", math_deg}, {"exp", math_exp}, {"tointeger", math_toint}, {"floor", math_floor}, {"fmod", math_fmod}, {"ult", math_ult}, {"log", math_log}, {"max", math_max}, {"min", math_min}, {"modf", math_modf}, {"rad", math_rad}, {"random", math_random}, {"randomseed", math_randomseed}, {"sin", math_sin}, {"sqrt", math_sqrt}, {"tan", math_tan}, {"type", math_type}, #if defined(LUA_COMPAT_MATHLIB) {"atan2", math_atan}, {"cosh", math_cosh}, {"sinh", math_sinh}, {"tanh", math_tanh}, {"pow", math_pow}, {"frexp", math_frexp}, {"ldexp", math_ldexp}, {"log10", math_log10}, #endif /* placeholders */ {"pi", NULL}, {"huge", NULL}, {"maxinteger", NULL}, {"mininteger", NULL}, {NULL, NULL} }; /* ** Open math library */ LUAMOD_API int luaopen_math (lua_State *L) { luaL_newlib(L, mathlib); lua_pushnumber(L, PI); lua_setfield(L, -2, "pi"); lua_pushnumber(L, (lua_Number)HUGE_VAL); lua_setfield(L, -2, "huge"); lua_pushinteger(L, LUA_MAXINTEGER); lua_setfield(L, -2, "maxinteger"); lua_pushinteger(L, LUA_MININTEGER); lua_setfield(L, -2, "mininteger"); return 1; } wcc-0.0.2/src/wsh/lua/src/lcode.h0000644000175000017500000000616513110675433015151 0ustar philphil/* ** $Id: lcode.h,v 1.63 2013/12/30 20:47:58 roberto Exp $ ** Code generator for Lua ** See Copyright Notice in lua.h */ #ifndef lcode_h #define lcode_h #include "llex.h" #include "lobject.h" #include "lopcodes.h" #include "lparser.h" /* ** Marks the end of a patch list. It is an invalid value both as an absolute ** address, and as a list link (would link an element to itself). */ #define NO_JUMP (-1) /* ** grep "ORDER OPR" if you change these enums (ORDER OP) */ typedef enum BinOpr { OPR_ADD, OPR_SUB, OPR_MUL, OPR_MOD, OPR_POW, OPR_DIV, OPR_IDIV, OPR_BAND, OPR_BOR, OPR_BXOR, OPR_SHL, OPR_SHR, OPR_CONCAT, OPR_EQ, OPR_LT, OPR_LE, OPR_NE, OPR_GT, OPR_GE, OPR_AND, OPR_OR, OPR_NOBINOPR } BinOpr; typedef enum UnOpr { OPR_MINUS, OPR_BNOT, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr; #define getcode(fs,e) ((fs)->f->code[(e)->u.info]) #define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx) #define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET) #define luaK_jumpto(fs,t) luaK_patchlist(fs, luaK_jump(fs), t) LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx); LUAI_FUNC int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C); LUAI_FUNC int luaK_codek (FuncState *fs, int reg, int k); LUAI_FUNC void luaK_fixline (FuncState *fs, int line); LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n); LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n); LUAI_FUNC void luaK_checkstack (FuncState *fs, int n); LUAI_FUNC int luaK_stringK (FuncState *fs, TString *s); LUAI_FUNC int luaK_intK (FuncState *fs, lua_Integer n); LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e); LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e); LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key); LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k); LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_goiffalse (FuncState *fs, expdesc *e); LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e); LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults); LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e); LUAI_FUNC int luaK_jump (FuncState *fs); LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret); LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target); LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list); LUAI_FUNC void luaK_patchclose (FuncState *fs, int list, int level); LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2); LUAI_FUNC int luaK_getlabel (FuncState *fs); LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v, int line); LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v); LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2, int line); LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore); #endif wcc-0.0.2/src/wsh/lua/src/lauxlib.h0000644000175000017500000002036013110675433015514 0ustar philphil/* ** $Id: lauxlib.h,v 1.129 2015/11/23 11:29:43 roberto Exp $ ** Auxiliary functions for building Lua libraries ** See Copyright Notice in lua.h */ #ifndef lauxlib_h #define lauxlib_h #include #include #include "lua.h" /* extra error code for 'luaL_load' */ #define LUA_ERRFILE (LUA_ERRERR+1) typedef struct luaL_Reg { const char *name; lua_CFunction func; } luaL_Reg; #define LUAL_NUMSIZES (sizeof(lua_Integer)*16 + sizeof(lua_Number)) LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver, size_t sz); #define luaL_checkversion(L) \ luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES) LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e); LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e); LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len); LUALIB_API int (luaL_argerror) (lua_State *L, int arg, const char *extramsg); LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg, size_t *l); LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg, const char *def, size_t *l); LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int arg); LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int arg, lua_Number def); LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int arg); LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int arg, lua_Integer def); LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg); LUALIB_API void (luaL_checktype) (lua_State *L, int arg, int t); LUALIB_API void (luaL_checkany) (lua_State *L, int arg); LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname); LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname); LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname); LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname); LUALIB_API void (luaL_where) (lua_State *L, int lvl); LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...); LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def, const char *const lst[]); LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname); LUALIB_API int (luaL_execresult) (lua_State *L, int stat); /* predefined references */ #define LUA_NOREF (-2) #define LUA_REFNIL (-1) LUALIB_API int (luaL_ref) (lua_State *L, int t); LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref); LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename, const char *mode); #define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL) LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz, const char *name, const char *mode); LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s); LUALIB_API lua_State *(luaL_newstate) (void); LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx); LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p, const char *r); LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup); LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname); LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1, const char *msg, int level); LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname, lua_CFunction openf, int glb); /* ** =============================================================== ** some useful macros ** =============================================================== */ #define luaL_newlibtable(L,l) \ lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1) #define luaL_newlib(L,l) \ (luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0)) #define luaL_argcheck(L, cond,arg,extramsg) \ ((void)((cond) || luaL_argerror(L, (arg), (extramsg)))) #define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL)) #define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL)) #define luaL_typename(L,i) lua_typename(L, lua_type(L,(i))) #define luaL_dofile(L, fn) \ (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_dostring(L, s) \ (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0)) #define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n))) #define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) #define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL) /* ** {====================================================== ** Generic Buffer manipulation ** ======================================================= */ typedef struct luaL_Buffer { char *b; /* buffer address */ size_t size; /* buffer size */ size_t n; /* number of characters in buffer */ lua_State *L; char initb[LUAL_BUFFERSIZE]; /* initial buffer */ } luaL_Buffer; #define luaL_addchar(B,c) \ ((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \ ((B)->b[(B)->n++] = (c))) #define luaL_addsize(B,s) ((B)->n += (s)) LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B); LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz); LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l); LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s); LUALIB_API void (luaL_addvalue) (luaL_Buffer *B); LUALIB_API void (luaL_pushresult) (luaL_Buffer *B); LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz); LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz); #define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE) /* }====================================================== */ /* ** {====================================================== ** File handles for IO library ** ======================================================= */ /* ** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and ** initial structure 'luaL_Stream' (it may contain other fields ** after that initial structure). */ #define LUA_FILEHANDLE "FILE*" typedef struct luaL_Stream { FILE *f; /* stream (NULL for incompletely created streams) */ lua_CFunction closef; /* to close stream (NULL for closed streams) */ } luaL_Stream; /* }====================================================== */ /* compatibility with old module system */ #if defined(LUA_COMPAT_MODULE) LUALIB_API void (luaL_pushmodule) (lua_State *L, const char *modname, int sizehint); LUALIB_API void (luaL_openlib) (lua_State *L, const char *libname, const luaL_Reg *l, int nup); #define luaL_register(L,n,l) (luaL_openlib(L,(n),(l),0)) #endif /* ** {================================================================== ** "Abstraction Layer" for basic report of messages and errors ** =================================================================== */ /* print a string */ #if !defined(lua_writestring) #define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout) #endif /* print a newline and flush the output */ #if !defined(lua_writeline) #define lua_writeline() (lua_writestring("\n", 1), fflush(stdout)) #endif /* print an error message */ #if !defined(lua_writestringerror) #define lua_writestringerror(s,p) \ (fprintf(stderr, (s), (p)), fflush(stderr)) #endif /* }================================================================== */ /* ** {============================================================ ** Compatibility with deprecated conversions ** ============================================================= */ #if defined(LUA_COMPAT_APIINTCASTS) #define luaL_checkunsigned(L,a) ((lua_Unsigned)luaL_checkinteger(L,a)) #define luaL_optunsigned(L,a,d) \ ((lua_Unsigned)luaL_optinteger(L,a,(lua_Integer)(d))) #define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n))) #define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d))) #define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n))) #define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d))) #endif /* }============================================================ */ #endif wcc-0.0.2/src/wsh/lua/src/ltm.c0000644000175000017500000000777513110675433014662 0ustar philphil/* ** $Id: ltm.c,v 2.36 2015/11/03 15:47:30 roberto Exp $ ** Tag methods ** See Copyright Notice in lua.h */ #define ltm_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lobject.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" #include "lvm.h" static const char udatatypename[] = "userdata"; LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTAGS] = { "no value", "nil", "boolean", udatatypename, "number", "string", "table", "function", udatatypename, "thread", "proto" /* this last case is used for tests only */ }; void luaT_init (lua_State *L) { static const char *const luaT_eventname[] = { /* ORDER TM */ "__index", "__newindex", "__gc", "__mode", "__len", "__eq", "__add", "__sub", "__mul", "__mod", "__pow", "__div", "__idiv", "__band", "__bor", "__bxor", "__shl", "__shr", "__unm", "__bnot", "__lt", "__le", "__concat", "__call" }; int i; for (i=0; itmname[i] = luaS_new(L, luaT_eventname[i]); luaC_fix(L, obj2gco(G(L)->tmname[i])); /* never collect these names */ } } /* ** function to be used with macro "fasttm": optimized for absence of ** tag methods */ const TValue *luaT_gettm (Table *events, TMS event, TString *ename) { const TValue *tm = luaH_getshortstr(events, ename); lua_assert(event <= TM_EQ); if (ttisnil(tm)) { /* no tag method? */ events->flags |= cast_byte(1u<metatable; break; case LUA_TUSERDATA: mt = uvalue(o)->metatable; break; default: mt = G(L)->mt[ttnov(o)]; } return (mt ? luaH_getshortstr(mt, G(L)->tmname[event]) : luaO_nilobject); } void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1, const TValue *p2, TValue *p3, int hasres) { ptrdiff_t result = savestack(L, p3); StkId func = L->top; setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */ setobj2s(L, func + 1, p1); /* 1st argument */ setobj2s(L, func + 2, p2); /* 2nd argument */ L->top += 3; if (!hasres) /* no result? 'p3' is third argument */ setobj2s(L, L->top++, p3); /* 3rd argument */ /* metamethod may yield only when called from Lua code */ if (isLua(L->ci)) luaD_call(L, func, hasres); else luaD_callnoyield(L, func, hasres); if (hasres) { /* if has result, move it to its place */ p3 = restorestack(L, result); setobjs2s(L, p3, --L->top); } } int luaT_callbinTM (lua_State *L, const TValue *p1, const TValue *p2, StkId res, TMS event) { const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */ if (ttisnil(tm)) tm = luaT_gettmbyobj(L, p2, event); /* try second operand */ if (ttisnil(tm)) return 0; luaT_callTM(L, tm, p1, p2, res, 1); return 1; } void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2, StkId res, TMS event) { if (!luaT_callbinTM(L, p1, p2, res, event)) { switch (event) { case TM_CONCAT: luaG_concaterror(L, p1, p2); /* call never returns, but to avoid warnings: *//* FALLTHROUGH */ case TM_BAND: case TM_BOR: case TM_BXOR: case TM_SHL: case TM_SHR: case TM_BNOT: { lua_Number dummy; if (tonumber(p1, &dummy) && tonumber(p2, &dummy)) luaG_tointerror(L, p1, p2); else luaG_opinterror(L, p1, p2, "perform bitwise operation on"); } /* calls never return, but to avoid warnings: *//* FALLTHROUGH */ default: luaG_opinterror(L, p1, p2, "perform arithmetic on"); } } } int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2, TMS event) { if (!luaT_callbinTM(L, p1, p2, L->top, event)) return -1; /* no metamethod */ else return !l_isfalse(L->top); } wcc-0.0.2/src/wsh/lua/src/linit.c0000644000175000017500000000327213110675433015171 0ustar philphil/* ** $Id: linit.c,v 1.38 2015/01/05 13:48:33 roberto Exp $ ** Initialization of libraries for lua.c and other clients ** See Copyright Notice in lua.h */ #define linit_c #define LUA_LIB /* ** If you embed Lua in your program and need to open the standard ** libraries, call luaL_openlibs in your program. If you need a ** different set of libraries, copy this file to your project and edit ** it to suit your needs. ** ** You can also *preload* libraries, so that a later 'require' can ** open the library, which is already linked to the application. ** For that, do the following code: ** ** luaL_getsubtable(L, LUA_REGISTRYINDEX, "_PRELOAD"); ** lua_pushcfunction(L, luaopen_modname); ** lua_setfield(L, -2, modname); ** lua_pop(L, 1); // remove _PRELOAD table */ #include "lprefix.h" #include #include "lua.h" #include "lualib.h" #include "lauxlib.h" /* ** these libs are loaded by lua.c and are readily available to any Lua ** program */ static const luaL_Reg loadedlibs[] = { {"_G", luaopen_base}, {LUA_LOADLIBNAME, luaopen_package}, {LUA_COLIBNAME, luaopen_coroutine}, {LUA_TABLIBNAME, luaopen_table}, {LUA_IOLIBNAME, luaopen_io}, {LUA_OSLIBNAME, luaopen_os}, {LUA_STRLIBNAME, luaopen_string}, {LUA_MATHLIBNAME, luaopen_math}, {LUA_UTF8LIBNAME, luaopen_utf8}, {LUA_DBLIBNAME, luaopen_debug}, #if defined(LUA_COMPAT_BITLIB) {LUA_BITLIBNAME, luaopen_bit32}, #endif {NULL, NULL} }; LUALIB_API void luaL_openlibs (lua_State *L) { const luaL_Reg *lib; /* "require" functions from 'loadedlibs' and set results to global table */ for (lib = loadedlibs; lib->func; lib++) { luaL_requiref(L, lib->name, lib->func, 1); lua_pop(L, 1); /* remove lib */ } } wcc-0.0.2/src/wsh/lua/src/Makefile0000644000175000017500000001533213110675433015346 0ustar philphil# Makefile for building Lua # See ../doc/readme.html for installation and customization instructions. # == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT ======================= # Your platform. See PLATS for possible values. PLAT= none CC= gcc -std=gnu99 CFLAGS= -O2 -Wall -Wextra -DLUA_COMPAT_5_2 $(SYSCFLAGS) $(MYCFLAGS) LDFLAGS= $(SYSLDFLAGS) $(MYLDFLAGS) LIBS= -lm $(SYSLIBS) $(MYLIBS) AR= ar rcu RANLIB= ranlib RM= rm -f SYSCFLAGS= SYSLDFLAGS= SYSLIBS= MYCFLAGS= MYLDFLAGS= MYLIBS= MYOBJS= # == END OF USER SETTINGS -- NO NEED TO CHANGE ANYTHING BELOW THIS LINE ======= PLATS= aix bsd c89 freebsd generic linux macosx mingw posix solaris LUA_A= liblua.a CORE_O= lapi.o lcode.o lctype.o ldebug.o ldo.o ldump.o lfunc.o lgc.o llex.o \ lmem.o lobject.o lopcodes.o lparser.o lstate.o lstring.o ltable.o \ ltm.o lundump.o lvm.o lzio.o LIB_O= lauxlib.o lbaselib.o lbitlib.o lcorolib.o ldblib.o liolib.o \ lmathlib.o loslib.o lstrlib.o ltablib.o lutf8lib.o loadlib.o linit.o BASE_O= $(CORE_O) $(LIB_O) $(MYOBJS) LUA_T= lua LUA_O= lua.o LUAC_T= luac LUAC_O= luac.o ALL_O= $(BASE_O) $(LUA_O) $(LUAC_O) ALL_T= $(LUA_A) $(LUA_T) $(LUAC_T) ALL_A= $(LUA_A) # Targets start here. default: $(PLAT) all: $(ALL_T) o: $(ALL_O) a: $(ALL_A) $(LUA_A): $(BASE_O) $(AR) $@ $(BASE_O) $(RANLIB) $@ $(LUA_T): $(LUA_O) $(LUA_A) $(CC) -o $@ $(LDFLAGS) $(LUA_O) $(LUA_A) $(LIBS) $(LUAC_T): $(LUAC_O) $(LUA_A) $(CC) -o $@ $(LDFLAGS) $(LUAC_O) $(LUA_A) $(LIBS) clean: $(RM) $(ALL_T) $(ALL_O) depend: @$(CC) $(CFLAGS) -MM l*.c echo: @echo "PLAT= $(PLAT)" @echo "CC= $(CC)" @echo "CFLAGS= $(CFLAGS)" @echo "LDFLAGS= $(SYSLDFLAGS)" @echo "LIBS= $(LIBS)" @echo "AR= $(AR)" @echo "RANLIB= $(RANLIB)" @echo "RM= $(RM)" # Convenience targets for popular platforms ALL= all none: @echo "Please do 'make PLATFORM' where PLATFORM is one of these:" @echo " $(PLATS)" aix: $(MAKE) $(ALL) CC="xlc" CFLAGS="-O2 -DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-ldl" SYSLDFLAGS="-brtl -bexpall" bsd: $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-Wl,-E" c89: $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_C89" CC="gcc -std=c89" @echo '' @echo '*** C89 does not guarantee 64-bit integers for Lua.' @echo '' freebsd: $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -lreadline" generic: $(ALL) linux: $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -ldl -lreadline" macosx: $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_MACOSX" SYSLIBS="-lreadline" CC=cc mingw: $(MAKE) "LUA_A=lua53.dll" "LUA_T=lua.exe" \ "AR=$(CC) -shared -o" "RANLIB=strip --strip-unneeded" \ "SYSCFLAGS=-DLUA_BUILD_AS_DLL" "SYSLIBS=" "SYSLDFLAGS=-s" lua.exe $(MAKE) "LUAC_T=luac.exe" luac.exe posix: $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX" solaris: $(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN -D_REENTRANT" SYSLIBS="-ldl" # list targets that do not create files (but not all makes understand .PHONY) .PHONY: all $(PLATS) default o a clean depend echo none # DO NOT DELETE lapi.o: lapi.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lstring.h \ ltable.h lundump.h lvm.h lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h lbitlib.o: lbitlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h lcode.o: lcode.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \ llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \ ldo.h lgc.h lstring.h ltable.h lvm.h lcorolib.o: lcorolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h lctype.o: lctype.c lprefix.h lctype.h lua.h luaconf.h llimits.h ldblib.o: ldblib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h ldebug.o: ldebug.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h lcode.h llex.h lopcodes.h lparser.h \ ldebug.h ldo.h lfunc.h lstring.h lgc.h ltable.h lvm.h ldo.o: ldo.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \ lparser.h lstring.h ltable.h lundump.h lvm.h ldump.o: ldump.c lprefix.h lua.h luaconf.h lobject.h llimits.h lstate.h \ ltm.h lzio.h lmem.h lundump.h lfunc.o: lfunc.c lprefix.h lua.h luaconf.h lfunc.h lobject.h llimits.h \ lgc.h lstate.h ltm.h lzio.h lmem.h lgc.o: lgc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \ llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h linit.o: linit.c lprefix.h lua.h luaconf.h lualib.h lauxlib.h liolib.o: liolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llex.o: llex.c lprefix.h lua.h luaconf.h lctype.h llimits.h ldebug.h \ lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lgc.h llex.h lparser.h \ lstring.h ltable.h lmathlib.o: lmathlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h lmem.o: lmem.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h loadlib.o: loadlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h lobject.o: lobject.c lprefix.h lua.h luaconf.h lctype.h llimits.h \ ldebug.h lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h \ lvm.h lopcodes.o: lopcodes.c lprefix.h lopcodes.h llimits.h lua.h luaconf.h loslib.o: loslib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h lparser.o: lparser.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \ llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \ ldo.h lfunc.h lstring.h lgc.h ltable.h lstate.o: lstate.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \ lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h llex.h \ lstring.h ltable.h lstring.o: lstring.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \ lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h lstrlib.o: lstrlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h ltable.o: ltable.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \ llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h ltm.o: ltm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \ llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h ltable.h lvm.h lua.o: lua.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h luac.o: luac.c lprefix.h lua.h luaconf.h lauxlib.h lobject.h llimits.h \ lstate.h ltm.h lzio.h lmem.h lundump.h ldebug.h lopcodes.h lundump.o: lundump.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \ lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lstring.h lgc.h \ lundump.h lutf8lib.o: lutf8lib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h lvm.o: lvm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \ llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lopcodes.h lstring.h \ ltable.h lvm.h lzio.o: lzio.c lprefix.h lua.h luaconf.h llimits.h lmem.h lstate.h \ lobject.h ltm.h lzio.h # (end of Makefile) wcc-0.0.2/src/wsh/lua/src/ldebug.c0000644000175000017500000004544713110675433015326 0ustar philphil/* ** $Id: ldebug.c,v 2.117 2015/11/02 18:48:07 roberto Exp $ ** Debug Interface ** See Copyright Notice in lua.h */ #define ldebug_c #define LUA_CORE #include "lprefix.h" #include #include #include #include "lua.h" #include "lapi.h" #include "lcode.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lobject.h" #include "lopcodes.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" #include "lvm.h" #define noLuaClosure(f) ((f) == NULL || (f)->c.tt == LUA_TCCL) /* Active Lua function (given call info) */ #define ci_func(ci) (clLvalue((ci)->func)) static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name); static int currentpc (CallInfo *ci) { lua_assert(isLua(ci)); return pcRel(ci->u.l.savedpc, ci_func(ci)->p); } static int currentline (CallInfo *ci) { return getfuncline(ci_func(ci)->p, currentpc(ci)); } /* ** If function yielded, its 'func' can be in the 'extra' field. The ** next function restores 'func' to its correct value for debugging ** purposes. (It exchanges 'func' and 'extra'; so, when called again, ** after debugging, it also "re-restores" ** 'func' to its altered value. */ static void swapextra (lua_State *L) { if (L->status == LUA_YIELD) { CallInfo *ci = L->ci; /* get function that yielded */ StkId temp = ci->func; /* exchange its 'func' and 'extra' values */ ci->func = restorestack(L, ci->extra); ci->extra = savestack(L, temp); } } /* ** this function can be called asynchronous (e.g. during a signal) */ LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) { if (func == NULL || mask == 0) { /* turn off hooks? */ mask = 0; func = NULL; } if (isLua(L->ci)) L->oldpc = L->ci->u.l.savedpc; L->hook = func; L->basehookcount = count; resethookcount(L); L->hookmask = cast_byte(mask); } LUA_API lua_Hook lua_gethook (lua_State *L) { return L->hook; } LUA_API int lua_gethookmask (lua_State *L) { return L->hookmask; } LUA_API int lua_gethookcount (lua_State *L) { return L->basehookcount; } LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) { int status; CallInfo *ci; if (level < 0) return 0; /* invalid (negative) level */ lua_lock(L); for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous) level--; if (level == 0 && ci != &L->base_ci) { /* level found? */ status = 1; ar->i_ci = ci; } else status = 0; /* no such level */ lua_unlock(L); return status; } static const char *upvalname (Proto *p, int uv) { TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name); if (s == NULL) return "?"; else return getstr(s); } static const char *findvararg (CallInfo *ci, int n, StkId *pos) { int nparams = clLvalue(ci->func)->p->numparams; if (n >= cast_int(ci->u.l.base - ci->func) - nparams) return NULL; /* no such vararg */ else { *pos = ci->func + nparams + n; return "(*vararg)"; /* generic name for any vararg */ } } static const char *findlocal (lua_State *L, CallInfo *ci, int n, StkId *pos) { const char *name = NULL; StkId base; if (isLua(ci)) { if (n < 0) /* access to vararg values? */ return findvararg(ci, -n, pos); else { base = ci->u.l.base; name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci)); } } else base = ci->func + 1; if (name == NULL) { /* no 'standard' name? */ StkId limit = (ci == L->ci) ? L->top : ci->next->func; if (limit - base >= n && n > 0) /* is 'n' inside 'ci' stack? */ name = "(*temporary)"; /* generic name for any valid slot */ else return NULL; /* no name */ } *pos = base + (n - 1); return name; } LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) { const char *name; lua_lock(L); swapextra(L); if (ar == NULL) { /* information about non-active function? */ if (!isLfunction(L->top - 1)) /* not a Lua function? */ name = NULL; else /* consider live variables at function start (parameters) */ name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0); } else { /* active function; get information through 'ar' */ StkId pos = NULL; /* to avoid warnings */ name = findlocal(L, ar->i_ci, n, &pos); if (name) { setobj2s(L, L->top, pos); api_incr_top(L); } } swapextra(L); lua_unlock(L); return name; } LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { StkId pos = NULL; /* to avoid warnings */ const char *name; lua_lock(L); swapextra(L); name = findlocal(L, ar->i_ci, n, &pos); if (name) { setobjs2s(L, pos, L->top - 1); L->top--; /* pop value */ } swapextra(L); lua_unlock(L); return name; } static void funcinfo (lua_Debug *ar, Closure *cl) { if (noLuaClosure(cl)) { ar->source = "=[C]"; ar->linedefined = -1; ar->lastlinedefined = -1; ar->what = "C"; } else { Proto *p = cl->l.p; ar->source = p->source ? getstr(p->source) : "=?"; ar->linedefined = p->linedefined; ar->lastlinedefined = p->lastlinedefined; ar->what = (ar->linedefined == 0) ? "main" : "Lua"; } luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); } static void collectvalidlines (lua_State *L, Closure *f) { if (noLuaClosure(f)) { setnilvalue(L->top); api_incr_top(L); } else { int i; TValue v; int *lineinfo = f->l.p->lineinfo; Table *t = luaH_new(L); /* new table to store active lines */ sethvalue(L, L->top, t); /* push it on stack */ api_incr_top(L); setbvalue(&v, 1); /* boolean 'true' to be the value of all indices */ for (i = 0; i < f->l.p->sizelineinfo; i++) /* for all lines with code */ luaH_setint(L, t, lineinfo[i], &v); /* table[line] = true */ } } static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, Closure *f, CallInfo *ci) { int status = 1; for (; *what; what++) { switch (*what) { case 'S': { funcinfo(ar, f); break; } case 'l': { ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1; break; } case 'u': { ar->nups = (f == NULL) ? 0 : f->c.nupvalues; if (noLuaClosure(f)) { ar->isvararg = 1; ar->nparams = 0; } else { ar->isvararg = f->l.p->is_vararg; ar->nparams = f->l.p->numparams; } break; } case 't': { ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0; break; } case 'n': { /* calling function is a known Lua function? */ if (ci && !(ci->callstatus & CIST_TAIL) && isLua(ci->previous)) ar->namewhat = getfuncname(L, ci->previous, &ar->name); else ar->namewhat = NULL; if (ar->namewhat == NULL) { ar->namewhat = ""; /* not found */ ar->name = NULL; } break; } case 'L': case 'f': /* handled by lua_getinfo */ break; default: status = 0; /* invalid option */ } } return status; } LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { int status; Closure *cl; CallInfo *ci; StkId func; lua_lock(L); swapextra(L); if (*what == '>') { ci = NULL; func = L->top - 1; api_check(L, ttisfunction(func), "function expected"); what++; /* skip the '>' */ L->top--; /* pop function */ } else { ci = ar->i_ci; func = ci->func; lua_assert(ttisfunction(ci->func)); } cl = ttisclosure(func) ? clvalue(func) : NULL; status = auxgetinfo(L, what, ar, cl, ci); if (strchr(what, 'f')) { setobjs2s(L, L->top, func); api_incr_top(L); } swapextra(L); /* correct before option 'L', which can raise a mem. error */ if (strchr(what, 'L')) collectvalidlines(L, cl); lua_unlock(L); return status; } /* ** {====================================================== ** Symbolic Execution ** ======================================================= */ static const char *getobjname (Proto *p, int lastpc, int reg, const char **name); /* ** find a "name" for the RK value 'c' */ static void kname (Proto *p, int pc, int c, const char **name) { if (ISK(c)) { /* is 'c' a constant? */ TValue *kvalue = &p->k[INDEXK(c)]; if (ttisstring(kvalue)) { /* literal constant? */ *name = svalue(kvalue); /* it is its own name */ return; } /* else no reasonable name found */ } else { /* 'c' is a register */ const char *what = getobjname(p, pc, c, name); /* search for 'c' */ if (what && *what == 'c') { /* found a constant name? */ return; /* 'name' already filled */ } /* else no reasonable name found */ } *name = "?"; /* no reasonable name found */ } static int filterpc (int pc, int jmptarget) { if (pc < jmptarget) /* is code conditional (inside a jump)? */ return -1; /* cannot know who sets that register */ else return pc; /* current position sets that register */ } /* ** try to find last instruction before 'lastpc' that modified register 'reg' */ static int findsetreg (Proto *p, int lastpc, int reg) { int pc; int setreg = -1; /* keep last instruction that changed 'reg' */ int jmptarget = 0; /* any code before this address is conditional */ for (pc = 0; pc < lastpc; pc++) { Instruction i = p->code[pc]; OpCode op = GET_OPCODE(i); int a = GETARG_A(i); switch (op) { case OP_LOADNIL: { int b = GETARG_B(i); if (a <= reg && reg <= a + b) /* set registers from 'a' to 'a+b' */ setreg = filterpc(pc, jmptarget); break; } case OP_TFORCALL: { if (reg >= a + 2) /* affect all regs above its base */ setreg = filterpc(pc, jmptarget); break; } case OP_CALL: case OP_TAILCALL: { if (reg >= a) /* affect all registers above base */ setreg = filterpc(pc, jmptarget); break; } case OP_JMP: { int b = GETARG_sBx(i); int dest = pc + 1 + b; /* jump is forward and do not skip 'lastpc'? */ if (pc < dest && dest <= lastpc) { if (dest > jmptarget) jmptarget = dest; /* update 'jmptarget' */ } break; } default: if (testAMode(op) && reg == a) /* any instruction that set A */ setreg = filterpc(pc, jmptarget); break; } } return setreg; } static const char *getobjname (Proto *p, int lastpc, int reg, const char **name) { int pc; *name = luaF_getlocalname(p, reg + 1, lastpc); if (*name) /* is a local? */ return "local"; /* else try symbolic execution */ pc = findsetreg(p, lastpc, reg); if (pc != -1) { /* could find instruction? */ Instruction i = p->code[pc]; OpCode op = GET_OPCODE(i); switch (op) { case OP_MOVE: { int b = GETARG_B(i); /* move from 'b' to 'a' */ if (b < GETARG_A(i)) return getobjname(p, pc, b, name); /* get name for 'b' */ break; } case OP_GETTABUP: case OP_GETTABLE: { int k = GETARG_C(i); /* key index */ int t = GETARG_B(i); /* table index */ const char *vn = (op == OP_GETTABLE) /* name of indexed variable */ ? luaF_getlocalname(p, t + 1, pc) : upvalname(p, t); kname(p, pc, k, name); return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field"; } case OP_GETUPVAL: { *name = upvalname(p, GETARG_B(i)); return "upvalue"; } case OP_LOADK: case OP_LOADKX: { int b = (op == OP_LOADK) ? GETARG_Bx(i) : GETARG_Ax(p->code[pc + 1]); if (ttisstring(&p->k[b])) { *name = svalue(&p->k[b]); return "constant"; } break; } case OP_SELF: { int k = GETARG_C(i); /* key index */ kname(p, pc, k, name); return "method"; } default: break; /* go through to return NULL */ } } return NULL; /* could not find reasonable name */ } static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) { TMS tm = (TMS)0; /* to avoid warnings */ Proto *p = ci_func(ci)->p; /* calling function */ int pc = currentpc(ci); /* calling instruction index */ Instruction i = p->code[pc]; /* calling instruction */ if (ci->callstatus & CIST_HOOKED) { /* was it called inside a hook? */ *name = "?"; return "hook"; } switch (GET_OPCODE(i)) { case OP_CALL: case OP_TAILCALL: /* get function name */ return getobjname(p, pc, GETARG_A(i), name); case OP_TFORCALL: { /* for iterator */ *name = "for iterator"; return "for iterator"; } /* all other instructions can call only through metamethods */ case OP_SELF: case OP_GETTABUP: case OP_GETTABLE: tm = TM_INDEX; break; case OP_SETTABUP: case OP_SETTABLE: tm = TM_NEWINDEX; break; case OP_ADD: case OP_SUB: case OP_MUL: case OP_MOD: case OP_POW: case OP_DIV: case OP_IDIV: case OP_BAND: case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR: { int offset = cast_int(GET_OPCODE(i)) - cast_int(OP_ADD); /* ORDER OP */ tm = cast(TMS, offset + cast_int(TM_ADD)); /* ORDER TM */ break; } case OP_UNM: tm = TM_UNM; break; case OP_BNOT: tm = TM_BNOT; break; case OP_LEN: tm = TM_LEN; break; case OP_CONCAT: tm = TM_CONCAT; break; case OP_EQ: tm = TM_EQ; break; case OP_LT: tm = TM_LT; break; case OP_LE: tm = TM_LE; break; default: lua_assert(0); /* other instructions cannot call a function */ } *name = getstr(G(L)->tmname[tm]); return "metamethod"; } /* }====================================================== */ /* ** The subtraction of two potentially unrelated pointers is ** not ISO C, but it should not crash a program; the subsequent ** checks are ISO C and ensure a correct result. */ static int isinstack (CallInfo *ci, const TValue *o) { ptrdiff_t i = o - ci->u.l.base; return (0 <= i && i < (ci->top - ci->u.l.base) && ci->u.l.base + i == o); } /* ** Checks whether value 'o' came from an upvalue. (That can only happen ** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on ** upvalues.) */ static const char *getupvalname (CallInfo *ci, const TValue *o, const char **name) { LClosure *c = ci_func(ci); int i; for (i = 0; i < c->nupvalues; i++) { if (c->upvals[i]->v == o) { *name = upvalname(c->p, i); return "upvalue"; } } return NULL; } static const char *varinfo (lua_State *L, const TValue *o) { const char *name = NULL; /* to avoid warnings */ CallInfo *ci = L->ci; const char *kind = NULL; if (isLua(ci)) { kind = getupvalname(ci, o, &name); /* check whether 'o' is an upvalue */ if (!kind && isinstack(ci, o)) /* no? try a register */ kind = getobjname(ci_func(ci)->p, currentpc(ci), cast_int(o - ci->u.l.base), &name); } return (kind) ? luaO_pushfstring(L, " (%s '%s')", kind, name) : ""; } l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) { const char *t = objtypename(o); luaG_runerror(L, "attempt to %s a %s value%s", op, t, varinfo(L, o)); } l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) { if (ttisstring(p1) || cvt2str(p1)) p1 = p2; luaG_typeerror(L, p1, "concatenate"); } l_noret luaG_opinterror (lua_State *L, const TValue *p1, const TValue *p2, const char *msg) { lua_Number temp; if (!tonumber(p1, &temp)) /* first operand is wrong? */ p2 = p1; /* now second is wrong */ luaG_typeerror(L, p2, msg); } /* ** Error when both values are convertible to numbers, but not to integers */ l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) { lua_Integer temp; if (!tointeger(p1, &temp)) p2 = p1; luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2)); } l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) { const char *t1 = objtypename(p1); const char *t2 = objtypename(p2); if (t1 == t2) luaG_runerror(L, "attempt to compare two %s values", t1); else luaG_runerror(L, "attempt to compare %s with %s", t1, t2); } /* add src:line information to 'msg' */ const char *luaG_addinfo (lua_State *L, const char *msg, TString *src, int line) { char buff[LUA_IDSIZE]; if (src) luaO_chunkid(buff, getstr(src), LUA_IDSIZE); else { /* no source available; use "?" instead */ buff[0] = '?'; buff[1] = '\0'; } return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); } l_noret luaG_errormsg (lua_State *L) { if (L->errfunc != 0) { /* is there an error handling function? */ StkId errfunc = restorestack(L, L->errfunc); setobjs2s(L, L->top, L->top - 1); /* move argument */ setobjs2s(L, L->top - 1, errfunc); /* push function */ L->top++; /* assume EXTRA_STACK */ luaD_callnoyield(L, L->top - 2, 1); /* call it */ } luaD_throw(L, LUA_ERRRUN); } l_noret luaG_runerror (lua_State *L, const char *fmt, ...) { CallInfo *ci = L->ci; const char *msg; va_list argp; va_start(argp, fmt); msg = luaO_pushvfstring(L, fmt, argp); /* format message */ va_end(argp); if (isLua(ci)) /* if Lua function, add source:line information */ luaG_addinfo(L, msg, ci_func(ci)->p->source, currentline(ci)); luaG_errormsg(L); } void luaG_traceexec (lua_State *L) { CallInfo *ci = L->ci; lu_byte mask = L->hookmask; int counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT)); if (counthook) resethookcount(L); /* reset count */ else if (!(mask & LUA_MASKLINE)) return; /* no line hook and count != 0; nothing to be done */ if (ci->callstatus & CIST_HOOKYIELD) { /* called hook last time? */ ci->callstatus &= ~CIST_HOOKYIELD; /* erase mark */ return; /* do not call hook again (VM yielded, so it did not move) */ } if (counthook) luaD_hook(L, LUA_HOOKCOUNT, -1); /* call count hook */ if (mask & LUA_MASKLINE) { Proto *p = ci_func(ci)->p; int npc = pcRel(ci->u.l.savedpc, p); int newline = getfuncline(p, npc); if (npc == 0 || /* call linehook when enter a new function, */ ci->u.l.savedpc <= L->oldpc || /* when jump back (loop), or when */ newline != getfuncline(p, pcRel(L->oldpc, p))) /* enter a new line */ luaD_hook(L, LUA_HOOKLINE, newline); /* call line hook */ } L->oldpc = ci->u.l.savedpc; if (L->status == LUA_YIELD) { /* did hook yield? */ if (counthook) L->hookcount = 1; /* undo decrement to zero */ ci->u.l.savedpc--; /* undo increment (resume will increment it again) */ ci->callstatus |= CIST_HOOKYIELD; /* mark that it yielded */ ci->func = L->top - 1; /* protect stack below results */ luaD_throw(L, LUA_YIELD); } } wcc-0.0.2/src/wsh/lua/src/lualib.h0000644000175000017500000000222513110675433015324 0ustar philphil/* ** $Id: lualib.h,v 1.44 2014/02/06 17:32:33 roberto Exp $ ** Lua standard libraries ** See Copyright Notice in lua.h */ #ifndef lualib_h #define lualib_h #include "lua.h" LUAMOD_API int (luaopen_base) (lua_State *L); #define LUA_COLIBNAME "coroutine" LUAMOD_API int (luaopen_coroutine) (lua_State *L); #define LUA_TABLIBNAME "table" LUAMOD_API int (luaopen_table) (lua_State *L); #define LUA_IOLIBNAME "io" LUAMOD_API int (luaopen_io) (lua_State *L); #define LUA_OSLIBNAME "os" LUAMOD_API int (luaopen_os) (lua_State *L); #define LUA_STRLIBNAME "string" LUAMOD_API int (luaopen_string) (lua_State *L); #define LUA_UTF8LIBNAME "utf8" LUAMOD_API int (luaopen_utf8) (lua_State *L); #define LUA_BITLIBNAME "bit32" LUAMOD_API int (luaopen_bit32) (lua_State *L); #define LUA_MATHLIBNAME "math" LUAMOD_API int (luaopen_math) (lua_State *L); #define LUA_DBLIBNAME "debug" LUAMOD_API int (luaopen_debug) (lua_State *L); #define LUA_LOADLIBNAME "package" LUAMOD_API int (luaopen_package) (lua_State *L); /* open all previous libraries */ LUALIB_API void (luaL_openlibs) (lua_State *L); #if !defined(lua_assert) #define lua_assert(x) ((void)0) #endif #endif wcc-0.0.2/src/wsh/lua/src/lfunc.c0000644000175000017500000000715313110675433015163 0ustar philphil/* ** $Id: lfunc.c,v 2.45 2014/11/02 19:19:04 roberto Exp $ ** Auxiliary functions to manipulate prototypes and closures ** See Copyright Notice in lua.h */ #define lfunc_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "lfunc.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" CClosure *luaF_newCclosure (lua_State *L, int n) { GCObject *o = luaC_newobj(L, LUA_TCCL, sizeCclosure(n)); CClosure *c = gco2ccl(o); c->nupvalues = cast_byte(n); return c; } LClosure *luaF_newLclosure (lua_State *L, int n) { GCObject *o = luaC_newobj(L, LUA_TLCL, sizeLclosure(n)); LClosure *c = gco2lcl(o); c->p = NULL; c->nupvalues = cast_byte(n); while (n--) c->upvals[n] = NULL; return c; } /* ** fill a closure with new closed upvalues */ void luaF_initupvals (lua_State *L, LClosure *cl) { int i; for (i = 0; i < cl->nupvalues; i++) { UpVal *uv = luaM_new(L, UpVal); uv->refcount = 1; uv->v = &uv->u.value; /* make it closed */ setnilvalue(uv->v); cl->upvals[i] = uv; } } UpVal *luaF_findupval (lua_State *L, StkId level) { UpVal **pp = &L->openupval; UpVal *p; UpVal *uv; lua_assert(isintwups(L) || L->openupval == NULL); while (*pp != NULL && (p = *pp)->v >= level) { lua_assert(upisopen(p)); if (p->v == level) /* found a corresponding upvalue? */ return p; /* return it */ pp = &p->u.open.next; } /* not found: create a new upvalue */ uv = luaM_new(L, UpVal); uv->refcount = 0; uv->u.open.next = *pp; /* link it to list of open upvalues */ uv->u.open.touched = 1; *pp = uv; uv->v = level; /* current value lives in the stack */ if (!isintwups(L)) { /* thread not in list of threads with upvalues? */ L->twups = G(L)->twups; /* link it to the list */ G(L)->twups = L; } return uv; } void luaF_close (lua_State *L, StkId level) { UpVal *uv; while (L->openupval != NULL && (uv = L->openupval)->v >= level) { lua_assert(upisopen(uv)); L->openupval = uv->u.open.next; /* remove from 'open' list */ if (uv->refcount == 0) /* no references? */ luaM_free(L, uv); /* free upvalue */ else { setobj(L, &uv->u.value, uv->v); /* move value to upvalue slot */ uv->v = &uv->u.value; /* now current value lives here */ luaC_upvalbarrier(L, uv); } } } Proto *luaF_newproto (lua_State *L) { GCObject *o = luaC_newobj(L, LUA_TPROTO, sizeof(Proto)); Proto *f = gco2p(o); f->k = NULL; f->sizek = 0; f->p = NULL; f->sizep = 0; f->code = NULL; f->cache = NULL; f->sizecode = 0; f->lineinfo = NULL; f->sizelineinfo = 0; f->upvalues = NULL; f->sizeupvalues = 0; f->numparams = 0; f->is_vararg = 0; f->maxstacksize = 0; f->locvars = NULL; f->sizelocvars = 0; f->linedefined = 0; f->lastlinedefined = 0; f->source = NULL; return f; } void luaF_freeproto (lua_State *L, Proto *f) { luaM_freearray(L, f->code, f->sizecode); luaM_freearray(L, f->p, f->sizep); luaM_freearray(L, f->k, f->sizek); luaM_freearray(L, f->lineinfo, f->sizelineinfo); luaM_freearray(L, f->locvars, f->sizelocvars); luaM_freearray(L, f->upvalues, f->sizeupvalues); luaM_free(L, f); } /* ** Look for n-th local variable at line 'line' in function 'func'. ** Returns NULL if not found. */ const char *luaF_getlocalname (const Proto *f, int local_number, int pc) { int i; for (i = 0; isizelocvars && f->locvars[i].startpc <= pc; i++) { if (pc < f->locvars[i].endpc) { /* is variable active? */ local_number--; if (local_number == 0) return getstr(f->locvars[i].varname); } } return NULL; /* not found */ } wcc-0.0.2/src/wsh/lua/src/lgc.h0000644000175000017500000001116413110675433014623 0ustar philphil/* ** $Id: lgc.h,v 2.90 2015/10/21 18:15:15 roberto Exp $ ** Garbage Collector ** See Copyright Notice in lua.h */ #ifndef lgc_h #define lgc_h #include "lobject.h" #include "lstate.h" /* ** Collectable objects may have one of three colors: white, which ** means the object is not marked; gray, which means the ** object is marked, but its references may be not marked; and ** black, which means that the object and all its references are marked. ** The main invariant of the garbage collector, while marking objects, ** is that a black object can never point to a white one. Moreover, ** any gray object must be in a "gray list" (gray, grayagain, weak, ** allweak, ephemeron) so that it can be visited again before finishing ** the collection cycle. These lists have no meaning when the invariant ** is not being enforced (e.g., sweep phase). */ /* how much to allocate before next GC step */ #if !defined(GCSTEPSIZE) /* ~100 small strings */ #define GCSTEPSIZE (cast_int(100 * sizeof(TString))) #endif /* ** Possible states of the Garbage Collector */ #define GCSpropagate 0 #define GCSatomic 1 #define GCSswpallgc 2 #define GCSswpfinobj 3 #define GCSswptobefnz 4 #define GCSswpend 5 #define GCScallfin 6 #define GCSpause 7 #define issweepphase(g) \ (GCSswpallgc <= (g)->gcstate && (g)->gcstate <= GCSswpend) /* ** macro to tell when main invariant (white objects cannot point to black ** ones) must be kept. During a collection, the sweep ** phase may break the invariant, as objects turned white may point to ** still-black objects. The invariant is restored when sweep ends and ** all objects are white again. */ #define keepinvariant(g) ((g)->gcstate <= GCSatomic) /* ** some useful bit tricks */ #define resetbits(x,m) ((x) &= cast(lu_byte, ~(m))) #define setbits(x,m) ((x) |= (m)) #define testbits(x,m) ((x) & (m)) #define bitmask(b) (1<<(b)) #define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2)) #define l_setbit(x,b) setbits(x, bitmask(b)) #define resetbit(x,b) resetbits(x, bitmask(b)) #define testbit(x,b) testbits(x, bitmask(b)) /* Layout for bit use in 'marked' field: */ #define WHITE0BIT 0 /* object is white (type 0) */ #define WHITE1BIT 1 /* object is white (type 1) */ #define BLACKBIT 2 /* object is black */ #define FINALIZEDBIT 3 /* object has been marked for finalization */ /* bit 7 is currently used by tests (luaL_checkmemory) */ #define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT) #define iswhite(x) testbits((x)->marked, WHITEBITS) #define isblack(x) testbit((x)->marked, BLACKBIT) #define isgray(x) /* neither white nor black */ \ (!testbits((x)->marked, WHITEBITS | bitmask(BLACKBIT))) #define tofinalize(x) testbit((x)->marked, FINALIZEDBIT) #define otherwhite(g) ((g)->currentwhite ^ WHITEBITS) #define isdeadm(ow,m) (!(((m) ^ WHITEBITS) & (ow))) #define isdead(g,v) isdeadm(otherwhite(g), (v)->marked) #define changewhite(x) ((x)->marked ^= WHITEBITS) #define gray2black(x) l_setbit((x)->marked, BLACKBIT) #define luaC_white(g) cast(lu_byte, (g)->currentwhite & WHITEBITS) /* ** Does one step of collection when debt becomes positive. 'pre'/'pos' ** allows some adjustments to be done only when needed. macro ** 'condchangemem' is used only for heavy tests (forcing a full ** GC cycle on every opportunity) */ #define luaC_condGC(L,pre,pos) \ { if (G(L)->GCdebt > 0) { pre; luaC_step(L); pos;}; \ condchangemem(L,pre,pos); } /* more often than not, 'pre'/'pos' are empty */ #define luaC_checkGC(L) luaC_condGC(L,,) #define luaC_barrier(L,p,v) ( \ (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \ luaC_barrier_(L,obj2gco(p),gcvalue(v)) : cast_void(0)) #define luaC_barrierback(L,p,v) ( \ (iscollectable(v) && isblack(p) && iswhite(gcvalue(v))) ? \ luaC_barrierback_(L,p) : cast_void(0)) #define luaC_objbarrier(L,p,o) ( \ (isblack(p) && iswhite(o)) ? \ luaC_barrier_(L,obj2gco(p),obj2gco(o)) : cast_void(0)) #define luaC_upvalbarrier(L,uv) ( \ (iscollectable((uv)->v) && !upisopen(uv)) ? \ luaC_upvalbarrier_(L,uv) : cast_void(0)) LUAI_FUNC void luaC_fix (lua_State *L, GCObject *o); LUAI_FUNC void luaC_freeallobjects (lua_State *L); LUAI_FUNC void luaC_step (lua_State *L); LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask); LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency); LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz); LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v); LUAI_FUNC void luaC_barrierback_ (lua_State *L, Table *o); LUAI_FUNC void luaC_upvalbarrier_ (lua_State *L, UpVal *uv); LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt); LUAI_FUNC void luaC_upvdeccount (lua_State *L, UpVal *uv); #endif wcc-0.0.2/src/wsh/lua/src/lvm.c0000644000175000017500000012526213110675433014654 0ustar philphil/* ** $Id: lvm.c,v 2.265 2015/11/23 11:30:45 roberto Exp $ ** Lua virtual machine ** See Copyright Notice in lua.h */ #define lvm_c #define LUA_CORE #include "lprefix.h" #include #include #include #include #include #include #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" #include "lobject.h" #include "lopcodes.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" #include "lvm.h" /* limit for table tag-method chains (to avoid loops) */ #define MAXTAGLOOP 2000 /* ** 'l_intfitsf' checks whether a given integer can be converted to a ** float without rounding. Used in comparisons. Left undefined if ** all integers fit in a float precisely. */ #if !defined(l_intfitsf) /* number of bits in the mantissa of a float */ #define NBM (l_mathlim(MANT_DIG)) /* ** Check whether some integers may not fit in a float, that is, whether ** (maxinteger >> NBM) > 0 (that implies (1 << NBM) <= maxinteger). ** (The shifts are done in parts to avoid shifting by more than the size ** of an integer. In a worst case, NBM == 113 for long double and ** sizeof(integer) == 32.) */ #if ((((LUA_MAXINTEGER >> (NBM / 4)) >> (NBM / 4)) >> (NBM / 4)) \ >> (NBM - (3 * (NBM / 4)))) > 0 #define l_intfitsf(i) \ (-((lua_Integer)1 << NBM) <= (i) && (i) <= ((lua_Integer)1 << NBM)) #endif #endif /* ** Try to convert a value to a float. The float case is already handled ** by the macro 'tonumber'. */ int luaV_tonumber_ (const TValue *obj, lua_Number *n) { TValue v; if (ttisinteger(obj)) { *n = cast_num(ivalue(obj)); return 1; } else if (cvt2num(obj) && /* string convertible to number? */ luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) { *n = nvalue(&v); /* convert result of 'luaO_str2num' to a float */ return 1; } else return 0; /* conversion failed */ } /* ** try to convert a value to an integer, rounding according to 'mode': ** mode == 0: accepts only integral values ** mode == 1: takes the floor of the number ** mode == 2: takes the ceil of the number */ int luaV_tointeger (const TValue *obj, lua_Integer *p, int mode) { TValue v; again: if (ttisfloat(obj)) { lua_Number n = fltvalue(obj); lua_Number f = l_floor(n); if (n != f) { /* not an integral value? */ if (mode == 0) return 0; /* fails if mode demands integral value */ else if (mode > 1) /* needs ceil? */ f += 1; /* convert floor to ceil (remember: n != f) */ } return lua_numbertointeger(f, p); } else if (ttisinteger(obj)) { *p = ivalue(obj); return 1; } else if (cvt2num(obj) && luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) { obj = &v; goto again; /* convert result from 'luaO_str2num' to an integer */ } return 0; /* conversion failed */ } /* ** Try to convert a 'for' limit to an integer, preserving the ** semantics of the loop. ** (The following explanation assumes a non-negative step; it is valid ** for negative steps mutatis mutandis.) ** If the limit can be converted to an integer, rounding down, that is ** it. ** Otherwise, check whether the limit can be converted to a number. If ** the number is too large, it is OK to set the limit as LUA_MAXINTEGER, ** which means no limit. If the number is too negative, the loop ** should not run, because any initial integer value is larger than the ** limit. So, it sets the limit to LUA_MININTEGER. 'stopnow' corrects ** the extreme case when the initial value is LUA_MININTEGER, in which ** case the LUA_MININTEGER limit would still run the loop once. */ static int forlimit (const TValue *obj, lua_Integer *p, lua_Integer step, int *stopnow) { *stopnow = 0; /* usually, let loops run */ if (!luaV_tointeger(obj, p, (step < 0 ? 2 : 1))) { /* not fit in integer? */ lua_Number n; /* try to convert to float */ if (!tonumber(obj, &n)) /* cannot convert to float? */ return 0; /* not a number */ if (luai_numlt(0, n)) { /* if true, float is larger than max integer */ *p = LUA_MAXINTEGER; if (step < 0) *stopnow = 1; } else { /* float is smaller than min integer */ *p = LUA_MININTEGER; if (step >= 0) *stopnow = 1; } } return 1; } /* ** Complete a table access: if 't' is a table, 'tm' has its metamethod; ** otherwise, 'tm' is NULL. */ void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val, const TValue *tm) { int loop; /* counter to avoid infinite loops */ lua_assert(tm != NULL || !ttistable(t)); for (loop = 0; loop < MAXTAGLOOP; loop++) { if (tm == NULL) { /* no metamethod (from a table)? */ if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_INDEX))) luaG_typeerror(L, t, "index"); /* no metamethod */ } if (ttisfunction(tm)) { /* metamethod is a function */ luaT_callTM(L, tm, t, key, val, 1); /* call it */ return; } t = tm; /* else repeat access over 'tm' */ if (luaV_fastget(L,t,key,tm,luaH_get)) { /* try fast track */ setobj2s(L, val, tm); /* done */ return; } /* else repeat */ } luaG_runerror(L, "gettable chain too long; possible loop"); } /* ** Main function for table assignment (invoking metamethods if needed). ** Compute 't[key] = val' */ void luaV_finishset (lua_State *L, const TValue *t, TValue *key, StkId val, const TValue *oldval) { int loop; /* counter to avoid infinite loops */ for (loop = 0; loop < MAXTAGLOOP; loop++) { const TValue *tm; if (oldval != NULL) { lua_assert(ttistable(t) && ttisnil(oldval)); /* must check the metamethod */ if ((tm = fasttm(L, hvalue(t)->metatable, TM_NEWINDEX)) == NULL && /* no metamethod; is there a previous entry in the table? */ (oldval != luaO_nilobject || /* no previous entry; must create one. (The next test is always true; we only need the assignment.) */ (oldval = luaH_newkey(L, hvalue(t), key), 1))) { /* no metamethod and (now) there is an entry with given key */ setobj2t(L, cast(TValue *, oldval), val); invalidateTMcache(hvalue(t)); luaC_barrierback(L, hvalue(t), val); return; } /* else will try the metamethod */ } else { /* not a table; check metamethod */ if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX))) luaG_typeerror(L, t, "index"); } /* try the metamethod */ if (ttisfunction(tm)) { luaT_callTM(L, tm, t, key, val, 0); return; } t = tm; /* else repeat assignment over 'tm' */ if (luaV_fastset(L, t, key, oldval, luaH_get, val)) return; /* done */ /* else loop */ } luaG_runerror(L, "settable chain too long; possible loop"); } /* ** Compare two strings 'ls' x 'rs', returning an integer smaller-equal- ** -larger than zero if 'ls' is smaller-equal-larger than 'rs'. ** The code is a little tricky because it allows '\0' in the strings ** and it uses 'strcoll' (to respect locales) for each segments ** of the strings. */ static int l_strcmp (const TString *ls, const TString *rs) { const char *l = getstr(ls); size_t ll = tsslen(ls); const char *r = getstr(rs); size_t lr = tsslen(rs); for (;;) { /* for each segment */ int temp = strcoll(l, r); if (temp != 0) /* not equal? */ return temp; /* done */ else { /* strings are equal up to a '\0' */ size_t len = strlen(l); /* index of first '\0' in both strings */ if (len == lr) /* 'rs' is finished? */ return (len == ll) ? 0 : 1; /* check 'ls' */ else if (len == ll) /* 'ls' is finished? */ return -1; /* 'ls' is smaller than 'rs' ('rs' is not finished) */ /* both strings longer than 'len'; go on comparing after the '\0' */ len++; l += len; ll -= len; r += len; lr -= len; } } } /* ** Check whether integer 'i' is less than float 'f'. If 'i' has an ** exact representation as a float ('l_intfitsf'), compare numbers as ** floats. Otherwise, if 'f' is outside the range for integers, result ** is trivial. Otherwise, compare them as integers. (When 'i' has no ** float representation, either 'f' is "far away" from 'i' or 'f' has ** no precision left for a fractional part; either way, how 'f' is ** truncated is irrelevant.) When 'f' is NaN, comparisons must result ** in false. */ static int LTintfloat (lua_Integer i, lua_Number f) { #if defined(l_intfitsf) if (!l_intfitsf(i)) { if (f >= -cast_num(LUA_MININTEGER)) /* -minint == maxint + 1 */ return 1; /* f >= maxint + 1 > i */ else if (f > cast_num(LUA_MININTEGER)) /* minint < f <= maxint ? */ return (i < cast(lua_Integer, f)); /* compare them as integers */ else /* f <= minint <= i (or 'f' is NaN) --> not(i < f) */ return 0; } #endif return luai_numlt(cast_num(i), f); /* compare them as floats */ } /* ** Check whether integer 'i' is less than or equal to float 'f'. ** See comments on previous function. */ static int LEintfloat (lua_Integer i, lua_Number f) { #if defined(l_intfitsf) if (!l_intfitsf(i)) { if (f >= -cast_num(LUA_MININTEGER)) /* -minint == maxint + 1 */ return 1; /* f >= maxint + 1 > i */ else if (f >= cast_num(LUA_MININTEGER)) /* minint <= f <= maxint ? */ return (i <= cast(lua_Integer, f)); /* compare them as integers */ else /* f < minint <= i (or 'f' is NaN) --> not(i <= f) */ return 0; } #endif return luai_numle(cast_num(i), f); /* compare them as floats */ } /* ** Return 'l < r', for numbers. */ static int LTnum (const TValue *l, const TValue *r) { if (ttisinteger(l)) { lua_Integer li = ivalue(l); if (ttisinteger(r)) return li < ivalue(r); /* both are integers */ else /* 'l' is int and 'r' is float */ return LTintfloat(li, fltvalue(r)); /* l < r ? */ } else { lua_Number lf = fltvalue(l); /* 'l' must be float */ if (ttisfloat(r)) return luai_numlt(lf, fltvalue(r)); /* both are float */ else if (luai_numisnan(lf)) /* 'r' is int and 'l' is float */ return 0; /* NaN < i is always false */ else /* without NaN, (l < r) <--> not(r <= l) */ return !LEintfloat(ivalue(r), lf); /* not (r <= l) ? */ } } /* ** Return 'l <= r', for numbers. */ static int LEnum (const TValue *l, const TValue *r) { if (ttisinteger(l)) { lua_Integer li = ivalue(l); if (ttisinteger(r)) return li <= ivalue(r); /* both are integers */ else /* 'l' is int and 'r' is float */ return LEintfloat(li, fltvalue(r)); /* l <= r ? */ } else { lua_Number lf = fltvalue(l); /* 'l' must be float */ if (ttisfloat(r)) return luai_numle(lf, fltvalue(r)); /* both are float */ else if (luai_numisnan(lf)) /* 'r' is int and 'l' is float */ return 0; /* NaN <= i is always false */ else /* without NaN, (l <= r) <--> not(r < l) */ return !LTintfloat(ivalue(r), lf); /* not (r < l) ? */ } } /* ** Main operation less than; return 'l < r'. */ int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) { int res; if (ttisnumber(l) && ttisnumber(r)) /* both operands are numbers? */ return LTnum(l, r); else if (ttisstring(l) && ttisstring(r)) /* both are strings? */ return l_strcmp(tsvalue(l), tsvalue(r)) < 0; else if ((res = luaT_callorderTM(L, l, r, TM_LT)) < 0) /* no metamethod? */ luaG_ordererror(L, l, r); /* error */ return res; } /* ** Main operation less than or equal to; return 'l <= r'. If it needs ** a metamethod and there is no '__le', try '__lt', based on ** l <= r iff !(r < l) (assuming a total order). If the metamethod ** yields during this substitution, the continuation has to know ** about it (to negate the result of r= 0) /* try 'le' */ return res; else { /* try 'lt': */ L->ci->callstatus |= CIST_LEQ; /* mark it is doing 'lt' for 'le' */ res = luaT_callorderTM(L, r, l, TM_LT); L->ci->callstatus ^= CIST_LEQ; /* clear mark */ if (res < 0) luaG_ordererror(L, l, r); return !res; /* result is negated */ } } /* ** Main operation for equality of Lua values; return 't1 == t2'. ** L == NULL means raw equality (no metamethods) */ int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) { const TValue *tm; if (ttype(t1) != ttype(t2)) { /* not the same variant? */ if (ttnov(t1) != ttnov(t2) || ttnov(t1) != LUA_TNUMBER) return 0; /* only numbers can be equal with different variants */ else { /* two numbers with different variants */ lua_Integer i1, i2; /* compare them as integers */ return (tointeger(t1, &i1) && tointeger(t2, &i2) && i1 == i2); } } /* values have same type and same variant */ switch (ttype(t1)) { case LUA_TNIL: return 1; case LUA_TNUMINT: return (ivalue(t1) == ivalue(t2)); case LUA_TNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2)); case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */ case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2); case LUA_TLCF: return fvalue(t1) == fvalue(t2); case LUA_TSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2)); case LUA_TLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2)); case LUA_TUSERDATA: { if (uvalue(t1) == uvalue(t2)) return 1; else if (L == NULL) return 0; tm = fasttm(L, uvalue(t1)->metatable, TM_EQ); if (tm == NULL) tm = fasttm(L, uvalue(t2)->metatable, TM_EQ); break; /* will try TM */ } case LUA_TTABLE: { if (hvalue(t1) == hvalue(t2)) return 1; else if (L == NULL) return 0; tm = fasttm(L, hvalue(t1)->metatable, TM_EQ); if (tm == NULL) tm = fasttm(L, hvalue(t2)->metatable, TM_EQ); break; /* will try TM */ } default: return gcvalue(t1) == gcvalue(t2); } if (tm == NULL) /* no TM? */ return 0; /* objects are different */ luaT_callTM(L, tm, t1, t2, L->top, 1); /* call TM */ return !l_isfalse(L->top); } /* macro used by 'luaV_concat' to ensure that element at 'o' is a string */ #define tostring(L,o) \ (ttisstring(o) || (cvt2str(o) && (luaO_tostring(L, o), 1))) #define isemptystr(o) (ttisshrstring(o) && tsvalue(o)->shrlen == 0) /* copy strings in stack from top - n up to top - 1 to buffer */ static void copy2buff (StkId top, int n, char *buff) { size_t tl = 0; /* size already copied */ do { size_t l = vslen(top - n); /* length of string being copied */ memcpy(buff + tl, svalue(top - n), l * sizeof(char)); tl += l; } while (--n > 0); } /* ** Main operation for concatenation: concat 'total' values in the stack, ** from 'L->top - total' up to 'L->top - 1'. */ void luaV_concat (lua_State *L, int total) { lua_assert(total >= 2); do { StkId top = L->top; int n = 2; /* number of elements handled in this pass (at least 2) */ if (!(ttisstring(top-2) || cvt2str(top-2)) || !tostring(L, top-1)) luaT_trybinTM(L, top-2, top-1, top-2, TM_CONCAT); else if (isemptystr(top - 1)) /* second operand is empty? */ cast_void(tostring(L, top - 2)); /* result is first operand */ else if (isemptystr(top - 2)) { /* first operand is an empty string? */ setobjs2s(L, top - 2, top - 1); /* result is second op. */ } else { /* at least two non-empty string values; get as many as possible */ size_t tl = vslen(top - 1); TString *ts; /* collect total length and number of strings */ for (n = 1; n < total && tostring(L, top - n - 1); n++) { size_t l = vslen(top - n - 1); if (l >= (MAX_SIZE/sizeof(char)) - tl) luaG_runerror(L, "string length overflow"); tl += l; } if (tl <= LUAI_MAXSHORTLEN) { /* is result a short string? */ char buff[LUAI_MAXSHORTLEN]; copy2buff(top, n, buff); /* copy strings to buffer */ ts = luaS_newlstr(L, buff, tl); } else { /* long string; copy strings directly to final result */ ts = luaS_createlngstrobj(L, tl); copy2buff(top, n, getstr(ts)); } setsvalue2s(L, top - n, ts); /* create result */ } total -= n-1; /* got 'n' strings to create 1 new */ L->top -= n-1; /* popped 'n' strings and pushed one */ } while (total > 1); /* repeat until only 1 result left */ } /* ** Main operation 'ra' = #rb'. */ void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) { const TValue *tm; switch (ttype(rb)) { case LUA_TTABLE: { Table *h = hvalue(rb); tm = fasttm(L, h->metatable, TM_LEN); if (tm) break; /* metamethod? break switch to call it */ setivalue(ra, luaH_getn(h)); /* else primitive len */ return; } case LUA_TSHRSTR: { setivalue(ra, tsvalue(rb)->shrlen); return; } case LUA_TLNGSTR: { setivalue(ra, tsvalue(rb)->u.lnglen); return; } default: { /* try metamethod */ tm = luaT_gettmbyobj(L, rb, TM_LEN); if (ttisnil(tm)) /* no metamethod? */ luaG_typeerror(L, rb, "get length of"); break; } } luaT_callTM(L, tm, rb, rb, ra, 1); } /* ** Integer division; return 'm // n', that is, floor(m/n). ** C division truncates its result (rounds towards zero). ** 'floor(q) == trunc(q)' when 'q >= 0' or when 'q' is integer, ** otherwise 'floor(q) == trunc(q) - 1'. */ lua_Integer luaV_div (lua_State *L, lua_Integer m, lua_Integer n) { if (l_castS2U(n) + 1u <= 1u) { /* special cases: -1 or 0 */ if (n == 0) luaG_runerror(L, "attempt to divide by zero"); return intop(-, 0, m); /* n==-1; avoid overflow with 0x80000...//-1 */ } else { lua_Integer q = m / n; /* perform C division */ if ((m ^ n) < 0 && m % n != 0) /* 'm/n' would be negative non-integer? */ q -= 1; /* correct result for different rounding */ return q; } } /* ** Integer modulus; return 'm % n'. (Assume that C '%' with ** negative operands follows C99 behavior. See previous comment ** about luaV_div.) */ lua_Integer luaV_mod (lua_State *L, lua_Integer m, lua_Integer n) { if (l_castS2U(n) + 1u <= 1u) { /* special cases: -1 or 0 */ if (n == 0) luaG_runerror(L, "attempt to perform 'n%%0'"); return 0; /* m % -1 == 0; avoid overflow with 0x80000...%-1 */ } else { lua_Integer r = m % n; if (r != 0 && (m ^ n) < 0) /* 'm/n' would be non-integer negative? */ r += n; /* correct result for different rounding */ return r; } } /* number of bits in an integer */ #define NBITS cast_int(sizeof(lua_Integer) * CHAR_BIT) /* ** Shift left operation. (Shift right just negates 'y'.) */ lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y) { if (y < 0) { /* shift right? */ if (y <= -NBITS) return 0; else return intop(>>, x, -y); } else { /* shift left */ if (y >= NBITS) return 0; else return intop(<<, x, y); } } /* ** check whether cached closure in prototype 'p' may be reused, that is, ** whether there is a cached closure with the same upvalues needed by ** new closure to be created. */ static LClosure *getcached (Proto *p, UpVal **encup, StkId base) { LClosure *c = p->cache; if (c != NULL) { /* is there a cached closure? */ int nup = p->sizeupvalues; Upvaldesc *uv = p->upvalues; int i; for (i = 0; i < nup; i++) { /* check whether it has right upvalues */ TValue *v = uv[i].instack ? base + uv[i].idx : encup[uv[i].idx]->v; if (c->upvals[i]->v != v) return NULL; /* wrong upvalue; cannot reuse closure */ } } return c; /* return cached closure (or NULL if no cached closure) */ } /* ** create a new Lua closure, push it in the stack, and initialize ** its upvalues. Note that the closure is not cached if prototype is ** already black (which means that 'cache' was already cleared by the ** GC). */ static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base, StkId ra) { int nup = p->sizeupvalues; Upvaldesc *uv = p->upvalues; int i; LClosure *ncl = luaF_newLclosure(L, nup); ncl->p = p; setclLvalue(L, ra, ncl); /* anchor new closure in stack */ for (i = 0; i < nup; i++) { /* fill in its upvalues */ if (uv[i].instack) /* upvalue refers to local variable? */ ncl->upvals[i] = luaF_findupval(L, base + uv[i].idx); else /* get upvalue from enclosing function */ ncl->upvals[i] = encup[uv[i].idx]; ncl->upvals[i]->refcount++; /* new closure is white, so we do not need a barrier here */ } if (!isblack(p)) /* cache will not break GC invariant? */ p->cache = ncl; /* save it on cache for reuse */ } /* ** finish execution of an opcode interrupted by an yield */ void luaV_finishOp (lua_State *L) { CallInfo *ci = L->ci; StkId base = ci->u.l.base; Instruction inst = *(ci->u.l.savedpc - 1); /* interrupted instruction */ OpCode op = GET_OPCODE(inst); switch (op) { /* finish its execution */ case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV: case OP_IDIV: case OP_BAND: case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR: case OP_MOD: case OP_POW: case OP_UNM: case OP_BNOT: case OP_LEN: case OP_GETTABUP: case OP_GETTABLE: case OP_SELF: { setobjs2s(L, base + GETARG_A(inst), --L->top); break; } case OP_LE: case OP_LT: case OP_EQ: { int res = !l_isfalse(L->top - 1); L->top--; if (ci->callstatus & CIST_LEQ) { /* "<=" using "<" instead? */ lua_assert(op == OP_LE); ci->callstatus ^= CIST_LEQ; /* clear mark */ res = !res; /* negate result */ } lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP); if (res != GETARG_A(inst)) /* condition failed? */ ci->u.l.savedpc++; /* skip jump instruction */ break; } case OP_CONCAT: { StkId top = L->top - 1; /* top when 'luaT_trybinTM' was called */ int b = GETARG_B(inst); /* first element to concatenate */ int total = cast_int(top - 1 - (base + b)); /* yet to concatenate */ setobj2s(L, top - 2, top); /* put TM result in proper position */ if (total > 1) { /* are there elements to concat? */ L->top = top - 1; /* top is one after last element (at top-2) */ luaV_concat(L, total); /* concat them (may yield again) */ } /* move final result to final position */ setobj2s(L, ci->u.l.base + GETARG_A(inst), L->top - 1); L->top = ci->top; /* restore top */ break; } case OP_TFORCALL: { lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_TFORLOOP); L->top = ci->top; /* correct top */ break; } case OP_CALL: { if (GETARG_C(inst) - 1 >= 0) /* nresults >= 0? */ L->top = ci->top; /* adjust results */ break; } case OP_TAILCALL: case OP_SETTABUP: case OP_SETTABLE: break; default: lua_assert(0); } } /* ** {================================================================== ** Function 'luaV_execute': main interpreter loop ** =================================================================== */ /* ** some macros for common tasks in 'luaV_execute' */ #define RA(i) (base+GETARG_A(i)) #define RB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i)) #define RC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i)) #define RKB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \ ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i)) #define RKC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \ ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i)) /* execute a jump instruction */ #define dojump(ci,i,e) \ { int a = GETARG_A(i); \ if (a != 0) luaF_close(L, ci->u.l.base + a - 1); \ ci->u.l.savedpc += GETARG_sBx(i) + e; } /* for test instructions, execute the jump instruction that follows it */ #define donextjump(ci) { i = *ci->u.l.savedpc; dojump(ci, i, 1); } #define Protect(x) { {x;}; base = ci->u.l.base; } #define checkGC(L,c) \ { luaC_condGC(L, L->top = (c), /* limit of live values */ \ Protect(L->top = ci->top)); /* restore top */ \ luai_threadyield(L); } #define vmdispatch(o) switch(o) #define vmcase(l) case l: #define vmbreak break /* ** copy of 'luaV_gettable', but protecting call to potential metamethod ** (which can reallocate the stack) */ #define gettableProtected(L,t,k,v) { const TValue *aux; \ if (luaV_fastget(L,t,k,aux,luaH_get)) { setobj2s(L, v, aux); } \ else Protect(luaV_finishget(L,t,k,v,aux)); } /* same for 'luaV_settable' */ #define settableProtected(L,t,k,v) { const TValue *slot; \ if (!luaV_fastset(L,t,k,slot,luaH_get,v)) \ Protect(luaV_finishset(L,t,k,v,slot)); } void luaV_execute (lua_State *L) { CallInfo *ci = L->ci; LClosure *cl; TValue *k; StkId base; ci->callstatus |= CIST_FRESH; /* fresh invocation of 'luaV_execute" */ newframe: /* reentry point when frame changes (call/return) */ lua_assert(ci == L->ci); cl = clLvalue(ci->func); /* local reference to function's closure */ k = cl->p->k; /* local reference to function's constant table */ base = ci->u.l.base; /* local copy of function's base */ /* main loop of interpreter */ for (;;) { Instruction i = *(ci->u.l.savedpc++); StkId ra; if (L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) Protect(luaG_traceexec(L)); /* WARNING: several calls may realloc the stack and invalidate 'ra' */ ra = RA(i); lua_assert(base == ci->u.l.base); lua_assert(base <= L->top && L->top < L->stack + L->stacksize); vmdispatch (GET_OPCODE(i)) { vmcase(OP_MOVE) { setobjs2s(L, ra, RB(i)); vmbreak; } vmcase(OP_LOADK) { TValue *rb = k + GETARG_Bx(i); setobj2s(L, ra, rb); vmbreak; } vmcase(OP_LOADKX) { TValue *rb; lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG); rb = k + GETARG_Ax(*ci->u.l.savedpc++); setobj2s(L, ra, rb); vmbreak; } vmcase(OP_LOADBOOL) { setbvalue(ra, GETARG_B(i)); if (GETARG_C(i)) ci->u.l.savedpc++; /* skip next instruction (if C) */ vmbreak; } vmcase(OP_LOADNIL) { int b = GETARG_B(i); do { setnilvalue(ra++); } while (b--); vmbreak; } vmcase(OP_GETUPVAL) { int b = GETARG_B(i); setobj2s(L, ra, cl->upvals[b]->v); vmbreak; } vmcase(OP_GETTABUP) { TValue *upval = cl->upvals[GETARG_B(i)]->v; TValue *rc = RKC(i); gettableProtected(L, upval, rc, ra); vmbreak; } vmcase(OP_GETTABLE) { StkId rb = RB(i); TValue *rc = RKC(i); gettableProtected(L, rb, rc, ra); vmbreak; } vmcase(OP_SETTABUP) { TValue *upval = cl->upvals[GETARG_A(i)]->v; TValue *rb = RKB(i); TValue *rc = RKC(i); settableProtected(L, upval, rb, rc); vmbreak; } vmcase(OP_SETUPVAL) { UpVal *uv = cl->upvals[GETARG_B(i)]; setobj(L, uv->v, ra); luaC_upvalbarrier(L, uv); vmbreak; } vmcase(OP_SETTABLE) { TValue *rb = RKB(i); TValue *rc = RKC(i); settableProtected(L, ra, rb, rc); vmbreak; } vmcase(OP_NEWTABLE) { int b = GETARG_B(i); int c = GETARG_C(i); Table *t = luaH_new(L); sethvalue(L, ra, t); if (b != 0 || c != 0) luaH_resize(L, t, luaO_fb2int(b), luaO_fb2int(c)); checkGC(L, ra + 1); vmbreak; } vmcase(OP_SELF) { const TValue *aux; StkId rb = RB(i); TValue *rc = RKC(i); TString *key = tsvalue(rc); /* key must be a string */ setobjs2s(L, ra + 1, rb); if (luaV_fastget(L, rb, key, aux, luaH_getstr)) { setobj2s(L, ra, aux); } else Protect(luaV_finishget(L, rb, rc, ra, aux)); vmbreak; } vmcase(OP_ADD) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Number nb; lua_Number nc; if (ttisinteger(rb) && ttisinteger(rc)) { lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc); setivalue(ra, intop(+, ib, ic)); } else if (tonumber(rb, &nb) && tonumber(rc, &nc)) { setfltvalue(ra, luai_numadd(L, nb, nc)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_ADD)); } vmbreak; } vmcase(OP_SUB) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Number nb; lua_Number nc; if (ttisinteger(rb) && ttisinteger(rc)) { lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc); setivalue(ra, intop(-, ib, ic)); } else if (tonumber(rb, &nb) && tonumber(rc, &nc)) { setfltvalue(ra, luai_numsub(L, nb, nc)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SUB)); } vmbreak; } vmcase(OP_MUL) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Number nb; lua_Number nc; if (ttisinteger(rb) && ttisinteger(rc)) { lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc); setivalue(ra, intop(*, ib, ic)); } else if (tonumber(rb, &nb) && tonumber(rc, &nc)) { setfltvalue(ra, luai_nummul(L, nb, nc)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MUL)); } vmbreak; } vmcase(OP_DIV) { /* float division (always with floats) */ TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Number nb; lua_Number nc; if (tonumber(rb, &nb) && tonumber(rc, &nc)) { setfltvalue(ra, luai_numdiv(L, nb, nc)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_DIV)); } vmbreak; } vmcase(OP_BAND) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Integer ib; lua_Integer ic; if (tointeger(rb, &ib) && tointeger(rc, &ic)) { setivalue(ra, intop(&, ib, ic)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BAND)); } vmbreak; } vmcase(OP_BOR) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Integer ib; lua_Integer ic; if (tointeger(rb, &ib) && tointeger(rc, &ic)) { setivalue(ra, intop(|, ib, ic)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BOR)); } vmbreak; } vmcase(OP_BXOR) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Integer ib; lua_Integer ic; if (tointeger(rb, &ib) && tointeger(rc, &ic)) { setivalue(ra, intop(^, ib, ic)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BXOR)); } vmbreak; } vmcase(OP_SHL) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Integer ib; lua_Integer ic; if (tointeger(rb, &ib) && tointeger(rc, &ic)) { setivalue(ra, luaV_shiftl(ib, ic)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHL)); } vmbreak; } vmcase(OP_SHR) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Integer ib; lua_Integer ic; if (tointeger(rb, &ib) && tointeger(rc, &ic)) { setivalue(ra, luaV_shiftl(ib, -ic)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHR)); } vmbreak; } vmcase(OP_MOD) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Number nb; lua_Number nc; if (ttisinteger(rb) && ttisinteger(rc)) { lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc); setivalue(ra, luaV_mod(L, ib, ic)); } else if (tonumber(rb, &nb) && tonumber(rc, &nc)) { lua_Number m; luai_nummod(L, nb, nc, m); setfltvalue(ra, m); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MOD)); } vmbreak; } vmcase(OP_IDIV) { /* floor division */ TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Number nb; lua_Number nc; if (ttisinteger(rb) && ttisinteger(rc)) { lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc); setivalue(ra, luaV_div(L, ib, ic)); } else if (tonumber(rb, &nb) && tonumber(rc, &nc)) { setfltvalue(ra, luai_numidiv(L, nb, nc)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_IDIV)); } vmbreak; } vmcase(OP_POW) { TValue *rb = RKB(i); TValue *rc = RKC(i); lua_Number nb; lua_Number nc; if (tonumber(rb, &nb) && tonumber(rc, &nc)) { setfltvalue(ra, luai_numpow(L, nb, nc)); } else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_POW)); } vmbreak; } vmcase(OP_UNM) { TValue *rb = RB(i); lua_Number nb; if (ttisinteger(rb)) { lua_Integer ib = ivalue(rb); setivalue(ra, intop(-, 0, ib)); } else if (tonumber(rb, &nb)) { setfltvalue(ra, luai_numunm(L, nb)); } else { Protect(luaT_trybinTM(L, rb, rb, ra, TM_UNM)); } vmbreak; } vmcase(OP_BNOT) { TValue *rb = RB(i); lua_Integer ib; if (tointeger(rb, &ib)) { setivalue(ra, intop(^, ~l_castS2U(0), ib)); } else { Protect(luaT_trybinTM(L, rb, rb, ra, TM_BNOT)); } vmbreak; } vmcase(OP_NOT) { TValue *rb = RB(i); int res = l_isfalse(rb); /* next assignment may change this value */ setbvalue(ra, res); vmbreak; } vmcase(OP_LEN) { Protect(luaV_objlen(L, ra, RB(i))); vmbreak; } vmcase(OP_CONCAT) { int b = GETARG_B(i); int c = GETARG_C(i); StkId rb; L->top = base + c + 1; /* mark the end of concat operands */ Protect(luaV_concat(L, c - b + 1)); ra = RA(i); /* 'luaV_concat' may invoke TMs and move the stack */ rb = base + b; setobjs2s(L, ra, rb); checkGC(L, (ra >= rb ? ra + 1 : rb)); L->top = ci->top; /* restore top */ vmbreak; } vmcase(OP_JMP) { dojump(ci, i, 0); vmbreak; } vmcase(OP_EQ) { TValue *rb = RKB(i); TValue *rc = RKC(i); Protect( if (luaV_equalobj(L, rb, rc) != GETARG_A(i)) ci->u.l.savedpc++; else donextjump(ci); ) vmbreak; } vmcase(OP_LT) { Protect( if (luaV_lessthan(L, RKB(i), RKC(i)) != GETARG_A(i)) ci->u.l.savedpc++; else donextjump(ci); ) vmbreak; } vmcase(OP_LE) { Protect( if (luaV_lessequal(L, RKB(i), RKC(i)) != GETARG_A(i)) ci->u.l.savedpc++; else donextjump(ci); ) vmbreak; } vmcase(OP_TEST) { if (GETARG_C(i) ? l_isfalse(ra) : !l_isfalse(ra)) ci->u.l.savedpc++; else donextjump(ci); vmbreak; } vmcase(OP_TESTSET) { TValue *rb = RB(i); if (GETARG_C(i) ? l_isfalse(rb) : !l_isfalse(rb)) ci->u.l.savedpc++; else { setobjs2s(L, ra, rb); donextjump(ci); } vmbreak; } vmcase(OP_CALL) { int b = GETARG_B(i); int nresults = GETARG_C(i) - 1; if (b != 0) L->top = ra+b; /* else previous instruction set top */ if (luaD_precall(L, ra, nresults)) { /* C function? */ if (nresults >= 0) L->top = ci->top; /* adjust results */ Protect((void)0); /* update 'base' */ } else { /* Lua function */ ci = L->ci; goto newframe; /* restart luaV_execute over new Lua function */ } vmbreak; } vmcase(OP_TAILCALL) { int b = GETARG_B(i); if (b != 0) L->top = ra+b; /* else previous instruction set top */ lua_assert(GETARG_C(i) - 1 == LUA_MULTRET); if (luaD_precall(L, ra, LUA_MULTRET)) { /* C function? */ Protect((void)0); /* update 'base' */ } else { /* tail call: put called frame (n) in place of caller one (o) */ CallInfo *nci = L->ci; /* called frame */ CallInfo *oci = nci->previous; /* caller frame */ StkId nfunc = nci->func; /* called function */ StkId ofunc = oci->func; /* caller function */ /* last stack slot filled by 'precall' */ StkId lim = nci->u.l.base + getproto(nfunc)->numparams; int aux; /* close all upvalues from previous call */ if (cl->p->sizep > 0) luaF_close(L, oci->u.l.base); /* move new frame into old one */ for (aux = 0; nfunc + aux < lim; aux++) setobjs2s(L, ofunc + aux, nfunc + aux); oci->u.l.base = ofunc + (nci->u.l.base - nfunc); /* correct base */ oci->top = L->top = ofunc + (L->top - nfunc); /* correct top */ oci->u.l.savedpc = nci->u.l.savedpc; oci->callstatus |= CIST_TAIL; /* function was tail called */ ci = L->ci = oci; /* remove new frame */ lua_assert(L->top == oci->u.l.base + getproto(ofunc)->maxstacksize); goto newframe; /* restart luaV_execute over new Lua function */ } vmbreak; } vmcase(OP_RETURN) { int b = GETARG_B(i); if (cl->p->sizep > 0) luaF_close(L, base); b = luaD_poscall(L, ci, ra, (b != 0 ? b - 1 : cast_int(L->top - ra))); if (ci->callstatus & CIST_FRESH) /* local 'ci' still from callee */ return; /* external invocation: return */ else { /* invocation via reentry: continue execution */ ci = L->ci; if (b) L->top = ci->top; lua_assert(isLua(ci)); lua_assert(GET_OPCODE(*((ci)->u.l.savedpc - 1)) == OP_CALL); goto newframe; /* restart luaV_execute over new Lua function */ } } vmcase(OP_FORLOOP) { if (ttisinteger(ra)) { /* integer loop? */ lua_Integer step = ivalue(ra + 2); lua_Integer idx = intop(+, ivalue(ra), step); /* increment index */ lua_Integer limit = ivalue(ra + 1); if ((0 < step) ? (idx <= limit) : (limit <= idx)) { ci->u.l.savedpc += GETARG_sBx(i); /* jump back */ chgivalue(ra, idx); /* update internal index... */ setivalue(ra + 3, idx); /* ...and external index */ } } else { /* floating loop */ lua_Number step = fltvalue(ra + 2); lua_Number idx = luai_numadd(L, fltvalue(ra), step); /* inc. index */ lua_Number limit = fltvalue(ra + 1); if (luai_numlt(0, step) ? luai_numle(idx, limit) : luai_numle(limit, idx)) { ci->u.l.savedpc += GETARG_sBx(i); /* jump back */ chgfltvalue(ra, idx); /* update internal index... */ setfltvalue(ra + 3, idx); /* ...and external index */ } } vmbreak; } vmcase(OP_FORPREP) { TValue *init = ra; TValue *plimit = ra + 1; TValue *pstep = ra + 2; lua_Integer ilimit; int stopnow; if (ttisinteger(init) && ttisinteger(pstep) && forlimit(plimit, &ilimit, ivalue(pstep), &stopnow)) { /* all values are integer */ lua_Integer initv = (stopnow ? 0 : ivalue(init)); setivalue(plimit, ilimit); setivalue(init, intop(-, initv, ivalue(pstep))); } else { /* try making all values floats */ lua_Number ninit; lua_Number nlimit; lua_Number nstep; if (!tonumber(plimit, &nlimit)) luaG_runerror(L, "'for' limit must be a number"); setfltvalue(plimit, nlimit); if (!tonumber(pstep, &nstep)) luaG_runerror(L, "'for' step must be a number"); setfltvalue(pstep, nstep); if (!tonumber(init, &ninit)) luaG_runerror(L, "'for' initial value must be a number"); setfltvalue(init, luai_numsub(L, ninit, nstep)); } ci->u.l.savedpc += GETARG_sBx(i); vmbreak; } vmcase(OP_TFORCALL) { StkId cb = ra + 3; /* call base */ setobjs2s(L, cb+2, ra+2); setobjs2s(L, cb+1, ra+1); setobjs2s(L, cb, ra); L->top = cb + 3; /* func. + 2 args (state and index) */ Protect(luaD_call(L, cb, GETARG_C(i))); L->top = ci->top; i = *(ci->u.l.savedpc++); /* go to next instruction */ ra = RA(i); lua_assert(GET_OPCODE(i) == OP_TFORLOOP); goto l_tforloop; } vmcase(OP_TFORLOOP) { l_tforloop: if (!ttisnil(ra + 1)) { /* continue loop? */ setobjs2s(L, ra, ra + 1); /* save control variable */ ci->u.l.savedpc += GETARG_sBx(i); /* jump back */ } vmbreak; } vmcase(OP_SETLIST) { int n = GETARG_B(i); int c = GETARG_C(i); unsigned int last; Table *h; if (n == 0) n = cast_int(L->top - ra) - 1; if (c == 0) { lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG); c = GETARG_Ax(*ci->u.l.savedpc++); } h = hvalue(ra); last = ((c-1)*LFIELDS_PER_FLUSH) + n; if (last > h->sizearray) /* needs more space? */ luaH_resizearray(L, h, last); /* preallocate it at once */ for (; n > 0; n--) { TValue *val = ra+n; luaH_setint(L, h, last--, val); luaC_barrierback(L, h, val); } L->top = ci->top; /* correct top (in case of previous open call) */ vmbreak; } vmcase(OP_CLOSURE) { Proto *p = cl->p->p[GETARG_Bx(i)]; LClosure *ncl = getcached(p, cl->upvals, base); /* cached closure */ if (ncl == NULL) /* no match? */ pushclosure(L, p, cl->upvals, base, ra); /* create a new one */ else setclLvalue(L, ra, ncl); /* push cashed closure */ checkGC(L, ra + 1); vmbreak; } vmcase(OP_VARARG) { int b = GETARG_B(i) - 1; /* required results */ int j; int n = cast_int(base - ci->func) - cl->p->numparams - 1; if (n < 0) /* less arguments than parameters? */ n = 0; /* no vararg arguments */ if (b < 0) { /* B == 0? */ b = n; /* get all var. arguments */ Protect(luaD_checkstack(L, n)); ra = RA(i); /* previous call may change the stack */ L->top = ra + n; } for (j = 0; j < b && j < n; j++) setobjs2s(L, ra + j, base - n + j); for (; j < b; j++) /* complete required results with nil */ setnilvalue(ra + j); vmbreak; } vmcase(OP_EXTRAARG) { lua_assert(0); vmbreak; } } } } /* }================================================================== */ wcc-0.0.2/src/wsh/lua/src/ltable.c0000644000175000017500000004635613110675433015327 0ustar philphil/* ** $Id: ltable.c,v 2.117 2015/11/19 19:16:22 roberto Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ #define ltable_c #define LUA_CORE #include "lprefix.h" /* ** Implementation of tables (aka arrays, objects, or hash tables). ** Tables keep its elements in two parts: an array part and a hash part. ** Non-negative integer keys are all candidates to be kept in the array ** part. The actual size of the array is the largest 'n' such that ** more than half the slots between 1 and n are in use. ** Hash uses a mix of chained scatter table with Brent's variation. ** A main invariant of these tables is that, if an element is not ** in its main position (i.e. the 'original' position that its hash gives ** to it), then the colliding element is in its own main position. ** Hence even when the load factor reaches 100%, performance remains good. */ #include #include #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "lvm.h" /* ** Maximum size of array part (MAXASIZE) is 2^MAXABITS. MAXABITS is ** the largest integer such that MAXASIZE fits in an unsigned int. */ #define MAXABITS cast_int(sizeof(int) * CHAR_BIT - 1) #define MAXASIZE (1u << MAXABITS) /* ** Maximum size of hash part is 2^MAXHBITS. MAXHBITS is the largest ** integer such that 2^MAXHBITS fits in a signed int. (Note that the ** maximum number of elements in a table, 2^MAXABITS + 2^MAXHBITS, still ** fits comfortably in an unsigned int.) */ #define MAXHBITS (MAXABITS - 1) #define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t)))) #define hashstr(t,str) hashpow2(t, (str)->hash) #define hashboolean(t,p) hashpow2(t, p) #define hashint(t,i) hashpow2(t, i) /* ** for some types, it is better to avoid modulus by power of 2, as ** they tend to have many 2 factors. */ #define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1)))) #define hashpointer(t,p) hashmod(t, point2uint(p)) #define dummynode (&dummynode_) #define isdummy(n) ((n) == dummynode) static const Node dummynode_ = { {NILCONSTANT}, /* value */ {{NILCONSTANT, 0}} /* key */ }; /* ** Hash for floating-point numbers. ** The main computation should be just ** n = frexp(n, &i); return (n * INT_MAX) + i ** but there are some numerical subtleties. ** In a two-complement representation, INT_MAX does not has an exact ** representation as a float, but INT_MIN does; because the absolute ** value of 'frexp' is smaller than 1 (unless 'n' is inf/NaN), the ** absolute value of the product 'frexp * -INT_MIN' is smaller or equal ** to INT_MAX. Next, the use of 'unsigned int' avoids overflows when ** adding 'i'; the use of '~u' (instead of '-u') avoids problems with ** INT_MIN. */ #if !defined(l_hashfloat) static int l_hashfloat (lua_Number n) { int i; lua_Integer ni; n = l_mathop(frexp)(n, &i) * -cast_num(INT_MIN); if (!lua_numbertointeger(n, &ni)) { /* is 'n' inf/-inf/NaN? */ lua_assert(luai_numisnan(n) || l_mathop(fabs)(n) == cast_num(HUGE_VAL)); return 0; } else { /* normal case */ unsigned int u = cast(unsigned int, i) + cast(unsigned int, ni); return cast_int(u <= cast(unsigned int, INT_MAX) ? u : ~u); } } #endif /* ** returns the 'main' position of an element in a table (that is, the index ** of its hash value) */ static Node *mainposition (const Table *t, const TValue *key) { switch (ttype(key)) { case LUA_TNUMINT: return hashint(t, ivalue(key)); case LUA_TNUMFLT: return hashmod(t, l_hashfloat(fltvalue(key))); case LUA_TSHRSTR: return hashstr(t, tsvalue(key)); case LUA_TLNGSTR: return hashpow2(t, luaS_hashlongstr(tsvalue(key))); case LUA_TBOOLEAN: return hashboolean(t, bvalue(key)); case LUA_TLIGHTUSERDATA: return hashpointer(t, pvalue(key)); case LUA_TLCF: return hashpointer(t, fvalue(key)); default: lua_assert(!ttisdeadkey(key)); return hashpointer(t, gcvalue(key)); } } /* ** returns the index for 'key' if 'key' is an appropriate key to live in ** the array part of the table, 0 otherwise. */ static unsigned int arrayindex (const TValue *key) { if (ttisinteger(key)) { lua_Integer k = ivalue(key); if (0 < k && (lua_Unsigned)k <= MAXASIZE) return cast(unsigned int, k); /* 'key' is an appropriate array index */ } return 0; /* 'key' did not match some condition */ } /* ** returns the index of a 'key' for table traversals. First goes all ** elements in the array part, then elements in the hash part. The ** beginning of a traversal is signaled by 0. */ static unsigned int findindex (lua_State *L, Table *t, StkId key) { unsigned int i; if (ttisnil(key)) return 0; /* first iteration */ i = arrayindex(key); if (i != 0 && i <= t->sizearray) /* is 'key' inside array part? */ return i; /* yes; that's the index */ else { int nx; Node *n = mainposition(t, key); for (;;) { /* check whether 'key' is somewhere in the chain */ /* key may be dead already, but it is ok to use it in 'next' */ if (luaV_rawequalobj(gkey(n), key) || (ttisdeadkey(gkey(n)) && iscollectable(key) && deadvalue(gkey(n)) == gcvalue(key))) { i = cast_int(n - gnode(t, 0)); /* key index in hash table */ /* hash elements are numbered after array ones */ return (i + 1) + t->sizearray; } nx = gnext(n); if (nx == 0) luaG_runerror(L, "invalid key to 'next'"); /* key not found */ else n += nx; } } } int luaH_next (lua_State *L, Table *t, StkId key) { unsigned int i = findindex(L, t, key); /* find original element */ for (; i < t->sizearray; i++) { /* try first array part */ if (!ttisnil(&t->array[i])) { /* a non-nil value? */ setivalue(key, i + 1); setobj2s(L, key+1, &t->array[i]); return 1; } } for (i -= t->sizearray; cast_int(i) < sizenode(t); i++) { /* hash part */ if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */ setobj2s(L, key, gkey(gnode(t, i))); setobj2s(L, key+1, gval(gnode(t, i))); return 1; } } return 0; /* no more elements */ } /* ** {============================================================= ** Rehash ** ============================================================== */ /* ** Compute the optimal size for the array part of table 't'. 'nums' is a ** "count array" where 'nums[i]' is the number of integers in the table ** between 2^(i - 1) + 1 and 2^i. 'pna' enters with the total number of ** integer keys in the table and leaves with the number of keys that ** will go to the array part; return the optimal size. */ static unsigned int computesizes (unsigned int nums[], unsigned int *pna) { int i; unsigned int twotoi; /* 2^i (candidate for optimal size) */ unsigned int a = 0; /* number of elements smaller than 2^i */ unsigned int na = 0; /* number of elements to go to array part */ unsigned int optimal = 0; /* optimal size for array part */ /* loop while keys can fill more than half of total size */ for (i = 0, twotoi = 1; *pna > twotoi / 2; i++, twotoi *= 2) { if (nums[i] > 0) { a += nums[i]; if (a > twotoi/2) { /* more than half elements present? */ optimal = twotoi; /* optimal size (till now) */ na = a; /* all elements up to 'optimal' will go to array part */ } } } lua_assert((optimal == 0 || optimal / 2 < na) && na <= optimal); *pna = na; return optimal; } static int countint (const TValue *key, unsigned int *nums) { unsigned int k = arrayindex(key); if (k != 0) { /* is 'key' an appropriate array index? */ nums[luaO_ceillog2(k)]++; /* count as such */ return 1; } else return 0; } /* ** Count keys in array part of table 't': Fill 'nums[i]' with ** number of keys that will go into corresponding slice and return ** total number of non-nil keys. */ static unsigned int numusearray (const Table *t, unsigned int *nums) { int lg; unsigned int ttlg; /* 2^lg */ unsigned int ause = 0; /* summation of 'nums' */ unsigned int i = 1; /* count to traverse all array keys */ /* traverse each slice */ for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) { unsigned int lc = 0; /* counter */ unsigned int lim = ttlg; if (lim > t->sizearray) { lim = t->sizearray; /* adjust upper limit */ if (i > lim) break; /* no more elements to count */ } /* count elements in range (2^(lg - 1), 2^lg] */ for (; i <= lim; i++) { if (!ttisnil(&t->array[i-1])) lc++; } nums[lg] += lc; ause += lc; } return ause; } static int numusehash (const Table *t, unsigned int *nums, unsigned int *pna) { int totaluse = 0; /* total number of elements */ int ause = 0; /* elements added to 'nums' (can go to array part) */ int i = sizenode(t); while (i--) { Node *n = &t->node[i]; if (!ttisnil(gval(n))) { ause += countint(gkey(n), nums); totaluse++; } } *pna += ause; return totaluse; } static void setarrayvector (lua_State *L, Table *t, unsigned int size) { unsigned int i; luaM_reallocvector(L, t->array, t->sizearray, size, TValue); for (i=t->sizearray; iarray[i]); t->sizearray = size; } static void setnodevector (lua_State *L, Table *t, unsigned int size) { int lsize; if (size == 0) { /* no elements to hash part? */ t->node = cast(Node *, dummynode); /* use common 'dummynode' */ lsize = 0; } else { int i; lsize = luaO_ceillog2(size); if (lsize > MAXHBITS) luaG_runerror(L, "table overflow"); size = twoto(lsize); t->node = luaM_newvector(L, size, Node); for (i = 0; i < (int)size; i++) { Node *n = gnode(t, i); gnext(n) = 0; setnilvalue(wgkey(n)); setnilvalue(gval(n)); } } t->lsizenode = cast_byte(lsize); t->lastfree = gnode(t, size); /* all positions are free */ } void luaH_resize (lua_State *L, Table *t, unsigned int nasize, unsigned int nhsize) { unsigned int i; int j; unsigned int oldasize = t->sizearray; int oldhsize = t->lsizenode; Node *nold = t->node; /* save old hash ... */ if (nasize > oldasize) /* array part must grow? */ setarrayvector(L, t, nasize); /* create new hash part with appropriate size */ setnodevector(L, t, nhsize); if (nasize < oldasize) { /* array part must shrink? */ t->sizearray = nasize; /* re-insert elements from vanishing slice */ for (i=nasize; iarray[i])) luaH_setint(L, t, i + 1, &t->array[i]); } /* shrink array */ luaM_reallocvector(L, t->array, oldasize, nasize, TValue); } /* re-insert elements from hash part */ for (j = twoto(oldhsize) - 1; j >= 0; j--) { Node *old = nold + j; if (!ttisnil(gval(old))) { /* doesn't need barrier/invalidate cache, as entry was already present in the table */ setobjt2t(L, luaH_set(L, t, gkey(old)), gval(old)); } } if (!isdummy(nold)) luaM_freearray(L, nold, cast(size_t, twoto(oldhsize))); /* free old hash */ } void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize) { int nsize = isdummy(t->node) ? 0 : sizenode(t); luaH_resize(L, t, nasize, nsize); } /* ** nums[i] = number of keys 'k' where 2^(i - 1) < k <= 2^i */ static void rehash (lua_State *L, Table *t, const TValue *ek) { unsigned int asize; /* optimal size for array part */ unsigned int na; /* number of keys in the array part */ unsigned int nums[MAXABITS + 1]; int i; int totaluse; for (i = 0; i <= MAXABITS; i++) nums[i] = 0; /* reset counts */ na = numusearray(t, nums); /* count keys in array part */ totaluse = na; /* all those keys are integer keys */ totaluse += numusehash(t, nums, &na); /* count keys in hash part */ /* count extra key */ na += countint(ek, nums); totaluse++; /* compute new size for array part */ asize = computesizes(nums, &na); /* resize the table to new computed sizes */ luaH_resize(L, t, asize, totaluse - na); } /* ** }============================================================= */ Table *luaH_new (lua_State *L) { GCObject *o = luaC_newobj(L, LUA_TTABLE, sizeof(Table)); Table *t = gco2t(o); t->metatable = NULL; t->flags = cast_byte(~0); t->array = NULL; t->sizearray = 0; setnodevector(L, t, 0); return t; } void luaH_free (lua_State *L, Table *t) { if (!isdummy(t->node)) luaM_freearray(L, t->node, cast(size_t, sizenode(t))); luaM_freearray(L, t->array, t->sizearray); luaM_free(L, t); } static Node *getfreepos (Table *t) { while (t->lastfree > t->node) { t->lastfree--; if (ttisnil(gkey(t->lastfree))) return t->lastfree; } return NULL; /* could not find a free place */ } /* ** inserts a new key into a hash table; first, check whether key's main ** position is free. If not, check whether colliding node is in its main ** position or not: if it is not, move colliding node to an empty place and ** put new key in its main position; otherwise (colliding node is in its main ** position), new key goes to an empty position. */ TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key) { Node *mp; TValue aux; if (ttisnil(key)) luaG_runerror(L, "table index is nil"); else if (ttisfloat(key)) { lua_Integer k; if (luaV_tointeger(key, &k, 0)) { /* index is int? */ setivalue(&aux, k); key = &aux; /* insert it as an integer */ } else if (luai_numisnan(fltvalue(key))) luaG_runerror(L, "table index is NaN"); } mp = mainposition(t, key); if (!ttisnil(gval(mp)) || isdummy(mp)) { /* main position is taken? */ Node *othern; Node *f = getfreepos(t); /* get a free place */ if (f == NULL) { /* cannot find a free place? */ rehash(L, t, key); /* grow table */ /* whatever called 'newkey' takes care of TM cache */ return luaH_set(L, t, key); /* insert key into grown table */ } lua_assert(!isdummy(f)); othern = mainposition(t, gkey(mp)); if (othern != mp) { /* is colliding node out of its main position? */ /* yes; move colliding node into free position */ while (othern + gnext(othern) != mp) /* find previous */ othern += gnext(othern); gnext(othern) = cast_int(f - othern); /* rechain to point to 'f' */ *f = *mp; /* copy colliding node into free pos. (mp->next also goes) */ if (gnext(mp) != 0) { gnext(f) += cast_int(mp - f); /* correct 'next' */ gnext(mp) = 0; /* now 'mp' is free */ } setnilvalue(gval(mp)); } else { /* colliding node is in its own main position */ /* new node will go into free position */ if (gnext(mp) != 0) gnext(f) = cast_int((mp + gnext(mp)) - f); /* chain new position */ else lua_assert(gnext(f) == 0); gnext(mp) = cast_int(f - mp); mp = f; } } setnodekey(L, &mp->i_key, key); luaC_barrierback(L, t, key); lua_assert(ttisnil(gval(mp))); return gval(mp); } /* ** search function for integers */ const TValue *luaH_getint (Table *t, lua_Integer key) { /* (1 <= key && key <= t->sizearray) */ if (l_castS2U(key) - 1 < t->sizearray) return &t->array[key - 1]; else { Node *n = hashint(t, key); for (;;) { /* check whether 'key' is somewhere in the chain */ if (ttisinteger(gkey(n)) && ivalue(gkey(n)) == key) return gval(n); /* that's it */ else { int nx = gnext(n); if (nx == 0) break; n += nx; } } return luaO_nilobject; } } /* ** search function for short strings */ const TValue *luaH_getshortstr (Table *t, TString *key) { Node *n = hashstr(t, key); lua_assert(key->tt == LUA_TSHRSTR); for (;;) { /* check whether 'key' is somewhere in the chain */ const TValue *k = gkey(n); if (ttisshrstring(k) && eqshrstr(tsvalue(k), key)) return gval(n); /* that's it */ else { int nx = gnext(n); if (nx == 0) return luaO_nilobject; /* not found */ n += nx; } } } /* ** "Generic" get version. (Not that generic: not valid for integers, ** which may be in array part, nor for floats with integral values.) */ static const TValue *getgeneric (Table *t, const TValue *key) { Node *n = mainposition(t, key); for (;;) { /* check whether 'key' is somewhere in the chain */ if (luaV_rawequalobj(gkey(n), key)) return gval(n); /* that's it */ else { int nx = gnext(n); if (nx == 0) return luaO_nilobject; /* not found */ n += nx; } } } const TValue *luaH_getstr (Table *t, TString *key) { if (key->tt == LUA_TSHRSTR) return luaH_getshortstr(t, key); else { /* for long strings, use generic case */ TValue ko; setsvalue(cast(lua_State *, NULL), &ko, key); return getgeneric(t, &ko); } } /* ** main search function */ const TValue *luaH_get (Table *t, const TValue *key) { switch (ttype(key)) { case LUA_TSHRSTR: return luaH_getshortstr(t, tsvalue(key)); case LUA_TNUMINT: return luaH_getint(t, ivalue(key)); case LUA_TNIL: return luaO_nilobject; case LUA_TNUMFLT: { lua_Integer k; if (luaV_tointeger(key, &k, 0)) /* index is int? */ return luaH_getint(t, k); /* use specialized version */ /* else... */ } /* FALLTHROUGH */ default: return getgeneric(t, key); } } /* ** beware: when using this function you probably need to check a GC ** barrier and invalidate the TM cache. */ TValue *luaH_set (lua_State *L, Table *t, const TValue *key) { const TValue *p = luaH_get(t, key); if (p != luaO_nilobject) return cast(TValue *, p); else return luaH_newkey(L, t, key); } void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) { const TValue *p = luaH_getint(t, key); TValue *cell; if (p != luaO_nilobject) cell = cast(TValue *, p); else { TValue k; setivalue(&k, key); cell = luaH_newkey(L, t, &k); } setobj2t(L, cell, value); } static int unbound_search (Table *t, unsigned int j) { unsigned int i = j; /* i is zero or a present index */ j++; /* find 'i' and 'j' such that i is present and j is not */ while (!ttisnil(luaH_getint(t, j))) { i = j; if (j > cast(unsigned int, MAX_INT)/2) { /* overflow? */ /* table was built with bad purposes: resort to linear search */ i = 1; while (!ttisnil(luaH_getint(t, i))) i++; return i - 1; } j *= 2; } /* now do a binary search between them */ while (j - i > 1) { unsigned int m = (i+j)/2; if (ttisnil(luaH_getint(t, m))) j = m; else i = m; } return i; } /* ** Try to find a boundary in table 't'. A 'boundary' is an integer index ** such that t[i] is non-nil and t[i+1] is nil (and 0 if t[1] is nil). */ int luaH_getn (Table *t) { unsigned int j = t->sizearray; if (j > 0 && ttisnil(&t->array[j - 1])) { /* there is a boundary in the array part: (binary) search for it */ unsigned int i = 0; while (j - i > 1) { unsigned int m = (i+j)/2; if (ttisnil(&t->array[m - 1])) j = m; else i = m; } return i; } /* else must find a boundary in hash part */ else if (isdummy(t->node)) /* hash part is empty? */ return j; /* that is easy... */ else return unbound_search(t, j); } #if defined(LUA_DEBUG) Node *luaH_mainposition (const Table *t, const TValue *key) { return mainposition(t, key); } int luaH_isdummy (Node *n) { return isdummy(n); } #endif wcc-0.0.2/src/wsh/lua/src/ltable.h0000644000175000017500000000352513110675433015323 0ustar philphil/* ** $Id: ltable.h,v 2.21 2015/11/03 15:47:30 roberto Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ #ifndef ltable_h #define ltable_h #include "lobject.h" #define gnode(t,i) (&(t)->node[i]) #define gval(n) (&(n)->i_val) #define gnext(n) ((n)->i_key.nk.next) /* 'const' to avoid wrong writings that can mess up field 'next' */ #define gkey(n) cast(const TValue*, (&(n)->i_key.tvk)) /* ** writable version of 'gkey'; allows updates to individual fields, ** but not to the whole (which has incompatible type) */ #define wgkey(n) (&(n)->i_key.nk) #define invalidateTMcache(t) ((t)->flags = 0) /* returns the key, given the value of a table entry */ #define keyfromval(v) \ (gkey(cast(Node *, cast(char *, (v)) - offsetof(Node, i_val)))) LUAI_FUNC const TValue *luaH_getint (Table *t, lua_Integer key); LUAI_FUNC void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value); LUAI_FUNC const TValue *luaH_getshortstr (Table *t, TString *key); LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key); LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key); LUAI_FUNC TValue *luaH_newkey (lua_State *L, Table *t, const TValue *key); LUAI_FUNC TValue *luaH_set (lua_State *L, Table *t, const TValue *key); LUAI_FUNC Table *luaH_new (lua_State *L); LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned int nasize, unsigned int nhsize); LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize); LUAI_FUNC void luaH_free (lua_State *L, Table *t); LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key); LUAI_FUNC int luaH_getn (Table *t); #if defined(LUA_DEBUG) LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key); LUAI_FUNC int luaH_isdummy (Node *n); #endif #endif wcc-0.0.2/src/wsh/lua/src/lstate.h0000644000175000017500000001667513110675433015366 0ustar philphil/* ** $Id: lstate.h,v 2.128 2015/11/13 12:16:51 roberto Exp $ ** Global State ** See Copyright Notice in lua.h */ #ifndef lstate_h #define lstate_h #include "lua.h" #include "lobject.h" #include "ltm.h" #include "lzio.h" /* ** Some notes about garbage-collected objects: All objects in Lua must ** be kept somehow accessible until being freed, so all objects always ** belong to one (and only one) of these lists, using field 'next' of ** the 'CommonHeader' for the link: ** ** 'allgc': all objects not marked for finalization; ** 'finobj': all objects marked for finalization; ** 'tobefnz': all objects ready to be finalized; ** 'fixedgc': all objects that are not to be collected (currently ** only small strings, such as reserved words). */ struct lua_longjmp; /* defined in ldo.c */ /* extra stack space to handle TM calls and some other extras */ #define EXTRA_STACK 5 #define BASIC_STACK_SIZE (2*LUA_MINSTACK) /* kinds of Garbage Collection */ #define KGC_NORMAL 0 #define KGC_EMERGENCY 1 /* gc was forced by an allocation failure */ typedef struct stringtable { TString **hash; int nuse; /* number of elements */ int size; } stringtable; /* ** Information about a call. ** When a thread yields, 'func' is adjusted to pretend that the ** top function has only the yielded values in its stack; in that ** case, the actual 'func' value is saved in field 'extra'. ** When a function calls another with a continuation, 'extra' keeps ** the function index so that, in case of errors, the continuation ** function can be called with the correct top. */ typedef struct CallInfo { StkId func; /* function index in the stack */ StkId top; /* top for this function */ struct CallInfo *previous, *next; /* dynamic call link */ union { struct { /* only for Lua functions */ StkId base; /* base for this function */ const Instruction *savedpc; } l; struct { /* only for C functions */ lua_KFunction k; /* continuation in case of yields */ ptrdiff_t old_errfunc; lua_KContext ctx; /* context info. in case of yields */ } c; } u; ptrdiff_t extra; short nresults; /* expected number of results from this function */ lu_byte callstatus; } CallInfo; /* ** Bits in CallInfo status */ #define CIST_OAH (1<<0) /* original value of 'allowhook' */ #define CIST_LUA (1<<1) /* call is running a Lua function */ #define CIST_HOOKED (1<<2) /* call is running a debug hook */ #define CIST_FRESH (1<<3) /* call is running on a fresh invocation of luaV_execute */ #define CIST_YPCALL (1<<4) /* call is a yieldable protected call */ #define CIST_TAIL (1<<5) /* call was tail called */ #define CIST_HOOKYIELD (1<<6) /* last hook called yielded */ #define CIST_LEQ (1<<7) /* using __lt for __le */ #define isLua(ci) ((ci)->callstatus & CIST_LUA) /* assume that CIST_OAH has offset 0 and that 'v' is strictly 0/1 */ #define setoah(st,v) ((st) = ((st) & ~CIST_OAH) | (v)) #define getoah(st) ((st) & CIST_OAH) /* ** 'global state', shared by all threads of this state */ typedef struct global_State { lua_Alloc frealloc; /* function to reallocate memory */ void *ud; /* auxiliary data to 'frealloc' */ l_mem totalbytes; /* number of bytes currently allocated - GCdebt */ l_mem GCdebt; /* bytes allocated not yet compensated by the collector */ lu_mem GCmemtrav; /* memory traversed by the GC */ lu_mem GCestimate; /* an estimate of the non-garbage memory in use */ stringtable strt; /* hash table for strings */ TValue l_registry; unsigned int seed; /* randomized seed for hashes */ lu_byte currentwhite; lu_byte gcstate; /* state of garbage collector */ lu_byte gckind; /* kind of GC running */ lu_byte gcrunning; /* true if GC is running */ GCObject *allgc; /* list of all collectable objects */ GCObject **sweepgc; /* current position of sweep in list */ GCObject *finobj; /* list of collectable objects with finalizers */ GCObject *gray; /* list of gray objects */ GCObject *grayagain; /* list of objects to be traversed atomically */ GCObject *weak; /* list of tables with weak values */ GCObject *ephemeron; /* list of ephemeron tables (weak keys) */ GCObject *allweak; /* list of all-weak tables */ GCObject *tobefnz; /* list of userdata to be GC */ GCObject *fixedgc; /* list of objects not to be collected */ struct lua_State *twups; /* list of threads with open upvalues */ unsigned int gcfinnum; /* number of finalizers to call in each GC step */ int gcpause; /* size of pause between successive GCs */ int gcstepmul; /* GC 'granularity' */ lua_CFunction panic; /* to be called in unprotected errors */ struct lua_State *mainthread; const lua_Number *version; /* pointer to version number */ TString *memerrmsg; /* memory-error message */ TString *tmname[TM_N]; /* array with tag-method names */ struct Table *mt[LUA_NUMTAGS]; /* metatables for basic types */ TString *strcache[STRCACHE_N][STRCACHE_M]; /* cache for strings in API */ } global_State; /* ** 'per thread' state */ struct lua_State { CommonHeader; unsigned short nci; /* number of items in 'ci' list */ lu_byte status; StkId top; /* first free slot in the stack */ global_State *l_G; CallInfo *ci; /* call info for current function */ const Instruction *oldpc; /* last pc traced */ StkId stack_last; /* last free slot in the stack */ StkId stack; /* stack base */ UpVal *openupval; /* list of open upvalues in this stack */ GCObject *gclist; struct lua_State *twups; /* list of threads with open upvalues */ struct lua_longjmp *errorJmp; /* current error recover point */ CallInfo base_ci; /* CallInfo for first level (C calling Lua) */ lua_Hook hook; ptrdiff_t errfunc; /* current error handling function (stack index) */ int stacksize; int basehookcount; int hookcount; unsigned short nny; /* number of non-yieldable calls in stack */ unsigned short nCcalls; /* number of nested C calls */ lu_byte hookmask; lu_byte allowhook; }; #define G(L) (L->l_G) /* ** Union of all collectable objects (only for conversions) */ union GCUnion { GCObject gc; /* common header */ struct TString ts; struct Udata u; union Closure cl; struct Table h; struct Proto p; struct lua_State th; /* thread */ }; #define cast_u(o) cast(union GCUnion *, (o)) /* macros to convert a GCObject into a specific value */ #define gco2ts(o) \ check_exp(novariant((o)->tt) == LUA_TSTRING, &((cast_u(o))->ts)) #define gco2u(o) check_exp((o)->tt == LUA_TUSERDATA, &((cast_u(o))->u)) #define gco2lcl(o) check_exp((o)->tt == LUA_TLCL, &((cast_u(o))->cl.l)) #define gco2ccl(o) check_exp((o)->tt == LUA_TCCL, &((cast_u(o))->cl.c)) #define gco2cl(o) \ check_exp(novariant((o)->tt) == LUA_TFUNCTION, &((cast_u(o))->cl)) #define gco2t(o) check_exp((o)->tt == LUA_TTABLE, &((cast_u(o))->h)) #define gco2p(o) check_exp((o)->tt == LUA_TPROTO, &((cast_u(o))->p)) #define gco2th(o) check_exp((o)->tt == LUA_TTHREAD, &((cast_u(o))->th)) /* macro to convert a Lua object into a GCObject */ #define obj2gco(v) \ check_exp(novariant((v)->tt) < LUA_TDEADKEY, (&(cast_u(v)->gc))) /* actual number of total bytes allocated */ #define gettotalbytes(g) cast(lu_mem, (g)->totalbytes + (g)->GCdebt) LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt); LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1); LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L); LUAI_FUNC void luaE_freeCI (lua_State *L); LUAI_FUNC void luaE_shrinkCI (lua_State *L); #endif wcc-0.0.2/src/wsh/lua/src/lapi.c0000644000175000017500000007512313110675433015003 0ustar philphil/* ** $Id: lapi.c,v 2.257 2015/11/02 18:48:07 roberto Exp $ ** Lua API ** See Copyright Notice in lua.h */ #define lapi_c #define LUA_CORE #include "lprefix.h" #include #include #include "lua.h" #include "lapi.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" #include "lundump.h" #include "lvm.h" const char lua_ident[] = "$LuaVersion: " LUA_COPYRIGHT " $" "$LuaAuthors: " LUA_AUTHORS " $"; /* value at a non-valid index */ #define NONVALIDVALUE cast(TValue *, luaO_nilobject) /* corresponding test */ #define isvalid(o) ((o) != luaO_nilobject) /* test for pseudo index */ #define ispseudo(i) ((i) <= LUA_REGISTRYINDEX) /* test for upvalue */ #define isupvalue(i) ((i) < LUA_REGISTRYINDEX) /* test for valid but not pseudo index */ #define isstackindex(i, o) (isvalid(o) && !ispseudo(i)) #define api_checkvalidindex(l,o) api_check(l, isvalid(o), "invalid index") #define api_checkstackindex(l, i, o) \ api_check(l, isstackindex(i, o), "index not in the stack") static TValue *index2addr (lua_State *L, int idx) { CallInfo *ci = L->ci; if (idx > 0) { TValue *o = ci->func + idx; api_check(L, idx <= ci->top - (ci->func + 1), "unacceptable index"); if (o >= L->top) return NONVALIDVALUE; else return o; } else if (!ispseudo(idx)) { /* negative index */ api_check(L, idx != 0 && -idx <= L->top - (ci->func + 1), "invalid index"); return L->top + idx; } else if (idx == LUA_REGISTRYINDEX) return &G(L)->l_registry; else { /* upvalues */ idx = LUA_REGISTRYINDEX - idx; api_check(L, idx <= MAXUPVAL + 1, "upvalue index too large"); if (ttislcf(ci->func)) /* light C function? */ return NONVALIDVALUE; /* it has no upvalues */ else { CClosure *func = clCvalue(ci->func); return (idx <= func->nupvalues) ? &func->upvalue[idx-1] : NONVALIDVALUE; } } } /* ** to be called by 'lua_checkstack' in protected mode, to grow stack ** capturing memory errors */ static void growstack (lua_State *L, void *ud) { int size = *(int *)ud; luaD_growstack(L, size); } LUA_API int lua_checkstack (lua_State *L, int n) { int res; CallInfo *ci = L->ci; lua_lock(L); api_check(L, n >= 0, "negative 'n'"); if (L->stack_last - L->top > n) /* stack large enough? */ res = 1; /* yes; check is OK */ else { /* no; need to grow stack */ int inuse = cast_int(L->top - L->stack) + EXTRA_STACK; if (inuse > LUAI_MAXSTACK - n) /* can grow without overflow? */ res = 0; /* no */ else /* try to grow stack */ res = (luaD_rawrunprotected(L, &growstack, &n) == LUA_OK); } if (res && ci->top < L->top + n) ci->top = L->top + n; /* adjust frame top */ lua_unlock(L); return res; } LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) { int i; if (from == to) return; lua_lock(to); api_checknelems(from, n); api_check(from, G(from) == G(to), "moving among independent states"); api_check(from, to->ci->top - to->top >= n, "stack overflow"); from->top -= n; for (i = 0; i < n; i++) { setobj2s(to, to->top, from->top + i); to->top++; /* stack already checked by previous 'api_check' */ } lua_unlock(to); } LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) { lua_CFunction old; lua_lock(L); old = G(L)->panic; G(L)->panic = panicf; lua_unlock(L); return old; } LUA_API const lua_Number *lua_version (lua_State *L) { static const lua_Number version = LUA_VERSION_NUM; if (L == NULL) return &version; else return G(L)->version; } /* ** basic stack manipulation */ /* ** convert an acceptable stack index into an absolute index */ LUA_API int lua_absindex (lua_State *L, int idx) { return (idx > 0 || ispseudo(idx)) ? idx : cast_int(L->top - L->ci->func) + idx; } LUA_API int lua_gettop (lua_State *L) { return cast_int(L->top - (L->ci->func + 1)); } LUA_API void lua_settop (lua_State *L, int idx) { StkId func = L->ci->func; lua_lock(L); if (idx >= 0) { api_check(L, idx <= L->stack_last - (func + 1), "new top too large"); while (L->top < (func + 1) + idx) setnilvalue(L->top++); L->top = (func + 1) + idx; } else { api_check(L, -(idx+1) <= (L->top - (func + 1)), "invalid new top"); L->top += idx+1; /* 'subtract' index (index is negative) */ } lua_unlock(L); } /* ** Reverse the stack segment from 'from' to 'to' ** (auxiliary to 'lua_rotate') */ static void reverse (lua_State *L, StkId from, StkId to) { for (; from < to; from++, to--) { TValue temp; setobj(L, &temp, from); setobjs2s(L, from, to); setobj2s(L, to, &temp); } } /* ** Let x = AB, where A is a prefix of length 'n'. Then, ** rotate x n == BA. But BA == (A^r . B^r)^r. */ LUA_API void lua_rotate (lua_State *L, int idx, int n) { StkId p, t, m; lua_lock(L); t = L->top - 1; /* end of stack segment being rotated */ p = index2addr(L, idx); /* start of segment */ api_checkstackindex(L, idx, p); api_check(L, (n >= 0 ? n : -n) <= (t - p + 1), "invalid 'n'"); m = (n >= 0 ? t - n : p - n - 1); /* end of prefix */ reverse(L, p, m); /* reverse the prefix with length 'n' */ reverse(L, m + 1, t); /* reverse the suffix */ reverse(L, p, t); /* reverse the entire segment */ lua_unlock(L); } LUA_API void lua_copy (lua_State *L, int fromidx, int toidx) { TValue *fr, *to; lua_lock(L); fr = index2addr(L, fromidx); to = index2addr(L, toidx); api_checkvalidindex(L, to); setobj(L, to, fr); if (isupvalue(toidx)) /* function upvalue? */ luaC_barrier(L, clCvalue(L->ci->func), fr); /* LUA_REGISTRYINDEX does not need gc barrier (collector revisits it before finishing collection) */ lua_unlock(L); } LUA_API void lua_pushvalue (lua_State *L, int idx) { lua_lock(L); setobj2s(L, L->top, index2addr(L, idx)); api_incr_top(L); lua_unlock(L); } /* ** access functions (stack -> C) */ LUA_API int lua_type (lua_State *L, int idx) { StkId o = index2addr(L, idx); return (isvalid(o) ? ttnov(o) : LUA_TNONE); } LUA_API const char *lua_typename (lua_State *L, int t) { UNUSED(L); api_check(L, LUA_TNONE <= t && t < LUA_NUMTAGS, "invalid tag"); return ttypename(t); } LUA_API int lua_iscfunction (lua_State *L, int idx) { StkId o = index2addr(L, idx); return (ttislcf(o) || (ttisCclosure(o))); } LUA_API int lua_isinteger (lua_State *L, int idx) { StkId o = index2addr(L, idx); return ttisinteger(o); } LUA_API int lua_isnumber (lua_State *L, int idx) { lua_Number n; const TValue *o = index2addr(L, idx); return tonumber(o, &n); } LUA_API int lua_isstring (lua_State *L, int idx) { const TValue *o = index2addr(L, idx); return (ttisstring(o) || cvt2str(o)); } LUA_API int lua_isuserdata (lua_State *L, int idx) { const TValue *o = index2addr(L, idx); return (ttisfulluserdata(o) || ttislightuserdata(o)); } LUA_API int lua_rawequal (lua_State *L, int index1, int index2) { StkId o1 = index2addr(L, index1); StkId o2 = index2addr(L, index2); return (isvalid(o1) && isvalid(o2)) ? luaV_rawequalobj(o1, o2) : 0; } LUA_API void lua_arith (lua_State *L, int op) { lua_lock(L); if (op != LUA_OPUNM && op != LUA_OPBNOT) api_checknelems(L, 2); /* all other operations expect two operands */ else { /* for unary operations, add fake 2nd operand */ api_checknelems(L, 1); setobjs2s(L, L->top, L->top - 1); api_incr_top(L); } /* first operand at top - 2, second at top - 1; result go to top - 2 */ luaO_arith(L, op, L->top - 2, L->top - 1, L->top - 2); L->top--; /* remove second operand */ lua_unlock(L); } LUA_API int lua_compare (lua_State *L, int index1, int index2, int op) { StkId o1, o2; int i = 0; lua_lock(L); /* may call tag method */ o1 = index2addr(L, index1); o2 = index2addr(L, index2); if (isvalid(o1) && isvalid(o2)) { switch (op) { case LUA_OPEQ: i = luaV_equalobj(L, o1, o2); break; case LUA_OPLT: i = luaV_lessthan(L, o1, o2); break; case LUA_OPLE: i = luaV_lessequal(L, o1, o2); break; default: api_check(L, 0, "invalid option"); } } lua_unlock(L); return i; } LUA_API size_t lua_stringtonumber (lua_State *L, const char *s) { size_t sz = luaO_str2num(s, L->top); if (sz != 0) api_incr_top(L); return sz; } LUA_API lua_Number lua_tonumberx (lua_State *L, int idx, int *pisnum) { lua_Number n; const TValue *o = index2addr(L, idx); int isnum = tonumber(o, &n); if (!isnum) n = 0; /* call to 'tonumber' may change 'n' even if it fails */ if (pisnum) *pisnum = isnum; return n; } LUA_API lua_Integer lua_tointegerx (lua_State *L, int idx, int *pisnum) { lua_Integer res; const TValue *o = index2addr(L, idx); int isnum = tointeger(o, &res); if (!isnum) res = 0; /* call to 'tointeger' may change 'n' even if it fails */ if (pisnum) *pisnum = isnum; return res; } LUA_API int lua_toboolean (lua_State *L, int idx) { const TValue *o = index2addr(L, idx); return !l_isfalse(o); } LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) { StkId o = index2addr(L, idx); if (!ttisstring(o)) { if (!cvt2str(o)) { /* not convertible? */ if (len != NULL) *len = 0; return NULL; } lua_lock(L); /* 'luaO_tostring' may create a new string */ luaC_checkGC(L); o = index2addr(L, idx); /* previous call may reallocate the stack */ luaO_tostring(L, o); lua_unlock(L); } if (len != NULL) *len = vslen(o); return svalue(o); } LUA_API size_t lua_rawlen (lua_State *L, int idx) { StkId o = index2addr(L, idx); switch (ttype(o)) { case LUA_TSHRSTR: return tsvalue(o)->shrlen; case LUA_TLNGSTR: return tsvalue(o)->u.lnglen; case LUA_TUSERDATA: return uvalue(o)->len; case LUA_TTABLE: return luaH_getn(hvalue(o)); default: return 0; } } LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) { StkId o = index2addr(L, idx); if (ttislcf(o)) return fvalue(o); else if (ttisCclosure(o)) return clCvalue(o)->f; else return NULL; /* not a C function */ } LUA_API void *lua_touserdata (lua_State *L, int idx) { StkId o = index2addr(L, idx); switch (ttnov(o)) { case LUA_TUSERDATA: return getudatamem(uvalue(o)); case LUA_TLIGHTUSERDATA: return pvalue(o); default: return NULL; } } LUA_API lua_State *lua_tothread (lua_State *L, int idx) { StkId o = index2addr(L, idx); return (!ttisthread(o)) ? NULL : thvalue(o); } LUA_API const void *lua_topointer (lua_State *L, int idx) { StkId o = index2addr(L, idx); switch (ttype(o)) { case LUA_TTABLE: return hvalue(o); case LUA_TLCL: return clLvalue(o); case LUA_TCCL: return clCvalue(o); case LUA_TLCF: return cast(void *, cast(size_t, fvalue(o))); case LUA_TTHREAD: return thvalue(o); case LUA_TUSERDATA: return getudatamem(uvalue(o)); case LUA_TLIGHTUSERDATA: return pvalue(o); default: return NULL; } } /* ** push functions (C -> stack) */ LUA_API void lua_pushnil (lua_State *L) { lua_lock(L); setnilvalue(L->top); api_incr_top(L); lua_unlock(L); } LUA_API void lua_pushnumber (lua_State *L, lua_Number n) { lua_lock(L); setfltvalue(L->top, n); api_incr_top(L); lua_unlock(L); } LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) { lua_lock(L); setivalue(L->top, n); api_incr_top(L); lua_unlock(L); } /* ** Pushes on the stack a string with given length. Avoid using 's' when ** 'len' == 0 (as 's' can be NULL in that case), due to later use of ** 'memcmp' and 'memcpy'. */ LUA_API const char *lua_pushlstring (lua_State *L, const char *s, size_t len) { TString *ts; lua_lock(L); luaC_checkGC(L); ts = (len == 0) ? luaS_new(L, "") : luaS_newlstr(L, s, len); setsvalue2s(L, L->top, ts); api_incr_top(L); lua_unlock(L); return getstr(ts); } LUA_API const char *lua_pushstring (lua_State *L, const char *s) { lua_lock(L); if (s == NULL) setnilvalue(L->top); else { TString *ts; luaC_checkGC(L); ts = luaS_new(L, s); setsvalue2s(L, L->top, ts); s = getstr(ts); /* internal copy's address */ } api_incr_top(L); lua_unlock(L); return s; } LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt, va_list argp) { const char *ret; lua_lock(L); luaC_checkGC(L); ret = luaO_pushvfstring(L, fmt, argp); lua_unlock(L); return ret; } LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) { const char *ret; va_list argp; lua_lock(L); luaC_checkGC(L); va_start(argp, fmt); ret = luaO_pushvfstring(L, fmt, argp); va_end(argp); lua_unlock(L); return ret; } LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) { lua_lock(L); if (n == 0) { setfvalue(L->top, fn); } else { CClosure *cl; api_checknelems(L, n); api_check(L, n <= MAXUPVAL, "upvalue index too large"); luaC_checkGC(L); cl = luaF_newCclosure(L, n); cl->f = fn; L->top -= n; while (n--) { setobj2n(L, &cl->upvalue[n], L->top + n); /* does not need barrier because closure is white */ } setclCvalue(L, L->top, cl); } api_incr_top(L); lua_unlock(L); } LUA_API void lua_pushboolean (lua_State *L, int b) { lua_lock(L); setbvalue(L->top, (b != 0)); /* ensure that true is 1 */ api_incr_top(L); lua_unlock(L); } LUA_API void lua_pushlightuserdata (lua_State *L, void *p) { lua_lock(L); setpvalue(L->top, p); api_incr_top(L); lua_unlock(L); } LUA_API int lua_pushthread (lua_State *L) { lua_lock(L); setthvalue(L, L->top, L); api_incr_top(L); lua_unlock(L); return (G(L)->mainthread == L); } /* ** get functions (Lua -> stack) */ static int auxgetstr (lua_State *L, const TValue *t, const char *k) { const TValue *aux; TString *str = luaS_new(L, k); if (luaV_fastget(L, t, str, aux, luaH_getstr)) { setobj2s(L, L->top, aux); api_incr_top(L); } else { setsvalue2s(L, L->top, str); api_incr_top(L); luaV_finishget(L, t, L->top - 1, L->top - 1, aux); } lua_unlock(L); return ttnov(L->top - 1); } LUA_API int lua_getglobal (lua_State *L, const char *name) { Table *reg = hvalue(&G(L)->l_registry); lua_lock(L); return auxgetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name); } LUA_API int lua_gettable (lua_State *L, int idx) { StkId t; lua_lock(L); t = index2addr(L, idx); luaV_gettable(L, t, L->top - 1, L->top - 1); lua_unlock(L); return ttnov(L->top - 1); } LUA_API int lua_getfield (lua_State *L, int idx, const char *k) { lua_lock(L); return auxgetstr(L, index2addr(L, idx), k); } LUA_API int lua_geti (lua_State *L, int idx, lua_Integer n) { StkId t; const TValue *aux; lua_lock(L); t = index2addr(L, idx); if (luaV_fastget(L, t, n, aux, luaH_getint)) { setobj2s(L, L->top, aux); api_incr_top(L); } else { setivalue(L->top, n); api_incr_top(L); luaV_finishget(L, t, L->top - 1, L->top - 1, aux); } lua_unlock(L); return ttnov(L->top - 1); } LUA_API int lua_rawget (lua_State *L, int idx) { StkId t; lua_lock(L); t = index2addr(L, idx); api_check(L, ttistable(t), "table expected"); setobj2s(L, L->top - 1, luaH_get(hvalue(t), L->top - 1)); lua_unlock(L); return ttnov(L->top - 1); } LUA_API int lua_rawgeti (lua_State *L, int idx, lua_Integer n) { StkId t; lua_lock(L); t = index2addr(L, idx); api_check(L, ttistable(t), "table expected"); setobj2s(L, L->top, luaH_getint(hvalue(t), n)); api_incr_top(L); lua_unlock(L); return ttnov(L->top - 1); } LUA_API int lua_rawgetp (lua_State *L, int idx, const void *p) { StkId t; TValue k; lua_lock(L); t = index2addr(L, idx); api_check(L, ttistable(t), "table expected"); setpvalue(&k, cast(void *, p)); setobj2s(L, L->top, luaH_get(hvalue(t), &k)); api_incr_top(L); lua_unlock(L); return ttnov(L->top - 1); } LUA_API void lua_createtable (lua_State *L, int narray, int nrec) { Table *t; lua_lock(L); luaC_checkGC(L); t = luaH_new(L); sethvalue(L, L->top, t); api_incr_top(L); if (narray > 0 || nrec > 0) luaH_resize(L, t, narray, nrec); lua_unlock(L); } LUA_API int lua_getmetatable (lua_State *L, int objindex) { const TValue *obj; Table *mt; int res = 0; lua_lock(L); obj = index2addr(L, objindex); switch (ttnov(obj)) { case LUA_TTABLE: mt = hvalue(obj)->metatable; break; case LUA_TUSERDATA: mt = uvalue(obj)->metatable; break; default: mt = G(L)->mt[ttnov(obj)]; break; } if (mt != NULL) { sethvalue(L, L->top, mt); api_incr_top(L); res = 1; } lua_unlock(L); return res; } LUA_API int lua_getuservalue (lua_State *L, int idx) { StkId o; lua_lock(L); o = index2addr(L, idx); api_check(L, ttisfulluserdata(o), "full userdata expected"); getuservalue(L, uvalue(o), L->top); api_incr_top(L); lua_unlock(L); return ttnov(L->top - 1); } /* ** set functions (stack -> Lua) */ /* ** t[k] = value at the top of the stack (where 'k' is a string) */ static void auxsetstr (lua_State *L, const TValue *t, const char *k) { const TValue *aux; TString *str = luaS_new(L, k); api_checknelems(L, 1); if (luaV_fastset(L, t, str, aux, luaH_getstr, L->top - 1)) L->top--; /* pop value */ else { setsvalue2s(L, L->top, str); /* push 'str' (to make it a TValue) */ api_incr_top(L); luaV_finishset(L, t, L->top - 1, L->top - 2, aux); L->top -= 2; /* pop value and key */ } lua_unlock(L); /* lock done by caller */ } LUA_API void lua_setglobal (lua_State *L, const char *name) { Table *reg = hvalue(&G(L)->l_registry); lua_lock(L); /* unlock done in 'auxsetstr' */ auxsetstr(L, luaH_getint(reg, LUA_RIDX_GLOBALS), name); } LUA_API void lua_settable (lua_State *L, int idx) { StkId t; lua_lock(L); api_checknelems(L, 2); t = index2addr(L, idx); luaV_settable(L, t, L->top - 2, L->top - 1); L->top -= 2; /* pop index and value */ lua_unlock(L); } LUA_API void lua_setfield (lua_State *L, int idx, const char *k) { lua_lock(L); /* unlock done in 'auxsetstr' */ auxsetstr(L, index2addr(L, idx), k); } LUA_API void lua_seti (lua_State *L, int idx, lua_Integer n) { StkId t; const TValue *aux; lua_lock(L); api_checknelems(L, 1); t = index2addr(L, idx); if (luaV_fastset(L, t, n, aux, luaH_getint, L->top - 1)) L->top--; /* pop value */ else { setivalue(L->top, n); api_incr_top(L); luaV_finishset(L, t, L->top - 1, L->top - 2, aux); L->top -= 2; /* pop value and key */ } lua_unlock(L); } LUA_API void lua_rawset (lua_State *L, int idx) { StkId o; TValue *slot; lua_lock(L); api_checknelems(L, 2); o = index2addr(L, idx); api_check(L, ttistable(o), "table expected"); slot = luaH_set(L, hvalue(o), L->top - 2); setobj2t(L, slot, L->top - 1); invalidateTMcache(hvalue(o)); luaC_barrierback(L, hvalue(o), L->top-1); L->top -= 2; lua_unlock(L); } LUA_API void lua_rawseti (lua_State *L, int idx, lua_Integer n) { StkId o; lua_lock(L); api_checknelems(L, 1); o = index2addr(L, idx); api_check(L, ttistable(o), "table expected"); luaH_setint(L, hvalue(o), n, L->top - 1); luaC_barrierback(L, hvalue(o), L->top-1); L->top--; lua_unlock(L); } LUA_API void lua_rawsetp (lua_State *L, int idx, const void *p) { StkId o; TValue k, *slot; lua_lock(L); api_checknelems(L, 1); o = index2addr(L, idx); api_check(L, ttistable(o), "table expected"); setpvalue(&k, cast(void *, p)); slot = luaH_set(L, hvalue(o), &k); setobj2t(L, slot, L->top - 1); luaC_barrierback(L, hvalue(o), L->top - 1); L->top--; lua_unlock(L); } LUA_API int lua_setmetatable (lua_State *L, int objindex) { TValue *obj; Table *mt; lua_lock(L); api_checknelems(L, 1); obj = index2addr(L, objindex); if (ttisnil(L->top - 1)) mt = NULL; else { api_check(L, ttistable(L->top - 1), "table expected"); mt = hvalue(L->top - 1); } switch (ttnov(obj)) { case LUA_TTABLE: { hvalue(obj)->metatable = mt; if (mt) { luaC_objbarrier(L, gcvalue(obj), mt); luaC_checkfinalizer(L, gcvalue(obj), mt); } break; } case LUA_TUSERDATA: { uvalue(obj)->metatable = mt; if (mt) { luaC_objbarrier(L, uvalue(obj), mt); luaC_checkfinalizer(L, gcvalue(obj), mt); } break; } default: { G(L)->mt[ttnov(obj)] = mt; break; } } L->top--; lua_unlock(L); return 1; } LUA_API void lua_setuservalue (lua_State *L, int idx) { StkId o; lua_lock(L); api_checknelems(L, 1); o = index2addr(L, idx); api_check(L, ttisfulluserdata(o), "full userdata expected"); setuservalue(L, uvalue(o), L->top - 1); luaC_barrier(L, gcvalue(o), L->top - 1); L->top--; lua_unlock(L); } /* ** 'load' and 'call' functions (run Lua code) */ #define checkresults(L,na,nr) \ api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)), \ "results from function overflow current stack size") LUA_API void lua_callk (lua_State *L, int nargs, int nresults, lua_KContext ctx, lua_KFunction k) { StkId func; lua_lock(L); api_check(L, k == NULL || !isLua(L->ci), "cannot use continuations inside hooks"); api_checknelems(L, nargs+1); api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread"); checkresults(L, nargs, nresults); func = L->top - (nargs+1); if (k != NULL && L->nny == 0) { /* need to prepare continuation? */ L->ci->u.c.k = k; /* save continuation */ L->ci->u.c.ctx = ctx; /* save context */ luaD_call(L, func, nresults); /* do the call */ } else /* no continuation or no yieldable */ luaD_callnoyield(L, func, nresults); /* just do the call */ adjustresults(L, nresults); lua_unlock(L); } /* ** Execute a protected call. */ struct CallS { /* data to 'f_call' */ StkId func; int nresults; }; static void f_call (lua_State *L, void *ud) { struct CallS *c = cast(struct CallS *, ud); luaD_callnoyield(L, c->func, c->nresults); } LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc, lua_KContext ctx, lua_KFunction k) { struct CallS c; int status; ptrdiff_t func; lua_lock(L); api_check(L, k == NULL || !isLua(L->ci), "cannot use continuations inside hooks"); api_checknelems(L, nargs+1); api_check(L, L->status == LUA_OK, "cannot do calls on non-normal thread"); checkresults(L, nargs, nresults); if (errfunc == 0) func = 0; else { StkId o = index2addr(L, errfunc); api_checkstackindex(L, errfunc, o); func = savestack(L, o); } c.func = L->top - (nargs+1); /* function to be called */ if (k == NULL || L->nny > 0) { /* no continuation or no yieldable? */ c.nresults = nresults; /* do a 'conventional' protected call */ status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func); } else { /* prepare continuation (call is already protected by 'resume') */ CallInfo *ci = L->ci; ci->u.c.k = k; /* save continuation */ ci->u.c.ctx = ctx; /* save context */ /* save information for error recovery */ ci->extra = savestack(L, c.func); ci->u.c.old_errfunc = L->errfunc; L->errfunc = func; setoah(ci->callstatus, L->allowhook); /* save value of 'allowhook' */ ci->callstatus |= CIST_YPCALL; /* function can do error recovery */ luaD_call(L, c.func, nresults); /* do the call */ ci->callstatus &= ~CIST_YPCALL; L->errfunc = ci->u.c.old_errfunc; status = LUA_OK; /* if it is here, there were no errors */ } adjustresults(L, nresults); lua_unlock(L); return status; } LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data, const char *chunkname, const char *mode) { ZIO z; int status; lua_lock(L); if (!chunkname) chunkname = "?"; luaZ_init(L, &z, reader, data); status = luaD_protectedparser(L, &z, chunkname, mode); if (status == LUA_OK) { /* no errors? */ LClosure *f = clLvalue(L->top - 1); /* get newly created function */ if (f->nupvalues >= 1) { /* does it have an upvalue? */ /* get global table from registry */ Table *reg = hvalue(&G(L)->l_registry); const TValue *gt = luaH_getint(reg, LUA_RIDX_GLOBALS); /* set global table as 1st upvalue of 'f' (may be LUA_ENV) */ setobj(L, f->upvals[0]->v, gt); luaC_upvalbarrier(L, f->upvals[0]); } } lua_unlock(L); return status; } LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data, int strip) { int status; TValue *o; lua_lock(L); api_checknelems(L, 1); o = L->top - 1; if (isLfunction(o)) status = luaU_dump(L, getproto(o), writer, data, strip); else status = 1; lua_unlock(L); return status; } LUA_API int lua_status (lua_State *L) { return L->status; } /* ** Garbage-collection function */ LUA_API int lua_gc (lua_State *L, int what, int data) { int res = 0; global_State *g; lua_lock(L); g = G(L); switch (what) { case LUA_GCSTOP: { g->gcrunning = 0; break; } case LUA_GCRESTART: { luaE_setdebt(g, 0); g->gcrunning = 1; break; } case LUA_GCCOLLECT: { luaC_fullgc(L, 0); break; } case LUA_GCCOUNT: { /* GC values are expressed in Kbytes: #bytes/2^10 */ res = cast_int(gettotalbytes(g) >> 10); break; } case LUA_GCCOUNTB: { res = cast_int(gettotalbytes(g) & 0x3ff); break; } case LUA_GCSTEP: { l_mem debt = 1; /* =1 to signal that it did an actual step */ lu_byte oldrunning = g->gcrunning; g->gcrunning = 1; /* allow GC to run */ if (data == 0) { luaE_setdebt(g, -GCSTEPSIZE); /* to do a "small" step */ luaC_step(L); } else { /* add 'data' to total debt */ debt = cast(l_mem, data) * 1024 + g->GCdebt; luaE_setdebt(g, debt); luaC_checkGC(L); } g->gcrunning = oldrunning; /* restore previous state */ if (debt > 0 && g->gcstate == GCSpause) /* end of cycle? */ res = 1; /* signal it */ break; } case LUA_GCSETPAUSE: { res = g->gcpause; g->gcpause = data; break; } case LUA_GCSETSTEPMUL: { res = g->gcstepmul; if (data < 40) data = 40; /* avoid ridiculous low values (and 0) */ g->gcstepmul = data; break; } case LUA_GCISRUNNING: { res = g->gcrunning; break; } default: res = -1; /* invalid option */ } lua_unlock(L); return res; } /* ** miscellaneous functions */ LUA_API int lua_error (lua_State *L) { lua_lock(L); api_checknelems(L, 1); luaG_errormsg(L); /* code unreachable; will unlock when control actually leaves the kernel */ return 0; /* to avoid warnings */ } LUA_API int lua_next (lua_State *L, int idx) { StkId t; int more; lua_lock(L); t = index2addr(L, idx); api_check(L, ttistable(t), "table expected"); more = luaH_next(L, hvalue(t), L->top - 1); if (more) { api_incr_top(L); } else /* no more elements */ L->top -= 1; /* remove key */ lua_unlock(L); return more; } LUA_API void lua_concat (lua_State *L, int n) { lua_lock(L); api_checknelems(L, n); if (n >= 2) { luaC_checkGC(L); luaV_concat(L, n); } else if (n == 0) { /* push empty string */ setsvalue2s(L, L->top, luaS_newlstr(L, "", 0)); api_incr_top(L); } /* else n == 1; nothing to do */ lua_unlock(L); } LUA_API void lua_len (lua_State *L, int idx) { StkId t; lua_lock(L); t = index2addr(L, idx); luaV_objlen(L, L->top, t); api_incr_top(L); lua_unlock(L); } LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) { lua_Alloc f; lua_lock(L); if (ud) *ud = G(L)->ud; f = G(L)->frealloc; lua_unlock(L); return f; } LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) { lua_lock(L); G(L)->ud = ud; G(L)->frealloc = f; lua_unlock(L); } LUA_API void *lua_newuserdata (lua_State *L, size_t size) { Udata *u; lua_lock(L); luaC_checkGC(L); u = luaS_newudata(L, size); setuvalue(L, L->top, u); api_incr_top(L); lua_unlock(L); return getudatamem(u); } static const char *aux_upvalue (StkId fi, int n, TValue **val, CClosure **owner, UpVal **uv) { switch (ttype(fi)) { case LUA_TCCL: { /* C closure */ CClosure *f = clCvalue(fi); if (!(1 <= n && n <= f->nupvalues)) return NULL; *val = &f->upvalue[n-1]; if (owner) *owner = f; return ""; } case LUA_TLCL: { /* Lua closure */ LClosure *f = clLvalue(fi); TString *name; Proto *p = f->p; if (!(1 <= n && n <= p->sizeupvalues)) return NULL; *val = f->upvals[n-1]->v; if (uv) *uv = f->upvals[n - 1]; name = p->upvalues[n-1].name; return (name == NULL) ? "(*no name)" : getstr(name); } default: return NULL; /* not a closure */ } } LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) { const char *name; TValue *val = NULL; /* to avoid warnings */ lua_lock(L); name = aux_upvalue(index2addr(L, funcindex), n, &val, NULL, NULL); if (name) { setobj2s(L, L->top, val); api_incr_top(L); } lua_unlock(L); return name; } LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) { const char *name; TValue *val = NULL; /* to avoid warnings */ CClosure *owner = NULL; UpVal *uv = NULL; StkId fi; lua_lock(L); fi = index2addr(L, funcindex); api_checknelems(L, 1); name = aux_upvalue(fi, n, &val, &owner, &uv); if (name) { L->top--; setobj(L, val, L->top); if (owner) { luaC_barrier(L, owner, L->top); } else if (uv) { luaC_upvalbarrier(L, uv); } } lua_unlock(L); return name; } static UpVal **getupvalref (lua_State *L, int fidx, int n, LClosure **pf) { LClosure *f; StkId fi = index2addr(L, fidx); api_check(L, ttisLclosure(fi), "Lua function expected"); f = clLvalue(fi); api_check(L, (1 <= n && n <= f->p->sizeupvalues), "invalid upvalue index"); if (pf) *pf = f; return &f->upvals[n - 1]; /* get its upvalue pointer */ } LUA_API void *lua_upvalueid (lua_State *L, int fidx, int n) { StkId fi = index2addr(L, fidx); switch (ttype(fi)) { case LUA_TLCL: { /* lua closure */ return *getupvalref(L, fidx, n, NULL); } case LUA_TCCL: { /* C closure */ CClosure *f = clCvalue(fi); api_check(L, 1 <= n && n <= f->nupvalues, "invalid upvalue index"); return &f->upvalue[n - 1]; } default: { api_check(L, 0, "closure expected"); return NULL; } } } LUA_API void lua_upvaluejoin (lua_State *L, int fidx1, int n1, int fidx2, int n2) { LClosure *f1; UpVal **up1 = getupvalref(L, fidx1, n1, &f1); UpVal **up2 = getupvalref(L, fidx2, n2, NULL); luaC_upvdeccount(L, *up1); *up1 = *up2; (*up1)->refcount++; if (upisopen(*up1)) (*up1)->u.open.touched = 1; luaC_upvalbarrier(L, *up1); } wcc-0.0.2/src/wsh/lua/src/lzio.c0000644000175000017500000000252113110675433015023 0ustar philphil/* ** $Id: lzio.c,v 1.37 2015/09/08 15:41:05 roberto Exp $ ** Buffered streams ** See Copyright Notice in lua.h */ #define lzio_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "llimits.h" #include "lmem.h" #include "lstate.h" #include "lzio.h" int luaZ_fill (ZIO *z) { size_t size; lua_State *L = z->L; const char *buff; lua_unlock(L); buff = z->reader(L, z->data, &size); lua_lock(L); if (buff == NULL || size == 0) return EOZ; z->n = size - 1; /* discount char being returned */ z->p = buff; return cast_uchar(*(z->p++)); } void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) { z->L = L; z->reader = reader; z->data = data; z->n = 0; z->p = NULL; } /* --------------------------------------------------------------- read --- */ size_t luaZ_read (ZIO *z, void *b, size_t n) { while (n) { size_t m; if (z->n == 0) { /* no bytes in buffer? */ if (luaZ_fill(z) == EOZ) /* try to read more */ return n; /* no more input; return number of missing bytes */ else { z->n++; /* luaZ_fill consumed first byte; put it back */ z->p--; } } m = (n <= z->n) ? n : z->n; /* min. between n and z->n */ memcpy(b, z->p, m); z->n -= m; z->p += m; b = (char *)b + m; n -= m; } return 0; } wcc-0.0.2/src/wsh/lua/src/lprefix.h0000644000175000017500000000154313110675433015527 0ustar philphil/* ** $Id: lprefix.h,v 1.2 2014/12/29 16:54:13 roberto Exp $ ** Definitions for Lua code that must come before any other header file ** See Copyright Notice in lua.h */ #ifndef lprefix_h #define lprefix_h /* ** Allows POSIX/XSI stuff */ #if !defined(LUA_USE_C89) /* { */ #if !defined(_XOPEN_SOURCE) #define _XOPEN_SOURCE 600 #elif _XOPEN_SOURCE == 0 #undef _XOPEN_SOURCE /* use -D_XOPEN_SOURCE=0 to undefine it */ #endif /* ** Allows manipulation of large files in gcc and some other compilers */ #if !defined(LUA_32BITS) && !defined(_FILE_OFFSET_BITS) #define _LARGEFILE_SOURCE 1 #define _FILE_OFFSET_BITS 64 #endif #endif /* } */ /* ** Windows stuff */ #if defined(_WIN32) /* { */ #if !defined(_CRT_SECURE_NO_WARNINGS) #define _CRT_SECURE_NO_WARNINGS /* avoid warnings about ISO C functions */ #endif #endif /* } */ #endif wcc-0.0.2/src/wsh/lua/src/lvm.h0000644000175000017500000000726313110675433014661 0ustar philphil/* ** $Id: lvm.h,v 2.39 2015/09/09 13:44:07 roberto Exp $ ** Lua virtual machine ** See Copyright Notice in lua.h */ #ifndef lvm_h #define lvm_h #include "ldo.h" #include "lobject.h" #include "ltm.h" #if !defined(LUA_NOCVTN2S) #define cvt2str(o) ttisnumber(o) #else #define cvt2str(o) 0 /* no conversion from numbers to strings */ #endif #if !defined(LUA_NOCVTS2N) #define cvt2num(o) ttisstring(o) #else #define cvt2num(o) 0 /* no conversion from strings to numbers */ #endif /* ** You can define LUA_FLOORN2I if you want to convert floats to integers ** by flooring them (instead of raising an error if they are not ** integral values) */ #if !defined(LUA_FLOORN2I) #define LUA_FLOORN2I 0 #endif #define tonumber(o,n) \ (ttisfloat(o) ? (*(n) = fltvalue(o), 1) : luaV_tonumber_(o,n)) #define tointeger(o,i) \ (ttisinteger(o) ? (*(i) = ivalue(o), 1) : luaV_tointeger(o,i,LUA_FLOORN2I)) #define intop(op,v1,v2) l_castU2S(l_castS2U(v1) op l_castS2U(v2)) #define luaV_rawequalobj(t1,t2) luaV_equalobj(NULL,t1,t2) /* ** fast track for 'gettable': 1 means 'aux' points to resulted value; ** 0 means 'aux' is metamethod (if 't' is a table) or NULL. 'f' is ** the raw get function to use. */ #define luaV_fastget(L,t,k,aux,f) \ (!ttistable(t) \ ? (aux = NULL, 0) /* not a table; 'aux' is NULL and result is 0 */ \ : (aux = f(hvalue(t), k), /* else, do raw access */ \ !ttisnil(aux) ? 1 /* result not nil? 'aux' has it */ \ : (aux = fasttm(L, hvalue(t)->metatable, TM_INDEX), /* get metamethod */\ aux != NULL ? 0 /* has metamethod? must call it */ \ : (aux = luaO_nilobject, 1)))) /* else, final result is nil */ /* ** standard implementation for 'gettable' */ #define luaV_gettable(L,t,k,v) { const TValue *aux; \ if (luaV_fastget(L,t,k,aux,luaH_get)) { setobj2s(L, v, aux); } \ else luaV_finishget(L,t,k,v,aux); } /* ** Fast track for set table. If 't' is a table and 't[k]' is not nil, ** call GC barrier, do a raw 't[k]=v', and return true; otherwise, ** return false with 'slot' equal to NULL (if 't' is not a table) or ** 'nil'. (This is needed by 'luaV_finishget'.) Note that, if the macro ** returns true, there is no need to 'invalidateTMcache', because the ** call is not creating a new entry. */ #define luaV_fastset(L,t,k,slot,f,v) \ (!ttistable(t) \ ? (slot = NULL, 0) \ : (slot = f(hvalue(t), k), \ ttisnil(slot) ? 0 \ : (luaC_barrierback(L, hvalue(t), v), \ setobj2t(L, cast(TValue *,slot), v), \ 1))) #define luaV_settable(L,t,k,v) { const TValue *slot; \ if (!luaV_fastset(L,t,k,slot,luaH_get,v)) \ luaV_finishset(L,t,k,v,slot); } LUAI_FUNC int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2); LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r); LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r); LUAI_FUNC int luaV_tonumber_ (const TValue *obj, lua_Number *n); LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, int mode); LUAI_FUNC void luaV_finishget (lua_State *L, const TValue *t, TValue *key, StkId val, const TValue *tm); LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key, StkId val, const TValue *oldval); LUAI_FUNC void luaV_finishOp (lua_State *L); LUAI_FUNC void luaV_execute (lua_State *L); LUAI_FUNC void luaV_concat (lua_State *L, int total); LUAI_FUNC lua_Integer luaV_div (lua_State *L, lua_Integer x, lua_Integer y); LUAI_FUNC lua_Integer luaV_mod (lua_State *L, lua_Integer x, lua_Integer y); LUAI_FUNC lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y); LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb); #endif wcc-0.0.2/src/wsh/lua/src/lmem.h0000644000175000017500000000460313110675433015010 0ustar philphil/* ** $Id: lmem.h,v 1.43 2014/12/19 17:26:14 roberto Exp $ ** Interface to Memory Manager ** See Copyright Notice in lua.h */ #ifndef lmem_h #define lmem_h #include #include "llimits.h" #include "lua.h" /* ** This macro reallocs a vector 'b' from 'on' to 'n' elements, where ** each element has size 'e'. In case of arithmetic overflow of the ** product 'n'*'e', it raises an error (calling 'luaM_toobig'). Because ** 'e' is always constant, it avoids the runtime division MAX_SIZET/(e). ** ** (The macro is somewhat complex to avoid warnings: The 'sizeof' ** comparison avoids a runtime comparison when overflow cannot occur. ** The compiler should be able to optimize the real test by itself, but ** when it does it, it may give a warning about "comparison is always ** false due to limited range of data type"; the +1 tricks the compiler, ** avoiding this warning but also this optimization.) */ #define luaM_reallocv(L,b,on,n,e) \ (((sizeof(n) >= sizeof(size_t) && cast(size_t, (n)) + 1 > MAX_SIZET/(e)) \ ? luaM_toobig(L) : cast_void(0)) , \ luaM_realloc_(L, (b), (on)*(e), (n)*(e))) /* ** Arrays of chars do not need any test */ #define luaM_reallocvchar(L,b,on,n) \ cast(char *, luaM_realloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char))) #define luaM_freemem(L, b, s) luaM_realloc_(L, (b), (s), 0) #define luaM_free(L, b) luaM_realloc_(L, (b), sizeof(*(b)), 0) #define luaM_freearray(L, b, n) luaM_realloc_(L, (b), (n)*sizeof(*(b)), 0) #define luaM_malloc(L,s) luaM_realloc_(L, NULL, 0, (s)) #define luaM_new(L,t) cast(t *, luaM_malloc(L, sizeof(t))) #define luaM_newvector(L,n,t) \ cast(t *, luaM_reallocv(L, NULL, 0, n, sizeof(t))) #define luaM_newobject(L,tag,s) luaM_realloc_(L, NULL, tag, (s)) #define luaM_growvector(L,v,nelems,size,t,limit,e) \ if ((nelems)+1 > (size)) \ ((v)=cast(t *, luaM_growaux_(L,v,&(size),sizeof(t),limit,e))) #define luaM_reallocvector(L, v,oldn,n,t) \ ((v)=cast(t *, luaM_reallocv(L, v, oldn, n, sizeof(t)))) LUAI_FUNC l_noret luaM_toobig (lua_State *L); /* not to be called directly */ LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize, size_t size); LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elem, int limit, const char *what); #endif wcc-0.0.2/src/wsh/lua/src/lctype.c0000644000175000017500000000441613110675433015353 0ustar philphil/* ** $Id: lctype.c,v 1.12 2014/11/02 19:19:04 roberto Exp $ ** 'ctype' functions for Lua ** See Copyright Notice in lua.h */ #define lctype_c #define LUA_CORE #include "lprefix.h" #include "lctype.h" #if !LUA_USE_CTYPE /* { */ #include LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = { 0x00, /* EOZ */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */ 0x00, 0x08, 0x08, 0x08, 0x08, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 1. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, /* 2. */ 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, /* 3. */ 0x16, 0x16, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 4. */ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 5. */ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x05, 0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 6. */ 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 7. */ 0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 8. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 9. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* a. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* b. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* c. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* d. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* e. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* f. */ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, }; #endif /* } */ wcc-0.0.2/src/wsh/lua/src/lstate.c0000644000175000017500000002045313110675433015346 0ustar philphil/* ** $Id: lstate.c,v 2.133 2015/11/13 12:16:51 roberto Exp $ ** Global State ** See Copyright Notice in lua.h */ #define lstate_c #define LUA_CORE #include "lprefix.h" #include #include #include "lua.h" #include "lapi.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" #include "llex.h" #include "lmem.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" #if !defined(LUAI_GCPAUSE) #define LUAI_GCPAUSE 200 /* 200% */ #endif #if !defined(LUAI_GCMUL) #define LUAI_GCMUL 200 /* GC runs 'twice the speed' of memory allocation */ #endif /* ** a macro to help the creation of a unique random seed when a state is ** created; the seed is used to randomize hashes. */ #if !defined(luai_makeseed) #include #define luai_makeseed() cast(unsigned int, time(NULL)) #endif /* ** thread state + extra space */ typedef struct LX { lu_byte extra_[LUA_EXTRASPACE]; lua_State l; } LX; /* ** Main thread combines a thread state and the global state */ typedef struct LG { LX l; global_State g; } LG; #define fromstate(L) (cast(LX *, cast(lu_byte *, (L)) - offsetof(LX, l))) /* ** Compute an initial seed as random as possible. Rely on Address Space ** Layout Randomization (if present) to increase randomness.. */ #define addbuff(b,p,e) \ { size_t t = cast(size_t, e); \ memcpy(b + p, &t, sizeof(t)); p += sizeof(t); } static unsigned int makeseed (lua_State *L) { char buff[4 * sizeof(size_t)]; unsigned int h = luai_makeseed(); int p = 0; addbuff(buff, p, L); /* heap variable */ addbuff(buff, p, &h); /* local variable */ addbuff(buff, p, luaO_nilobject); /* global variable */ addbuff(buff, p, &lua_newstate); /* public function */ lua_assert(p == sizeof(buff)); return luaS_hash(buff, p, h); } /* ** set GCdebt to a new value keeping the value (totalbytes + GCdebt) ** invariant (and avoiding underflows in 'totalbytes') */ void luaE_setdebt (global_State *g, l_mem debt) { l_mem tb = gettotalbytes(g); lua_assert(tb > 0); if (debt < tb - MAX_LMEM) debt = tb - MAX_LMEM; /* will make 'totalbytes == MAX_LMEM' */ g->totalbytes = tb - debt; g->GCdebt = debt; } CallInfo *luaE_extendCI (lua_State *L) { CallInfo *ci = luaM_new(L, CallInfo); lua_assert(L->ci->next == NULL); L->ci->next = ci; ci->previous = L->ci; ci->next = NULL; L->nci++; return ci; } /* ** free all CallInfo structures not in use by a thread */ void luaE_freeCI (lua_State *L) { CallInfo *ci = L->ci; CallInfo *next = ci->next; ci->next = NULL; while ((ci = next) != NULL) { next = ci->next; luaM_free(L, ci); L->nci--; } } /* ** free half of the CallInfo structures not in use by a thread */ void luaE_shrinkCI (lua_State *L) { CallInfo *ci = L->ci; CallInfo *next2; /* next's next */ /* while there are two nexts */ while (ci->next != NULL && (next2 = ci->next->next) != NULL) { luaM_free(L, ci->next); /* free next */ L->nci--; ci->next = next2; /* remove 'next' from the list */ next2->previous = ci; ci = next2; /* keep next's next */ } } static void stack_init (lua_State *L1, lua_State *L) { int i; CallInfo *ci; /* initialize stack array */ L1->stack = luaM_newvector(L, BASIC_STACK_SIZE, TValue); L1->stacksize = BASIC_STACK_SIZE; for (i = 0; i < BASIC_STACK_SIZE; i++) setnilvalue(L1->stack + i); /* erase new stack */ L1->top = L1->stack; L1->stack_last = L1->stack + L1->stacksize - EXTRA_STACK; /* initialize first ci */ ci = &L1->base_ci; ci->next = ci->previous = NULL; ci->callstatus = 0; ci->func = L1->top; setnilvalue(L1->top++); /* 'function' entry for this 'ci' */ ci->top = L1->top + LUA_MINSTACK; L1->ci = ci; } static void freestack (lua_State *L) { if (L->stack == NULL) return; /* stack not completely built yet */ L->ci = &L->base_ci; /* free the entire 'ci' list */ luaE_freeCI(L); lua_assert(L->nci == 0); luaM_freearray(L, L->stack, L->stacksize); /* free stack array */ } /* ** Create registry table and its predefined values */ static void init_registry (lua_State *L, global_State *g) { TValue temp; /* create registry */ Table *registry = luaH_new(L); sethvalue(L, &g->l_registry, registry); luaH_resize(L, registry, LUA_RIDX_LAST, 0); /* registry[LUA_RIDX_MAINTHREAD] = L */ setthvalue(L, &temp, L); /* temp = L */ luaH_setint(L, registry, LUA_RIDX_MAINTHREAD, &temp); /* registry[LUA_RIDX_GLOBALS] = table of globals */ sethvalue(L, &temp, luaH_new(L)); /* temp = new table (global table) */ luaH_setint(L, registry, LUA_RIDX_GLOBALS, &temp); } /* ** open parts of the state that may cause memory-allocation errors. ** ('g->version' != NULL flags that the state was completely build) */ static void f_luaopen (lua_State *L, void *ud) { global_State *g = G(L); UNUSED(ud); stack_init(L, L); /* init stack */ init_registry(L, g); luaS_init(L); luaT_init(L); luaX_init(L); g->gcrunning = 1; /* allow gc */ g->version = lua_version(NULL); luai_userstateopen(L); } /* ** preinitialize a thread with consistent values without allocating ** any memory (to avoid errors) */ static void preinit_thread (lua_State *L, global_State *g) { G(L) = g; L->stack = NULL; L->ci = NULL; L->nci = 0; L->stacksize = 0; L->twups = L; /* thread has no upvalues */ L->errorJmp = NULL; L->nCcalls = 0; L->hook = NULL; L->hookmask = 0; L->basehookcount = 0; L->allowhook = 1; resethookcount(L); L->openupval = NULL; L->nny = 1; L->status = LUA_OK; L->errfunc = 0; } static void close_state (lua_State *L) { global_State *g = G(L); luaF_close(L, L->stack); /* close all upvalues for this thread */ luaC_freeallobjects(L); /* collect all objects */ if (g->version) /* closing a fully built state? */ luai_userstateclose(L); luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size); freestack(L); lua_assert(gettotalbytes(g) == sizeof(LG)); (*g->frealloc)(g->ud, fromstate(L), sizeof(LG), 0); /* free main block */ } LUA_API lua_State *lua_newthread (lua_State *L) { global_State *g = G(L); lua_State *L1; lua_lock(L); luaC_checkGC(L); /* create new thread */ L1 = &cast(LX *, luaM_newobject(L, LUA_TTHREAD, sizeof(LX)))->l; L1->marked = luaC_white(g); L1->tt = LUA_TTHREAD; /* link it on list 'allgc' */ L1->next = g->allgc; g->allgc = obj2gco(L1); /* anchor it on L stack */ setthvalue(L, L->top, L1); api_incr_top(L); preinit_thread(L1, g); L1->hookmask = L->hookmask; L1->basehookcount = L->basehookcount; L1->hook = L->hook; resethookcount(L1); /* initialize L1 extra space */ memcpy(lua_getextraspace(L1), lua_getextraspace(g->mainthread), LUA_EXTRASPACE); luai_userstatethread(L, L1); stack_init(L1, L); /* init stack */ lua_unlock(L); return L1; } void luaE_freethread (lua_State *L, lua_State *L1) { LX *l = fromstate(L1); luaF_close(L1, L1->stack); /* close all upvalues for this thread */ lua_assert(L1->openupval == NULL); luai_userstatefree(L, L1); freestack(L1); luaM_free(L, l); } LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) { int i; lua_State *L; global_State *g; LG *l = cast(LG *, (*f)(ud, NULL, LUA_TTHREAD, sizeof(LG))); if (l == NULL) return NULL; L = &l->l.l; g = &l->g; L->next = NULL; L->tt = LUA_TTHREAD; g->currentwhite = bitmask(WHITE0BIT); L->marked = luaC_white(g); preinit_thread(L, g); g->frealloc = f; g->ud = ud; g->mainthread = L; g->seed = makeseed(L); g->gcrunning = 0; /* no GC while building state */ g->GCestimate = 0; g->strt.size = g->strt.nuse = 0; g->strt.hash = NULL; setnilvalue(&g->l_registry); g->panic = NULL; g->version = NULL; g->gcstate = GCSpause; g->gckind = KGC_NORMAL; g->allgc = g->finobj = g->tobefnz = g->fixedgc = NULL; g->sweepgc = NULL; g->gray = g->grayagain = NULL; g->weak = g->ephemeron = g->allweak = NULL; g->twups = NULL; g->totalbytes = sizeof(LG); g->GCdebt = 0; g->gcfinnum = 0; g->gcpause = LUAI_GCPAUSE; g->gcstepmul = LUAI_GCMUL; for (i=0; i < LUA_NUMTAGS; i++) g->mt[i] = NULL; if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) { /* memory allocation error: free partial state */ close_state(L); L = NULL; } return L; } LUA_API void lua_close (lua_State *L) { L = G(L)->mainthread; /* only the main thread can be closed */ lua_lock(L); close_state(L); } wcc-0.0.2/src/wsh/lua/src/lopcodes.h0000644000175000017500000002112413110675433015663 0ustar philphil/* ** $Id: lopcodes.h,v 1.148 2014/10/25 11:50:46 roberto Exp $ ** Opcodes for Lua virtual machine ** See Copyright Notice in lua.h */ #ifndef lopcodes_h #define lopcodes_h #include "llimits.h" /*=========================================================================== We assume that instructions are unsigned numbers. All instructions have an opcode in the first 6 bits. Instructions can have the following fields: 'A' : 8 bits 'B' : 9 bits 'C' : 9 bits 'Ax' : 26 bits ('A', 'B', and 'C' together) 'Bx' : 18 bits ('B' and 'C' together) 'sBx' : signed Bx A signed argument is represented in excess K; that is, the number value is the unsigned value minus K. K is exactly the maximum value for that argument (so that -max is represented by 0, and +max is represented by 2*max), which is half the maximum for the corresponding unsigned argument. ===========================================================================*/ enum OpMode {iABC, iABx, iAsBx, iAx}; /* basic instruction format */ /* ** size and position of opcode arguments. */ #define SIZE_C 9 #define SIZE_B 9 #define SIZE_Bx (SIZE_C + SIZE_B) #define SIZE_A 8 #define SIZE_Ax (SIZE_C + SIZE_B + SIZE_A) #define SIZE_OP 6 #define POS_OP 0 #define POS_A (POS_OP + SIZE_OP) #define POS_C (POS_A + SIZE_A) #define POS_B (POS_C + SIZE_C) #define POS_Bx POS_C #define POS_Ax POS_A /* ** limits for opcode arguments. ** we use (signed) int to manipulate most arguments, ** so they must fit in LUAI_BITSINT-1 bits (-1 for sign) */ #if SIZE_Bx < LUAI_BITSINT-1 #define MAXARG_Bx ((1<>1) /* 'sBx' is signed */ #else #define MAXARG_Bx MAX_INT #define MAXARG_sBx MAX_INT #endif #if SIZE_Ax < LUAI_BITSINT-1 #define MAXARG_Ax ((1<>POS_OP) & MASK1(SIZE_OP,0))) #define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \ ((cast(Instruction, o)<>pos) & MASK1(size,0))) #define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \ ((cast(Instruction, v)<> RK(C) */ OP_UNM,/* A B R(A) := -R(B) */ OP_BNOT,/* A B R(A) := ~R(B) */ OP_NOT,/* A B R(A) := not R(B) */ OP_LEN,/* A B R(A) := length of R(B) */ OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */ OP_JMP,/* A sBx pc+=sBx; if (A) close all upvalues >= R(A - 1) */ OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */ OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */ OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */ OP_TEST,/* A C if not (R(A) <=> C) then pc++ */ OP_TESTSET,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */ OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */ OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */ OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */ OP_FORLOOP,/* A sBx R(A)+=R(A+2); if R(A) > 4) & 3)) #define getCMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 2) & 3)) #define testAMode(m) (luaP_opmodes[m] & (1 << 6)) #define testTMode(m) (luaP_opmodes[m] & (1 << 7)) LUAI_DDEC const char *const luaP_opnames[NUM_OPCODES+1]; /* opcode names */ /* number of list items to accumulate before a SETLIST instruction */ #define LFIELDS_PER_FLUSH 50 #endif wcc-0.0.2/src/wsh/lua/src/ltm.h0000644000175000017500000000332513110675433014652 0ustar philphil/* ** $Id: ltm.h,v 2.21 2014/10/25 11:50:46 roberto Exp $ ** Tag methods ** See Copyright Notice in lua.h */ #ifndef ltm_h #define ltm_h #include "lobject.h" /* * WARNING: if you change the order of this enumeration, * grep "ORDER TM" and "ORDER OP" */ typedef enum { TM_INDEX, TM_NEWINDEX, TM_GC, TM_MODE, TM_LEN, TM_EQ, /* last tag method with fast access */ TM_ADD, TM_SUB, TM_MUL, TM_MOD, TM_POW, TM_DIV, TM_IDIV, TM_BAND, TM_BOR, TM_BXOR, TM_SHL, TM_SHR, TM_UNM, TM_BNOT, TM_LT, TM_LE, TM_CONCAT, TM_CALL, TM_N /* number of elements in the enum */ } TMS; #define gfasttm(g,et,e) ((et) == NULL ? NULL : \ ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e])) #define fasttm(l,et,e) gfasttm(G(l), et, e) #define ttypename(x) luaT_typenames_[(x) + 1] #define objtypename(x) ttypename(ttnov(x)) LUAI_DDEC const char *const luaT_typenames_[LUA_TOTALTAGS]; LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename); LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event); LUAI_FUNC void luaT_init (lua_State *L); LUAI_FUNC void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1, const TValue *p2, TValue *p3, int hasres); LUAI_FUNC int luaT_callbinTM (lua_State *L, const TValue *p1, const TValue *p2, StkId res, TMS event); LUAI_FUNC void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2, StkId res, TMS event); LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2, TMS event); #endif wcc-0.0.2/src/wsh/lua/src/lua.hpp0000644000175000017500000000027713110675433015202 0ustar philphil// lua.hpp // Lua header files for C++ // <> not supplied automatically because Lua also compiles as C++ extern "C" { #include "lua.h" #include "lualib.h" #include "lauxlib.h" } wcc-0.0.2/src/wsh/lua/src/lutf8lib.c0000644000175000017500000001563213110675433015606 0ustar philphil/* ** $Id: lutf8lib.c,v 1.15 2015/03/28 19:16:55 roberto Exp $ ** Standard library for UTF-8 manipulation ** See Copyright Notice in lua.h */ #define lutf8lib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" #define MAXUNICODE 0x10FFFF #define iscont(p) ((*(p) & 0xC0) == 0x80) /* from strlib */ /* translate a relative string position: negative means back from end */ static lua_Integer u_posrelat (lua_Integer pos, size_t len) { if (pos >= 0) return pos; else if (0u - (size_t)pos > len) return 0; else return (lua_Integer)len + pos + 1; } /* ** Decode one UTF-8 sequence, returning NULL if byte sequence is invalid. */ static const char *utf8_decode (const char *o, int *val) { static const unsigned int limits[] = {0xFF, 0x7F, 0x7FF, 0xFFFF}; const unsigned char *s = (const unsigned char *)o; unsigned int c = s[0]; unsigned int res = 0; /* final result */ if (c < 0x80) /* ascii? */ res = c; else { int count = 0; /* to count number of continuation bytes */ while (c & 0x40) { /* still have continuation bytes? */ int cc = s[++count]; /* read next byte */ if ((cc & 0xC0) != 0x80) /* not a continuation byte? */ return NULL; /* invalid byte sequence */ res = (res << 6) | (cc & 0x3F); /* add lower 6 bits from cont. byte */ c <<= 1; /* to test next bit */ } res |= ((c & 0x7F) << (count * 5)); /* add first byte */ if (count > 3 || res > MAXUNICODE || res <= limits[count]) return NULL; /* invalid byte sequence */ s += count; /* skip continuation bytes read */ } if (val) *val = res; return (const char *)s + 1; /* +1 to include first byte */ } /* ** utf8len(s [, i [, j]]) --> number of characters that start in the ** range [i,j], or nil + current position if 's' is not well formed in ** that interval */ static int utflen (lua_State *L) { int n = 0; size_t len; const char *s = luaL_checklstring(L, 1, &len); lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len); lua_Integer posj = u_posrelat(luaL_optinteger(L, 3, -1), len); luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 2, "initial position out of string"); luaL_argcheck(L, --posj < (lua_Integer)len, 3, "final position out of string"); while (posi <= posj) { const char *s1 = utf8_decode(s + posi, NULL); if (s1 == NULL) { /* conversion error? */ lua_pushnil(L); /* return nil ... */ lua_pushinteger(L, posi + 1); /* ... and current position */ return 2; } posi = s1 - s; n++; } lua_pushinteger(L, n); return 1; } /* ** codepoint(s, [i, [j]]) -> returns codepoints for all characters ** that start in the range [i,j] */ static int codepoint (lua_State *L) { size_t len; const char *s = luaL_checklstring(L, 1, &len); lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len); lua_Integer pose = u_posrelat(luaL_optinteger(L, 3, posi), len); int n; const char *se; luaL_argcheck(L, posi >= 1, 2, "out of range"); luaL_argcheck(L, pose <= (lua_Integer)len, 3, "out of range"); if (posi > pose) return 0; /* empty interval; return no values */ if (pose - posi >= INT_MAX) /* (lua_Integer -> int) overflow? */ return luaL_error(L, "string slice too long"); n = (int)(pose - posi) + 1; luaL_checkstack(L, n, "string slice too long"); n = 0; se = s + pose; for (s += posi - 1; s < se;) { int code; s = utf8_decode(s, &code); if (s == NULL) return luaL_error(L, "invalid UTF-8 code"); lua_pushinteger(L, code); n++; } return n; } static void pushutfchar (lua_State *L, int arg) { lua_Integer code = luaL_checkinteger(L, arg); luaL_argcheck(L, 0 <= code && code <= MAXUNICODE, arg, "value out of range"); lua_pushfstring(L, "%U", (long)code); } /* ** utfchar(n1, n2, ...) -> char(n1)..char(n2)... */ static int utfchar (lua_State *L) { int n = lua_gettop(L); /* number of arguments */ if (n == 1) /* optimize common case of single char */ pushutfchar(L, 1); else { int i; luaL_Buffer b; luaL_buffinit(L, &b); for (i = 1; i <= n; i++) { pushutfchar(L, i); luaL_addvalue(&b); } luaL_pushresult(&b); } return 1; } /* ** offset(s, n, [i]) -> index where n-th character counting from ** position 'i' starts; 0 means character at 'i'. */ static int byteoffset (lua_State *L) { size_t len; const char *s = luaL_checklstring(L, 1, &len); lua_Integer n = luaL_checkinteger(L, 2); lua_Integer posi = (n >= 0) ? 1 : len + 1; posi = u_posrelat(luaL_optinteger(L, 3, posi), len); luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 3, "position out of range"); if (n == 0) { /* find beginning of current byte sequence */ while (posi > 0 && iscont(s + posi)) posi--; } else { if (iscont(s + posi)) luaL_error(L, "initial position is a continuation byte"); if (n < 0) { while (n < 0 && posi > 0) { /* move back */ do { /* find beginning of previous character */ posi--; } while (posi > 0 && iscont(s + posi)); n++; } } else { n--; /* do not move for 1st character */ while (n > 0 && posi < (lua_Integer)len) { do { /* find beginning of next character */ posi++; } while (iscont(s + posi)); /* (cannot pass final '\0') */ n--; } } } if (n == 0) /* did it find given character? */ lua_pushinteger(L, posi + 1); else /* no such character */ lua_pushnil(L); return 1; } static int iter_aux (lua_State *L) { size_t len; const char *s = luaL_checklstring(L, 1, &len); lua_Integer n = lua_tointeger(L, 2) - 1; if (n < 0) /* first iteration? */ n = 0; /* start from here */ else if (n < (lua_Integer)len) { n++; /* skip current byte */ while (iscont(s + n)) n++; /* and its continuations */ } if (n >= (lua_Integer)len) return 0; /* no more codepoints */ else { int code; const char *next = utf8_decode(s + n, &code); if (next == NULL || iscont(next)) return luaL_error(L, "invalid UTF-8 code"); lua_pushinteger(L, n + 1); lua_pushinteger(L, code); return 2; } } static int iter_codes (lua_State *L) { luaL_checkstring(L, 1); lua_pushcfunction(L, iter_aux); lua_pushvalue(L, 1); lua_pushinteger(L, 0); return 3; } /* pattern to match a single UTF-8 character */ #define UTF8PATT "[\0-\x7F\xC2-\xF4][\x80-\xBF]*" static const luaL_Reg funcs[] = { {"offset", byteoffset}, {"codepoint", codepoint}, {"char", utfchar}, {"len", utflen}, {"codes", iter_codes}, /* placeholders */ {"charpattern", NULL}, {NULL, NULL} }; LUAMOD_API int luaopen_utf8 (lua_State *L) { luaL_newlib(L, funcs); lua_pushlstring(L, UTF8PATT, sizeof(UTF8PATT)/sizeof(char) - 1); lua_setfield(L, -2, "charpattern"); return 1; } wcc-0.0.2/src/wsh/lua/src/lua.c0000644000175000017500000004276413110675433014644 0ustar philphil/* ** $Id: lua.c,v 1.226 2015/08/14 19:11:20 roberto Exp $ ** Lua stand-alone interpreter ** See Copyright Notice in lua.h */ #define lua_c #include "lprefix.h" #include #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" #if !defined(LUA_PROMPT) #define LUA_PROMPT "> " #define LUA_PROMPT2 ">> " #endif #if !defined(LUA_PROGNAME) #define LUA_PROGNAME "lua" #endif #if !defined(LUA_MAXINPUT) #define LUA_MAXINPUT 512 #endif #if !defined(LUA_INIT_VAR) #define LUA_INIT_VAR "LUA_INIT" #endif #define LUA_INITVARVERSION \ LUA_INIT_VAR "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR /* ** lua_stdin_is_tty detects whether the standard input is a 'tty' (that ** is, whether we're running lua interactively). */ #if !defined(lua_stdin_is_tty) /* { */ #if defined(LUA_USE_POSIX) /* { */ #include #define lua_stdin_is_tty() isatty(0) #elif defined(LUA_USE_WINDOWS) /* }{ */ #include #define lua_stdin_is_tty() _isatty(_fileno(stdin)) #else /* }{ */ /* ISO C definition */ #define lua_stdin_is_tty() 1 /* assume stdin is a tty */ #endif /* } */ #endif /* } */ /* ** lua_readline defines how to show a prompt and then read a line from ** the standard input. ** lua_saveline defines how to "save" a read line in a "history". ** lua_freeline defines how to free a line read by lua_readline. */ #if !defined(lua_readline) /* { */ #if defined(LUA_USE_READLINE) /* { */ #include #include #define lua_readline(L,b,p) ((void)L, ((b)=readline(p)) != NULL) #define lua_saveline(L,line) ((void)L, add_history(line)) #define lua_freeline(L,b) ((void)L, free(b)) #else /* }{ */ #define lua_readline(L,b,p) \ ((void)L, fputs(p, stdout), fflush(stdout), /* show prompt */ \ fgets(b, LUA_MAXINPUT, stdin) != NULL) /* get line */ #define lua_saveline(L,line) { (void)L; (void)line; } #define lua_freeline(L,b) { (void)L; (void)b; } #endif /* } */ #endif /* } */ static lua_State *globalL = NULL; static const char *progname = LUA_PROGNAME; /* ** Hook set by signal function to stop the interpreter. */ static void lstop (lua_State *L, lua_Debug *ar) { (void)ar; /* unused arg. */ lua_sethook(L, NULL, 0, 0); /* reset hook */ luaL_error(L, "interrupted!"); } /* ** Function to be called at a C signal. Because a C signal cannot ** just change a Lua state (as there is no proper synchronization), ** this function only sets a hook that, when called, will stop the ** interpreter. */ static void laction (int i) { signal(i, SIG_DFL); /* if another SIGINT happens, terminate process */ lua_sethook(globalL, lstop, LUA_MASKCALL | LUA_MASKRET | LUA_MASKCOUNT, 1); } static void print_usage (const char *badoption) { lua_writestringerror("%s: ", progname); if (badoption[1] == 'e' || badoption[1] == 'l') lua_writestringerror("'%s' needs argument\n", badoption); else lua_writestringerror("unrecognized option '%s'\n", badoption); lua_writestringerror( "usage: %s [options] [script [args]]\n" "Available options are:\n" " -e stat execute string 'stat'\n" " -i enter interactive mode after executing 'script'\n" " -l name require library 'name'\n" " -v show version information\n" " -E ignore environment variables\n" " -- stop handling options\n" " - stop handling options and execute stdin\n" , progname); } /* ** Prints an error message, adding the program name in front of it ** (if present) */ static void l_message (const char *pname, const char *msg) { if (pname) lua_writestringerror("%s: ", pname); lua_writestringerror("%s\n", msg); } /* ** Check whether 'status' is not OK and, if so, prints the error ** message on the top of the stack. It assumes that the error object ** is a string, as it was either generated by Lua or by 'msghandler'. */ static int report (lua_State *L, int status) { if (status != LUA_OK) { const char *msg = lua_tostring(L, -1); l_message(progname, msg); lua_pop(L, 1); /* remove message */ } return status; } /* ** Message handler used to run all chunks */ static int msghandler (lua_State *L) { const char *msg = lua_tostring(L, 1); if (msg == NULL) { /* is error object not a string? */ if (luaL_callmeta(L, 1, "__tostring") && /* does it have a metamethod */ lua_type(L, -1) == LUA_TSTRING) /* that produces a string? */ return 1; /* that is the message */ else msg = lua_pushfstring(L, "(error object is a %s value)", luaL_typename(L, 1)); } luaL_traceback(L, L, msg, 1); /* append a standard traceback */ return 1; /* return the traceback */ } /* ** Interface to 'lua_pcall', which sets appropriate message function ** and C-signal handler. Used to run all chunks. */ static int docall (lua_State *L, int narg, int nres) { int status; int base = lua_gettop(L) - narg; /* function index */ lua_pushcfunction(L, msghandler); /* push message handler */ lua_insert(L, base); /* put it under function and args */ globalL = L; /* to be available to 'laction' */ signal(SIGINT, laction); /* set C-signal handler */ status = lua_pcall(L, narg, nres, base); signal(SIGINT, SIG_DFL); /* reset C-signal handler */ lua_remove(L, base); /* remove message handler from the stack */ return status; } static void print_version (void) { lua_writestring(LUA_COPYRIGHT, strlen(LUA_COPYRIGHT)); lua_writeline(); } /* ** Create the 'arg' table, which stores all arguments from the ** command line ('argv'). It should be aligned so that, at index 0, ** it has 'argv[script]', which is the script name. The arguments ** to the script (everything after 'script') go to positive indices; ** other arguments (before the script name) go to negative indices. ** If there is no script name, assume interpreter's name as base. */ static void createargtable (lua_State *L, char **argv, int argc, int script) { int i, narg; if (script == argc) script = 0; /* no script name? */ narg = argc - (script + 1); /* number of positive indices */ lua_createtable(L, narg, script + 1); for (i = 0; i < argc; i++) { lua_pushstring(L, argv[i]); lua_rawseti(L, -2, i - script); } lua_setglobal(L, "arg"); } static int dochunk (lua_State *L, int status) { if (status == LUA_OK) status = docall(L, 0, 0); return report(L, status); } static int dofile (lua_State *L, const char *name) { return dochunk(L, luaL_loadfile(L, name)); } static int dostring (lua_State *L, const char *s, const char *name) { return dochunk(L, luaL_loadbuffer(L, s, strlen(s), name)); } /* ** Calls 'require(name)' and stores the result in a global variable ** with the given name. */ static int dolibrary (lua_State *L, const char *name) { int status; lua_getglobal(L, "require"); lua_pushstring(L, name); status = docall(L, 1, 1); /* call 'require(name)' */ if (status == LUA_OK) lua_setglobal(L, name); /* global[name] = require return */ return report(L, status); } /* ** Returns the string to be used as a prompt by the interpreter. */ static const char *get_prompt (lua_State *L, int firstline) { const char *p; lua_getglobal(L, firstline ? "_PROMPT" : "_PROMPT2"); p = lua_tostring(L, -1); if (p == NULL) p = (firstline ? LUA_PROMPT : LUA_PROMPT2); return p; } /* mark in error messages for incomplete statements */ #define EOFMARK "" #define marklen (sizeof(EOFMARK)/sizeof(char) - 1) /* ** Check whether 'status' signals a syntax error and the error ** message at the top of the stack ends with the above mark for ** incomplete statements. */ static int incomplete (lua_State *L, int status) { if (status == LUA_ERRSYNTAX) { size_t lmsg; const char *msg = lua_tolstring(L, -1, &lmsg); if (lmsg >= marklen && strcmp(msg + lmsg - marklen, EOFMARK) == 0) { lua_pop(L, 1); return 1; } } return 0; /* else... */ } /* ** Prompt the user, read a line, and push it into the Lua stack. */ static int pushline (lua_State *L, int firstline) { char buffer[LUA_MAXINPUT]; char *b = buffer; size_t l; const char *prmt = get_prompt(L, firstline); int readstatus = lua_readline(L, b, prmt); if (readstatus == 0) return 0; /* no input (prompt will be popped by caller) */ lua_pop(L, 1); /* remove prompt */ l = strlen(b); if (l > 0 && b[l-1] == '\n') /* line ends with newline? */ b[--l] = '\0'; /* remove it */ if (firstline && b[0] == '=') /* for compatibility with 5.2, ... */ lua_pushfstring(L, "return %s", b + 1); /* change '=' to 'return' */ else lua_pushlstring(L, b, l); lua_freeline(L, b); return 1; } /* ** Try to compile line on the stack as 'return ;'; on return, stack ** has either compiled chunk or original line (if compilation failed). */ static int addreturn (lua_State *L) { const char *line = lua_tostring(L, -1); /* original line */ const char *retline = lua_pushfstring(L, "return %s;", line); int status = luaL_loadbuffer(L, retline, strlen(retline), "=stdin"); if (status == LUA_OK) { lua_remove(L, -2); /* remove modified line */ if (line[0] != '\0') /* non empty? */ lua_saveline(L, line); /* keep history */ } else lua_pop(L, 2); /* pop result from 'luaL_loadbuffer' and modified line */ return status; } /* ** Read multiple lines until a complete Lua statement */ static int multiline (lua_State *L) { for (;;) { /* repeat until gets a complete statement */ size_t len; const char *line = lua_tolstring(L, 1, &len); /* get what it has */ int status = luaL_loadbuffer(L, line, len, "=stdin"); /* try it */ if (!incomplete(L, status) || !pushline(L, 0)) { lua_saveline(L, line); /* keep history */ return status; /* cannot or should not try to add continuation line */ } lua_pushliteral(L, "\n"); /* add newline... */ lua_insert(L, -2); /* ...between the two lines */ lua_concat(L, 3); /* join them */ } } /* ** Read a line and try to load (compile) it first as an expression (by ** adding "return " in front of it) and second as a statement. Return ** the final status of load/call with the resulting function (if any) ** in the top of the stack. */ static int loadline (lua_State *L) { int status; lua_settop(L, 0); if (!pushline(L, 1)) return -1; /* no input */ if ((status = addreturn(L)) != LUA_OK) /* 'return ...' did not work? */ status = multiline(L); /* try as command, maybe with continuation lines */ lua_remove(L, 1); /* remove line from the stack */ lua_assert(lua_gettop(L) == 1); return status; } /* ** Prints (calling the Lua 'print' function) any values on the stack */ static void l_print (lua_State *L) { int n = lua_gettop(L); if (n > 0) { /* any result to be printed? */ luaL_checkstack(L, LUA_MINSTACK, "too many results to print"); lua_getglobal(L, "print"); lua_insert(L, 1); if (lua_pcall(L, n, 0, 0) != LUA_OK) l_message(progname, lua_pushfstring(L, "error calling 'print' (%s)", lua_tostring(L, -1))); } } /* ** Do the REPL: repeatedly read (load) a line, evaluate (call) it, and ** print any results. */ static void doREPL (lua_State *L) { int status; const char *oldprogname = progname; progname = NULL; /* no 'progname' on errors in interactive mode */ while ((status = loadline(L)) != -1) { if (status == LUA_OK) status = docall(L, 0, LUA_MULTRET); if (status == LUA_OK) l_print(L); else report(L, status); } lua_settop(L, 0); /* clear stack */ lua_writeline(); progname = oldprogname; } /* ** Push on the stack the contents of table 'arg' from 1 to #arg */ static int pushargs (lua_State *L) { int i, n; if (lua_getglobal(L, "arg") != LUA_TTABLE) luaL_error(L, "'arg' is not a table"); n = (int)luaL_len(L, -1); luaL_checkstack(L, n + 3, "too many arguments to script"); for (i = 1; i <= n; i++) lua_rawgeti(L, -i, i); lua_remove(L, -i); /* remove table from the stack */ return n; } static int handle_script (lua_State *L, char **argv) { int status; const char *fname = argv[0]; if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0) fname = NULL; /* stdin */ status = luaL_loadfile(L, fname); if (status == LUA_OK) { int n = pushargs(L); /* push arguments to script */ status = docall(L, n, LUA_MULTRET); } return report(L, status); } /* bits of various argument indicators in 'args' */ #define has_error 1 /* bad option */ #define has_i 2 /* -i */ #define has_v 4 /* -v */ #define has_e 8 /* -e */ #define has_E 16 /* -E */ /* ** Traverses all arguments from 'argv', returning a mask with those ** needed before running any Lua code (or an error code if it finds ** any invalid argument). 'first' returns the first not-handled argument ** (either the script name or a bad argument in case of error). */ static int collectargs (char **argv, int *first) { int args = 0; int i; for (i = 1; argv[i] != NULL; i++) { *first = i; if (argv[i][0] != '-') /* not an option? */ return args; /* stop handling options */ switch (argv[i][1]) { /* else check option */ case '-': /* '--' */ if (argv[i][2] != '\0') /* extra characters after '--'? */ return has_error; /* invalid option */ *first = i + 1; return args; case '\0': /* '-' */ return args; /* script "name" is '-' */ case 'E': if (argv[i][2] != '\0') /* extra characters after 1st? */ return has_error; /* invalid option */ args |= has_E; break; case 'i': args |= has_i; /* (-i implies -v) *//* FALLTHROUGH */ case 'v': if (argv[i][2] != '\0') /* extra characters after 1st? */ return has_error; /* invalid option */ args |= has_v; break; case 'e': args |= has_e; /* FALLTHROUGH */ case 'l': /* both options need an argument */ if (argv[i][2] == '\0') { /* no concatenated argument? */ i++; /* try next 'argv' */ if (argv[i] == NULL || argv[i][0] == '-') return has_error; /* no next argument or it is another option */ } break; default: /* invalid option */ return has_error; } } *first = i; /* no script name */ return args; } /* ** Processes options 'e' and 'l', which involve running Lua code. ** Returns 0 if some code raises an error. */ static int runargs (lua_State *L, char **argv, int n) { int i; for (i = 1; i < n; i++) { int option = argv[i][1]; lua_assert(argv[i][0] == '-'); /* already checked */ if (option == 'e' || option == 'l') { int status; const char *extra = argv[i] + 2; /* both options need an argument */ if (*extra == '\0') extra = argv[++i]; lua_assert(extra != NULL); status = (option == 'e') ? dostring(L, extra, "=(command line)") : dolibrary(L, extra); if (status != LUA_OK) return 0; } } return 1; } static int handle_luainit (lua_State *L) { const char *name = "=" LUA_INITVARVERSION; const char *init = getenv(name + 1); if (init == NULL) { name = "=" LUA_INIT_VAR; init = getenv(name + 1); /* try alternative name */ } if (init == NULL) return LUA_OK; else if (init[0] == '@') return dofile(L, init+1); else return dostring(L, init, name); } /* ** Main body of stand-alone interpreter (to be called in protected mode). ** Reads the options and handles them all. */ static int pmain (lua_State *L) { int argc = (int)lua_tointeger(L, 1); char **argv = (char **)lua_touserdata(L, 2); int script; int args = collectargs(argv, &script); luaL_checkversion(L); /* check that interpreter has correct version */ if (argv[0] && argv[0][0]) progname = argv[0]; if (args == has_error) { /* bad arg? */ print_usage(argv[script]); /* 'script' has index of bad arg. */ return 0; } if (args & has_v) /* option '-v'? */ print_version(); if (args & has_E) { /* option '-E'? */ lua_pushboolean(L, 1); /* signal for libraries to ignore env. vars. */ lua_setfield(L, LUA_REGISTRYINDEX, "LUA_NOENV"); } luaL_openlibs(L); /* open standard libraries */ createargtable(L, argv, argc, script); /* create table 'arg' */ if (!(args & has_E)) { /* no option '-E'? */ if (handle_luainit(L) != LUA_OK) /* run LUA_INIT */ return 0; /* error running LUA_INIT */ } if (!runargs(L, argv, script)) /* execute arguments -e and -l */ return 0; /* something failed */ if (script < argc && /* execute main script (if there is one) */ handle_script(L, argv + script) != LUA_OK) return 0; if (args & has_i) /* -i option? */ doREPL(L); /* do read-eval-print loop */ else if (script == argc && !(args & (has_e | has_v))) { /* no arguments? */ if (lua_stdin_is_tty()) { /* running in interactive mode? */ print_version(); doREPL(L); /* do read-eval-print loop */ } else dofile(L, NULL); /* executes stdin as a file */ } lua_pushboolean(L, 1); /* signal no errors */ return 1; } int main (int argc, char **argv) { int status, result; lua_State *L = luaL_newstate(); /* create state */ if (L == NULL) { l_message(argv[0], "cannot create state: not enough memory"); return EXIT_FAILURE; } lua_pushcfunction(L, &pmain); /* to call 'pmain' in protected mode */ lua_pushinteger(L, argc); /* 1st argument */ lua_pushlightuserdata(L, argv); /* 2nd argument */ status = lua_pcall(L, 2, 1, 0); /* do the call */ result = lua_toboolean(L, -1); /* get result */ report(L, status); lua_close(L); return (result && status == LUA_OK) ? EXIT_SUCCESS : EXIT_FAILURE; } wcc-0.0.2/src/wsh/lua/src/ldo.c0000644000175000017500000006112613110675433014632 0ustar philphil/* ** $Id: ldo.c,v 2.150 2015/11/19 19:16:22 roberto Exp $ ** Stack and Call structure of Lua ** See Copyright Notice in lua.h */ #define ldo_c #define LUA_CORE #include "lprefix.h" #include #include #include #include "lua.h" #include "lapi.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lopcodes.h" #include "lparser.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" #include "lundump.h" #include "lvm.h" #include "lzio.h" #define errorstatus(s) ((s) > LUA_YIELD) /* ** {====================================================== ** Error-recovery functions ** ======================================================= */ /* ** LUAI_THROW/LUAI_TRY define how Lua does exception handling. By ** default, Lua handles errors with exceptions when compiling as ** C++ code, with _longjmp/_setjmp when asked to use them, and with ** longjmp/setjmp otherwise. */ #if !defined(LUAI_THROW) /* { */ #if defined(__cplusplus) && !defined(LUA_USE_LONGJMP) /* { */ /* C++ exceptions */ #define LUAI_THROW(L,c) throw(c) #define LUAI_TRY(L,c,a) \ try { a } catch(...) { if ((c)->status == 0) (c)->status = -1; } #define luai_jmpbuf int /* dummy variable */ #elif defined(LUA_USE_POSIX) /* }{ */ /* in POSIX, try _longjmp/_setjmp (more efficient) */ #define LUAI_THROW(L,c) _longjmp((c)->b, 1) #define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a } #define luai_jmpbuf jmp_buf #else /* }{ */ /* ISO C handling with long jumps */ #define LUAI_THROW(L,c) longjmp((c)->b, 1) #define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a } #define luai_jmpbuf jmp_buf #endif /* } */ #endif /* } */ /* chain list of long jump buffers */ struct lua_longjmp { struct lua_longjmp *previous; luai_jmpbuf b; volatile int status; /* error code */ }; static void seterrorobj (lua_State *L, int errcode, StkId oldtop) { switch (errcode) { case LUA_ERRMEM: { /* memory error? */ setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */ break; } case LUA_ERRERR: { setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling")); break; } default: { setobjs2s(L, oldtop, L->top - 1); /* error message on current top */ break; } } L->top = oldtop + 1; } l_noret luaD_throw (lua_State *L, int errcode) { if (L->errorJmp) { /* thread has an error handler? */ L->errorJmp->status = errcode; /* set status */ LUAI_THROW(L, L->errorJmp); /* jump to it */ } else { /* thread has no error handler */ global_State *g = G(L); L->status = cast_byte(errcode); /* mark it as dead */ if (g->mainthread->errorJmp) { /* main thread has a handler? */ setobjs2s(L, g->mainthread->top++, L->top - 1); /* copy error obj. */ luaD_throw(g->mainthread, errcode); /* re-throw in main thread */ } else { /* no handler at all; abort */ if (g->panic) { /* panic function? */ seterrorobj(L, errcode, L->top); /* assume EXTRA_STACK */ if (L->ci->top < L->top) L->ci->top = L->top; /* pushing msg. can break this invariant */ lua_unlock(L); g->panic(L); /* call panic function (last chance to jump out) */ } abort(); } } } int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { unsigned short oldnCcalls = L->nCcalls; struct lua_longjmp lj; lj.status = LUA_OK; lj.previous = L->errorJmp; /* chain new error handler */ L->errorJmp = &lj; LUAI_TRY(L, &lj, (*f)(L, ud); ); L->errorJmp = lj.previous; /* restore old error handler */ L->nCcalls = oldnCcalls; return lj.status; } /* }====================================================== */ /* ** {================================================================== ** Stack reallocation ** =================================================================== */ static void correctstack (lua_State *L, TValue *oldstack) { CallInfo *ci; UpVal *up; L->top = (L->top - oldstack) + L->stack; for (up = L->openupval; up != NULL; up = up->u.open.next) up->v = (up->v - oldstack) + L->stack; for (ci = L->ci; ci != NULL; ci = ci->previous) { ci->top = (ci->top - oldstack) + L->stack; ci->func = (ci->func - oldstack) + L->stack; if (isLua(ci)) ci->u.l.base = (ci->u.l.base - oldstack) + L->stack; } } /* some space for error handling */ #define ERRORSTACKSIZE (LUAI_MAXSTACK + 200) void luaD_reallocstack (lua_State *L, int newsize) { TValue *oldstack = L->stack; int lim = L->stacksize; lua_assert(newsize <= LUAI_MAXSTACK || newsize == ERRORSTACKSIZE); lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK); luaM_reallocvector(L, L->stack, L->stacksize, newsize, TValue); for (; lim < newsize; lim++) setnilvalue(L->stack + lim); /* erase new segment */ L->stacksize = newsize; L->stack_last = L->stack + newsize - EXTRA_STACK; correctstack(L, oldstack); } void luaD_growstack (lua_State *L, int n) { int size = L->stacksize; if (size > LUAI_MAXSTACK) /* error after extra size? */ luaD_throw(L, LUA_ERRERR); else { int needed = cast_int(L->top - L->stack) + n + EXTRA_STACK; int newsize = 2 * size; if (newsize > LUAI_MAXSTACK) newsize = LUAI_MAXSTACK; if (newsize < needed) newsize = needed; if (newsize > LUAI_MAXSTACK) { /* stack overflow? */ luaD_reallocstack(L, ERRORSTACKSIZE); luaG_runerror(L, "stack overflow"); } else luaD_reallocstack(L, newsize); } } static int stackinuse (lua_State *L) { CallInfo *ci; StkId lim = L->top; for (ci = L->ci; ci != NULL; ci = ci->previous) { lua_assert(ci->top <= L->stack_last); if (lim < ci->top) lim = ci->top; } return cast_int(lim - L->stack) + 1; /* part of stack in use */ } void luaD_shrinkstack (lua_State *L) { int inuse = stackinuse(L); int goodsize = inuse + (inuse / 8) + 2*EXTRA_STACK; if (goodsize > LUAI_MAXSTACK) goodsize = LUAI_MAXSTACK; if (L->stacksize > LUAI_MAXSTACK) /* was handling stack overflow? */ luaE_freeCI(L); /* free all CIs (list grew because of an error) */ else luaE_shrinkCI(L); /* shrink list */ if (inuse <= LUAI_MAXSTACK && /* not handling stack overflow? */ goodsize < L->stacksize) /* trying to shrink? */ luaD_reallocstack(L, goodsize); /* shrink it */ else condmovestack(L,,); /* don't change stack (change only for debugging) */ } void luaD_inctop (lua_State *L) { luaD_checkstack(L, 1); L->top++; } /* }================================================================== */ void luaD_hook (lua_State *L, int event, int line) { lua_Hook hook = L->hook; if (hook && L->allowhook) { CallInfo *ci = L->ci; ptrdiff_t top = savestack(L, L->top); ptrdiff_t ci_top = savestack(L, ci->top); lua_Debug ar; ar.event = event; ar.currentline = line; ar.i_ci = ci; luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ ci->top = L->top + LUA_MINSTACK; lua_assert(ci->top <= L->stack_last); L->allowhook = 0; /* cannot call hooks inside a hook */ ci->callstatus |= CIST_HOOKED; lua_unlock(L); (*hook)(L, &ar); lua_lock(L); lua_assert(!L->allowhook); L->allowhook = 1; ci->top = restorestack(L, ci_top); L->top = restorestack(L, top); ci->callstatus &= ~CIST_HOOKED; } } static void callhook (lua_State *L, CallInfo *ci) { int hook = LUA_HOOKCALL; ci->u.l.savedpc++; /* hooks assume 'pc' is already incremented */ if (isLua(ci->previous) && GET_OPCODE(*(ci->previous->u.l.savedpc - 1)) == OP_TAILCALL) { ci->callstatus |= CIST_TAIL; hook = LUA_HOOKTAILCALL; } luaD_hook(L, hook, -1); ci->u.l.savedpc--; /* correct 'pc' */ } static StkId adjust_varargs (lua_State *L, Proto *p, int actual) { int i; int nfixargs = p->numparams; StkId base, fixed; /* move fixed parameters to final position */ fixed = L->top - actual; /* first fixed argument */ base = L->top; /* final position of first argument */ for (i = 0; i < nfixargs && i < actual; i++) { setobjs2s(L, L->top++, fixed + i); setnilvalue(fixed + i); /* erase original copy (for GC) */ } for (; i < nfixargs; i++) setnilvalue(L->top++); /* complete missing arguments */ return base; } /* ** Check whether __call metafield of 'func' is a function. If so, put ** it in stack below original 'func' so that 'luaD_precall' can call ** it. Raise an error if __call metafield is not a function. */ static void tryfuncTM (lua_State *L, StkId func) { const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL); StkId p; if (!ttisfunction(tm)) luaG_typeerror(L, func, "call"); /* Open a hole inside the stack at 'func' */ for (p = L->top; p > func; p--) setobjs2s(L, p, p-1); L->top++; /* slot ensured by caller */ setobj2s(L, func, tm); /* tag method is the new function to be called */ } #define next_ci(L) (L->ci = (L->ci->next ? L->ci->next : luaE_extendCI(L))) /* macro to check stack size, preserving 'p' */ #define checkstackp(L,n,p) \ luaD_checkstackaux(L, n, \ ptrdiff_t t__ = savestack(L, p); /* save 'p' */ \ luaC_checkGC(L), /* stack grow uses memory */ \ p = restorestack(L, t__)) /* 'pos' part: restore 'p' */ /* ** Prepares a function call: checks the stack, creates a new CallInfo ** entry, fills in the relevant information, calls hook if needed. ** If function is a C function, does the call, too. (Otherwise, leave ** the execution ('luaV_execute') to the caller, to allow stackless ** calls.) Returns true iff function has been executed (C function). */ int luaD_precall (lua_State *L, StkId func, int nresults) { lua_CFunction f; CallInfo *ci; switch (ttype(func)) { case LUA_TCCL: /* C closure */ f = clCvalue(func)->f; goto Cfunc; case LUA_TLCF: /* light C function */ f = fvalue(func); Cfunc: { int n; /* number of returns */ checkstackp(L, LUA_MINSTACK, func); /* ensure minimum stack size */ ci = next_ci(L); /* now 'enter' new function */ ci->nresults = nresults; ci->func = func; ci->top = L->top + LUA_MINSTACK; lua_assert(ci->top <= L->stack_last); ci->callstatus = 0; if (L->hookmask & LUA_MASKCALL) luaD_hook(L, LUA_HOOKCALL, -1); lua_unlock(L); n = (*f)(L); /* do the actual call */ lua_lock(L); api_checknelems(L, n); luaD_poscall(L, ci, L->top - n, n); return 1; } case LUA_TLCL: { /* Lua function: prepare its call */ StkId base; Proto *p = clLvalue(func)->p; int n = cast_int(L->top - func) - 1; /* number of real arguments */ int fsize = p->maxstacksize; /* frame size */ checkstackp(L, fsize, func); if (p->is_vararg != 1) { /* do not use vararg? */ for (; n < p->numparams; n++) setnilvalue(L->top++); /* complete missing arguments */ base = func + 1; } else base = adjust_varargs(L, p, n); ci = next_ci(L); /* now 'enter' new function */ ci->nresults = nresults; ci->func = func; ci->u.l.base = base; L->top = ci->top = base + fsize; lua_assert(ci->top <= L->stack_last); ci->u.l.savedpc = p->code; /* starting point */ ci->callstatus = CIST_LUA; if (L->hookmask & LUA_MASKCALL) callhook(L, ci); return 0; } default: { /* not a function */ checkstackp(L, 1, func); /* ensure space for metamethod */ tryfuncTM(L, func); /* try to get '__call' metamethod */ return luaD_precall(L, func, nresults); /* now it must be a function */ } } } /* ** Given 'nres' results at 'firstResult', move 'wanted' of them to 'res'. ** Handle most typical cases (zero results for commands, one result for ** expressions, multiple results for tail calls/single parameters) ** separated. */ static int moveresults (lua_State *L, const TValue *firstResult, StkId res, int nres, int wanted) { switch (wanted) { /* handle typical cases separately */ case 0: break; /* nothing to move */ case 1: { /* one result needed */ if (nres == 0) /* no results? */ firstResult = luaO_nilobject; /* adjust with nil */ setobjs2s(L, res, firstResult); /* move it to proper place */ break; } case LUA_MULTRET: { int i; for (i = 0; i < nres; i++) /* move all results to correct place */ setobjs2s(L, res + i, firstResult + i); L->top = res + nres; return 0; /* wanted == LUA_MULTRET */ } default: { int i; if (wanted <= nres) { /* enough results? */ for (i = 0; i < wanted; i++) /* move wanted results to correct place */ setobjs2s(L, res + i, firstResult + i); } else { /* not enough results; use all of them plus nils */ for (i = 0; i < nres; i++) /* move all results to correct place */ setobjs2s(L, res + i, firstResult + i); for (; i < wanted; i++) /* complete wanted number of results */ setnilvalue(res + i); } break; } } L->top = res + wanted; /* top points after the last result */ return 1; } /* ** Finishes a function call: calls hook if necessary, removes CallInfo, ** moves current number of results to proper place; returns 0 iff call ** wanted multiple (variable number of) results. */ int luaD_poscall (lua_State *L, CallInfo *ci, StkId firstResult, int nres) { StkId res; int wanted = ci->nresults; if (L->hookmask & (LUA_MASKRET | LUA_MASKLINE)) { if (L->hookmask & LUA_MASKRET) { ptrdiff_t fr = savestack(L, firstResult); /* hook may change stack */ luaD_hook(L, LUA_HOOKRET, -1); firstResult = restorestack(L, fr); } L->oldpc = ci->previous->u.l.savedpc; /* 'oldpc' for caller function */ } res = ci->func; /* res == final position of 1st result */ L->ci = ci->previous; /* back to caller */ /* move results to proper place */ return moveresults(L, firstResult, res, nres, wanted); } /* ** Check appropriate error for stack overflow ("regular" overflow or ** overflow while handling stack overflow). If 'nCalls' is larger than ** LUAI_MAXCCALLS (which means it is handling a "regular" overflow) but ** smaller than 9/8 of LUAI_MAXCCALLS, does not report an error (to ** allow overflow handling to work) */ static void stackerror (lua_State *L) { if (L->nCcalls == LUAI_MAXCCALLS) luaG_runerror(L, "C stack overflow"); else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3))) luaD_throw(L, LUA_ERRERR); /* error while handing stack error */ } /* ** Call a function (C or Lua). The function to be called is at *func. ** The arguments are on the stack, right after the function. ** When returns, all the results are on the stack, starting at the original ** function position. */ void luaD_call (lua_State *L, StkId func, int nResults) { if (++L->nCcalls >= LUAI_MAXCCALLS) stackerror(L); if (!luaD_precall(L, func, nResults)) /* is a Lua function? */ luaV_execute(L); /* call it */ L->nCcalls--; } /* ** Similar to 'luaD_call', but does not allow yields during the call */ void luaD_callnoyield (lua_State *L, StkId func, int nResults) { L->nny++; luaD_call(L, func, nResults); L->nny--; } /* ** Completes the execution of an interrupted C function, calling its ** continuation function. */ static void finishCcall (lua_State *L, int status) { CallInfo *ci = L->ci; int n; /* must have a continuation and must be able to call it */ lua_assert(ci->u.c.k != NULL && L->nny == 0); /* error status can only happen in a protected call */ lua_assert((ci->callstatus & CIST_YPCALL) || status == LUA_YIELD); if (ci->callstatus & CIST_YPCALL) { /* was inside a pcall? */ ci->callstatus &= ~CIST_YPCALL; /* finish 'lua_pcall' */ L->errfunc = ci->u.c.old_errfunc; } /* finish 'lua_callk'/'lua_pcall'; CIST_YPCALL and 'errfunc' already handled */ adjustresults(L, ci->nresults); /* call continuation function */ lua_unlock(L); n = (*ci->u.c.k)(L, status, ci->u.c.ctx); lua_lock(L); api_checknelems(L, n); /* finish 'luaD_precall' */ luaD_poscall(L, ci, L->top - n, n); } /* ** Executes "full continuation" (everything in the stack) of a ** previously interrupted coroutine until the stack is empty (or another ** interruption long-jumps out of the loop). If the coroutine is ** recovering from an error, 'ud' points to the error status, which must ** be passed to the first continuation function (otherwise the default ** status is LUA_YIELD). */ static void unroll (lua_State *L, void *ud) { if (ud != NULL) /* error status? */ finishCcall(L, *(int *)ud); /* finish 'lua_pcallk' callee */ while (L->ci != &L->base_ci) { /* something in the stack */ if (!isLua(L->ci)) /* C function? */ finishCcall(L, LUA_YIELD); /* complete its execution */ else { /* Lua function */ luaV_finishOp(L); /* finish interrupted instruction */ luaV_execute(L); /* execute down to higher C 'boundary' */ } } } /* ** Try to find a suspended protected call (a "recover point") for the ** given thread. */ static CallInfo *findpcall (lua_State *L) { CallInfo *ci; for (ci = L->ci; ci != NULL; ci = ci->previous) { /* search for a pcall */ if (ci->callstatus & CIST_YPCALL) return ci; } return NULL; /* no pending pcall */ } /* ** Recovers from an error in a coroutine. Finds a recover point (if ** there is one) and completes the execution of the interrupted ** 'luaD_pcall'. If there is no recover point, returns zero. */ static int recover (lua_State *L, int status) { StkId oldtop; CallInfo *ci = findpcall(L); if (ci == NULL) return 0; /* no recovery point */ /* "finish" luaD_pcall */ oldtop = restorestack(L, ci->extra); luaF_close(L, oldtop); seterrorobj(L, status, oldtop); L->ci = ci; L->allowhook = getoah(ci->callstatus); /* restore original 'allowhook' */ L->nny = 0; /* should be zero to be yieldable */ luaD_shrinkstack(L); L->errfunc = ci->u.c.old_errfunc; return 1; /* continue running the coroutine */ } /* ** signal an error in the call to 'resume', not in the execution of the ** coroutine itself. (Such errors should not be handled by any coroutine ** error handler and should not kill the coroutine.) */ static l_noret resume_error (lua_State *L, const char *msg, StkId firstArg) { L->top = firstArg; /* remove args from the stack */ setsvalue2s(L, L->top, luaS_new(L, msg)); /* push error message */ api_incr_top(L); luaD_throw(L, -1); /* jump back to 'lua_resume' */ } /* ** Do the work for 'lua_resume' in protected mode. Most of the work ** depends on the status of the coroutine: initial state, suspended ** inside a hook, or regularly suspended (optionally with a continuation ** function), plus erroneous cases: non-suspended coroutine or dead ** coroutine. */ static void resume (lua_State *L, void *ud) { int nCcalls = L->nCcalls; int n = *(cast(int*, ud)); /* number of arguments */ StkId firstArg = L->top - n; /* first argument */ CallInfo *ci = L->ci; if (nCcalls >= LUAI_MAXCCALLS) resume_error(L, "C stack overflow", firstArg); if (L->status == LUA_OK) { /* may be starting a coroutine */ if (ci != &L->base_ci) /* not in base level? */ resume_error(L, "cannot resume non-suspended coroutine", firstArg); /* coroutine is in base level; start running it */ if (!luaD_precall(L, firstArg - 1, LUA_MULTRET)) /* Lua function? */ luaV_execute(L); /* call it */ } else if (L->status != LUA_YIELD) resume_error(L, "cannot resume dead coroutine", firstArg); else { /* resuming from previous yield */ L->status = LUA_OK; /* mark that it is running (again) */ ci->func = restorestack(L, ci->extra); if (isLua(ci)) /* yielded inside a hook? */ luaV_execute(L); /* just continue running Lua code */ else { /* 'common' yield */ if (ci->u.c.k != NULL) { /* does it have a continuation function? */ lua_unlock(L); n = (*ci->u.c.k)(L, LUA_YIELD, ci->u.c.ctx); /* call continuation */ lua_lock(L); api_checknelems(L, n); firstArg = L->top - n; /* yield results come from continuation */ } luaD_poscall(L, ci, firstArg, n); /* finish 'luaD_precall' */ } unroll(L, NULL); /* run continuation */ } lua_assert(nCcalls == L->nCcalls); } LUA_API int lua_resume (lua_State *L, lua_State *from, int nargs) { int status; unsigned short oldnny = L->nny; /* save "number of non-yieldable" calls */ lua_lock(L); luai_userstateresume(L, nargs); L->nCcalls = (from) ? from->nCcalls + 1 : 1; L->nny = 0; /* allow yields */ api_checknelems(L, (L->status == LUA_OK) ? nargs + 1 : nargs); status = luaD_rawrunprotected(L, resume, &nargs); if (status == -1) /* error calling 'lua_resume'? */ status = LUA_ERRRUN; else { /* continue running after recoverable errors */ while (errorstatus(status) && recover(L, status)) { /* unroll continuation */ status = luaD_rawrunprotected(L, unroll, &status); } if (errorstatus(status)) { /* unrecoverable error? */ L->status = cast_byte(status); /* mark thread as 'dead' */ seterrorobj(L, status, L->top); /* push error message */ L->ci->top = L->top; } else lua_assert(status == L->status); /* normal end or yield */ } L->nny = oldnny; /* restore 'nny' */ L->nCcalls--; lua_assert(L->nCcalls == ((from) ? from->nCcalls : 0)); lua_unlock(L); return status; } LUA_API int lua_isyieldable (lua_State *L) { return (L->nny == 0); } LUA_API int lua_yieldk (lua_State *L, int nresults, lua_KContext ctx, lua_KFunction k) { CallInfo *ci = L->ci; luai_userstateyield(L, nresults); lua_lock(L); api_checknelems(L, nresults); if (L->nny > 0) { if (L != G(L)->mainthread) luaG_runerror(L, "attempt to yield across a C-call boundary"); else luaG_runerror(L, "attempt to yield from outside a coroutine"); } L->status = LUA_YIELD; ci->extra = savestack(L, ci->func); /* save current 'func' */ if (isLua(ci)) { /* inside a hook? */ api_check(L, k == NULL, "hooks cannot continue after yielding"); } else { if ((ci->u.c.k = k) != NULL) /* is there a continuation? */ ci->u.c.ctx = ctx; /* save context */ ci->func = L->top - nresults - 1; /* protect stack below results */ luaD_throw(L, LUA_YIELD); } lua_assert(ci->callstatus & CIST_HOOKED); /* must be inside a hook */ lua_unlock(L); return 0; /* return to 'luaD_hook' */ } int luaD_pcall (lua_State *L, Pfunc func, void *u, ptrdiff_t old_top, ptrdiff_t ef) { int status; CallInfo *old_ci = L->ci; lu_byte old_allowhooks = L->allowhook; unsigned short old_nny = L->nny; ptrdiff_t old_errfunc = L->errfunc; L->errfunc = ef; status = luaD_rawrunprotected(L, func, u); if (status != LUA_OK) { /* an error occurred? */ StkId oldtop = restorestack(L, old_top); luaF_close(L, oldtop); /* close possible pending closures */ seterrorobj(L, status, oldtop); L->ci = old_ci; L->allowhook = old_allowhooks; L->nny = old_nny; luaD_shrinkstack(L); } L->errfunc = old_errfunc; return status; } /* ** Execute a protected parser. */ struct SParser { /* data to 'f_parser' */ ZIO *z; Mbuffer buff; /* dynamic structure used by the scanner */ Dyndata dyd; /* dynamic structures used by the parser */ const char *mode; const char *name; }; static void checkmode (lua_State *L, const char *mode, const char *x) { if (mode && strchr(mode, x[0]) == NULL) { luaO_pushfstring(L, "attempt to load a %s chunk (mode is '%s')", x, mode); luaD_throw(L, LUA_ERRSYNTAX); } } static void f_parser (lua_State *L, void *ud) { LClosure *cl; struct SParser *p = cast(struct SParser *, ud); int c = zgetc(p->z); /* read first character */ if (c == LUA_SIGNATURE[0]) { checkmode(L, p->mode, "binary"); cl = luaU_undump(L, p->z, p->name); } else { checkmode(L, p->mode, "text"); cl = luaY_parser(L, p->z, &p->buff, &p->dyd, p->name, c); } lua_assert(cl->nupvalues == cl->p->sizeupvalues); luaF_initupvals(L, cl); } int luaD_protectedparser (lua_State *L, ZIO *z, const char *name, const char *mode) { struct SParser p; int status; L->nny++; /* cannot yield during parsing */ p.z = z; p.name = name; p.mode = mode; p.dyd.actvar.arr = NULL; p.dyd.actvar.size = 0; p.dyd.gt.arr = NULL; p.dyd.gt.size = 0; p.dyd.label.arr = NULL; p.dyd.label.size = 0; luaZ_initbuffer(L, &p.buff); status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc); luaZ_freebuffer(L, &p.buff); luaM_freearray(L, p.dyd.actvar.arr, p.dyd.actvar.size); luaM_freearray(L, p.dyd.gt.arr, p.dyd.gt.size); luaM_freearray(L, p.dyd.label.arr, p.dyd.label.size); L->nny--; return status; } wcc-0.0.2/src/wsh/lua/src/lstrlib.c0000644000175000017500000013144713110675433015533 0ustar philphil/* ** $Id: lstrlib.c,v 1.239 2015/11/25 16:28:17 roberto Exp $ ** Standard library for string operations and pattern-matching ** See Copyright Notice in lua.h */ #define lstrlib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" /* ** maximum number of captures that a pattern can do during ** pattern-matching. This limit is arbitrary. */ #if !defined(LUA_MAXCAPTURES) #define LUA_MAXCAPTURES 32 #endif /* macro to 'unsign' a character */ #define uchar(c) ((unsigned char)(c)) /* ** Some sizes are better limited to fit in 'int', but must also fit in ** 'size_t'. (We assume that 'lua_Integer' cannot be smaller than 'int'.) */ #define MAX_SIZET ((size_t)(~(size_t)0)) #define MAXSIZE \ (sizeof(size_t) < sizeof(int) ? MAX_SIZET : (size_t)(INT_MAX)) static int str_len (lua_State *L) { size_t l; luaL_checklstring(L, 1, &l); lua_pushinteger(L, (lua_Integer)l); return 1; } /* translate a relative string position: negative means back from end */ static lua_Integer posrelat (lua_Integer pos, size_t len) { if (pos >= 0) return pos; else if (0u - (size_t)pos > len) return 0; else return (lua_Integer)len + pos + 1; } static int str_sub (lua_State *L) { size_t l; const char *s = luaL_checklstring(L, 1, &l); lua_Integer start = posrelat(luaL_checkinteger(L, 2), l); lua_Integer end = posrelat(luaL_optinteger(L, 3, -1), l); if (start < 1) start = 1; if (end > (lua_Integer)l) end = l; if (start <= end) lua_pushlstring(L, s + start - 1, (size_t)(end - start) + 1); else lua_pushliteral(L, ""); return 1; } static int str_reverse (lua_State *L) { size_t l, i; luaL_Buffer b; const char *s = luaL_checklstring(L, 1, &l); char *p = luaL_buffinitsize(L, &b, l); for (i = 0; i < l; i++) p[i] = s[l - i - 1]; luaL_pushresultsize(&b, l); return 1; } static int str_lower (lua_State *L) { size_t l; size_t i; luaL_Buffer b; const char *s = luaL_checklstring(L, 1, &l); char *p = luaL_buffinitsize(L, &b, l); for (i=0; i MAXSIZE / n) /* may overflow? */ return luaL_error(L, "resulting string too large"); else { size_t totallen = (size_t)n * l + (size_t)(n - 1) * lsep; luaL_Buffer b; char *p = luaL_buffinitsize(L, &b, totallen); while (n-- > 1) { /* first n-1 copies (followed by separator) */ memcpy(p, s, l * sizeof(char)); p += l; if (lsep > 0) { /* empty 'memcpy' is not that cheap */ memcpy(p, sep, lsep * sizeof(char)); p += lsep; } } memcpy(p, s, l * sizeof(char)); /* last copy (not followed by separator) */ luaL_pushresultsize(&b, totallen); } return 1; } static int str_byte (lua_State *L) { size_t l; const char *s = luaL_checklstring(L, 1, &l); lua_Integer posi = posrelat(luaL_optinteger(L, 2, 1), l); lua_Integer pose = posrelat(luaL_optinteger(L, 3, posi), l); int n, i; if (posi < 1) posi = 1; if (pose > (lua_Integer)l) pose = l; if (posi > pose) return 0; /* empty interval; return no values */ if (pose - posi >= INT_MAX) /* arithmetic overflow? */ return luaL_error(L, "string slice too long"); n = (int)(pose - posi) + 1; luaL_checkstack(L, n, "string slice too long"); for (i=0; i= ms->level || ms->capture[l].len == CAP_UNFINISHED) return luaL_error(ms->L, "invalid capture index %%%d", l + 1); return l; } static int capture_to_close (MatchState *ms) { int level = ms->level; for (level--; level>=0; level--) if (ms->capture[level].len == CAP_UNFINISHED) return level; return luaL_error(ms->L, "invalid pattern capture"); } static const char *classend (MatchState *ms, const char *p) { switch (*p++) { case L_ESC: { if (p == ms->p_end) luaL_error(ms->L, "malformed pattern (ends with '%%')"); return p+1; } case '[': { if (*p == '^') p++; do { /* look for a ']' */ if (p == ms->p_end) luaL_error(ms->L, "malformed pattern (missing ']')"); if (*(p++) == L_ESC && p < ms->p_end) p++; /* skip escapes (e.g. '%]') */ } while (*p != ']'); return p+1; } default: { return p; } } } static int match_class (int c, int cl) { int res; switch (tolower(cl)) { case 'a' : res = isalpha(c); break; case 'c' : res = iscntrl(c); break; case 'd' : res = isdigit(c); break; case 'g' : res = isgraph(c); break; case 'l' : res = islower(c); break; case 'p' : res = ispunct(c); break; case 's' : res = isspace(c); break; case 'u' : res = isupper(c); break; case 'w' : res = isalnum(c); break; case 'x' : res = isxdigit(c); break; case 'z' : res = (c == 0); break; /* deprecated option */ default: return (cl == c); } return (islower(cl) ? res : !res); } static int matchbracketclass (int c, const char *p, const char *ec) { int sig = 1; if (*(p+1) == '^') { sig = 0; p++; /* skip the '^' */ } while (++p < ec) { if (*p == L_ESC) { p++; if (match_class(c, uchar(*p))) return sig; } else if ((*(p+1) == '-') && (p+2 < ec)) { p+=2; if (uchar(*(p-2)) <= c && c <= uchar(*p)) return sig; } else if (uchar(*p) == c) return sig; } return !sig; } static int singlematch (MatchState *ms, const char *s, const char *p, const char *ep) { if (s >= ms->src_end) return 0; else { int c = uchar(*s); switch (*p) { case '.': return 1; /* matches any char */ case L_ESC: return match_class(c, uchar(*(p+1))); case '[': return matchbracketclass(c, p, ep-1); default: return (uchar(*p) == c); } } } static const char *matchbalance (MatchState *ms, const char *s, const char *p) { if (p >= ms->p_end - 1) luaL_error(ms->L, "malformed pattern (missing arguments to '%%b')"); if (*s != *p) return NULL; else { int b = *p; int e = *(p+1); int cont = 1; while (++s < ms->src_end) { if (*s == e) { if (--cont == 0) return s+1; } else if (*s == b) cont++; } } return NULL; /* string ends out of balance */ } static const char *max_expand (MatchState *ms, const char *s, const char *p, const char *ep) { ptrdiff_t i = 0; /* counts maximum expand for item */ while (singlematch(ms, s + i, p, ep)) i++; /* keeps trying to match with the maximum repetitions */ while (i>=0) { const char *res = match(ms, (s+i), ep+1); if (res) return res; i--; /* else didn't match; reduce 1 repetition to try again */ } return NULL; } static const char *min_expand (MatchState *ms, const char *s, const char *p, const char *ep) { for (;;) { const char *res = match(ms, s, ep+1); if (res != NULL) return res; else if (singlematch(ms, s, p, ep)) s++; /* try with one more repetition */ else return NULL; } } static const char *start_capture (MatchState *ms, const char *s, const char *p, int what) { const char *res; int level = ms->level; if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures"); ms->capture[level].init = s; ms->capture[level].len = what; ms->level = level+1; if ((res=match(ms, s, p)) == NULL) /* match failed? */ ms->level--; /* undo capture */ return res; } static const char *end_capture (MatchState *ms, const char *s, const char *p) { int l = capture_to_close(ms); const char *res; ms->capture[l].len = s - ms->capture[l].init; /* close capture */ if ((res = match(ms, s, p)) == NULL) /* match failed? */ ms->capture[l].len = CAP_UNFINISHED; /* undo capture */ return res; } static const char *match_capture (MatchState *ms, const char *s, int l) { size_t len; l = check_capture(ms, l); len = ms->capture[l].len; if ((size_t)(ms->src_end-s) >= len && memcmp(ms->capture[l].init, s, len) == 0) return s+len; else return NULL; } static const char *match (MatchState *ms, const char *s, const char *p) { if (ms->matchdepth-- == 0) luaL_error(ms->L, "pattern too complex"); init: /* using goto's to optimize tail recursion */ if (p != ms->p_end) { /* end of pattern? */ switch (*p) { case '(': { /* start capture */ if (*(p + 1) == ')') /* position capture? */ s = start_capture(ms, s, p + 2, CAP_POSITION); else s = start_capture(ms, s, p + 1, CAP_UNFINISHED); break; } case ')': { /* end capture */ s = end_capture(ms, s, p + 1); break; } case '$': { if ((p + 1) != ms->p_end) /* is the '$' the last char in pattern? */ goto dflt; /* no; go to default */ s = (s == ms->src_end) ? s : NULL; /* check end of string */ break; } case L_ESC: { /* escaped sequences not in the format class[*+?-]? */ switch (*(p + 1)) { case 'b': { /* balanced string? */ s = matchbalance(ms, s, p + 2); if (s != NULL) { p += 4; goto init; /* return match(ms, s, p + 4); */ } /* else fail (s == NULL) */ break; } case 'f': { /* frontier? */ const char *ep; char previous; p += 2; if (*p != '[') luaL_error(ms->L, "missing '[' after '%%f' in pattern"); ep = classend(ms, p); /* points to what is next */ previous = (s == ms->src_init) ? '\0' : *(s - 1); if (!matchbracketclass(uchar(previous), p, ep - 1) && matchbracketclass(uchar(*s), p, ep - 1)) { p = ep; goto init; /* return match(ms, s, ep); */ } s = NULL; /* match failed */ break; } case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { /* capture results (%0-%9)? */ s = match_capture(ms, s, uchar(*(p + 1))); if (s != NULL) { p += 2; goto init; /* return match(ms, s, p + 2) */ } break; } default: goto dflt; } break; } default: dflt: { /* pattern class plus optional suffix */ const char *ep = classend(ms, p); /* points to optional suffix */ /* does not match at least once? */ if (!singlematch(ms, s, p, ep)) { if (*ep == '*' || *ep == '?' || *ep == '-') { /* accept empty? */ p = ep + 1; goto init; /* return match(ms, s, ep + 1); */ } else /* '+' or no suffix */ s = NULL; /* fail */ } else { /* matched once */ if (ms->nrep-- == 0) luaL_error(ms->L, "pattern too complex"); switch (*ep) { /* handle optional suffix */ case '?': { /* optional */ const char *res; if ((res = match(ms, s + 1, ep + 1)) != NULL) s = res; else { p = ep + 1; goto init; /* else return match(ms, s, ep + 1); */ } break; } case '+': /* 1 or more repetitions */ s++; /* 1 match already done */ /* FALLTHROUGH */ case '*': /* 0 or more repetitions */ s = max_expand(ms, s, p, ep); break; case '-': /* 0 or more repetitions (minimum) */ s = min_expand(ms, s, p, ep); break; default: /* no suffix */ s++; p = ep; goto init; /* return match(ms, s + 1, ep); */ } } break; } } } ms->matchdepth++; return s; } static const char *lmemfind (const char *s1, size_t l1, const char *s2, size_t l2) { if (l2 == 0) return s1; /* empty strings are everywhere */ else if (l2 > l1) return NULL; /* avoids a negative 'l1' */ else { const char *init; /* to search for a '*s2' inside 's1' */ l2--; /* 1st char will be checked by 'memchr' */ l1 = l1-l2; /* 's2' cannot be found after that */ while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) { init++; /* 1st char is already checked */ if (memcmp(init, s2+1, l2) == 0) return init-1; else { /* correct 'l1' and 's1' to try again */ l1 -= init-s1; s1 = init; } } return NULL; /* not found */ } } static void push_onecapture (MatchState *ms, int i, const char *s, const char *e) { if (i >= ms->level) { if (i == 0) /* ms->level == 0, too */ lua_pushlstring(ms->L, s, e - s); /* add whole match */ else luaL_error(ms->L, "invalid capture index %%%d", i + 1); } else { ptrdiff_t l = ms->capture[i].len; if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture"); if (l == CAP_POSITION) lua_pushinteger(ms->L, (ms->capture[i].init - ms->src_init) + 1); else lua_pushlstring(ms->L, ms->capture[i].init, l); } } static int push_captures (MatchState *ms, const char *s, const char *e) { int i; int nlevels = (ms->level == 0 && s) ? 1 : ms->level; luaL_checkstack(ms->L, nlevels, "too many captures"); for (i = 0; i < nlevels; i++) push_onecapture(ms, i, s, e); return nlevels; /* number of strings pushed */ } /* check whether pattern has no special characters */ static int nospecials (const char *p, size_t l) { size_t upto = 0; do { if (strpbrk(p + upto, SPECIALS)) return 0; /* pattern has a special character */ upto += strlen(p + upto) + 1; /* may have more after \0 */ } while (upto <= l); return 1; /* no special chars found */ } static void prepstate (MatchState *ms, lua_State *L, const char *s, size_t ls, const char *p, size_t lp) { ms->L = L; ms->matchdepth = MAXCCALLS; ms->src_init = s; ms->src_end = s + ls; ms->p_end = p + lp; if (ls < (MAX_SIZET - B_REPS) / A_REPS) ms->nrep = A_REPS * ls + B_REPS; else /* overflow (very long subject) */ ms->nrep = MAX_SIZET; /* no limit */ } static void reprepstate (MatchState *ms) { ms->level = 0; lua_assert(ms->matchdepth == MAXCCALLS); } static int str_find_aux (lua_State *L, int find) { size_t ls, lp; const char *s = luaL_checklstring(L, 1, &ls); const char *p = luaL_checklstring(L, 2, &lp); lua_Integer init = posrelat(luaL_optinteger(L, 3, 1), ls); if (init < 1) init = 1; else if (init > (lua_Integer)ls + 1) { /* start after string's end? */ lua_pushnil(L); /* cannot find anything */ return 1; } /* explicit request or no special characters? */ if (find && (lua_toboolean(L, 4) || nospecials(p, lp))) { /* do a plain search */ const char *s2 = lmemfind(s + init - 1, ls - (size_t)init + 1, p, lp); if (s2) { lua_pushinteger(L, (s2 - s) + 1); lua_pushinteger(L, (s2 - s) + lp); return 2; } } else { MatchState ms; const char *s1 = s + init - 1; int anchor = (*p == '^'); if (anchor) { p++; lp--; /* skip anchor character */ } prepstate(&ms, L, s, ls, p, lp); do { const char *res; reprepstate(&ms); if ((res=match(&ms, s1, p)) != NULL) { if (find) { lua_pushinteger(L, (s1 - s) + 1); /* start */ lua_pushinteger(L, res - s); /* end */ return push_captures(&ms, NULL, 0) + 2; } else return push_captures(&ms, s1, res); } } while (s1++ < ms.src_end && !anchor); } lua_pushnil(L); /* not found */ return 1; } static int str_find (lua_State *L) { return str_find_aux(L, 1); } static int str_match (lua_State *L) { return str_find_aux(L, 0); } /* state for 'gmatch' */ typedef struct GMatchState { const char *src; /* current position */ const char *p; /* pattern */ MatchState ms; /* match state */ } GMatchState; static int gmatch_aux (lua_State *L) { GMatchState *gm = (GMatchState *)lua_touserdata(L, lua_upvalueindex(3)); const char *src; for (src = gm->src; src <= gm->ms.src_end; src++) { const char *e; reprepstate(&gm->ms); if ((e = match(&gm->ms, src, gm->p)) != NULL) { if (e == src) /* empty match? */ gm->src =src + 1; /* go at least one position */ else gm->src = e; return push_captures(&gm->ms, src, e); } } return 0; /* not found */ } static int gmatch (lua_State *L) { size_t ls, lp; const char *s = luaL_checklstring(L, 1, &ls); const char *p = luaL_checklstring(L, 2, &lp); GMatchState *gm; lua_settop(L, 2); /* keep them on closure to avoid being collected */ gm = (GMatchState *)lua_newuserdata(L, sizeof(GMatchState)); prepstate(&gm->ms, L, s, ls, p, lp); gm->src = s; gm->p = p; lua_pushcclosure(L, gmatch_aux, 3); return 1; } static void add_s (MatchState *ms, luaL_Buffer *b, const char *s, const char *e) { size_t l, i; lua_State *L = ms->L; const char *news = lua_tolstring(L, 3, &l); for (i = 0; i < l; i++) { if (news[i] != L_ESC) luaL_addchar(b, news[i]); else { i++; /* skip ESC */ if (!isdigit(uchar(news[i]))) { if (news[i] != L_ESC) luaL_error(L, "invalid use of '%c' in replacement string", L_ESC); luaL_addchar(b, news[i]); } else if (news[i] == '0') luaL_addlstring(b, s, e - s); else { push_onecapture(ms, news[i] - '1', s, e); luaL_tolstring(L, -1, NULL); /* if number, convert it to string */ lua_remove(L, -2); /* remove original value */ luaL_addvalue(b); /* add capture to accumulated result */ } } } } static void add_value (MatchState *ms, luaL_Buffer *b, const char *s, const char *e, int tr) { lua_State *L = ms->L; switch (tr) { case LUA_TFUNCTION: { int n; lua_pushvalue(L, 3); n = push_captures(ms, s, e); lua_call(L, n, 1); break; } case LUA_TTABLE: { push_onecapture(ms, 0, s, e); lua_gettable(L, 3); break; } default: { /* LUA_TNUMBER or LUA_TSTRING */ add_s(ms, b, s, e); return; } } if (!lua_toboolean(L, -1)) { /* nil or false? */ lua_pop(L, 1); lua_pushlstring(L, s, e - s); /* keep original text */ } else if (!lua_isstring(L, -1)) luaL_error(L, "invalid replacement value (a %s)", luaL_typename(L, -1)); luaL_addvalue(b); /* add result to accumulator */ } static int str_gsub (lua_State *L) { size_t srcl, lp; const char *src = luaL_checklstring(L, 1, &srcl); const char *p = luaL_checklstring(L, 2, &lp); int tr = lua_type(L, 3); lua_Integer max_s = luaL_optinteger(L, 4, srcl + 1); int anchor = (*p == '^'); lua_Integer n = 0; MatchState ms; luaL_Buffer b; luaL_argcheck(L, tr == LUA_TNUMBER || tr == LUA_TSTRING || tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3, "string/function/table expected"); luaL_buffinit(L, &b); if (anchor) { p++; lp--; /* skip anchor character */ } prepstate(&ms, L, src, srcl, p, lp); while (n < max_s) { const char *e; reprepstate(&ms); if ((e = match(&ms, src, p)) != NULL) { n++; add_value(&ms, &b, src, e, tr); } if (e && e>src) /* non empty match? */ src = e; /* skip it */ else if (src < ms.src_end) luaL_addchar(&b, *src++); else break; if (anchor) break; } luaL_addlstring(&b, src, ms.src_end-src); luaL_pushresult(&b); lua_pushinteger(L, n); /* number of substitutions */ return 2; } /* }====================================================== */ /* ** {====================================================== ** STRING FORMAT ** ======================================================= */ #if !defined(lua_number2strx) /* { */ /* ** Hexadecimal floating-point formatter */ #include #include #define SIZELENMOD (sizeof(LUA_NUMBER_FRMLEN)/sizeof(char)) /* ** Number of bits that goes into the first digit. It can be any value ** between 1 and 4; the following definition tries to align the number ** to nibble boundaries by making what is left after that first digit a ** multiple of 4. */ #define L_NBFD ((l_mathlim(MANT_DIG) - 1)%4 + 1) /* ** Add integer part of 'x' to buffer and return new 'x' */ static lua_Number adddigit (char *buff, int n, lua_Number x) { lua_Number dd = l_mathop(floor)(x); /* get integer part from 'x' */ int d = (int)dd; buff[n] = (d < 10 ? d + '0' : d - 10 + 'a'); /* add to buffer */ return x - dd; /* return what is left */ } static int num2straux (char *buff, int sz, lua_Number x) { if (x != x || x == HUGE_VAL || x == -HUGE_VAL) /* inf or NaN? */ return l_sprintf(buff, sz, LUA_NUMBER_FMT, x); /* equal to '%g' */ else if (x == 0) { /* can be -0... */ /* create "0" or "-0" followed by exponent */ return l_sprintf(buff, sz, LUA_NUMBER_FMT "x0p+0", x); } else { int e; lua_Number m = l_mathop(frexp)(x, &e); /* 'x' fraction and exponent */ int n = 0; /* character count */ if (m < 0) { /* is number negative? */ buff[n++] = '-'; /* add signal */ m = -m; /* make it positive */ } buff[n++] = '0'; buff[n++] = 'x'; /* add "0x" */ m = adddigit(buff, n++, m * (1 << L_NBFD)); /* add first digit */ e -= L_NBFD; /* this digit goes before the radix point */ if (m > 0) { /* more digits? */ buff[n++] = lua_getlocaledecpoint(); /* add radix point */ do { /* add as many digits as needed */ m = adddigit(buff, n++, m * 16); } while (m > 0); } n += l_sprintf(buff + n, sz - n, "p%+d", e); /* add exponent */ lua_assert(n < sz); return n; } } static int lua_number2strx (lua_State *L, char *buff, int sz, const char *fmt, lua_Number x) { int n = num2straux(buff, sz, x); if (fmt[SIZELENMOD] == 'A') { int i; for (i = 0; i < n; i++) buff[i] = toupper(uchar(buff[i])); } else if (fmt[SIZELENMOD] != 'a') luaL_error(L, "modifiers for format '%%a'/'%%A' not implemented"); return n; } #endif /* } */ /* ** Maximum size of each formatted item. This maximum size is produced ** by format('%.99f', -maxfloat), and is equal to 99 + 3 ('-', '.', ** and '\0') + number of decimal digits to represent maxfloat (which ** is maximum exponent + 1). (99+3+1 then rounded to 120 for "extra ** expenses", such as locale-dependent stuff) */ #define MAX_ITEM (120 + l_mathlim(MAX_10_EXP)) /* valid flags in a format specification */ #define FLAGS "-+ #0" /* ** maximum size of each format specification (such as "%-099.99d") */ #define MAX_FORMAT 32 static void addquoted (lua_State *L, luaL_Buffer *b, int arg) { size_t l; const char *s = luaL_checklstring(L, arg, &l); luaL_addchar(b, '"'); while (l--) { if (*s == '"' || *s == '\\' || *s == '\n') { luaL_addchar(b, '\\'); luaL_addchar(b, *s); } else if (*s == '\0' || iscntrl(uchar(*s))) { char buff[10]; if (!isdigit(uchar(*(s+1)))) l_sprintf(buff, sizeof(buff), "\\%d", (int)uchar(*s)); else l_sprintf(buff, sizeof(buff), "\\%03d", (int)uchar(*s)); luaL_addstring(b, buff); } else luaL_addchar(b, *s); s++; } luaL_addchar(b, '"'); } static const char *scanformat (lua_State *L, const char *strfrmt, char *form) { const char *p = strfrmt; while (*p != '\0' && strchr(FLAGS, *p) != NULL) p++; /* skip flags */ if ((size_t)(p - strfrmt) >= sizeof(FLAGS)/sizeof(char)) luaL_error(L, "invalid format (repeated flags)"); if (isdigit(uchar(*p))) p++; /* skip width */ if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ if (*p == '.') { p++; if (isdigit(uchar(*p))) p++; /* skip precision */ if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ } if (isdigit(uchar(*p))) luaL_error(L, "invalid format (width or precision too long)"); *(form++) = '%'; memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char)); form += (p - strfrmt) + 1; *form = '\0'; return p; } /* ** add length modifier into formats */ static void addlenmod (char *form, const char *lenmod) { size_t l = strlen(form); size_t lm = strlen(lenmod); char spec = form[l - 1]; strcpy(form + l - 1, lenmod); form[l + lm - 1] = spec; form[l + lm] = '\0'; } static int str_format (lua_State *L) { int top = lua_gettop(L); int arg = 1; size_t sfl; const char *strfrmt = luaL_checklstring(L, arg, &sfl); const char *strfrmt_end = strfrmt+sfl; luaL_Buffer b; luaL_buffinit(L, &b); while (strfrmt < strfrmt_end) { if (*strfrmt != L_ESC) luaL_addchar(&b, *strfrmt++); else if (*++strfrmt == L_ESC) luaL_addchar(&b, *strfrmt++); /* %% */ else { /* format item */ char form[MAX_FORMAT]; /* to store the format ('%...') */ char *buff = luaL_prepbuffsize(&b, MAX_ITEM); /* to put formatted item */ int nb = 0; /* number of bytes in added item */ if (++arg > top) luaL_argerror(L, arg, "no value"); strfrmt = scanformat(L, strfrmt, form); switch (*strfrmt++) { case 'c': { nb = l_sprintf(buff, MAX_ITEM, form, (int)luaL_checkinteger(L, arg)); break; } case 'd': case 'i': case 'o': case 'u': case 'x': case 'X': { lua_Integer n = luaL_checkinteger(L, arg); addlenmod(form, LUA_INTEGER_FRMLEN); nb = l_sprintf(buff, MAX_ITEM, form, n); break; } case 'a': case 'A': addlenmod(form, LUA_NUMBER_FRMLEN); nb = lua_number2strx(L, buff, MAX_ITEM, form, luaL_checknumber(L, arg)); break; case 'e': case 'E': case 'f': case 'g': case 'G': { addlenmod(form, LUA_NUMBER_FRMLEN); nb = l_sprintf(buff, MAX_ITEM, form, luaL_checknumber(L, arg)); break; } case 'q': { addquoted(L, &b, arg); break; } case 's': { size_t l; const char *s = luaL_tolstring(L, arg, &l); if (form[2] == '\0') /* no modifiers? */ luaL_addvalue(&b); /* keep entire string */ else { luaL_argcheck(L, l == strlen(s), arg, "string contains zeros"); if (!strchr(form, '.') && l >= 100) { /* no precision and string is too long to be formatted */ luaL_addvalue(&b); /* keep entire string */ } else { /* format the string into 'buff' */ nb = l_sprintf(buff, MAX_ITEM, form, s); lua_pop(L, 1); /* remove result from 'luaL_tolstring' */ } } break; } default: { /* also treat cases 'pnLlh' */ return luaL_error(L, "invalid option '%%%c' to 'format'", *(strfrmt - 1)); } } lua_assert(nb < MAX_ITEM); luaL_addsize(&b, nb); } } luaL_pushresult(&b); return 1; } /* }====================================================== */ /* ** {====================================================== ** PACK/UNPACK ** ======================================================= */ /* value used for padding */ #if !defined(LUA_PACKPADBYTE) #define LUA_PACKPADBYTE 0x00 #endif /* maximum size for the binary representation of an integer */ #define MAXINTSIZE 16 /* number of bits in a character */ #define NB CHAR_BIT /* mask for one character (NB 1's) */ #define MC ((1 << NB) - 1) /* size of a lua_Integer */ #define SZINT ((int)sizeof(lua_Integer)) /* dummy union to get native endianness */ static const union { int dummy; char little; /* true iff machine is little endian */ } nativeendian = {1}; /* dummy structure to get native alignment requirements */ struct cD { char c; union { double d; void *p; lua_Integer i; lua_Number n; } u; }; #define MAXALIGN (offsetof(struct cD, u)) /* ** Union for serializing floats */ typedef union Ftypes { float f; double d; lua_Number n; char buff[5 * sizeof(lua_Number)]; /* enough for any float type */ } Ftypes; /* ** information to pack/unpack stuff */ typedef struct Header { lua_State *L; int islittle; int maxalign; } Header; /* ** options for pack/unpack */ typedef enum KOption { Kint, /* signed integers */ Kuint, /* unsigned integers */ Kfloat, /* floating-point numbers */ Kchar, /* fixed-length strings */ Kstring, /* strings with prefixed length */ Kzstr, /* zero-terminated strings */ Kpadding, /* padding */ Kpaddalign, /* padding for alignment */ Knop /* no-op (configuration or spaces) */ } KOption; /* ** Read an integer numeral from string 'fmt' or return 'df' if ** there is no numeral */ static int digit (int c) { return '0' <= c && c <= '9'; } static int getnum (const char **fmt, int df) { if (!digit(**fmt)) /* no number? */ return df; /* return default value */ else { int a = 0; do { a = a*10 + (*((*fmt)++) - '0'); } while (digit(**fmt) && a <= ((int)MAXSIZE - 9)/10); return a; } } /* ** Read an integer numeral and raises an error if it is larger ** than the maximum size for integers. */ static int getnumlimit (Header *h, const char **fmt, int df) { int sz = getnum(fmt, df); if (sz > MAXINTSIZE || sz <= 0) luaL_error(h->L, "integral size (%d) out of limits [1,%d]", sz, MAXINTSIZE); return sz; } /* ** Initialize Header */ static void initheader (lua_State *L, Header *h) { h->L = L; h->islittle = nativeendian.little; h->maxalign = 1; } /* ** Read and classify next option. 'size' is filled with option's size. */ static KOption getoption (Header *h, const char **fmt, int *size) { int opt = *((*fmt)++); *size = 0; /* default */ switch (opt) { case 'b': *size = sizeof(char); return Kint; case 'B': *size = sizeof(char); return Kuint; case 'h': *size = sizeof(short); return Kint; case 'H': *size = sizeof(short); return Kuint; case 'l': *size = sizeof(long); return Kint; case 'L': *size = sizeof(long); return Kuint; case 'j': *size = sizeof(lua_Integer); return Kint; case 'J': *size = sizeof(lua_Integer); return Kuint; case 'T': *size = sizeof(size_t); return Kuint; case 'f': *size = sizeof(float); return Kfloat; case 'd': *size = sizeof(double); return Kfloat; case 'n': *size = sizeof(lua_Number); return Kfloat; case 'i': *size = getnumlimit(h, fmt, sizeof(int)); return Kint; case 'I': *size = getnumlimit(h, fmt, sizeof(int)); return Kuint; case 's': *size = getnumlimit(h, fmt, sizeof(size_t)); return Kstring; case 'c': *size = getnum(fmt, -1); if (*size == -1) luaL_error(h->L, "missing size for format option 'c'"); return Kchar; case 'z': return Kzstr; case 'x': *size = 1; return Kpadding; case 'X': return Kpaddalign; case ' ': break; case '<': h->islittle = 1; break; case '>': h->islittle = 0; break; case '=': h->islittle = nativeendian.little; break; case '!': h->maxalign = getnumlimit(h, fmt, MAXALIGN); break; default: luaL_error(h->L, "invalid format option '%c'", opt); } return Knop; } /* ** Read, classify, and fill other details about the next option. ** 'psize' is filled with option's size, 'notoalign' with its ** alignment requirements. ** Local variable 'size' gets the size to be aligned. (Kpadal option ** always gets its full alignment, other options are limited by ** the maximum alignment ('maxalign'). Kchar option needs no alignment ** despite its size. */ static KOption getdetails (Header *h, size_t totalsize, const char **fmt, int *psize, int *ntoalign) { KOption opt = getoption(h, fmt, psize); int align = *psize; /* usually, alignment follows size */ if (opt == Kpaddalign) { /* 'X' gets alignment from following option */ if (**fmt == '\0' || getoption(h, fmt, &align) == Kchar || align == 0) luaL_argerror(h->L, 1, "invalid next option for option 'X'"); } if (align <= 1 || opt == Kchar) /* need no alignment? */ *ntoalign = 0; else { if (align > h->maxalign) /* enforce maximum alignment */ align = h->maxalign; if ((align & (align - 1)) != 0) /* is 'align' not a power of 2? */ luaL_argerror(h->L, 1, "format asks for alignment not power of 2"); *ntoalign = (align - (int)(totalsize & (align - 1))) & (align - 1); } return opt; } /* ** Pack integer 'n' with 'size' bytes and 'islittle' endianness. ** The final 'if' handles the case when 'size' is larger than ** the size of a Lua integer, correcting the extra sign-extension ** bytes if necessary (by default they would be zeros). */ static void packint (luaL_Buffer *b, lua_Unsigned n, int islittle, int size, int neg) { char *buff = luaL_prepbuffsize(b, size); int i; buff[islittle ? 0 : size - 1] = (char)(n & MC); /* first byte */ for (i = 1; i < size; i++) { n >>= NB; buff[islittle ? i : size - 1 - i] = (char)(n & MC); } if (neg && size > SZINT) { /* negative number need sign extension? */ for (i = SZINT; i < size; i++) /* correct extra bytes */ buff[islittle ? i : size - 1 - i] = (char)MC; } luaL_addsize(b, size); /* add result to buffer */ } /* ** Copy 'size' bytes from 'src' to 'dest', correcting endianness if ** given 'islittle' is different from native endianness. */ static void copywithendian (volatile char *dest, volatile const char *src, int size, int islittle) { if (islittle == nativeendian.little) { while (size-- != 0) *(dest++) = *(src++); } else { dest += size - 1; while (size-- != 0) *(dest--) = *(src++); } } static int str_pack (lua_State *L) { luaL_Buffer b; Header h; const char *fmt = luaL_checkstring(L, 1); /* format string */ int arg = 1; /* current argument to pack */ size_t totalsize = 0; /* accumulate total size of result */ initheader(L, &h); lua_pushnil(L); /* mark to separate arguments from string buffer */ luaL_buffinit(L, &b); while (*fmt != '\0') { int size, ntoalign; KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign); totalsize += ntoalign + size; while (ntoalign-- > 0) luaL_addchar(&b, LUA_PACKPADBYTE); /* fill alignment */ arg++; switch (opt) { case Kint: { /* signed integers */ lua_Integer n = luaL_checkinteger(L, arg); if (size < SZINT) { /* need overflow check? */ lua_Integer lim = (lua_Integer)1 << ((size * NB) - 1); luaL_argcheck(L, -lim <= n && n < lim, arg, "integer overflow"); } packint(&b, (lua_Unsigned)n, h.islittle, size, (n < 0)); break; } case Kuint: { /* unsigned integers */ lua_Integer n = luaL_checkinteger(L, arg); if (size < SZINT) /* need overflow check? */ luaL_argcheck(L, (lua_Unsigned)n < ((lua_Unsigned)1 << (size * NB)), arg, "unsigned overflow"); packint(&b, (lua_Unsigned)n, h.islittle, size, 0); break; } case Kfloat: { /* floating-point options */ volatile Ftypes u; char *buff = luaL_prepbuffsize(&b, size); lua_Number n = luaL_checknumber(L, arg); /* get argument */ if (size == sizeof(u.f)) u.f = (float)n; /* copy it into 'u' */ else if (size == sizeof(u.d)) u.d = (double)n; else u.n = n; /* move 'u' to final result, correcting endianness if needed */ copywithendian(buff, u.buff, size, h.islittle); luaL_addsize(&b, size); break; } case Kchar: { /* fixed-size string */ size_t len; const char *s = luaL_checklstring(L, arg, &len); if ((size_t)size <= len) /* string larger than (or equal to) needed? */ luaL_addlstring(&b, s, size); /* truncate string to asked size */ else { /* string smaller than needed */ luaL_addlstring(&b, s, len); /* add it all */ while (len++ < (size_t)size) /* pad extra space */ luaL_addchar(&b, LUA_PACKPADBYTE); } break; } case Kstring: { /* strings with length count */ size_t len; const char *s = luaL_checklstring(L, arg, &len); luaL_argcheck(L, size >= (int)sizeof(size_t) || len < ((size_t)1 << (size * NB)), arg, "string length does not fit in given size"); packint(&b, (lua_Unsigned)len, h.islittle, size, 0); /* pack length */ luaL_addlstring(&b, s, len); totalsize += len; break; } case Kzstr: { /* zero-terminated string */ size_t len; const char *s = luaL_checklstring(L, arg, &len); luaL_argcheck(L, strlen(s) == len, arg, "string contains zeros"); luaL_addlstring(&b, s, len); luaL_addchar(&b, '\0'); /* add zero at the end */ totalsize += len + 1; break; } case Kpadding: luaL_addchar(&b, LUA_PACKPADBYTE); /* FALLTHROUGH */ case Kpaddalign: case Knop: arg--; /* undo increment */ break; } } luaL_pushresult(&b); return 1; } static int str_packsize (lua_State *L) { Header h; const char *fmt = luaL_checkstring(L, 1); /* format string */ size_t totalsize = 0; /* accumulate total size of result */ initheader(L, &h); while (*fmt != '\0') { int size, ntoalign; KOption opt = getdetails(&h, totalsize, &fmt, &size, &ntoalign); size += ntoalign; /* total space used by option */ luaL_argcheck(L, totalsize <= MAXSIZE - size, 1, "format result too large"); totalsize += size; switch (opt) { case Kstring: /* strings with length count */ case Kzstr: /* zero-terminated string */ luaL_argerror(L, 1, "variable-length format"); /* call never return, but to avoid warnings: *//* FALLTHROUGH */ default: break; } } lua_pushinteger(L, (lua_Integer)totalsize); return 1; } /* ** Unpack an integer with 'size' bytes and 'islittle' endianness. ** If size is smaller than the size of a Lua integer and integer ** is signed, must do sign extension (propagating the sign to the ** higher bits); if size is larger than the size of a Lua integer, ** it must check the unread bytes to see whether they do not cause an ** overflow. */ static lua_Integer unpackint (lua_State *L, const char *str, int islittle, int size, int issigned) { lua_Unsigned res = 0; int i; int limit = (size <= SZINT) ? size : SZINT; for (i = limit - 1; i >= 0; i--) { res <<= NB; res |= (lua_Unsigned)(unsigned char)str[islittle ? i : size - 1 - i]; } if (size < SZINT) { /* real size smaller than lua_Integer? */ if (issigned) { /* needs sign extension? */ lua_Unsigned mask = (lua_Unsigned)1 << (size*NB - 1); res = ((res ^ mask) - mask); /* do sign extension */ } } else if (size > SZINT) { /* must check unread bytes */ int mask = (!issigned || (lua_Integer)res >= 0) ? 0 : MC; for (i = limit; i < size; i++) { if ((unsigned char)str[islittle ? i : size - 1 - i] != mask) luaL_error(L, "%d-byte integer does not fit into Lua Integer", size); } } return (lua_Integer)res; } static int str_unpack (lua_State *L) { Header h; const char *fmt = luaL_checkstring(L, 1); size_t ld; const char *data = luaL_checklstring(L, 2, &ld); size_t pos = (size_t)posrelat(luaL_optinteger(L, 3, 1), ld) - 1; int n = 0; /* number of results */ luaL_argcheck(L, pos <= ld, 3, "initial position out of string"); initheader(L, &h); while (*fmt != '\0') { int size, ntoalign; KOption opt = getdetails(&h, pos, &fmt, &size, &ntoalign); if ((size_t)ntoalign + size > ~pos || pos + ntoalign + size > ld) luaL_argerror(L, 2, "data string too short"); pos += ntoalign; /* skip alignment */ /* stack space for item + next position */ luaL_checkstack(L, 2, "too many results"); n++; switch (opt) { case Kint: case Kuint: { lua_Integer res = unpackint(L, data + pos, h.islittle, size, (opt == Kint)); lua_pushinteger(L, res); break; } case Kfloat: { volatile Ftypes u; lua_Number num; copywithendian(u.buff, data + pos, size, h.islittle); if (size == sizeof(u.f)) num = (lua_Number)u.f; else if (size == sizeof(u.d)) num = (lua_Number)u.d; else num = u.n; lua_pushnumber(L, num); break; } case Kchar: { lua_pushlstring(L, data + pos, size); break; } case Kstring: { size_t len = (size_t)unpackint(L, data + pos, h.islittle, size, 0); luaL_argcheck(L, pos + len + size <= ld, 2, "data string too short"); lua_pushlstring(L, data + pos + size, len); pos += len; /* skip string */ break; } case Kzstr: { size_t len = (int)strlen(data + pos); lua_pushlstring(L, data + pos, len); pos += len + 1; /* skip string plus final '\0' */ break; } case Kpaddalign: case Kpadding: case Knop: n--; /* undo increment */ break; } pos += size; } lua_pushinteger(L, pos + 1); /* next position */ return n + 1; } /* }====================================================== */ static const luaL_Reg strlib[] = { {"byte", str_byte}, {"char", str_char}, {"dump", str_dump}, {"find", str_find}, {"format", str_format}, {"gmatch", gmatch}, {"gsub", str_gsub}, {"len", str_len}, {"lower", str_lower}, {"match", str_match}, {"rep", str_rep}, {"reverse", str_reverse}, {"sub", str_sub}, {"upper", str_upper}, {"pack", str_pack}, {"packsize", str_packsize}, {"unpack", str_unpack}, {NULL, NULL} }; static void createmetatable (lua_State *L) { lua_createtable(L, 0, 1); /* table to be metatable for strings */ lua_pushliteral(L, ""); /* dummy string */ lua_pushvalue(L, -2); /* copy table */ lua_setmetatable(L, -2); /* set table as metatable for strings */ lua_pop(L, 1); /* pop dummy string */ lua_pushvalue(L, -2); /* get string library */ lua_setfield(L, -2, "__index"); /* metatable.__index = string */ lua_pop(L, 1); /* pop metatable */ } /* ** Open string library */ LUAMOD_API int luaopen_string (lua_State *L) { luaL_newlib(L, strlib); createmetatable(L); return 1; } wcc-0.0.2/src/wsh/lua/src/lbitlib.c0000644000175000017500000001153713110675433015476 0ustar philphil/* ** $Id: lbitlib.c,v 1.30 2015/11/11 19:08:09 roberto Exp $ ** Standard library for bitwise operations ** See Copyright Notice in lua.h */ #define lbitlib_c #define LUA_LIB #include "lprefix.h" #include "lua.h" #include "lauxlib.h" #include "lualib.h" #if defined(LUA_COMPAT_BITLIB) /* { */ #define pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n)) #define checkunsigned(L,i) ((lua_Unsigned)luaL_checkinteger(L,i)) /* number of bits to consider in a number */ #if !defined(LUA_NBITS) #define LUA_NBITS 32 #endif /* ** a lua_Unsigned with its first LUA_NBITS bits equal to 1. (Shift must ** be made in two parts to avoid problems when LUA_NBITS is equal to the ** number of bits in a lua_Unsigned.) */ #define ALLONES (~(((~(lua_Unsigned)0) << (LUA_NBITS - 1)) << 1)) /* macro to trim extra bits */ #define trim(x) ((x) & ALLONES) /* builds a number with 'n' ones (1 <= n <= LUA_NBITS) */ #define mask(n) (~((ALLONES << 1) << ((n) - 1))) static lua_Unsigned andaux (lua_State *L) { int i, n = lua_gettop(L); lua_Unsigned r = ~(lua_Unsigned)0; for (i = 1; i <= n; i++) r &= checkunsigned(L, i); return trim(r); } static int b_and (lua_State *L) { lua_Unsigned r = andaux(L); pushunsigned(L, r); return 1; } static int b_test (lua_State *L) { lua_Unsigned r = andaux(L); lua_pushboolean(L, r != 0); return 1; } static int b_or (lua_State *L) { int i, n = lua_gettop(L); lua_Unsigned r = 0; for (i = 1; i <= n; i++) r |= checkunsigned(L, i); pushunsigned(L, trim(r)); return 1; } static int b_xor (lua_State *L) { int i, n = lua_gettop(L); lua_Unsigned r = 0; for (i = 1; i <= n; i++) r ^= checkunsigned(L, i); pushunsigned(L, trim(r)); return 1; } static int b_not (lua_State *L) { lua_Unsigned r = ~checkunsigned(L, 1); pushunsigned(L, trim(r)); return 1; } static int b_shift (lua_State *L, lua_Unsigned r, lua_Integer i) { if (i < 0) { /* shift right? */ i = -i; r = trim(r); if (i >= LUA_NBITS) r = 0; else r >>= i; } else { /* shift left */ if (i >= LUA_NBITS) r = 0; else r <<= i; r = trim(r); } pushunsigned(L, r); return 1; } static int b_lshift (lua_State *L) { return b_shift(L, checkunsigned(L, 1), luaL_checkinteger(L, 2)); } static int b_rshift (lua_State *L) { return b_shift(L, checkunsigned(L, 1), -luaL_checkinteger(L, 2)); } static int b_arshift (lua_State *L) { lua_Unsigned r = checkunsigned(L, 1); lua_Integer i = luaL_checkinteger(L, 2); if (i < 0 || !(r & ((lua_Unsigned)1 << (LUA_NBITS - 1)))) return b_shift(L, r, -i); else { /* arithmetic shift for 'negative' number */ if (i >= LUA_NBITS) r = ALLONES; else r = trim((r >> i) | ~(trim(~(lua_Unsigned)0) >> i)); /* add signal bit */ pushunsigned(L, r); return 1; } } static int b_rot (lua_State *L, lua_Integer d) { lua_Unsigned r = checkunsigned(L, 1); int i = d & (LUA_NBITS - 1); /* i = d % NBITS */ r = trim(r); if (i != 0) /* avoid undefined shift of LUA_NBITS when i == 0 */ r = (r << i) | (r >> (LUA_NBITS - i)); pushunsigned(L, trim(r)); return 1; } static int b_lrot (lua_State *L) { return b_rot(L, luaL_checkinteger(L, 2)); } static int b_rrot (lua_State *L) { return b_rot(L, -luaL_checkinteger(L, 2)); } /* ** get field and width arguments for field-manipulation functions, ** checking whether they are valid. ** ('luaL_error' called without 'return' to avoid later warnings about ** 'width' being used uninitialized.) */ static int fieldargs (lua_State *L, int farg, int *width) { lua_Integer f = luaL_checkinteger(L, farg); lua_Integer w = luaL_optinteger(L, farg + 1, 1); luaL_argcheck(L, 0 <= f, farg, "field cannot be negative"); luaL_argcheck(L, 0 < w, farg + 1, "width must be positive"); if (f + w > LUA_NBITS) luaL_error(L, "trying to access non-existent bits"); *width = (int)w; return (int)f; } static int b_extract (lua_State *L) { int w; lua_Unsigned r = trim(checkunsigned(L, 1)); int f = fieldargs(L, 2, &w); r = (r >> f) & mask(w); pushunsigned(L, r); return 1; } static int b_replace (lua_State *L) { int w; lua_Unsigned r = trim(checkunsigned(L, 1)); lua_Unsigned v = trim(checkunsigned(L, 2)); int f = fieldargs(L, 3, &w); lua_Unsigned m = mask(w); r = (r & ~(m << f)) | ((v & m) << f); pushunsigned(L, r); return 1; } static const luaL_Reg bitlib[] = { {"arshift", b_arshift}, {"band", b_and}, {"bnot", b_not}, {"bor", b_or}, {"bxor", b_xor}, {"btest", b_test}, {"extract", b_extract}, {"lrotate", b_lrot}, {"lshift", b_lshift}, {"replace", b_replace}, {"rrotate", b_rrot}, {"rshift", b_rshift}, {NULL, NULL} }; LUAMOD_API int luaopen_bit32 (lua_State *L) { luaL_newlib(L, bitlib); return 1; } #else /* }{ */ LUAMOD_API int luaopen_bit32 (lua_State *L) { return luaL_error(L, "library 'bit32' has been deprecated"); } #endif /* } */ wcc-0.0.2/src/wsh/lua/src/lcorolib.c0000644000175000017500000000725013110675433015657 0ustar philphil/* ** $Id: lcorolib.c,v 1.9 2014/11/02 19:19:04 roberto Exp $ ** Coroutine Library ** See Copyright Notice in lua.h */ #define lcorolib_c #define LUA_LIB #include "lprefix.h" #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" static lua_State *getco (lua_State *L) { lua_State *co = lua_tothread(L, 1); luaL_argcheck(L, co, 1, "thread expected"); return co; } static int auxresume (lua_State *L, lua_State *co, int narg) { int status; if (!lua_checkstack(co, narg)) { lua_pushliteral(L, "too many arguments to resume"); return -1; /* error flag */ } if (lua_status(co) == LUA_OK && lua_gettop(co) == 0) { lua_pushliteral(L, "cannot resume dead coroutine"); return -1; /* error flag */ } lua_xmove(L, co, narg); status = lua_resume(co, L, narg); if (status == LUA_OK || status == LUA_YIELD) { int nres = lua_gettop(co); if (!lua_checkstack(L, nres + 1)) { lua_pop(co, nres); /* remove results anyway */ lua_pushliteral(L, "too many results to resume"); return -1; /* error flag */ } lua_xmove(co, L, nres); /* move yielded values */ return nres; } else { lua_xmove(co, L, 1); /* move error message */ return -1; /* error flag */ } } static int luaB_coresume (lua_State *L) { lua_State *co = getco(L); int r; r = auxresume(L, co, lua_gettop(L) - 1); if (r < 0) { lua_pushboolean(L, 0); lua_insert(L, -2); return 2; /* return false + error message */ } else { lua_pushboolean(L, 1); lua_insert(L, -(r + 1)); return r + 1; /* return true + 'resume' returns */ } } static int luaB_auxwrap (lua_State *L) { lua_State *co = lua_tothread(L, lua_upvalueindex(1)); int r = auxresume(L, co, lua_gettop(L)); if (r < 0) { if (lua_isstring(L, -1)) { /* error object is a string? */ luaL_where(L, 1); /* add extra info */ lua_insert(L, -2); lua_concat(L, 2); } return lua_error(L); /* propagate error */ } return r; } static int luaB_cocreate (lua_State *L) { lua_State *NL; luaL_checktype(L, 1, LUA_TFUNCTION); NL = lua_newthread(L); lua_pushvalue(L, 1); /* move function to top */ lua_xmove(L, NL, 1); /* move function from L to NL */ return 1; } static int luaB_cowrap (lua_State *L) { luaB_cocreate(L); lua_pushcclosure(L, luaB_auxwrap, 1); return 1; } static int luaB_yield (lua_State *L) { return lua_yield(L, lua_gettop(L)); } static int luaB_costatus (lua_State *L) { lua_State *co = getco(L); if (L == co) lua_pushliteral(L, "running"); else { switch (lua_status(co)) { case LUA_YIELD: lua_pushliteral(L, "suspended"); break; case LUA_OK: { lua_Debug ar; if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */ lua_pushliteral(L, "normal"); /* it is running */ else if (lua_gettop(co) == 0) lua_pushliteral(L, "dead"); else lua_pushliteral(L, "suspended"); /* initial state */ break; } default: /* some error occurred */ lua_pushliteral(L, "dead"); break; } } return 1; } static int luaB_yieldable (lua_State *L) { lua_pushboolean(L, lua_isyieldable(L)); return 1; } static int luaB_corunning (lua_State *L) { int ismain = lua_pushthread(L); lua_pushboolean(L, ismain); return 2; } static const luaL_Reg co_funcs[] = { {"create", luaB_cocreate}, {"resume", luaB_coresume}, {"running", luaB_corunning}, {"status", luaB_costatus}, {"wrap", luaB_cowrap}, {"yield", luaB_yield}, {"isyieldable", luaB_yieldable}, {NULL, NULL} }; LUAMOD_API int luaopen_coroutine (lua_State *L) { luaL_newlib(L, co_funcs); return 1; } wcc-0.0.2/src/wsh/lua/src/lundump.h0000644000175000017500000000143713110675433015544 0ustar philphil/* ** $Id: lundump.h,v 1.45 2015/09/08 15:41:05 roberto Exp $ ** load precompiled Lua chunks ** See Copyright Notice in lua.h */ #ifndef lundump_h #define lundump_h #include "llimits.h" #include "lobject.h" #include "lzio.h" /* data to catch conversion errors */ #define LUAC_DATA "\x19\x93\r\n\x1a\n" #define LUAC_INT 0x5678 #define LUAC_NUM cast_num(370.5) #define MYINT(s) (s[0]-'0') #define LUAC_VERSION (MYINT(LUA_VERSION_MAJOR)*16+MYINT(LUA_VERSION_MINOR)) #define LUAC_FORMAT 0 /* this is the official format */ /* load one chunk; from lundump.c */ LUAI_FUNC LClosure* luaU_undump (lua_State* L, ZIO* Z, const char* name); /* dump one chunk; from ldump.c */ LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, void* data, int strip); #endif wcc-0.0.2/src/wsh/lua/src/lfunc.h0000644000175000017500000000313713110675433015166 0ustar philphil/* ** $Id: lfunc.h,v 2.15 2015/01/13 15:49:11 roberto Exp $ ** Auxiliary functions to manipulate prototypes and closures ** See Copyright Notice in lua.h */ #ifndef lfunc_h #define lfunc_h #include "lobject.h" #define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \ cast(int, sizeof(TValue)*((n)-1))) #define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \ cast(int, sizeof(TValue *)*((n)-1))) /* test whether thread is in 'twups' list */ #define isintwups(L) (L->twups != L) /* ** maximum number of upvalues in a closure (both C and Lua). (Value ** must fit in a VM register.) */ #define MAXUPVAL 255 /* ** Upvalues for Lua closures */ struct UpVal { TValue *v; /* points to stack or to its own value */ lu_mem refcount; /* reference counter */ union { struct { /* (when open) */ UpVal *next; /* linked list */ int touched; /* mark to avoid cycles with dead threads */ } open; TValue value; /* the value (when closed) */ } u; }; #define upisopen(up) ((up)->v != &(up)->u.value) LUAI_FUNC Proto *luaF_newproto (lua_State *L); LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nelems); LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nelems); LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl); LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level); LUAI_FUNC void luaF_close (lua_State *L, StkId level); LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f); LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number, int pc); #endif wcc-0.0.2/src/wsh/lua/src/lauxlib.c0000644000175000017500000007163313110675433015520 0ustar philphil/* ** $Id: lauxlib.c,v 1.284 2015/11/19 19:16:22 roberto Exp $ ** Auxiliary functions for building Lua libraries ** See Copyright Notice in lua.h */ #define lauxlib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include #include /* This file uses only the official API of Lua. ** Any function declared here could be written as an application function. */ #include "lua.h" #include "lauxlib.h" /* ** {====================================================== ** Traceback ** ======================================================= */ #define LEVELS1 10 /* size of the first part of the stack */ #define LEVELS2 11 /* size of the second part of the stack */ /* ** search for 'objidx' in table at index -1. ** return 1 + string at top if find a good name. */ static int findfield (lua_State *L, int objidx, int level) { if (level == 0 || !lua_istable(L, -1)) return 0; /* not found */ lua_pushnil(L); /* start 'next' loop */ while (lua_next(L, -2)) { /* for each pair in table */ if (lua_type(L, -2) == LUA_TSTRING) { /* ignore non-string keys */ if (lua_rawequal(L, objidx, -1)) { /* found object? */ lua_pop(L, 1); /* remove value (but keep name) */ return 1; } else if (findfield(L, objidx, level - 1)) { /* try recursively */ lua_remove(L, -2); /* remove table (but keep name) */ lua_pushliteral(L, "."); lua_insert(L, -2); /* place '.' between the two names */ lua_concat(L, 3); return 1; } } lua_pop(L, 1); /* remove value */ } return 0; /* not found */ } /* ** Search for a name for a function in all loaded modules ** (registry._LOADED). */ static int pushglobalfuncname (lua_State *L, lua_Debug *ar) { int top = lua_gettop(L); lua_getinfo(L, "f", ar); /* push function */ lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); if (findfield(L, top + 1, 2)) { const char *name = lua_tostring(L, -1); if (strncmp(name, "_G.", 3) == 0) { /* name start with '_G.'? */ lua_pushstring(L, name + 3); /* push name without prefix */ lua_remove(L, -2); /* remove original name */ } lua_copy(L, -1, top + 1); /* move name to proper place */ lua_pop(L, 2); /* remove pushed values */ return 1; } else { lua_settop(L, top); /* remove function and global table */ return 0; } } static void pushfuncname (lua_State *L, lua_Debug *ar) { if (pushglobalfuncname(L, ar)) { /* try first a global name */ lua_pushfstring(L, "function '%s'", lua_tostring(L, -1)); lua_remove(L, -2); /* remove name */ } else if (*ar->namewhat != '\0') /* is there a name from code? */ lua_pushfstring(L, "%s '%s'", ar->namewhat, ar->name); /* use it */ else if (*ar->what == 'm') /* main? */ lua_pushliteral(L, "main chunk"); else if (*ar->what != 'C') /* for Lua functions, use */ lua_pushfstring(L, "function <%s:%d>", ar->short_src, ar->linedefined); else /* nothing left... */ lua_pushliteral(L, "?"); } static int lastlevel (lua_State *L) { lua_Debug ar; int li = 1, le = 1; /* find an upper bound */ while (lua_getstack(L, le, &ar)) { li = le; le *= 2; } /* do a binary search */ while (li < le) { int m = (li + le)/2; if (lua_getstack(L, m, &ar)) li = m + 1; else le = m; } return le - 1; } LUALIB_API void luaL_traceback (lua_State *L, lua_State *L1, const char *msg, int level) { lua_Debug ar; int top = lua_gettop(L); int last = lastlevel(L1); int n1 = (last - level > LEVELS1 + LEVELS2) ? LEVELS1 : -1; if (msg) lua_pushfstring(L, "%s\n", msg); luaL_checkstack(L, 10, NULL); lua_pushliteral(L, "stack traceback:"); while (lua_getstack(L1, level++, &ar)) { if (n1-- == 0) { /* too many levels? */ lua_pushliteral(L, "\n\t..."); /* add a '...' */ level = last - LEVELS2 + 1; /* and skip to last ones */ } else { lua_getinfo(L1, "Slnt", &ar); lua_pushfstring(L, "\n\t%s:", ar.short_src); if (ar.currentline > 0) lua_pushfstring(L, "%d:", ar.currentline); lua_pushliteral(L, " in "); pushfuncname(L, &ar); if (ar.istailcall) lua_pushliteral(L, "\n\t(...tail calls...)"); lua_concat(L, lua_gettop(L) - top); } } lua_concat(L, lua_gettop(L) - top); } /* }====================================================== */ /* ** {====================================================== ** Error-report functions ** ======================================================= */ LUALIB_API int luaL_argerror (lua_State *L, int arg, const char *extramsg) { lua_Debug ar; if (!lua_getstack(L, 0, &ar)) /* no stack frame? */ return luaL_error(L, "bad argument #%d (%s)", arg, extramsg); lua_getinfo(L, "n", &ar); if (strcmp(ar.namewhat, "method") == 0) { arg--; /* do not count 'self' */ if (arg == 0) /* error is in the self argument itself? */ return luaL_error(L, "calling '%s' on bad self (%s)", ar.name, extramsg); } if (ar.name == NULL) ar.name = (pushglobalfuncname(L, &ar)) ? lua_tostring(L, -1) : "?"; return luaL_error(L, "bad argument #%d to '%s' (%s)", arg, ar.name, extramsg); } static int typeerror (lua_State *L, int arg, const char *tname) { const char *msg; const char *typearg; /* name for the type of the actual argument */ if (luaL_getmetafield(L, arg, "__name") == LUA_TSTRING) typearg = lua_tostring(L, -1); /* use the given type name */ else if (lua_type(L, arg) == LUA_TLIGHTUSERDATA) typearg = "light userdata"; /* special name for messages */ else typearg = luaL_typename(L, arg); /* standard name */ msg = lua_pushfstring(L, "%s expected, got %s", tname, typearg); return luaL_argerror(L, arg, msg); } static void tag_error (lua_State *L, int arg, int tag) { typeerror(L, arg, lua_typename(L, tag)); } LUALIB_API void luaL_where (lua_State *L, int level) { lua_Debug ar; if (lua_getstack(L, level, &ar)) { /* check function at level */ lua_getinfo(L, "Sl", &ar); /* get info about it */ if (ar.currentline > 0) { /* is there info? */ lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline); return; } } lua_pushliteral(L, ""); /* else, no information available... */ } LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) { va_list argp; va_start(argp, fmt); luaL_where(L, 1); lua_pushvfstring(L, fmt, argp); va_end(argp); lua_concat(L, 2); return lua_error(L); } LUALIB_API int luaL_fileresult (lua_State *L, int stat, const char *fname) { int en = errno; /* calls to Lua API may change this value */ if (stat) { lua_pushboolean(L, 1); return 1; } else { lua_pushnil(L); if (fname) lua_pushfstring(L, "%s: %s", fname, strerror(en)); else lua_pushstring(L, strerror(en)); lua_pushinteger(L, en); return 3; } } #if !defined(l_inspectstat) /* { */ #if defined(LUA_USE_POSIX) #include /* ** use appropriate macros to interpret 'pclose' return status */ #define l_inspectstat(stat,what) \ if (WIFEXITED(stat)) { stat = WEXITSTATUS(stat); } \ else if (WIFSIGNALED(stat)) { stat = WTERMSIG(stat); what = "signal"; } #else #define l_inspectstat(stat,what) /* no op */ #endif #endif /* } */ LUALIB_API int luaL_execresult (lua_State *L, int stat) { const char *what = "exit"; /* type of termination */ if (stat == -1) /* error? */ return luaL_fileresult(L, 0, NULL); else { l_inspectstat(stat, what); /* interpret result */ if (*what == 'e' && stat == 0) /* successful termination? */ lua_pushboolean(L, 1); else lua_pushnil(L); lua_pushstring(L, what); lua_pushinteger(L, stat); return 3; /* return true/nil,what,code */ } } /* }====================================================== */ /* ** {====================================================== ** Userdata's metatable manipulation ** ======================================================= */ LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) { if (luaL_getmetatable(L, tname) != LUA_TNIL) /* name already in use? */ return 0; /* leave previous value on top, but return 0 */ lua_pop(L, 1); lua_createtable(L, 0, 2); /* create metatable */ lua_pushstring(L, tname); lua_setfield(L, -2, "__name"); /* metatable.__name = tname */ lua_pushvalue(L, -1); lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */ return 1; } LUALIB_API void luaL_setmetatable (lua_State *L, const char *tname) { luaL_getmetatable(L, tname); lua_setmetatable(L, -2); } LUALIB_API void *luaL_testudata (lua_State *L, int ud, const char *tname) { void *p = lua_touserdata(L, ud); if (p != NULL) { /* value is a userdata? */ if (lua_getmetatable(L, ud)) { /* does it have a metatable? */ luaL_getmetatable(L, tname); /* get correct metatable */ if (!lua_rawequal(L, -1, -2)) /* not the same? */ p = NULL; /* value is a userdata with wrong metatable */ lua_pop(L, 2); /* remove both metatables */ return p; } } return NULL; /* value is not a userdata with a metatable */ } LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) { void *p = luaL_testudata(L, ud, tname); if (p == NULL) typeerror(L, ud, tname); return p; } /* }====================================================== */ /* ** {====================================================== ** Argument check functions ** ======================================================= */ LUALIB_API int luaL_checkoption (lua_State *L, int arg, const char *def, const char *const lst[]) { const char *name = (def) ? luaL_optstring(L, arg, def) : luaL_checkstring(L, arg); int i; for (i=0; lst[i]; i++) if (strcmp(lst[i], name) == 0) return i; return luaL_argerror(L, arg, lua_pushfstring(L, "invalid option '%s'", name)); } LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *msg) { /* keep some extra space to run error routines, if needed */ const int extra = LUA_MINSTACK; if (!lua_checkstack(L, space + extra)) { if (msg) luaL_error(L, "stack overflow (%s)", msg); else luaL_error(L, "stack overflow"); } } LUALIB_API void luaL_checktype (lua_State *L, int arg, int t) { if (lua_type(L, arg) != t) tag_error(L, arg, t); } LUALIB_API void luaL_checkany (lua_State *L, int arg) { if (lua_type(L, arg) == LUA_TNONE) luaL_argerror(L, arg, "value expected"); } LUALIB_API const char *luaL_checklstring (lua_State *L, int arg, size_t *len) { const char *s = lua_tolstring(L, arg, len); if (!s) tag_error(L, arg, LUA_TSTRING); return s; } LUALIB_API const char *luaL_optlstring (lua_State *L, int arg, const char *def, size_t *len) { if (lua_isnoneornil(L, arg)) { if (len) *len = (def ? strlen(def) : 0); return def; } else return luaL_checklstring(L, arg, len); } LUALIB_API lua_Number luaL_checknumber (lua_State *L, int arg) { int isnum; lua_Number d = lua_tonumberx(L, arg, &isnum); if (!isnum) tag_error(L, arg, LUA_TNUMBER); return d; } LUALIB_API lua_Number luaL_optnumber (lua_State *L, int arg, lua_Number def) { return luaL_opt(L, luaL_checknumber, arg, def); } static void interror (lua_State *L, int arg) { if (lua_isnumber(L, arg)) luaL_argerror(L, arg, "number has no integer representation"); else tag_error(L, arg, LUA_TNUMBER); } LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int arg) { int isnum; lua_Integer d = lua_tointegerx(L, arg, &isnum); if (!isnum) { interror(L, arg); } return d; } LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int arg, lua_Integer def) { return luaL_opt(L, luaL_checkinteger, arg, def); } /* }====================================================== */ /* ** {====================================================== ** Generic Buffer manipulation ** ======================================================= */ /* userdata to box arbitrary data */ typedef struct UBox { void *box; size_t bsize; } UBox; static void *resizebox (lua_State *L, int idx, size_t newsize) { void *ud; lua_Alloc allocf = lua_getallocf(L, &ud); UBox *box = (UBox *)lua_touserdata(L, idx); void *temp = allocf(ud, box->box, box->bsize, newsize); if (temp == NULL && newsize > 0) { /* allocation error? */ resizebox(L, idx, 0); /* free buffer */ luaL_error(L, "not enough memory for buffer allocation"); } box->box = temp; box->bsize = newsize; return temp; } static int boxgc (lua_State *L) { resizebox(L, 1, 0); return 0; } static void *newbox (lua_State *L, size_t newsize) { UBox *box = (UBox *)lua_newuserdata(L, sizeof(UBox)); box->box = NULL; box->bsize = 0; if (luaL_newmetatable(L, "LUABOX")) { /* creating metatable? */ lua_pushcfunction(L, boxgc); lua_setfield(L, -2, "__gc"); /* metatable.__gc = boxgc */ } lua_setmetatable(L, -2); return resizebox(L, -1, newsize); } /* ** check whether buffer is using a userdata on the stack as a temporary ** buffer */ #define buffonstack(B) ((B)->b != (B)->initb) /* ** returns a pointer to a free area with at least 'sz' bytes */ LUALIB_API char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz) { lua_State *L = B->L; if (B->size - B->n < sz) { /* not enough space? */ char *newbuff; size_t newsize = B->size * 2; /* double buffer size */ if (newsize - B->n < sz) /* not big enough? */ newsize = B->n + sz; if (newsize < B->n || newsize - B->n < sz) luaL_error(L, "buffer too large"); /* create larger buffer */ if (buffonstack(B)) newbuff = (char *)resizebox(L, -1, newsize); else { /* no buffer yet */ newbuff = (char *)newbox(L, newsize); memcpy(newbuff, B->b, B->n * sizeof(char)); /* copy original content */ } B->b = newbuff; B->size = newsize; } return &B->b[B->n]; } LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) { if (l > 0) { /* avoid 'memcpy' when 's' can be NULL */ char *b = luaL_prepbuffsize(B, l); memcpy(b, s, l * sizeof(char)); luaL_addsize(B, l); } } LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) { luaL_addlstring(B, s, strlen(s)); } LUALIB_API void luaL_pushresult (luaL_Buffer *B) { lua_State *L = B->L; lua_pushlstring(L, B->b, B->n); if (buffonstack(B)) { resizebox(L, -2, 0); /* delete old buffer */ lua_remove(L, -2); /* remove its header from the stack */ } } LUALIB_API void luaL_pushresultsize (luaL_Buffer *B, size_t sz) { luaL_addsize(B, sz); luaL_pushresult(B); } LUALIB_API void luaL_addvalue (luaL_Buffer *B) { lua_State *L = B->L; size_t l; const char *s = lua_tolstring(L, -1, &l); if (buffonstack(B)) lua_insert(L, -2); /* put value below buffer */ luaL_addlstring(B, s, l); lua_remove(L, (buffonstack(B)) ? -2 : -1); /* remove value */ } LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) { B->L = L; B->b = B->initb; B->n = 0; B->size = LUAL_BUFFERSIZE; } LUALIB_API char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz) { luaL_buffinit(L, B); return luaL_prepbuffsize(B, sz); } /* }====================================================== */ /* ** {====================================================== ** Reference system ** ======================================================= */ /* index of free-list header */ #define freelist 0 LUALIB_API int luaL_ref (lua_State *L, int t) { int ref; if (lua_isnil(L, -1)) { lua_pop(L, 1); /* remove from stack */ return LUA_REFNIL; /* 'nil' has a unique fixed reference */ } t = lua_absindex(L, t); lua_rawgeti(L, t, freelist); /* get first free element */ ref = (int)lua_tointeger(L, -1); /* ref = t[freelist] */ lua_pop(L, 1); /* remove it from stack */ if (ref != 0) { /* any free element? */ lua_rawgeti(L, t, ref); /* remove it from list */ lua_rawseti(L, t, freelist); /* (t[freelist] = t[ref]) */ } else /* no free elements */ ref = (int)lua_rawlen(L, t) + 1; /* get a new reference */ lua_rawseti(L, t, ref); return ref; } LUALIB_API void luaL_unref (lua_State *L, int t, int ref) { if (ref >= 0) { t = lua_absindex(L, t); lua_rawgeti(L, t, freelist); lua_rawseti(L, t, ref); /* t[ref] = t[freelist] */ lua_pushinteger(L, ref); lua_rawseti(L, t, freelist); /* t[freelist] = ref */ } } /* }====================================================== */ /* ** {====================================================== ** Load functions ** ======================================================= */ typedef struct LoadF { int n; /* number of pre-read characters */ FILE *f; /* file being read */ char buff[BUFSIZ]; /* area for reading file */ } LoadF; static const char *getF (lua_State *L, void *ud, size_t *size) { LoadF *lf = (LoadF *)ud; (void)L; /* not used */ if (lf->n > 0) { /* are there pre-read characters to be read? */ *size = lf->n; /* return them (chars already in buffer) */ lf->n = 0; /* no more pre-read characters */ } else { /* read a block from file */ /* 'fread' can return > 0 *and* set the EOF flag. If next call to 'getF' called 'fread', it might still wait for user input. The next check avoids this problem. */ if (feof(lf->f)) return NULL; *size = fread(lf->buff, 1, sizeof(lf->buff), lf->f); /* read block */ } return lf->buff; } static int errfile (lua_State *L, const char *what, int fnameindex) { const char *serr = strerror(errno); const char *filename = lua_tostring(L, fnameindex) + 1; lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr); lua_remove(L, fnameindex); return LUA_ERRFILE; } static int skipBOM (LoadF *lf) { const char *p = "\xEF\xBB\xBF"; /* UTF-8 BOM mark */ int c; lf->n = 0; do { c = getc(lf->f); if (c == EOF || c != *(const unsigned char *)p++) return c; lf->buff[lf->n++] = c; /* to be read by the parser */ } while (*p != '\0'); lf->n = 0; /* prefix matched; discard it */ return getc(lf->f); /* return next character */ } /* ** reads the first character of file 'f' and skips an optional BOM mark ** in its beginning plus its first line if it starts with '#'. Returns ** true if it skipped the first line. In any case, '*cp' has the ** first "valid" character of the file (after the optional BOM and ** a first-line comment). */ static int skipcomment (LoadF *lf, int *cp) { int c = *cp = skipBOM(lf); if (c == '#') { /* first line is a comment (Unix exec. file)? */ do { /* skip first line */ c = getc(lf->f); } while (c != EOF && c != '\n') ; *cp = getc(lf->f); /* skip end-of-line, if present */ return 1; /* there was a comment */ } else return 0; /* no comment */ } LUALIB_API int luaL_loadfilex (lua_State *L, const char *filename, const char *mode) { LoadF lf; int status, readstatus; int c; int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */ if (filename == NULL) { lua_pushliteral(L, "=stdin"); lf.f = stdin; } else { lua_pushfstring(L, "@%s", filename); lf.f = fopen(filename, "r"); if (lf.f == NULL) return errfile(L, "open", fnameindex); } if (skipcomment(&lf, &c)) /* read initial portion */ lf.buff[lf.n++] = '\n'; /* add line to correct line numbers */ if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */ lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */ if (lf.f == NULL) return errfile(L, "reopen", fnameindex); skipcomment(&lf, &c); /* re-read initial portion */ } if (c != EOF) lf.buff[lf.n++] = c; /* 'c' is the first character of the stream */ status = lua_load(L, getF, &lf, lua_tostring(L, -1), mode); readstatus = ferror(lf.f); if (filename) fclose(lf.f); /* close file (even in case of errors) */ if (readstatus) { lua_settop(L, fnameindex); /* ignore results from 'lua_load' */ return errfile(L, "read", fnameindex); } lua_remove(L, fnameindex); return status; } typedef struct LoadS { const char *s; size_t size; } LoadS; static const char *getS (lua_State *L, void *ud, size_t *size) { LoadS *ls = (LoadS *)ud; (void)L; /* not used */ if (ls->size == 0) return NULL; *size = ls->size; ls->size = 0; return ls->s; } LUALIB_API int luaL_loadbufferx (lua_State *L, const char *buff, size_t size, const char *name, const char *mode) { LoadS ls; ls.s = buff; ls.size = size; return lua_load(L, getS, &ls, name, mode); } LUALIB_API int luaL_loadstring (lua_State *L, const char *s) { return luaL_loadbuffer(L, s, strlen(s), s); } /* }====================================================== */ LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) { if (!lua_getmetatable(L, obj)) /* no metatable? */ return LUA_TNIL; else { int tt; lua_pushstring(L, event); tt = lua_rawget(L, -2); if (tt == LUA_TNIL) /* is metafield nil? */ lua_pop(L, 2); /* remove metatable and metafield */ else lua_remove(L, -2); /* remove only metatable */ return tt; /* return metafield type */ } } LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) { obj = lua_absindex(L, obj); if (luaL_getmetafield(L, obj, event) == LUA_TNIL) /* no metafield? */ return 0; lua_pushvalue(L, obj); lua_call(L, 1, 1); return 1; } LUALIB_API lua_Integer luaL_len (lua_State *L, int idx) { lua_Integer l; int isnum; lua_len(L, idx); l = lua_tointegerx(L, -1, &isnum); if (!isnum) luaL_error(L, "object length is not an integer"); lua_pop(L, 1); /* remove object */ return l; } LUALIB_API const char *luaL_tolstring (lua_State *L, int idx, size_t *len) { if (!luaL_callmeta(L, idx, "__tostring")) { /* no metafield? */ switch (lua_type(L, idx)) { case LUA_TNUMBER: { if (lua_isinteger(L, idx)) lua_pushfstring(L, "%I", lua_tointeger(L, idx)); else lua_pushfstring(L, "%f", lua_tonumber(L, idx)); break; } case LUA_TSTRING: lua_pushvalue(L, idx); break; case LUA_TBOOLEAN: lua_pushstring(L, (lua_toboolean(L, idx) ? "true" : "false")); break; case LUA_TNIL: lua_pushliteral(L, "nil"); break; default: lua_pushfstring(L, "%s: %p", luaL_typename(L, idx), lua_topointer(L, idx)); break; } } return lua_tolstring(L, -1, len); } /* ** {====================================================== ** Compatibility with 5.1 module functions ** ======================================================= */ #if defined(LUA_COMPAT_MODULE) static const char *luaL_findtable (lua_State *L, int idx, const char *fname, int szhint) { const char *e; if (idx) lua_pushvalue(L, idx); do { e = strchr(fname, '.'); if (e == NULL) e = fname + strlen(fname); lua_pushlstring(L, fname, e - fname); if (lua_rawget(L, -2) == LUA_TNIL) { /* no such field? */ lua_pop(L, 1); /* remove this nil */ lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */ lua_pushlstring(L, fname, e - fname); lua_pushvalue(L, -2); lua_settable(L, -4); /* set new table into field */ } else if (!lua_istable(L, -1)) { /* field has a non-table value? */ lua_pop(L, 2); /* remove table and value */ return fname; /* return problematic part of the name */ } lua_remove(L, -2); /* remove previous table */ fname = e + 1; } while (*e == '.'); return NULL; } /* ** Count number of elements in a luaL_Reg list. */ static int libsize (const luaL_Reg *l) { int size = 0; for (; l && l->name; l++) size++; return size; } /* ** Find or create a module table with a given name. The function ** first looks at the _LOADED table and, if that fails, try a ** global variable with that name. In any case, leaves on the stack ** the module table. */ LUALIB_API void luaL_pushmodule (lua_State *L, const char *modname, int sizehint) { luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 1); /* get _LOADED table */ if (lua_getfield(L, -1, modname) != LUA_TTABLE) { /* no _LOADED[modname]? */ lua_pop(L, 1); /* remove previous result */ /* try global variable (and create one if it does not exist) */ lua_pushglobaltable(L); if (luaL_findtable(L, 0, modname, sizehint) != NULL) luaL_error(L, "name conflict for module '%s'", modname); lua_pushvalue(L, -1); lua_setfield(L, -3, modname); /* _LOADED[modname] = new table */ } lua_remove(L, -2); /* remove _LOADED table */ } LUALIB_API void luaL_openlib (lua_State *L, const char *libname, const luaL_Reg *l, int nup) { luaL_checkversion(L); if (libname) { luaL_pushmodule(L, libname, libsize(l)); /* get/create library table */ lua_insert(L, -(nup + 1)); /* move library table to below upvalues */ } if (l) luaL_setfuncs(L, l, nup); else lua_pop(L, nup); /* remove upvalues */ } #endif /* }====================================================== */ /* ** set functions from list 'l' into table at top - 'nup'; each ** function gets the 'nup' elements at the top as upvalues. ** Returns with only the table at the stack. */ LUALIB_API void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) { luaL_checkstack(L, nup, "too many upvalues"); for (; l->name != NULL; l++) { /* fill the table with given functions */ int i; for (i = 0; i < nup; i++) /* copy upvalues to the top */ lua_pushvalue(L, -nup); lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */ lua_setfield(L, -(nup + 2), l->name); } lua_pop(L, nup); /* remove upvalues */ } /* ** ensure that stack[idx][fname] has a table and push that table ** into the stack */ LUALIB_API int luaL_getsubtable (lua_State *L, int idx, const char *fname) { if (lua_getfield(L, idx, fname) == LUA_TTABLE) return 1; /* table already there */ else { lua_pop(L, 1); /* remove previous result */ idx = lua_absindex(L, idx); lua_newtable(L); lua_pushvalue(L, -1); /* copy to be left at top */ lua_setfield(L, idx, fname); /* assign new table to field */ return 0; /* false, because did not find table there */ } } /* ** Stripped-down 'require': After checking "loaded" table, calls 'openf' ** to open a module, registers the result in 'package.loaded' table and, ** if 'glb' is true, also registers the result in the global table. ** Leaves resulting module on the top. */ LUALIB_API void luaL_requiref (lua_State *L, const char *modname, lua_CFunction openf, int glb) { luaL_getsubtable(L, LUA_REGISTRYINDEX, "_LOADED"); lua_getfield(L, -1, modname); /* _LOADED[modname] */ if (!lua_toboolean(L, -1)) { /* package not already loaded? */ lua_pop(L, 1); /* remove field */ lua_pushcfunction(L, openf); lua_pushstring(L, modname); /* argument to open function */ lua_call(L, 1, 1); /* call 'openf' to open module */ lua_pushvalue(L, -1); /* make copy of module (call result) */ lua_setfield(L, -3, modname); /* _LOADED[modname] = module */ } lua_remove(L, -2); /* remove _LOADED table */ if (glb) { lua_pushvalue(L, -1); /* copy of module */ lua_setglobal(L, modname); /* _G[modname] = module */ } } LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p, const char *r) { const char *wild; size_t l = strlen(p); luaL_Buffer b; luaL_buffinit(L, &b); while ((wild = strstr(s, p)) != NULL) { luaL_addlstring(&b, s, wild - s); /* push prefix */ luaL_addstring(&b, r); /* push replacement in place of pattern */ s = wild + l; /* continue after 'p' */ } luaL_addstring(&b, s); /* push last suffix */ luaL_pushresult(&b); return lua_tostring(L, -1); } static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) { (void)ud; (void)osize; /* not used */ if (nsize == 0) { free(ptr); return NULL; } else return realloc(ptr, nsize); } static int panic (lua_State *L) { lua_writestringerror("PANIC: unprotected error in call to Lua API (%s)\n", lua_tostring(L, -1)); return 0; /* return to Lua to abort */ } LUALIB_API lua_State *luaL_newstate (void) { lua_State *L = lua_newstate(l_alloc, NULL); if (L) lua_atpanic(L, &panic); return L; } LUALIB_API void luaL_checkversion_ (lua_State *L, lua_Number ver, size_t sz) { const lua_Number *v = lua_version(L); if (sz != LUAL_NUMSIZES) /* check numeric types */ luaL_error(L, "core and library have incompatible numeric types"); if (v != lua_version(NULL)) luaL_error(L, "multiple Lua VMs detected"); else if (*v != ver) luaL_error(L, "version mismatch: app. needs %f, Lua core provides %f", ver, *v); } wcc-0.0.2/src/wsh/lua/src/lobject.c0000644000175000017500000003404713110675433015500 0ustar philphil/* ** $Id: lobject.c,v 2.108 2015/11/02 16:09:30 roberto Exp $ ** Some generic functions over Lua objects ** See Copyright Notice in lua.h */ #define lobject_c #define LUA_CORE #include "lprefix.h" #include #include #include #include #include #include #include "lua.h" #include "lctype.h" #include "ldebug.h" #include "ldo.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" #include "lstring.h" #include "lvm.h" LUAI_DDEF const TValue luaO_nilobject_ = {NILCONSTANT}; /* ** converts an integer to a "floating point byte", represented as ** (eeeeexxx), where the real value is (1xxx) * 2^(eeeee - 1) if ** eeeee != 0 and (xxx) otherwise. */ int luaO_int2fb (unsigned int x) { int e = 0; /* exponent */ if (x < 8) return x; while (x >= (8 << 4)) { /* coarse steps */ x = (x + 0xf) >> 4; /* x = ceil(x / 16) */ e += 4; } while (x >= (8 << 1)) { /* fine steps */ x = (x + 1) >> 1; /* x = ceil(x / 2) */ e++; } return ((e+1) << 3) | (cast_int(x) - 8); } /* converts back */ int luaO_fb2int (int x) { return (x < 8) ? x : ((x & 7) + 8) << ((x >> 3) - 1); } /* ** Computes ceil(log2(x)) */ int luaO_ceillog2 (unsigned int x) { static const lu_byte log_2[256] = { /* log_2[i] = ceil(log2(i - 1)) */ 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8 }; int l = 0; x--; while (x >= 256) { l += 8; x >>= 8; } return l + log_2[x]; } static lua_Integer intarith (lua_State *L, int op, lua_Integer v1, lua_Integer v2) { switch (op) { case LUA_OPADD: return intop(+, v1, v2); case LUA_OPSUB:return intop(-, v1, v2); case LUA_OPMUL:return intop(*, v1, v2); case LUA_OPMOD: return luaV_mod(L, v1, v2); case LUA_OPIDIV: return luaV_div(L, v1, v2); case LUA_OPBAND: return intop(&, v1, v2); case LUA_OPBOR: return intop(|, v1, v2); case LUA_OPBXOR: return intop(^, v1, v2); case LUA_OPSHL: return luaV_shiftl(v1, v2); case LUA_OPSHR: return luaV_shiftl(v1, -v2); case LUA_OPUNM: return intop(-, 0, v1); case LUA_OPBNOT: return intop(^, ~l_castS2U(0), v1); default: lua_assert(0); return 0; } } static lua_Number numarith (lua_State *L, int op, lua_Number v1, lua_Number v2) { switch (op) { case LUA_OPADD: return luai_numadd(L, v1, v2); case LUA_OPSUB: return luai_numsub(L, v1, v2); case LUA_OPMUL: return luai_nummul(L, v1, v2); case LUA_OPDIV: return luai_numdiv(L, v1, v2); case LUA_OPPOW: return luai_numpow(L, v1, v2); case LUA_OPIDIV: return luai_numidiv(L, v1, v2); case LUA_OPUNM: return luai_numunm(L, v1); case LUA_OPMOD: { lua_Number m; luai_nummod(L, v1, v2, m); return m; } default: lua_assert(0); return 0; } } void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2, TValue *res) { switch (op) { case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR: case LUA_OPSHL: case LUA_OPSHR: case LUA_OPBNOT: { /* operate only on integers */ lua_Integer i1; lua_Integer i2; if (tointeger(p1, &i1) && tointeger(p2, &i2)) { setivalue(res, intarith(L, op, i1, i2)); return; } else break; /* go to the end */ } case LUA_OPDIV: case LUA_OPPOW: { /* operate only on floats */ lua_Number n1; lua_Number n2; if (tonumber(p1, &n1) && tonumber(p2, &n2)) { setfltvalue(res, numarith(L, op, n1, n2)); return; } else break; /* go to the end */ } default: { /* other operations */ lua_Number n1; lua_Number n2; if (ttisinteger(p1) && ttisinteger(p2)) { setivalue(res, intarith(L, op, ivalue(p1), ivalue(p2))); return; } else if (tonumber(p1, &n1) && tonumber(p2, &n2)) { setfltvalue(res, numarith(L, op, n1, n2)); return; } else break; /* go to the end */ } } /* could not perform raw operation; try metamethod */ lua_assert(L != NULL); /* should not fail when folding (compile time) */ luaT_trybinTM(L, p1, p2, res, cast(TMS, (op - LUA_OPADD) + TM_ADD)); } int luaO_hexavalue (int c) { if (lisdigit(c)) return c - '0'; else return (ltolower(c) - 'a') + 10; } static int isneg (const char **s) { if (**s == '-') { (*s)++; return 1; } else if (**s == '+') (*s)++; return 0; } /* ** {================================================================== ** Lua's implementation for 'lua_strx2number' ** =================================================================== */ #if !defined(lua_strx2number) /* maximum number of significant digits to read (to avoid overflows even with single floats) */ #define MAXSIGDIG 30 /* ** convert an hexadecimal numeric string to a number, following ** C99 specification for 'strtod' */ static lua_Number lua_strx2number (const char *s, char **endptr) { int dot = lua_getlocaledecpoint(); lua_Number r = 0.0; /* result (accumulator) */ int sigdig = 0; /* number of significant digits */ int nosigdig = 0; /* number of non-significant digits */ int e = 0; /* exponent correction */ int neg; /* 1 if number is negative */ int hasdot = 0; /* true after seen a dot */ *endptr = cast(char *, s); /* nothing is valid yet */ while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */ neg = isneg(&s); /* check signal */ if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */ return 0.0; /* invalid format (no '0x') */ for (s += 2; ; s++) { /* skip '0x' and read numeral */ if (*s == dot) { if (hasdot) break; /* second dot? stop loop */ else hasdot = 1; } else if (lisxdigit(cast_uchar(*s))) { if (sigdig == 0 && *s == '0') /* non-significant digit (zero)? */ nosigdig++; else if (++sigdig <= MAXSIGDIG) /* can read it without overflow? */ r = (r * cast_num(16.0)) + luaO_hexavalue(*s); else e++; /* too many digits; ignore, but still count for exponent */ if (hasdot) e--; /* decimal digit? correct exponent */ } else break; /* neither a dot nor a digit */ } if (nosigdig + sigdig == 0) /* no digits? */ return 0.0; /* invalid format */ *endptr = cast(char *, s); /* valid up to here */ e *= 4; /* each digit multiplies/divides value by 2^4 */ if (*s == 'p' || *s == 'P') { /* exponent part? */ int exp1 = 0; /* exponent value */ int neg1; /* exponent signal */ s++; /* skip 'p' */ neg1 = isneg(&s); /* signal */ if (!lisdigit(cast_uchar(*s))) return 0.0; /* invalid; must have at least one digit */ while (lisdigit(cast_uchar(*s))) /* read exponent */ exp1 = exp1 * 10 + *(s++) - '0'; if (neg1) exp1 = -exp1; e += exp1; *endptr = cast(char *, s); /* valid up to here */ } if (neg) r = -r; return l_mathop(ldexp)(r, e); } #endif /* }====================================================== */ static const char *l_str2d (const char *s, lua_Number *result) { char *endptr; if (strpbrk(s, "nN")) /* reject 'inf' and 'nan' */ return NULL; else if (strpbrk(s, "xX")) /* hex? */ *result = lua_strx2number(s, &endptr); else *result = lua_str2number(s, &endptr); if (endptr == s) return NULL; /* nothing recognized */ while (lisspace(cast_uchar(*endptr))) endptr++; return (*endptr == '\0' ? endptr : NULL); /* OK if no trailing characters */ } static const char *l_str2int (const char *s, lua_Integer *result) { lua_Unsigned a = 0; int empty = 1; int neg; while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */ neg = isneg(&s); if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X')) { /* hex? */ s += 2; /* skip '0x' */ for (; lisxdigit(cast_uchar(*s)); s++) { a = a * 16 + luaO_hexavalue(*s); empty = 0; } } else { /* decimal */ for (; lisdigit(cast_uchar(*s)); s++) { a = a * 10 + *s - '0'; empty = 0; } } while (lisspace(cast_uchar(*s))) s++; /* skip trailing spaces */ if (empty || *s != '\0') return NULL; /* something wrong in the numeral */ else { *result = l_castU2S((neg) ? 0u - a : a); return s; } } size_t luaO_str2num (const char *s, TValue *o) { lua_Integer i; lua_Number n; const char *e; if ((e = l_str2int(s, &i)) != NULL) { /* try as an integer */ setivalue(o, i); } else if ((e = l_str2d(s, &n)) != NULL) { /* else try as a float */ setfltvalue(o, n); } else return 0; /* conversion failed */ return (e - s) + 1; /* success; return string size */ } int luaO_utf8esc (char *buff, unsigned long x) { int n = 1; /* number of bytes put in buffer (backwards) */ lua_assert(x <= 0x10FFFF); if (x < 0x80) /* ascii? */ buff[UTF8BUFFSZ - 1] = cast(char, x); else { /* need continuation bytes */ unsigned int mfb = 0x3f; /* maximum that fits in first byte */ do { /* add continuation bytes */ buff[UTF8BUFFSZ - (n++)] = cast(char, 0x80 | (x & 0x3f)); x >>= 6; /* remove added bits */ mfb >>= 1; /* now there is one less bit available in first byte */ } while (x > mfb); /* still needs continuation byte? */ buff[UTF8BUFFSZ - n] = cast(char, (~mfb << 1) | x); /* add first byte */ } return n; } /* maximum length of the conversion of a number to a string */ #define MAXNUMBER2STR 50 /* ** Convert a number object to a string */ void luaO_tostring (lua_State *L, StkId obj) { char buff[MAXNUMBER2STR]; size_t len; lua_assert(ttisnumber(obj)); if (ttisinteger(obj)) len = lua_integer2str(buff, sizeof(buff), ivalue(obj)); else { len = lua_number2str(buff, sizeof(buff), fltvalue(obj)); #if !defined(LUA_COMPAT_FLOATSTRING) if (buff[strspn(buff, "-0123456789")] == '\0') { /* looks like an int? */ buff[len++] = lua_getlocaledecpoint(); buff[len++] = '0'; /* adds '.0' to result */ } #endif } setsvalue2s(L, obj, luaS_newlstr(L, buff, len)); } static void pushstr (lua_State *L, const char *str, size_t l) { setsvalue2s(L, L->top, luaS_newlstr(L, str, l)); luaD_inctop(L); } /* this function handles only '%d', '%c', '%f', '%p', and '%s' conventional formats, plus Lua-specific '%I' and '%U' */ const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { int n = 0; for (;;) { const char *e = strchr(fmt, '%'); if (e == NULL) break; pushstr(L, fmt, e - fmt); switch (*(e+1)) { case 's': { const char *s = va_arg(argp, char *); if (s == NULL) s = "(null)"; pushstr(L, s, strlen(s)); break; } case 'c': { char buff = cast(char, va_arg(argp, int)); if (lisprint(cast_uchar(buff))) pushstr(L, &buff, 1); else /* non-printable character; print its code */ luaO_pushfstring(L, "<\\%d>", cast_uchar(buff)); break; } case 'd': { setivalue(L->top, va_arg(argp, int)); goto top2str; } case 'I': { setivalue(L->top, cast(lua_Integer, va_arg(argp, l_uacInt))); goto top2str; } case 'f': { setfltvalue(L->top, cast_num(va_arg(argp, l_uacNumber))); top2str: luaD_inctop(L); luaO_tostring(L, L->top - 1); break; } case 'p': { char buff[4*sizeof(void *) + 8]; /* should be enough space for a '%p' */ int l = l_sprintf(buff, sizeof(buff), "%p", va_arg(argp, void *)); pushstr(L, buff, l); break; } case 'U': { char buff[UTF8BUFFSZ]; int l = luaO_utf8esc(buff, cast(long, va_arg(argp, long))); pushstr(L, buff + UTF8BUFFSZ - l, l); break; } case '%': { pushstr(L, "%", 1); break; } default: { luaG_runerror(L, "invalid option '%%%c' to 'lua_pushfstring'", *(e + 1)); } } n += 2; fmt = e+2; } luaD_checkstack(L, 1); pushstr(L, fmt, strlen(fmt)); if (n > 0) luaV_concat(L, n + 1); return svalue(L->top - 1); } const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) { const char *msg; va_list argp; va_start(argp, fmt); msg = luaO_pushvfstring(L, fmt, argp); va_end(argp); return msg; } /* number of chars of a literal string without the ending \0 */ #define LL(x) (sizeof(x)/sizeof(char) - 1) #define RETS "..." #define PRE "[string \"" #define POS "\"]" #define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) ) void luaO_chunkid (char *out, const char *source, size_t bufflen) { size_t l = strlen(source); if (*source == '=') { /* 'literal' source */ if (l <= bufflen) /* small enough? */ memcpy(out, source + 1, l * sizeof(char)); else { /* truncate it */ addstr(out, source + 1, bufflen - 1); *out = '\0'; } } else if (*source == '@') { /* file name */ if (l <= bufflen) /* small enough? */ memcpy(out, source + 1, l * sizeof(char)); else { /* add '...' before rest of name */ addstr(out, RETS, LL(RETS)); bufflen -= LL(RETS); memcpy(out, source + 1 + l - bufflen, bufflen * sizeof(char)); } } else { /* string; format as [string "source"] */ const char *nl = strchr(source, '\n'); /* find first new line (if any) */ addstr(out, PRE, LL(PRE)); /* add prefix */ bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */ if (l < bufflen && nl == NULL) { /* small one-line source? */ addstr(out, source, l); /* keep it */ } else { if (nl != NULL) l = nl - source; /* stop at first newline */ if (l > bufflen) l = bufflen; addstr(out, source, l); addstr(out, RETS, LL(RETS)); } memcpy(out, POS, (LL(POS) + 1) * sizeof(char)); } } wcc-0.0.2/src/wsh/lua/src/lua.h0000644000175000017500000003475113110675433014646 0ustar philphil/* ** $Id: lua.h,v 1.329 2015/11/13 17:18:42 roberto Exp $ ** Lua - A Scripting Language ** Lua.org, PUC-Rio, Brazil (http://www.lua.org) ** See Copyright Notice at the end of this file */ #ifndef lua_h #define lua_h #include #include #include "luaconf.h" #define LUA_VERSION_MAJOR "5" #define LUA_VERSION_MINOR "3" #define LUA_VERSION_NUM 503 #define LUA_VERSION_RELEASE "2" #define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR #define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE #define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2015 Lua.org, PUC-Rio" #define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes" /* mark for precompiled code ('Lua') */ #define LUA_SIGNATURE "\x1bLua" /* option for multiple returns in 'lua_pcall' and 'lua_call' */ #define LUA_MULTRET (-1) /* ** Pseudo-indices ** (-LUAI_MAXSTACK is the minimum valid index; we keep some free empty ** space after that to help overflow detection) */ #define LUA_REGISTRYINDEX (-LUAI_MAXSTACK - 1000) #define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i)) /* thread status */ #define LUA_OK 0 #define LUA_YIELD 1 #define LUA_ERRRUN 2 #define LUA_ERRSYNTAX 3 #define LUA_ERRMEM 4 #define LUA_ERRGCMM 5 #define LUA_ERRERR 6 typedef struct lua_State lua_State; /* ** basic types */ #define LUA_TNONE (-1) #define LUA_TNIL 0 #define LUA_TBOOLEAN 1 #define LUA_TLIGHTUSERDATA 2 #define LUA_TNUMBER 3 #define LUA_TSTRING 4 #define LUA_TTABLE 5 #define LUA_TFUNCTION 6 #define LUA_TUSERDATA 7 #define LUA_TTHREAD 8 #define LUA_NUMTAGS 9 /* minimum Lua stack available to a C function */ #define LUA_MINSTACK 20 /* predefined values in the registry */ #define LUA_RIDX_MAINTHREAD 1 #define LUA_RIDX_GLOBALS 2 #define LUA_RIDX_LAST LUA_RIDX_GLOBALS /* type of numbers in Lua */ typedef LUA_NUMBER lua_Number; /* type for integer functions */ typedef LUA_INTEGER lua_Integer; /* unsigned integer type */ typedef LUA_UNSIGNED lua_Unsigned; /* type for continuation-function contexts */ typedef LUA_KCONTEXT lua_KContext; /* ** Type for C functions registered with Lua */ typedef int (*lua_CFunction) (lua_State *L); /* ** Type for continuation functions */ typedef int (*lua_KFunction) (lua_State *L, int status, lua_KContext ctx); /* ** Type for functions that read/write blocks when loading/dumping Lua chunks */ typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz); typedef int (*lua_Writer) (lua_State *L, const void *p, size_t sz, void *ud); /* ** Type for memory-allocation functions */ typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize); /* ** generic extra include file */ #if defined(LUA_USER_H) #include LUA_USER_H #endif /* ** RCS ident string */ extern const char lua_ident[]; /* ** state manipulation */ LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud); LUA_API void (lua_close) (lua_State *L); LUA_API lua_State *(lua_newthread) (lua_State *L); LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf); LUA_API const lua_Number *(lua_version) (lua_State *L); /* ** basic stack manipulation */ LUA_API int (lua_absindex) (lua_State *L, int idx); LUA_API int (lua_gettop) (lua_State *L); LUA_API void (lua_settop) (lua_State *L, int idx); LUA_API void (lua_pushvalue) (lua_State *L, int idx); LUA_API void (lua_rotate) (lua_State *L, int idx, int n); LUA_API void (lua_copy) (lua_State *L, int fromidx, int toidx); LUA_API int (lua_checkstack) (lua_State *L, int n); LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n); /* ** access functions (stack -> C) */ LUA_API int (lua_isnumber) (lua_State *L, int idx); LUA_API int (lua_isstring) (lua_State *L, int idx); LUA_API int (lua_iscfunction) (lua_State *L, int idx); LUA_API int (lua_isinteger) (lua_State *L, int idx); LUA_API int (lua_isuserdata) (lua_State *L, int idx); LUA_API int (lua_type) (lua_State *L, int idx); LUA_API const char *(lua_typename) (lua_State *L, int tp); LUA_API lua_Number (lua_tonumberx) (lua_State *L, int idx, int *isnum); LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum); LUA_API int (lua_toboolean) (lua_State *L, int idx); LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len); LUA_API size_t (lua_rawlen) (lua_State *L, int idx); LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx); LUA_API void *(lua_touserdata) (lua_State *L, int idx); LUA_API lua_State *(lua_tothread) (lua_State *L, int idx); LUA_API const void *(lua_topointer) (lua_State *L, int idx); /* ** Comparison and arithmetic functions */ #define LUA_OPADD 0 /* ORDER TM, ORDER OP */ #define LUA_OPSUB 1 #define LUA_OPMUL 2 #define LUA_OPMOD 3 #define LUA_OPPOW 4 #define LUA_OPDIV 5 #define LUA_OPIDIV 6 #define LUA_OPBAND 7 #define LUA_OPBOR 8 #define LUA_OPBXOR 9 #define LUA_OPSHL 10 #define LUA_OPSHR 11 #define LUA_OPUNM 12 #define LUA_OPBNOT 13 LUA_API void (lua_arith) (lua_State *L, int op); #define LUA_OPEQ 0 #define LUA_OPLT 1 #define LUA_OPLE 2 LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2); LUA_API int (lua_compare) (lua_State *L, int idx1, int idx2, int op); /* ** push functions (C -> stack) */ LUA_API void (lua_pushnil) (lua_State *L); LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n); LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n); LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t len); LUA_API const char *(lua_pushstring) (lua_State *L, const char *s); LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt, va_list argp); LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...); LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n); LUA_API void (lua_pushboolean) (lua_State *L, int b); LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p); LUA_API int (lua_pushthread) (lua_State *L); /* ** get functions (Lua -> stack) */ LUA_API int (lua_getglobal) (lua_State *L, const char *name); LUA_API int (lua_gettable) (lua_State *L, int idx); LUA_API int (lua_getfield) (lua_State *L, int idx, const char *k); LUA_API int (lua_geti) (lua_State *L, int idx, lua_Integer n); LUA_API int (lua_rawget) (lua_State *L, int idx); LUA_API int (lua_rawgeti) (lua_State *L, int idx, lua_Integer n); LUA_API int (lua_rawgetp) (lua_State *L, int idx, const void *p); LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec); LUA_API void *(lua_newuserdata) (lua_State *L, size_t sz); LUA_API int (lua_getmetatable) (lua_State *L, int objindex); LUA_API int (lua_getuservalue) (lua_State *L, int idx); /* ** set functions (stack -> Lua) */ LUA_API void (lua_setglobal) (lua_State *L, const char *name); LUA_API void (lua_settable) (lua_State *L, int idx); LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k); LUA_API void (lua_seti) (lua_State *L, int idx, lua_Integer n); LUA_API void (lua_rawset) (lua_State *L, int idx); LUA_API void (lua_rawseti) (lua_State *L, int idx, lua_Integer n); LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p); LUA_API int (lua_setmetatable) (lua_State *L, int objindex); LUA_API void (lua_setuservalue) (lua_State *L, int idx); /* ** 'load' and 'call' functions (load and run Lua code) */ LUA_API void (lua_callk) (lua_State *L, int nargs, int nresults, lua_KContext ctx, lua_KFunction k); #define lua_call(L,n,r) lua_callk(L, (n), (r), 0, NULL) LUA_API int (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc, lua_KContext ctx, lua_KFunction k); #define lua_pcall(L,n,r,f) lua_pcallk(L, (n), (r), (f), 0, NULL) LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt, const char *chunkname, const char *mode); LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data, int strip); /* ** coroutine functions */ LUA_API int (lua_yieldk) (lua_State *L, int nresults, lua_KContext ctx, lua_KFunction k); LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg); LUA_API int (lua_status) (lua_State *L); LUA_API int (lua_isyieldable) (lua_State *L); #define lua_yield(L,n) lua_yieldk(L, (n), 0, NULL) /* ** garbage-collection function and options */ #define LUA_GCSTOP 0 #define LUA_GCRESTART 1 #define LUA_GCCOLLECT 2 #define LUA_GCCOUNT 3 #define LUA_GCCOUNTB 4 #define LUA_GCSTEP 5 #define LUA_GCSETPAUSE 6 #define LUA_GCSETSTEPMUL 7 #define LUA_GCISRUNNING 9 LUA_API int (lua_gc) (lua_State *L, int what, int data); /* ** miscellaneous functions */ LUA_API int (lua_error) (lua_State *L); LUA_API int (lua_next) (lua_State *L, int idx); LUA_API void (lua_concat) (lua_State *L, int n); LUA_API void (lua_len) (lua_State *L, int idx); LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s); LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud); LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud); /* ** {============================================================== ** some useful macros ** =============================================================== */ #define lua_getextraspace(L) ((void *)((char *)(L) - LUA_EXTRASPACE)) #define lua_tonumber(L,i) lua_tonumberx(L,(i),NULL) #define lua_tointeger(L,i) lua_tointegerx(L,(i),NULL) #define lua_pop(L,n) lua_settop(L, -(n)-1) #define lua_newtable(L) lua_createtable(L, 0, 0) #define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n))) #define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0) #define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION) #define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE) #define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA) #define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL) #define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN) #define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD) #define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE) #define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0) #define lua_pushliteral(L, s) lua_pushstring(L, "" s) #define lua_pushglobaltable(L) \ lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS) #define lua_tostring(L,i) lua_tolstring(L, (i), NULL) #define lua_insert(L,idx) lua_rotate(L, (idx), 1) #define lua_remove(L,idx) (lua_rotate(L, (idx), -1), lua_pop(L, 1)) #define lua_replace(L,idx) (lua_copy(L, -1, (idx)), lua_pop(L, 1)) /* }============================================================== */ /* ** {============================================================== ** compatibility macros for unsigned conversions ** =============================================================== */ #if defined(LUA_COMPAT_APIINTCASTS) #define lua_pushunsigned(L,n) lua_pushinteger(L, (lua_Integer)(n)) #define lua_tounsignedx(L,i,is) ((lua_Unsigned)lua_tointegerx(L,i,is)) #define lua_tounsigned(L,i) lua_tounsignedx(L,(i),NULL) #endif /* }============================================================== */ /* ** {====================================================================== ** Debug API ** ======================================================================= */ /* ** Event codes */ #define LUA_HOOKCALL 0 #define LUA_HOOKRET 1 #define LUA_HOOKLINE 2 #define LUA_HOOKCOUNT 3 #define LUA_HOOKTAILCALL 4 /* ** Event masks */ #define LUA_MASKCALL (1 << LUA_HOOKCALL) #define LUA_MASKRET (1 << LUA_HOOKRET) #define LUA_MASKLINE (1 << LUA_HOOKLINE) #define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT) typedef struct lua_Debug lua_Debug; /* activation record */ /* Functions to be called by the debugger in specific events */ typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar); LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar); LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar); LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n); LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n); LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n); LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n); LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n); LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1, int fidx2, int n2); LUA_API void (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count); LUA_API lua_Hook (lua_gethook) (lua_State *L); LUA_API int (lua_gethookmask) (lua_State *L); LUA_API int (lua_gethookcount) (lua_State *L); struct lua_Debug { int event; const char *name; /* (n) */ const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */ const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */ const char *source; /* (S) */ int currentline; /* (l) */ int linedefined; /* (S) */ int lastlinedefined; /* (S) */ unsigned char nups; /* (u) number of upvalues */ unsigned char nparams;/* (u) number of parameters */ char isvararg; /* (u) */ char istailcall; /* (t) */ char short_src[LUA_IDSIZE]; /* (S) */ /* private part */ struct CallInfo *i_ci; /* active function */ }; /* }====================================================================== */ /****************************************************************************** * Copyright (C) 1994-2015 Lua.org, PUC-Rio. * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be * included in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ******************************************************************************/ #endif wcc-0.0.2/src/wsh/lua/src/luac.c0000644000175000017500000002402713110675433014777 0ustar philphil/* ** $Id: luac.c,v 1.75 2015/03/12 01:58:27 lhf Exp $ ** Lua compiler (saves bytecodes to files; also lists bytecodes) ** See Copyright Notice in lua.h */ #define luac_c #define LUA_CORE #include "lprefix.h" #include #include #include #include #include #include "lua.h" #include "lauxlib.h" #include "lobject.h" #include "lstate.h" #include "lundump.h" static void PrintFunction(const Proto* f, int full); #define luaU_print PrintFunction #define PROGNAME "luac" /* default program name */ #define OUTPUT PROGNAME ".out" /* default output file */ static int listing=0; /* list bytecodes? */ static int dumping=1; /* dump bytecodes? */ static int stripping=0; /* strip debug information? */ static char Output[]={ OUTPUT }; /* default output file name */ static const char* output=Output; /* actual output file name */ static const char* progname=PROGNAME; /* actual program name */ static void fatal(const char* message) { fprintf(stderr,"%s: %s\n",progname,message); exit(EXIT_FAILURE); } static void cannot(const char* what) { fprintf(stderr,"%s: cannot %s %s: %s\n",progname,what,output,strerror(errno)); exit(EXIT_FAILURE); } static void usage(const char* message) { if (*message=='-') fprintf(stderr,"%s: unrecognized option '%s'\n",progname,message); else fprintf(stderr,"%s: %s\n",progname,message); fprintf(stderr, "usage: %s [options] [filenames]\n" "Available options are:\n" " -l list (use -l -l for full listing)\n" " -o name output to file 'name' (default is \"%s\")\n" " -p parse only\n" " -s strip debug information\n" " -v show version information\n" " -- stop handling options\n" " - stop handling options and process stdin\n" ,progname,Output); exit(EXIT_FAILURE); } #define IS(s) (strcmp(argv[i],s)==0) static int doargs(int argc, char* argv[]) { int i; int version=0; if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0]; for (i=1; itop+(i)) static const Proto* combine(lua_State* L, int n) { if (n==1) return toproto(L,-1); else { Proto* f; int i=n; if (lua_load(L,reader,&i,"=(" PROGNAME ")",NULL)!=LUA_OK) fatal(lua_tostring(L,-1)); f=toproto(L,-1); for (i=0; ip[i]=toproto(L,i-n-1); if (f->p[i]->sizeupvalues>0) f->p[i]->upvalues[0].instack=0; } f->sizelineinfo=0; return f; } } static int writer(lua_State* L, const void* p, size_t size, void* u) { UNUSED(L); return (fwrite(p,size,1,(FILE*)u)!=1) && (size!=0); } static int pmain(lua_State* L) { int argc=(int)lua_tointeger(L,1); char** argv=(char**)lua_touserdata(L,2); const Proto* f; int i; if (!lua_checkstack(L,argc)) fatal("too many input files"); for (i=0; i1); if (dumping) { FILE* D= (output==NULL) ? stdout : fopen(output,"wb"); if (D==NULL) cannot("open"); lua_lock(L); luaU_dump(L,f,writer,D,stripping); lua_unlock(L); if (ferror(D)) cannot("write"); if (fclose(D)) cannot("close"); } return 0; } int main(int argc, char* argv[]) { lua_State* L; int i=doargs(argc,argv); argc-=i; argv+=i; if (argc<=0) usage("no input files given"); L=luaL_newstate(); if (L==NULL) fatal("cannot create state: not enough memory"); lua_pushcfunction(L,&pmain); lua_pushinteger(L,argc); lua_pushlightuserdata(L,argv); if (lua_pcall(L,2,0,0)!=LUA_OK) fatal(lua_tostring(L,-1)); lua_close(L); return EXIT_SUCCESS; } /* ** $Id: luac.c,v 1.75 2015/03/12 01:58:27 lhf Exp $ ** print bytecodes ** See Copyright Notice in lua.h */ #include #include #define luac_c #define LUA_CORE #include "ldebug.h" #include "lobject.h" #include "lopcodes.h" #define VOID(p) ((const void*)(p)) static void PrintString(const TString* ts) { const char* s=getstr(ts); size_t i,n=tsslen(ts); printf("%c",'"'); for (i=0; ik[i]; switch (ttype(o)) { case LUA_TNIL: printf("nil"); break; case LUA_TBOOLEAN: printf(bvalue(o) ? "true" : "false"); break; case LUA_TNUMFLT: { char buff[100]; sprintf(buff,LUA_NUMBER_FMT,fltvalue(o)); printf("%s",buff); if (buff[strspn(buff,"-0123456789")]=='\0') printf(".0"); break; } case LUA_TNUMINT: printf(LUA_INTEGER_FMT,ivalue(o)); break; case LUA_TSHRSTR: case LUA_TLNGSTR: PrintString(tsvalue(o)); break; default: /* cannot happen */ printf("? type=%d",ttype(o)); break; } } #define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-") #define MYK(x) (-1-(x)) static void PrintCode(const Proto* f) { const Instruction* code=f->code; int pc,n=f->sizecode; for (pc=0; pc0) printf("[%d]\t",line); else printf("[-]\t"); printf("%-9s\t",luaP_opnames[o]); switch (getOpMode(o)) { case iABC: printf("%d",a); if (getBMode(o)!=OpArgN) printf(" %d",ISK(b) ? (MYK(INDEXK(b))) : b); if (getCMode(o)!=OpArgN) printf(" %d",ISK(c) ? (MYK(INDEXK(c))) : c); break; case iABx: printf("%d",a); if (getBMode(o)==OpArgK) printf(" %d",MYK(bx)); if (getBMode(o)==OpArgU) printf(" %d",bx); break; case iAsBx: printf("%d %d",a,sbx); break; case iAx: printf("%d",MYK(ax)); break; } switch (o) { case OP_LOADK: printf("\t; "); PrintConstant(f,bx); break; case OP_GETUPVAL: case OP_SETUPVAL: printf("\t; %s",UPVALNAME(b)); break; case OP_GETTABUP: printf("\t; %s",UPVALNAME(b)); if (ISK(c)) { printf(" "); PrintConstant(f,INDEXK(c)); } break; case OP_SETTABUP: printf("\t; %s",UPVALNAME(a)); if (ISK(b)) { printf(" "); PrintConstant(f,INDEXK(b)); } if (ISK(c)) { printf(" "); PrintConstant(f,INDEXK(c)); } break; case OP_GETTABLE: case OP_SELF: if (ISK(c)) { printf("\t; "); PrintConstant(f,INDEXK(c)); } break; case OP_SETTABLE: case OP_ADD: case OP_SUB: case OP_MUL: case OP_POW: case OP_DIV: case OP_IDIV: case OP_BAND: case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR: case OP_EQ: case OP_LT: case OP_LE: if (ISK(b) || ISK(c)) { printf("\t; "); if (ISK(b)) PrintConstant(f,INDEXK(b)); else printf("-"); printf(" "); if (ISK(c)) PrintConstant(f,INDEXK(c)); else printf("-"); } break; case OP_JMP: case OP_FORLOOP: case OP_FORPREP: case OP_TFORLOOP: printf("\t; to %d",sbx+pc+2); break; case OP_CLOSURE: printf("\t; %p",VOID(f->p[bx])); break; case OP_SETLIST: if (c==0) printf("\t; %d",(int)code[++pc]); else printf("\t; %d",c); break; case OP_EXTRAARG: printf("\t; "); PrintConstant(f,ax); break; default: break; } printf("\n"); } } #define SS(x) ((x==1)?"":"s") #define S(x) (int)(x),SS(x) static void PrintHeader(const Proto* f) { const char* s=f->source ? getstr(f->source) : "=?"; if (*s=='@' || *s=='=') s++; else if (*s==LUA_SIGNATURE[0]) s="(bstring)"; else s="(string)"; printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n", (f->linedefined==0)?"main":"function",s, f->linedefined,f->lastlinedefined, S(f->sizecode),VOID(f)); printf("%d%s param%s, %d slot%s, %d upvalue%s, ", (int)(f->numparams),f->is_vararg?"+":"",SS(f->numparams), S(f->maxstacksize),S(f->sizeupvalues)); printf("%d local%s, %d constant%s, %d function%s\n", S(f->sizelocvars),S(f->sizek),S(f->sizep)); } static void PrintDebug(const Proto* f) { int i,n; n=f->sizek; printf("constants (%d) for %p:\n",n,VOID(f)); for (i=0; isizelocvars; printf("locals (%d) for %p:\n",n,VOID(f)); for (i=0; ilocvars[i].varname),f->locvars[i].startpc+1,f->locvars[i].endpc+1); } n=f->sizeupvalues; printf("upvalues (%d) for %p:\n",n,VOID(f)); for (i=0; iupvalues[i].instack,f->upvalues[i].idx); } } static void PrintFunction(const Proto* f, int full) { int i,n=f->sizep; PrintHeader(f); PrintCode(f); if (full) PrintDebug(f); for (i=0; ip[i],full); } wcc-0.0.2/src/wsh/lua/src/lbaselib.c0000644000175000017500000003276013110675433015633 0ustar philphil/* ** $Id: lbaselib.c,v 1.312 2015/10/29 15:21:04 roberto Exp $ ** Basic library ** See Copyright Notice in lua.h */ #define lbaselib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" static int luaB_print (lua_State *L) { int n = lua_gettop(L); /* number of arguments */ int i; lua_getglobal(L, "tostring"); for (i=1; i<=n; i++) { const char *s; size_t l; lua_pushvalue(L, -1); /* function to be called */ lua_pushvalue(L, i); /* value to print */ lua_call(L, 1, 1); s = lua_tolstring(L, -1, &l); /* get result */ if (s == NULL) return luaL_error(L, "'tostring' must return a string to 'print'"); if (i>1) lua_writestring("\t", 1); lua_writestring(s, l); lua_pop(L, 1); /* pop result */ } lua_writeline(); return 0; } #define SPACECHARS " \f\n\r\t\v" static const char *b_str2int (const char *s, int base, lua_Integer *pn) { lua_Unsigned n = 0; int neg = 0; s += strspn(s, SPACECHARS); /* skip initial spaces */ if (*s == '-') { s++; neg = 1; } /* handle signal */ else if (*s == '+') s++; if (!isalnum((unsigned char)*s)) /* no digit? */ return NULL; do { int digit = (isdigit((unsigned char)*s)) ? *s - '0' : (toupper((unsigned char)*s) - 'A') + 10; if (digit >= base) return NULL; /* invalid numeral */ n = n * base + digit; s++; } while (isalnum((unsigned char)*s)); s += strspn(s, SPACECHARS); /* skip trailing spaces */ *pn = (lua_Integer)((neg) ? (0u - n) : n); return s; } static int luaB_tonumber (lua_State *L) { if (lua_isnoneornil(L, 2)) { /* standard conversion? */ luaL_checkany(L, 1); if (lua_type(L, 1) == LUA_TNUMBER) { /* already a number? */ lua_settop(L, 1); /* yes; return it */ return 1; } else { size_t l; const char *s = lua_tolstring(L, 1, &l); if (s != NULL && lua_stringtonumber(L, s) == l + 1) return 1; /* successful conversion to number */ /* else not a number */ } } else { size_t l; const char *s; lua_Integer n = 0; /* to avoid warnings */ lua_Integer base = luaL_checkinteger(L, 2); luaL_checktype(L, 1, LUA_TSTRING); /* no numbers as strings */ s = lua_tolstring(L, 1, &l); luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); if (b_str2int(s, (int)base, &n) == s + l) { lua_pushinteger(L, n); return 1; } /* else not a number */ } /* else not a number */ lua_pushnil(L); /* not a number */ return 1; } static int luaB_error (lua_State *L) { int level = (int)luaL_optinteger(L, 2, 1); lua_settop(L, 1); if (lua_isstring(L, 1) && level > 0) { /* add extra information? */ luaL_where(L, level); lua_pushvalue(L, 1); lua_concat(L, 2); } return lua_error(L); } static int luaB_getmetatable (lua_State *L) { luaL_checkany(L, 1); if (!lua_getmetatable(L, 1)) { lua_pushnil(L); return 1; /* no metatable */ } luaL_getmetafield(L, 1, "__metatable"); return 1; /* returns either __metatable field (if present) or metatable */ } static int luaB_setmetatable (lua_State *L) { int t = lua_type(L, 2); luaL_checktype(L, 1, LUA_TTABLE); luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table expected"); if (luaL_getmetafield(L, 1, "__metatable") != LUA_TNIL) return luaL_error(L, "cannot change a protected metatable"); lua_settop(L, 2); lua_setmetatable(L, 1); return 1; } static int luaB_rawequal (lua_State *L) { luaL_checkany(L, 1); luaL_checkany(L, 2); lua_pushboolean(L, lua_rawequal(L, 1, 2)); return 1; } static int luaB_rawlen (lua_State *L) { int t = lua_type(L, 1); luaL_argcheck(L, t == LUA_TTABLE || t == LUA_TSTRING, 1, "table or string expected"); lua_pushinteger(L, lua_rawlen(L, 1)); return 1; } static int luaB_rawget (lua_State *L) { luaL_checktype(L, 1, LUA_TTABLE); luaL_checkany(L, 2); lua_settop(L, 2); lua_rawget(L, 1); return 1; } static int luaB_rawset (lua_State *L) { luaL_checktype(L, 1, LUA_TTABLE); luaL_checkany(L, 2); luaL_checkany(L, 3); lua_settop(L, 3); lua_rawset(L, 1); return 1; } static int luaB_collectgarbage (lua_State *L) { static const char *const opts[] = {"stop", "restart", "collect", "count", "step", "setpause", "setstepmul", "isrunning", NULL}; static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT, LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL, LUA_GCISRUNNING}; int o = optsnum[luaL_checkoption(L, 1, "collect", opts)]; int ex = (int)luaL_optinteger(L, 2, 0); int res = lua_gc(L, o, ex); switch (o) { case LUA_GCCOUNT: { int b = lua_gc(L, LUA_GCCOUNTB, 0); lua_pushnumber(L, (lua_Number)res + ((lua_Number)b/1024)); return 1; } case LUA_GCSTEP: case LUA_GCISRUNNING: { lua_pushboolean(L, res); return 1; } default: { lua_pushinteger(L, res); return 1; } } } static int luaB_type (lua_State *L) { int t = lua_type(L, 1); luaL_argcheck(L, t != LUA_TNONE, 1, "value expected"); lua_pushstring(L, lua_typename(L, t)); return 1; } static int pairsmeta (lua_State *L, const char *method, int iszero, lua_CFunction iter) { if (luaL_getmetafield(L, 1, method) == LUA_TNIL) { /* no metamethod? */ luaL_checktype(L, 1, LUA_TTABLE); /* argument must be a table */ lua_pushcfunction(L, iter); /* will return generator, */ lua_pushvalue(L, 1); /* state, */ if (iszero) lua_pushinteger(L, 0); /* and initial value */ else lua_pushnil(L); } else { lua_pushvalue(L, 1); /* argument 'self' to metamethod */ lua_call(L, 1, 3); /* get 3 values from metamethod */ } return 3; } static int luaB_next (lua_State *L) { luaL_checktype(L, 1, LUA_TTABLE); lua_settop(L, 2); /* create a 2nd argument if there isn't one */ if (lua_next(L, 1)) return 2; else { lua_pushnil(L); return 1; } } static int luaB_pairs (lua_State *L) { return pairsmeta(L, "__pairs", 0, luaB_next); } /* ** Traversal function for 'ipairs' */ static int ipairsaux (lua_State *L) { lua_Integer i = luaL_checkinteger(L, 2) + 1; lua_pushinteger(L, i); return (lua_geti(L, 1, i) == LUA_TNIL) ? 1 : 2; } /* ** This function will use either 'ipairsaux' or 'ipairsaux_raw' to ** traverse a table, depending on whether the table has metamethods ** that can affect the traversal. */ static int luaB_ipairs (lua_State *L) { #if defined(LUA_COMPAT_IPAIRS) return pairsmeta(L, "__ipairs", 1, ipairsaux); #else luaL_checkany(L, 1); lua_pushcfunction(L, ipairsaux); /* iteration function */ lua_pushvalue(L, 1); /* state */ lua_pushinteger(L, 0); /* initial value */ return 3; #endif } static int load_aux (lua_State *L, int status, int envidx) { if (status == LUA_OK) { if (envidx != 0) { /* 'env' parameter? */ lua_pushvalue(L, envidx); /* environment for loaded function */ if (!lua_setupvalue(L, -2, 1)) /* set it as 1st upvalue */ lua_pop(L, 1); /* remove 'env' if not used by previous call */ } return 1; } else { /* error (message is on top of the stack) */ lua_pushnil(L); lua_insert(L, -2); /* put before error message */ return 2; /* return nil plus error message */ } } static int luaB_loadfile (lua_State *L) { const char *fname = luaL_optstring(L, 1, NULL); const char *mode = luaL_optstring(L, 2, NULL); int env = (!lua_isnone(L, 3) ? 3 : 0); /* 'env' index or 0 if no 'env' */ int status = luaL_loadfilex(L, fname, mode); return load_aux(L, status, env); } /* ** {====================================================== ** Generic Read function ** ======================================================= */ /* ** reserved slot, above all arguments, to hold a copy of the returned ** string to avoid it being collected while parsed. 'load' has four ** optional arguments (chunk, source name, mode, and environment). */ #define RESERVEDSLOT 5 /* ** Reader for generic 'load' function: 'lua_load' uses the ** stack for internal stuff, so the reader cannot change the ** stack top. Instead, it keeps its resulting string in a ** reserved slot inside the stack. */ static const char *generic_reader (lua_State *L, void *ud, size_t *size) { (void)(ud); /* not used */ luaL_checkstack(L, 2, "too many nested functions"); lua_pushvalue(L, 1); /* get function */ lua_call(L, 0, 1); /* call it */ if (lua_isnil(L, -1)) { lua_pop(L, 1); /* pop result */ *size = 0; return NULL; } else if (!lua_isstring(L, -1)) luaL_error(L, "reader function must return a string"); lua_replace(L, RESERVEDSLOT); /* save string in reserved slot */ return lua_tolstring(L, RESERVEDSLOT, size); } static int luaB_load (lua_State *L) { int status; size_t l; const char *s = lua_tolstring(L, 1, &l); const char *mode = luaL_optstring(L, 3, "bt"); int env = (!lua_isnone(L, 4) ? 4 : 0); /* 'env' index or 0 if no 'env' */ if (s != NULL) { /* loading a string? */ const char *chunkname = luaL_optstring(L, 2, s); status = luaL_loadbufferx(L, s, l, chunkname, mode); } else { /* loading from a reader function */ const char *chunkname = luaL_optstring(L, 2, "=(load)"); luaL_checktype(L, 1, LUA_TFUNCTION); lua_settop(L, RESERVEDSLOT); /* create reserved slot */ status = lua_load(L, generic_reader, NULL, chunkname, mode); } return load_aux(L, status, env); } /* }====================================================== */ static int dofilecont (lua_State *L, int d1, lua_KContext d2) { (void)d1; (void)d2; /* only to match 'lua_Kfunction' prototype */ return lua_gettop(L) - 1; } static int luaB_dofile (lua_State *L) { const char *fname = luaL_optstring(L, 1, NULL); lua_settop(L, 1); if (luaL_loadfile(L, fname) != LUA_OK) return lua_error(L); lua_callk(L, 0, LUA_MULTRET, 0, dofilecont); return dofilecont(L, 0, 0); } static int luaB_assert (lua_State *L) { if (lua_toboolean(L, 1)) /* condition is true? */ return lua_gettop(L); /* return all arguments */ else { /* error */ luaL_checkany(L, 1); /* there must be a condition */ lua_remove(L, 1); /* remove it */ lua_pushliteral(L, "assertion failed!"); /* default message */ lua_settop(L, 1); /* leave only message (default if no other one) */ return luaB_error(L); /* call 'error' */ } } static int luaB_select (lua_State *L) { int n = lua_gettop(L); if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') { lua_pushinteger(L, n-1); return 1; } else { lua_Integer i = luaL_checkinteger(L, 1); if (i < 0) i = n + i; else if (i > n) i = n; luaL_argcheck(L, 1 <= i, 1, "index out of range"); return n - (int)i; } } /* ** Continuation function for 'pcall' and 'xpcall'. Both functions ** already pushed a 'true' before doing the call, so in case of success ** 'finishpcall' only has to return everything in the stack minus ** 'extra' values (where 'extra' is exactly the number of items to be ** ignored). */ static int finishpcall (lua_State *L, int status, lua_KContext extra) { if (status != LUA_OK && status != LUA_YIELD) { /* error? */ lua_pushboolean(L, 0); /* first result (false) */ lua_pushvalue(L, -2); /* error message */ return 2; /* return false, msg */ } else return lua_gettop(L) - (int)extra; /* return all results */ } static int luaB_pcall (lua_State *L) { int status; luaL_checkany(L, 1); lua_pushboolean(L, 1); /* first result if no errors */ lua_insert(L, 1); /* put it in place */ status = lua_pcallk(L, lua_gettop(L) - 2, LUA_MULTRET, 0, 0, finishpcall); return finishpcall(L, status, 0); } /* ** Do a protected call with error handling. After 'lua_rotate', the ** stack will have ; so, the function passes ** 2 to 'finishpcall' to skip the 2 first values when returning results. */ static int luaB_xpcall (lua_State *L) { int status; int n = lua_gettop(L); luaL_checktype(L, 2, LUA_TFUNCTION); /* check error function */ lua_pushboolean(L, 1); /* first result */ lua_pushvalue(L, 1); /* function */ lua_rotate(L, 3, 2); /* move them below function's arguments */ status = lua_pcallk(L, n - 2, LUA_MULTRET, 2, 2, finishpcall); return finishpcall(L, status, 2); } static int luaB_tostring (lua_State *L) { luaL_checkany(L, 1); luaL_tolstring(L, 1, NULL); return 1; } static const luaL_Reg base_funcs[] = { {"assert", luaB_assert}, {"collectgarbage", luaB_collectgarbage}, {"dofile", luaB_dofile}, {"error", luaB_error}, {"getmetatable", luaB_getmetatable}, {"ipairs", luaB_ipairs}, {"loadfile", luaB_loadfile}, {"load", luaB_load}, #if defined(LUA_COMPAT_LOADSTRING) {"loadstring", luaB_load}, #endif {"next", luaB_next}, {"pairs", luaB_pairs}, {"pcall", luaB_pcall}, {"print", luaB_print}, {"rawequal", luaB_rawequal}, {"rawlen", luaB_rawlen}, {"rawget", luaB_rawget}, {"rawset", luaB_rawset}, {"select", luaB_select}, {"setmetatable", luaB_setmetatable}, {"tonumber", luaB_tonumber}, {"tostring", luaB_tostring}, {"type", luaB_type}, {"xpcall", luaB_xpcall}, /* placeholders */ {"_G", NULL}, {"_VERSION", NULL}, {NULL, NULL} }; LUAMOD_API int luaopen_base (lua_State *L) { /* open lib into global table */ lua_pushglobaltable(L); luaL_setfuncs(L, base_funcs, 0); /* set global _G */ lua_pushvalue(L, -1); lua_setfield(L, -2, "_G"); /* set global _VERSION */ lua_pushliteral(L, LUA_VERSION); lua_setfield(L, -2, "_VERSION"); return 1; } wcc-0.0.2/src/wsh/lua/src/lopcodes.c0000644000175000017500000000672613110675433015671 0ustar philphil/* ** $Id: lopcodes.c,v 1.55 2015/01/05 13:48:33 roberto Exp $ ** Opcodes for Lua virtual machine ** See Copyright Notice in lua.h */ #define lopcodes_c #define LUA_CORE #include "lprefix.h" #include #include "lopcodes.h" /* ORDER OP */ LUAI_DDEF const char *const luaP_opnames[NUM_OPCODES+1] = { "MOVE", "LOADK", "LOADKX", "LOADBOOL", "LOADNIL", "GETUPVAL", "GETTABUP", "GETTABLE", "SETTABUP", "SETUPVAL", "SETTABLE", "NEWTABLE", "SELF", "ADD", "SUB", "MUL", "MOD", "POW", "DIV", "IDIV", "BAND", "BOR", "BXOR", "SHL", "SHR", "UNM", "BNOT", "NOT", "LEN", "CONCAT", "JMP", "EQ", "LT", "LE", "TEST", "TESTSET", "CALL", "TAILCALL", "RETURN", "FORLOOP", "FORPREP", "TFORCALL", "TFORLOOP", "SETLIST", "CLOSURE", "VARARG", "EXTRAARG", NULL }; #define opmode(t,a,b,c,m) (((t)<<7) | ((a)<<6) | ((b)<<4) | ((c)<<2) | (m)) LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = { /* T A B C mode opcode */ opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_MOVE */ ,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_LOADK */ ,opmode(0, 1, OpArgN, OpArgN, iABx) /* OP_LOADKX */ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_LOADBOOL */ ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_LOADNIL */ ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_GETUPVAL */ ,opmode(0, 1, OpArgU, OpArgK, iABC) /* OP_GETTABUP */ ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_GETTABLE */ ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABUP */ ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_SETUPVAL */ ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABLE */ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_NEWTABLE */ ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_SELF */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_ADD */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SUB */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MUL */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MOD */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_POW */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_DIV */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_IDIV */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BAND */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BOR */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_BXOR */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SHL */ ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SHR */ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_UNM */ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_BNOT */ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_NOT */ ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LEN */ ,opmode(0, 1, OpArgR, OpArgR, iABC) /* OP_CONCAT */ ,opmode(0, 0, OpArgR, OpArgN, iAsBx) /* OP_JMP */ ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_EQ */ ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LT */ ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LE */ ,opmode(1, 0, OpArgN, OpArgU, iABC) /* OP_TEST */ ,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TESTSET */ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_CALL */ ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_TAILCALL */ ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_RETURN */ ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORLOOP */ ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORPREP */ ,opmode(0, 0, OpArgN, OpArgU, iABC) /* OP_TFORCALL */ ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_TFORLOOP */ ,opmode(0, 0, OpArgU, OpArgU, iABC) /* OP_SETLIST */ ,opmode(0, 1, OpArgU, OpArgN, iABx) /* OP_CLOSURE */ ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_VARARG */ ,opmode(0, 0, OpArgU, OpArgU, iAx) /* OP_EXTRAARG */ }; wcc-0.0.2/src/wsh/lua/src/lmem.c0000644000175000017500000000515713110675433015010 0ustar philphil/* ** $Id: lmem.c,v 1.91 2015/03/06 19:45:54 roberto Exp $ ** Interface to Memory Manager ** See Copyright Notice in lua.h */ #define lmem_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" /* ** About the realloc function: ** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize); ** ('osize' is the old size, 'nsize' is the new size) ** ** * frealloc(ud, NULL, x, s) creates a new block of size 's' (no ** matter 'x'). ** ** * frealloc(ud, p, x, 0) frees the block 'p' ** (in this specific case, frealloc must return NULL); ** particularly, frealloc(ud, NULL, 0, 0) does nothing ** (which is equivalent to free(NULL) in ISO C) ** ** frealloc returns NULL if it cannot create or reallocate the area ** (any reallocation to an equal or smaller size cannot fail!) */ #define MINSIZEARRAY 4 void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems, int limit, const char *what) { void *newblock; int newsize; if (*size >= limit/2) { /* cannot double it? */ if (*size >= limit) /* cannot grow even a little? */ luaG_runerror(L, "too many %s (limit is %d)", what, limit); newsize = limit; /* still have at least one free place */ } else { newsize = (*size)*2; if (newsize < MINSIZEARRAY) newsize = MINSIZEARRAY; /* minimum size */ } newblock = luaM_reallocv(L, block, *size, newsize, size_elems); *size = newsize; /* update only when everything else is OK */ return newblock; } l_noret luaM_toobig (lua_State *L) { luaG_runerror(L, "memory allocation error: block too big"); } /* ** generic allocation routine. */ void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) { void *newblock; global_State *g = G(L); size_t realosize = (block) ? osize : 0; lua_assert((realosize == 0) == (block == NULL)); #if defined(HARDMEMTESTS) if (nsize > realosize && g->gcrunning) luaC_fullgc(L, 1); /* force a GC whenever possible */ #endif newblock = (*g->frealloc)(g->ud, block, osize, nsize); if (newblock == NULL && nsize > 0) { lua_assert(nsize > realosize); /* cannot fail when shrinking a block */ if (g->version) { /* is state fully built? */ luaC_fullgc(L, 1); /* try to free some memory... */ newblock = (*g->frealloc)(g->ud, block, osize, nsize); /* try again */ } if (newblock == NULL) luaD_throw(L, LUA_ERRMEM); } lua_assert((nsize == 0) == (newblock == NULL)); g->GCdebt = (g->GCdebt + nsize) - realosize; return newblock; } wcc-0.0.2/src/wsh/lua/src/lctype.h0000644000175000017500000000345513110675433015362 0ustar philphil/* ** $Id: lctype.h,v 1.12 2011/07/15 12:50:29 roberto Exp $ ** 'ctype' functions for Lua ** See Copyright Notice in lua.h */ #ifndef lctype_h #define lctype_h #include "lua.h" /* ** WARNING: the functions defined here do not necessarily correspond ** to the similar functions in the standard C ctype.h. They are ** optimized for the specific needs of Lua */ #if !defined(LUA_USE_CTYPE) #if 'A' == 65 && '0' == 48 /* ASCII case: can use its own tables; faster and fixed */ #define LUA_USE_CTYPE 0 #else /* must use standard C ctype */ #define LUA_USE_CTYPE 1 #endif #endif #if !LUA_USE_CTYPE /* { */ #include #include "llimits.h" #define ALPHABIT 0 #define DIGITBIT 1 #define PRINTBIT 2 #define SPACEBIT 3 #define XDIGITBIT 4 #define MASK(B) (1 << (B)) /* ** add 1 to char to allow index -1 (EOZ) */ #define testprop(c,p) (luai_ctype_[(c)+1] & (p)) /* ** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_' */ #define lislalpha(c) testprop(c, MASK(ALPHABIT)) #define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT))) #define lisdigit(c) testprop(c, MASK(DIGITBIT)) #define lisspace(c) testprop(c, MASK(SPACEBIT)) #define lisprint(c) testprop(c, MASK(PRINTBIT)) #define lisxdigit(c) testprop(c, MASK(XDIGITBIT)) /* ** this 'ltolower' only works for alphabetic characters */ #define ltolower(c) ((c) | ('A' ^ 'a')) /* two more entries for 0 and -1 (EOZ) */ LUAI_DDEC const lu_byte luai_ctype_[UCHAR_MAX + 2]; #else /* }{ */ /* ** use standard C ctypes */ #include #define lislalpha(c) (isalpha(c) || (c) == '_') #define lislalnum(c) (isalnum(c) || (c) == '_') #define lisdigit(c) (isdigit(c)) #define lisspace(c) (isspace(c)) #define lisprint(c) (isprint(c)) #define lisxdigit(c) (isxdigit(c)) #define ltolower(c) (tolower(c)) #endif /* } */ #endif wcc-0.0.2/src/wsh/lua/src/lcode.c0000644000175000017500000006027413110675433015145 0ustar philphil/* ** $Id: lcode.c,v 2.103 2015/11/19 19:16:22 roberto Exp $ ** Code generator for Lua ** See Copyright Notice in lua.h */ #define lcode_c #define LUA_CORE #include "lprefix.h" #include #include #include "lua.h" #include "lcode.h" #include "ldebug.h" #include "ldo.h" #include "lgc.h" #include "llex.h" #include "lmem.h" #include "lobject.h" #include "lopcodes.h" #include "lparser.h" #include "lstring.h" #include "ltable.h" #include "lvm.h" /* Maximum number of registers in a Lua function (must fit in 8 bits) */ #define MAXREGS 255 #define hasjumps(e) ((e)->t != (e)->f) static int tonumeral(expdesc *e, TValue *v) { if (hasjumps(e)) return 0; /* not a numeral */ switch (e->k) { case VKINT: if (v) setivalue(v, e->u.ival); return 1; case VKFLT: if (v) setfltvalue(v, e->u.nval); return 1; default: return 0; } } void luaK_nil (FuncState *fs, int from, int n) { Instruction *previous; int l = from + n - 1; /* last register to set nil */ if (fs->pc > fs->lasttarget) { /* no jumps to current position? */ previous = &fs->f->code[fs->pc-1]; if (GET_OPCODE(*previous) == OP_LOADNIL) { int pfrom = GETARG_A(*previous); int pl = pfrom + GETARG_B(*previous); if ((pfrom <= from && from <= pl + 1) || (from <= pfrom && pfrom <= l + 1)) { /* can connect both? */ if (pfrom < from) from = pfrom; /* from = min(from, pfrom) */ if (pl > l) l = pl; /* l = max(l, pl) */ SETARG_A(*previous, from); SETARG_B(*previous, l - from); return; } } /* else go through */ } luaK_codeABC(fs, OP_LOADNIL, from, n - 1, 0); /* else no optimization */ } int luaK_jump (FuncState *fs) { int jpc = fs->jpc; /* save list of jumps to here */ int j; fs->jpc = NO_JUMP; j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP); luaK_concat(fs, &j, jpc); /* keep them on hold */ return j; } void luaK_ret (FuncState *fs, int first, int nret) { luaK_codeABC(fs, OP_RETURN, first, nret+1, 0); } static int condjump (FuncState *fs, OpCode op, int A, int B, int C) { luaK_codeABC(fs, op, A, B, C); return luaK_jump(fs); } static void fixjump (FuncState *fs, int pc, int dest) { Instruction *jmp = &fs->f->code[pc]; int offset = dest-(pc+1); lua_assert(dest != NO_JUMP); if (abs(offset) > MAXARG_sBx) luaX_syntaxerror(fs->ls, "control structure too long"); SETARG_sBx(*jmp, offset); } /* ** returns current 'pc' and marks it as a jump target (to avoid wrong ** optimizations with consecutive instructions not in the same basic block). */ int luaK_getlabel (FuncState *fs) { fs->lasttarget = fs->pc; return fs->pc; } static int getjump (FuncState *fs, int pc) { int offset = GETARG_sBx(fs->f->code[pc]); if (offset == NO_JUMP) /* point to itself represents end of list */ return NO_JUMP; /* end of list */ else return (pc+1)+offset; /* turn offset into absolute position */ } static Instruction *getjumpcontrol (FuncState *fs, int pc) { Instruction *pi = &fs->f->code[pc]; if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1)))) return pi-1; else return pi; } /* ** check whether list has any jump that do not produce a value ** (or produce an inverted value) */ static int need_value (FuncState *fs, int list) { for (; list != NO_JUMP; list = getjump(fs, list)) { Instruction i = *getjumpcontrol(fs, list); if (GET_OPCODE(i) != OP_TESTSET) return 1; } return 0; /* not found */ } static int patchtestreg (FuncState *fs, int node, int reg) { Instruction *i = getjumpcontrol(fs, node); if (GET_OPCODE(*i) != OP_TESTSET) return 0; /* cannot patch other instructions */ if (reg != NO_REG && reg != GETARG_B(*i)) SETARG_A(*i, reg); else /* no register to put value or register already has the value */ *i = CREATE_ABC(OP_TEST, GETARG_B(*i), 0, GETARG_C(*i)); return 1; } static void removevalues (FuncState *fs, int list) { for (; list != NO_JUMP; list = getjump(fs, list)) patchtestreg(fs, list, NO_REG); } static void patchlistaux (FuncState *fs, int list, int vtarget, int reg, int dtarget) { while (list != NO_JUMP) { int next = getjump(fs, list); if (patchtestreg(fs, list, reg)) fixjump(fs, list, vtarget); else fixjump(fs, list, dtarget); /* jump to default target */ list = next; } } static void dischargejpc (FuncState *fs) { patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc); fs->jpc = NO_JUMP; } void luaK_patchlist (FuncState *fs, int list, int target) { if (target == fs->pc) luaK_patchtohere(fs, list); else { lua_assert(target < fs->pc); patchlistaux(fs, list, target, NO_REG, target); } } void luaK_patchclose (FuncState *fs, int list, int level) { level++; /* argument is +1 to reserve 0 as non-op */ while (list != NO_JUMP) { int next = getjump(fs, list); lua_assert(GET_OPCODE(fs->f->code[list]) == OP_JMP && (GETARG_A(fs->f->code[list]) == 0 || GETARG_A(fs->f->code[list]) >= level)); SETARG_A(fs->f->code[list], level); list = next; } } void luaK_patchtohere (FuncState *fs, int list) { luaK_getlabel(fs); luaK_concat(fs, &fs->jpc, list); } void luaK_concat (FuncState *fs, int *l1, int l2) { if (l2 == NO_JUMP) return; else if (*l1 == NO_JUMP) *l1 = l2; else { int list = *l1; int next; while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */ list = next; fixjump(fs, list, l2); } } static int luaK_code (FuncState *fs, Instruction i) { Proto *f = fs->f; dischargejpc(fs); /* 'pc' will change */ /* put new instruction in code array */ luaM_growvector(fs->ls->L, f->code, fs->pc, f->sizecode, Instruction, MAX_INT, "opcodes"); f->code[fs->pc] = i; /* save corresponding line information */ luaM_growvector(fs->ls->L, f->lineinfo, fs->pc, f->sizelineinfo, int, MAX_INT, "opcodes"); f->lineinfo[fs->pc] = fs->ls->lastline; return fs->pc++; } int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) { lua_assert(getOpMode(o) == iABC); lua_assert(getBMode(o) != OpArgN || b == 0); lua_assert(getCMode(o) != OpArgN || c == 0); lua_assert(a <= MAXARG_A && b <= MAXARG_B && c <= MAXARG_C); return luaK_code(fs, CREATE_ABC(o, a, b, c)); } int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) { lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx); lua_assert(getCMode(o) == OpArgN); lua_assert(a <= MAXARG_A && bc <= MAXARG_Bx); return luaK_code(fs, CREATE_ABx(o, a, bc)); } static int codeextraarg (FuncState *fs, int a) { lua_assert(a <= MAXARG_Ax); return luaK_code(fs, CREATE_Ax(OP_EXTRAARG, a)); } int luaK_codek (FuncState *fs, int reg, int k) { if (k <= MAXARG_Bx) return luaK_codeABx(fs, OP_LOADK, reg, k); else { int p = luaK_codeABx(fs, OP_LOADKX, reg, 0); codeextraarg(fs, k); return p; } } void luaK_checkstack (FuncState *fs, int n) { int newstack = fs->freereg + n; if (newstack > fs->f->maxstacksize) { if (newstack >= MAXREGS) luaX_syntaxerror(fs->ls, "function or expression needs too many registers"); fs->f->maxstacksize = cast_byte(newstack); } } void luaK_reserveregs (FuncState *fs, int n) { luaK_checkstack(fs, n); fs->freereg += n; } static void freereg (FuncState *fs, int reg) { if (!ISK(reg) && reg >= fs->nactvar) { fs->freereg--; lua_assert(reg == fs->freereg); } } static void freeexp (FuncState *fs, expdesc *e) { if (e->k == VNONRELOC) freereg(fs, e->u.info); } /* ** Use scanner's table to cache position of constants in constant list ** and try to reuse constants */ static int addk (FuncState *fs, TValue *key, TValue *v) { lua_State *L = fs->ls->L; Proto *f = fs->f; TValue *idx = luaH_set(L, fs->ls->h, key); /* index scanner table */ int k, oldsize; if (ttisinteger(idx)) { /* is there an index there? */ k = cast_int(ivalue(idx)); /* correct value? (warning: must distinguish floats from integers!) */ if (k < fs->nk && ttype(&f->k[k]) == ttype(v) && luaV_rawequalobj(&f->k[k], v)) return k; /* reuse index */ } /* constant not found; create a new entry */ oldsize = f->sizek; k = fs->nk; /* numerical value does not need GC barrier; table has no metatable, so it does not need to invalidate cache */ setivalue(idx, k); luaM_growvector(L, f->k, k, f->sizek, TValue, MAXARG_Ax, "constants"); while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]); setobj(L, &f->k[k], v); fs->nk++; luaC_barrier(L, f, v); return k; } int luaK_stringK (FuncState *fs, TString *s) { TValue o; setsvalue(fs->ls->L, &o, s); return addk(fs, &o, &o); } /* ** Integers use userdata as keys to avoid collision with floats with same ** value; conversion to 'void*' used only for hashing, no "precision" ** problems */ int luaK_intK (FuncState *fs, lua_Integer n) { TValue k, o; setpvalue(&k, cast(void*, cast(size_t, n))); setivalue(&o, n); return addk(fs, &k, &o); } static int luaK_numberK (FuncState *fs, lua_Number r) { TValue o; setfltvalue(&o, r); return addk(fs, &o, &o); } static int boolK (FuncState *fs, int b) { TValue o; setbvalue(&o, b); return addk(fs, &o, &o); } static int nilK (FuncState *fs) { TValue k, v; setnilvalue(&v); /* cannot use nil as key; instead use table itself to represent nil */ sethvalue(fs->ls->L, &k, fs->ls->h); return addk(fs, &k, &v); } void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) { if (e->k == VCALL) { /* expression is an open function call? */ SETARG_C(getcode(fs, e), nresults+1); } else if (e->k == VVARARG) { SETARG_B(getcode(fs, e), nresults+1); SETARG_A(getcode(fs, e), fs->freereg); luaK_reserveregs(fs, 1); } } void luaK_setoneret (FuncState *fs, expdesc *e) { if (e->k == VCALL) { /* expression is an open function call? */ e->k = VNONRELOC; e->u.info = GETARG_A(getcode(fs, e)); } else if (e->k == VVARARG) { SETARG_B(getcode(fs, e), 2); e->k = VRELOCABLE; /* can relocate its simple result */ } } void luaK_dischargevars (FuncState *fs, expdesc *e) { switch (e->k) { case VLOCAL: { e->k = VNONRELOC; break; } case VUPVAL: { e->u.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.info, 0); e->k = VRELOCABLE; break; } case VINDEXED: { OpCode op = OP_GETTABUP; /* assume 't' is in an upvalue */ freereg(fs, e->u.ind.idx); if (e->u.ind.vt == VLOCAL) { /* 't' is in a register? */ freereg(fs, e->u.ind.t); op = OP_GETTABLE; } e->u.info = luaK_codeABC(fs, op, 0, e->u.ind.t, e->u.ind.idx); e->k = VRELOCABLE; break; } case VVARARG: case VCALL: { luaK_setoneret(fs, e); break; } default: break; /* there is one value available (somewhere) */ } } static int code_label (FuncState *fs, int A, int b, int jump) { luaK_getlabel(fs); /* those instructions may be jump targets */ return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump); } static void discharge2reg (FuncState *fs, expdesc *e, int reg) { luaK_dischargevars(fs, e); switch (e->k) { case VNIL: { luaK_nil(fs, reg, 1); break; } case VFALSE: case VTRUE: { luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0); break; } case VK: { luaK_codek(fs, reg, e->u.info); break; } case VKFLT: { luaK_codek(fs, reg, luaK_numberK(fs, e->u.nval)); break; } case VKINT: { luaK_codek(fs, reg, luaK_intK(fs, e->u.ival)); break; } case VRELOCABLE: { Instruction *pc = &getcode(fs, e); SETARG_A(*pc, reg); break; } case VNONRELOC: { if (reg != e->u.info) luaK_codeABC(fs, OP_MOVE, reg, e->u.info, 0); break; } default: { lua_assert(e->k == VVOID || e->k == VJMP); return; /* nothing to do... */ } } e->u.info = reg; e->k = VNONRELOC; } static void discharge2anyreg (FuncState *fs, expdesc *e) { if (e->k != VNONRELOC) { luaK_reserveregs(fs, 1); discharge2reg(fs, e, fs->freereg-1); } } static void exp2reg (FuncState *fs, expdesc *e, int reg) { discharge2reg(fs, e, reg); if (e->k == VJMP) luaK_concat(fs, &e->t, e->u.info); /* put this jump in 't' list */ if (hasjumps(e)) { int final; /* position after whole expression */ int p_f = NO_JUMP; /* position of an eventual LOAD false */ int p_t = NO_JUMP; /* position of an eventual LOAD true */ if (need_value(fs, e->t) || need_value(fs, e->f)) { int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs); p_f = code_label(fs, reg, 0, 1); p_t = code_label(fs, reg, 1, 0); luaK_patchtohere(fs, fj); } final = luaK_getlabel(fs); patchlistaux(fs, e->f, final, reg, p_f); patchlistaux(fs, e->t, final, reg, p_t); } e->f = e->t = NO_JUMP; e->u.info = reg; e->k = VNONRELOC; } void luaK_exp2nextreg (FuncState *fs, expdesc *e) { luaK_dischargevars(fs, e); freeexp(fs, e); luaK_reserveregs(fs, 1); exp2reg(fs, e, fs->freereg - 1); } int luaK_exp2anyreg (FuncState *fs, expdesc *e) { luaK_dischargevars(fs, e); if (e->k == VNONRELOC) { if (!hasjumps(e)) return e->u.info; /* exp is already in a register */ if (e->u.info >= fs->nactvar) { /* reg. is not a local? */ exp2reg(fs, e, e->u.info); /* put value on it */ return e->u.info; } } luaK_exp2nextreg(fs, e); /* default */ return e->u.info; } void luaK_exp2anyregup (FuncState *fs, expdesc *e) { if (e->k != VUPVAL || hasjumps(e)) luaK_exp2anyreg(fs, e); } void luaK_exp2val (FuncState *fs, expdesc *e) { if (hasjumps(e)) luaK_exp2anyreg(fs, e); else luaK_dischargevars(fs, e); } int luaK_exp2RK (FuncState *fs, expdesc *e) { luaK_exp2val(fs, e); switch (e->k) { case VTRUE: case VFALSE: case VNIL: { if (fs->nk <= MAXINDEXRK) { /* constant fits in RK operand? */ e->u.info = (e->k == VNIL) ? nilK(fs) : boolK(fs, (e->k == VTRUE)); e->k = VK; return RKASK(e->u.info); } else break; } case VKINT: { e->u.info = luaK_intK(fs, e->u.ival); e->k = VK; goto vk; } case VKFLT: { e->u.info = luaK_numberK(fs, e->u.nval); e->k = VK; } /* FALLTHROUGH */ case VK: { vk: if (e->u.info <= MAXINDEXRK) /* constant fits in 'argC'? */ return RKASK(e->u.info); else break; } default: break; } /* not a constant in the right range: put it in a register */ return luaK_exp2anyreg(fs, e); } void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) { switch (var->k) { case VLOCAL: { freeexp(fs, ex); exp2reg(fs, ex, var->u.info); return; } case VUPVAL: { int e = luaK_exp2anyreg(fs, ex); luaK_codeABC(fs, OP_SETUPVAL, e, var->u.info, 0); break; } case VINDEXED: { OpCode op = (var->u.ind.vt == VLOCAL) ? OP_SETTABLE : OP_SETTABUP; int e = luaK_exp2RK(fs, ex); luaK_codeABC(fs, op, var->u.ind.t, var->u.ind.idx, e); break; } default: { lua_assert(0); /* invalid var kind to store */ break; } } freeexp(fs, ex); } void luaK_self (FuncState *fs, expdesc *e, expdesc *key) { int ereg; luaK_exp2anyreg(fs, e); ereg = e->u.info; /* register where 'e' was placed */ freeexp(fs, e); e->u.info = fs->freereg; /* base register for op_self */ e->k = VNONRELOC; luaK_reserveregs(fs, 2); /* function and 'self' produced by op_self */ luaK_codeABC(fs, OP_SELF, e->u.info, ereg, luaK_exp2RK(fs, key)); freeexp(fs, key); } static void invertjump (FuncState *fs, expdesc *e) { Instruction *pc = getjumpcontrol(fs, e->u.info); lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET && GET_OPCODE(*pc) != OP_TEST); SETARG_A(*pc, !(GETARG_A(*pc))); } static int jumponcond (FuncState *fs, expdesc *e, int cond) { if (e->k == VRELOCABLE) { Instruction ie = getcode(fs, e); if (GET_OPCODE(ie) == OP_NOT) { fs->pc--; /* remove previous OP_NOT */ return condjump(fs, OP_TEST, GETARG_B(ie), 0, !cond); } /* else go through */ } discharge2anyreg(fs, e); freeexp(fs, e); return condjump(fs, OP_TESTSET, NO_REG, e->u.info, cond); } void luaK_goiftrue (FuncState *fs, expdesc *e) { int pc; /* pc of last jump */ luaK_dischargevars(fs, e); switch (e->k) { case VJMP: { invertjump(fs, e); pc = e->u.info; break; } case VK: case VKFLT: case VKINT: case VTRUE: { pc = NO_JUMP; /* always true; do nothing */ break; } default: { pc = jumponcond(fs, e, 0); break; } } luaK_concat(fs, &e->f, pc); /* insert last jump in 'f' list */ luaK_patchtohere(fs, e->t); e->t = NO_JUMP; } void luaK_goiffalse (FuncState *fs, expdesc *e) { int pc; /* pc of last jump */ luaK_dischargevars(fs, e); switch (e->k) { case VJMP: { pc = e->u.info; break; } case VNIL: case VFALSE: { pc = NO_JUMP; /* always false; do nothing */ break; } default: { pc = jumponcond(fs, e, 1); break; } } luaK_concat(fs, &e->t, pc); /* insert last jump in 't' list */ luaK_patchtohere(fs, e->f); e->f = NO_JUMP; } static void codenot (FuncState *fs, expdesc *e) { luaK_dischargevars(fs, e); switch (e->k) { case VNIL: case VFALSE: { e->k = VTRUE; break; } case VK: case VKFLT: case VKINT: case VTRUE: { e->k = VFALSE; break; } case VJMP: { invertjump(fs, e); break; } case VRELOCABLE: case VNONRELOC: { discharge2anyreg(fs, e); freeexp(fs, e); e->u.info = luaK_codeABC(fs, OP_NOT, 0, e->u.info, 0); e->k = VRELOCABLE; break; } default: { lua_assert(0); /* cannot happen */ break; } } /* interchange true and false lists */ { int temp = e->f; e->f = e->t; e->t = temp; } removevalues(fs, e->f); removevalues(fs, e->t); } void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) { lua_assert(!hasjumps(t)); t->u.ind.t = t->u.info; t->u.ind.idx = luaK_exp2RK(fs, k); t->u.ind.vt = (t->k == VUPVAL) ? VUPVAL : check_exp(vkisinreg(t->k), VLOCAL); t->k = VINDEXED; } /* ** return false if folding can raise an error */ static int validop (int op, TValue *v1, TValue *v2) { switch (op) { case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR: case LUA_OPSHL: case LUA_OPSHR: case LUA_OPBNOT: { /* conversion errors */ lua_Integer i; return (tointeger(v1, &i) && tointeger(v2, &i)); } case LUA_OPDIV: case LUA_OPIDIV: case LUA_OPMOD: /* division by 0 */ return (nvalue(v2) != 0); default: return 1; /* everything else is valid */ } } /* ** Try to "constant-fold" an operation; return 1 iff successful */ static int constfolding (FuncState *fs, int op, expdesc *e1, expdesc *e2) { TValue v1, v2, res; if (!tonumeral(e1, &v1) || !tonumeral(e2, &v2) || !validop(op, &v1, &v2)) return 0; /* non-numeric operands or not safe to fold */ luaO_arith(fs->ls->L, op, &v1, &v2, &res); /* does operation */ if (ttisinteger(&res)) { e1->k = VKINT; e1->u.ival = ivalue(&res); } else { /* folds neither NaN nor 0.0 (to avoid collapsing with -0.0) */ lua_Number n = fltvalue(&res); if (luai_numisnan(n) || n == 0) return 0; e1->k = VKFLT; e1->u.nval = n; } return 1; } /* ** Code for binary and unary expressions that "produce values" ** (arithmetic operations, bitwise operations, concat, length). First ** try to do constant folding (only for numeric [arithmetic and ** bitwise] operations, which is what 'lua_arith' accepts). ** Expression to produce final result will be encoded in 'e1'. */ static void codeexpval (FuncState *fs, OpCode op, expdesc *e1, expdesc *e2, int line) { lua_assert(op >= OP_ADD); if (op <= OP_BNOT && constfolding(fs, (op - OP_ADD) + LUA_OPADD, e1, e2)) return; /* result has been folded */ else { int o1, o2; /* move operands to registers (if needed) */ if (op == OP_UNM || op == OP_BNOT || op == OP_LEN) { /* unary op? */ o2 = 0; /* no second expression */ o1 = luaK_exp2anyreg(fs, e1); /* cannot operate on constants */ } else { /* regular case (binary operators) */ o2 = luaK_exp2RK(fs, e2); /* both operands are "RK" */ o1 = luaK_exp2RK(fs, e1); } if (o1 > o2) { /* free registers in proper order */ freeexp(fs, e1); freeexp(fs, e2); } else { freeexp(fs, e2); freeexp(fs, e1); } e1->u.info = luaK_codeABC(fs, op, 0, o1, o2); /* generate opcode */ e1->k = VRELOCABLE; /* all those operations are relocatable */ luaK_fixline(fs, line); } } static void codecomp (FuncState *fs, OpCode op, int cond, expdesc *e1, expdesc *e2) { int o1 = luaK_exp2RK(fs, e1); int o2 = luaK_exp2RK(fs, e2); freeexp(fs, e2); freeexp(fs, e1); if (cond == 0 && op != OP_EQ) { int temp; /* exchange args to replace by '<' or '<=' */ temp = o1; o1 = o2; o2 = temp; /* o1 <==> o2 */ cond = 1; } e1->u.info = condjump(fs, op, cond, o1, o2); e1->k = VJMP; } void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e, int line) { expdesc e2; e2.t = e2.f = NO_JUMP; e2.k = VKINT; e2.u.ival = 0; switch (op) { case OPR_MINUS: case OPR_BNOT: case OPR_LEN: { codeexpval(fs, cast(OpCode, (op - OPR_MINUS) + OP_UNM), e, &e2, line); break; } case OPR_NOT: codenot(fs, e); break; default: lua_assert(0); } } void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) { switch (op) { case OPR_AND: { luaK_goiftrue(fs, v); break; } case OPR_OR: { luaK_goiffalse(fs, v); break; } case OPR_CONCAT: { luaK_exp2nextreg(fs, v); /* operand must be on the 'stack' */ break; } case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV: case OPR_IDIV: case OPR_MOD: case OPR_POW: case OPR_BAND: case OPR_BOR: case OPR_BXOR: case OPR_SHL: case OPR_SHR: { if (!tonumeral(v, NULL)) luaK_exp2RK(fs, v); break; } default: { luaK_exp2RK(fs, v); break; } } } void luaK_posfix (FuncState *fs, BinOpr op, expdesc *e1, expdesc *e2, int line) { switch (op) { case OPR_AND: { lua_assert(e1->t == NO_JUMP); /* list must be closed */ luaK_dischargevars(fs, e2); luaK_concat(fs, &e2->f, e1->f); *e1 = *e2; break; } case OPR_OR: { lua_assert(e1->f == NO_JUMP); /* list must be closed */ luaK_dischargevars(fs, e2); luaK_concat(fs, &e2->t, e1->t); *e1 = *e2; break; } case OPR_CONCAT: { luaK_exp2val(fs, e2); if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) { lua_assert(e1->u.info == GETARG_B(getcode(fs, e2))-1); freeexp(fs, e1); SETARG_B(getcode(fs, e2), e1->u.info); e1->k = VRELOCABLE; e1->u.info = e2->u.info; } else { luaK_exp2nextreg(fs, e2); /* operand must be on the 'stack' */ codeexpval(fs, OP_CONCAT, e1, e2, line); } break; } case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV: case OPR_IDIV: case OPR_MOD: case OPR_POW: case OPR_BAND: case OPR_BOR: case OPR_BXOR: case OPR_SHL: case OPR_SHR: { codeexpval(fs, cast(OpCode, (op - OPR_ADD) + OP_ADD), e1, e2, line); break; } case OPR_EQ: case OPR_LT: case OPR_LE: { codecomp(fs, cast(OpCode, (op - OPR_EQ) + OP_EQ), 1, e1, e2); break; } case OPR_NE: case OPR_GT: case OPR_GE: { codecomp(fs, cast(OpCode, (op - OPR_NE) + OP_EQ), 0, e1, e2); break; } default: lua_assert(0); } } void luaK_fixline (FuncState *fs, int line) { fs->f->lineinfo[fs->pc - 1] = line; } void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) { int c = (nelems - 1)/LFIELDS_PER_FLUSH + 1; int b = (tostore == LUA_MULTRET) ? 0 : tostore; lua_assert(tostore != 0); if (c <= MAXARG_C) luaK_codeABC(fs, OP_SETLIST, base, b, c); else if (c <= MAXARG_Ax) { luaK_codeABC(fs, OP_SETLIST, base, b, 0); codeextraarg(fs, c); } else luaX_syntaxerror(fs->ls, "constructor too long"); fs->freereg = base + 1; /* free registers with list values */ } wcc-0.0.2/src/wsh/lua/src/lobject.h0000644000175000017500000003430213110675433015477 0ustar philphil/* ** $Id: lobject.h,v 2.116 2015/11/03 18:33:10 roberto Exp $ ** Type definitions for Lua objects ** See Copyright Notice in lua.h */ #ifndef lobject_h #define lobject_h #include #include "llimits.h" #include "lua.h" /* ** Extra tags for non-values */ #define LUA_TPROTO LUA_NUMTAGS /* function prototypes */ #define LUA_TDEADKEY (LUA_NUMTAGS+1) /* removed keys in tables */ /* ** number of all possible tags (including LUA_TNONE but excluding DEADKEY) */ #define LUA_TOTALTAGS (LUA_TPROTO + 2) /* ** tags for Tagged Values have the following use of bits: ** bits 0-3: actual tag (a LUA_T* value) ** bits 4-5: variant bits ** bit 6: whether value is collectable */ /* ** LUA_TFUNCTION variants: ** 0 - Lua function ** 1 - light C function ** 2 - regular C function (closure) */ /* Variant tags for functions */ #define LUA_TLCL (LUA_TFUNCTION | (0 << 4)) /* Lua closure */ #define LUA_TLCF (LUA_TFUNCTION | (1 << 4)) /* light C function */ #define LUA_TCCL (LUA_TFUNCTION | (2 << 4)) /* C closure */ /* Variant tags for strings */ #define LUA_TSHRSTR (LUA_TSTRING | (0 << 4)) /* short strings */ #define LUA_TLNGSTR (LUA_TSTRING | (1 << 4)) /* long strings */ /* Variant tags for numbers */ #define LUA_TNUMFLT (LUA_TNUMBER | (0 << 4)) /* float numbers */ #define LUA_TNUMINT (LUA_TNUMBER | (1 << 4)) /* integer numbers */ /* Bit mark for collectable types */ #define BIT_ISCOLLECTABLE (1 << 6) /* mark a tag as collectable */ #define ctb(t) ((t) | BIT_ISCOLLECTABLE) /* ** Common type for all collectable objects */ typedef struct GCObject GCObject; /* ** Common Header for all collectable objects (in macro form, to be ** included in other objects) */ #define CommonHeader GCObject *next; lu_byte tt; lu_byte marked /* ** Common type has only the common header */ struct GCObject { CommonHeader; }; /* ** Tagged Values. This is the basic representation of values in Lua, ** an actual value plus a tag with its type. */ /* ** Union of all Lua values */ typedef union Value { GCObject *gc; /* collectable objects */ void *p; /* light userdata */ int b; /* booleans */ lua_CFunction f; /* light C functions */ lua_Integer i; /* integer numbers */ lua_Number n; /* float numbers */ } Value; #define TValuefields Value value_; int tt_ typedef struct lua_TValue { TValuefields; } TValue; /* macro defining a nil value */ #define NILCONSTANT {NULL}, LUA_TNIL #define val_(o) ((o)->value_) /* raw type tag of a TValue */ #define rttype(o) ((o)->tt_) /* tag with no variants (bits 0-3) */ #define novariant(x) ((x) & 0x0F) /* type tag of a TValue (bits 0-3 for tags + variant bits 4-5) */ #define ttype(o) (rttype(o) & 0x3F) /* type tag of a TValue with no variants (bits 0-3) */ #define ttnov(o) (novariant(rttype(o))) /* Macros to test type */ #define checktag(o,t) (rttype(o) == (t)) #define checktype(o,t) (ttnov(o) == (t)) #define ttisnumber(o) checktype((o), LUA_TNUMBER) #define ttisfloat(o) checktag((o), LUA_TNUMFLT) #define ttisinteger(o) checktag((o), LUA_TNUMINT) #define ttisnil(o) checktag((o), LUA_TNIL) #define ttisboolean(o) checktag((o), LUA_TBOOLEAN) #define ttislightuserdata(o) checktag((o), LUA_TLIGHTUSERDATA) #define ttisstring(o) checktype((o), LUA_TSTRING) #define ttisshrstring(o) checktag((o), ctb(LUA_TSHRSTR)) #define ttislngstring(o) checktag((o), ctb(LUA_TLNGSTR)) #define ttistable(o) checktag((o), ctb(LUA_TTABLE)) #define ttisfunction(o) checktype(o, LUA_TFUNCTION) #define ttisclosure(o) ((rttype(o) & 0x1F) == LUA_TFUNCTION) #define ttisCclosure(o) checktag((o), ctb(LUA_TCCL)) #define ttisLclosure(o) checktag((o), ctb(LUA_TLCL)) #define ttislcf(o) checktag((o), LUA_TLCF) #define ttisfulluserdata(o) checktag((o), ctb(LUA_TUSERDATA)) #define ttisthread(o) checktag((o), ctb(LUA_TTHREAD)) #define ttisdeadkey(o) checktag((o), LUA_TDEADKEY) /* Macros to access values */ #define ivalue(o) check_exp(ttisinteger(o), val_(o).i) #define fltvalue(o) check_exp(ttisfloat(o), val_(o).n) #define nvalue(o) check_exp(ttisnumber(o), \ (ttisinteger(o) ? cast_num(ivalue(o)) : fltvalue(o))) #define gcvalue(o) check_exp(iscollectable(o), val_(o).gc) #define pvalue(o) check_exp(ttislightuserdata(o), val_(o).p) #define tsvalue(o) check_exp(ttisstring(o), gco2ts(val_(o).gc)) #define uvalue(o) check_exp(ttisfulluserdata(o), gco2u(val_(o).gc)) #define clvalue(o) check_exp(ttisclosure(o), gco2cl(val_(o).gc)) #define clLvalue(o) check_exp(ttisLclosure(o), gco2lcl(val_(o).gc)) #define clCvalue(o) check_exp(ttisCclosure(o), gco2ccl(val_(o).gc)) #define fvalue(o) check_exp(ttislcf(o), val_(o).f) #define hvalue(o) check_exp(ttistable(o), gco2t(val_(o).gc)) #define bvalue(o) check_exp(ttisboolean(o), val_(o).b) #define thvalue(o) check_exp(ttisthread(o), gco2th(val_(o).gc)) /* a dead value may get the 'gc' field, but cannot access its contents */ #define deadvalue(o) check_exp(ttisdeadkey(o), cast(void *, val_(o).gc)) #define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0)) #define iscollectable(o) (rttype(o) & BIT_ISCOLLECTABLE) /* Macros for internal tests */ #define righttt(obj) (ttype(obj) == gcvalue(obj)->tt) #define checkliveness(L,obj) \ lua_longassert(!iscollectable(obj) || \ (righttt(obj) && (L == NULL || !isdead(G(L),gcvalue(obj))))) /* Macros to set values */ #define settt_(o,t) ((o)->tt_=(t)) #define setfltvalue(obj,x) \ { TValue *io=(obj); val_(io).n=(x); settt_(io, LUA_TNUMFLT); } #define chgfltvalue(obj,x) \ { TValue *io=(obj); lua_assert(ttisfloat(io)); val_(io).n=(x); } #define setivalue(obj,x) \ { TValue *io=(obj); val_(io).i=(x); settt_(io, LUA_TNUMINT); } #define chgivalue(obj,x) \ { TValue *io=(obj); lua_assert(ttisinteger(io)); val_(io).i=(x); } #define setnilvalue(obj) settt_(obj, LUA_TNIL) #define setfvalue(obj,x) \ { TValue *io=(obj); val_(io).f=(x); settt_(io, LUA_TLCF); } #define setpvalue(obj,x) \ { TValue *io=(obj); val_(io).p=(x); settt_(io, LUA_TLIGHTUSERDATA); } #define setbvalue(obj,x) \ { TValue *io=(obj); val_(io).b=(x); settt_(io, LUA_TBOOLEAN); } #define setgcovalue(L,obj,x) \ { TValue *io = (obj); GCObject *i_g=(x); \ val_(io).gc = i_g; settt_(io, ctb(i_g->tt)); } #define setsvalue(L,obj,x) \ { TValue *io = (obj); TString *x_ = (x); \ val_(io).gc = obj2gco(x_); settt_(io, ctb(x_->tt)); \ checkliveness(L,io); } #define setuvalue(L,obj,x) \ { TValue *io = (obj); Udata *x_ = (x); \ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TUSERDATA)); \ checkliveness(L,io); } #define setthvalue(L,obj,x) \ { TValue *io = (obj); lua_State *x_ = (x); \ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TTHREAD)); \ checkliveness(L,io); } #define setclLvalue(L,obj,x) \ { TValue *io = (obj); LClosure *x_ = (x); \ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TLCL)); \ checkliveness(L,io); } #define setclCvalue(L,obj,x) \ { TValue *io = (obj); CClosure *x_ = (x); \ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TCCL)); \ checkliveness(L,io); } #define sethvalue(L,obj,x) \ { TValue *io = (obj); Table *x_ = (x); \ val_(io).gc = obj2gco(x_); settt_(io, ctb(LUA_TTABLE)); \ checkliveness(L,io); } #define setdeadvalue(obj) settt_(obj, LUA_TDEADKEY) #define setobj(L,obj1,obj2) \ { TValue *io1=(obj1); *io1 = *(obj2); \ (void)L; checkliveness(L,io1); } /* ** different types of assignments, according to destination */ /* from stack to (same) stack */ #define setobjs2s setobj /* to stack (not from same stack) */ #define setobj2s setobj #define setsvalue2s setsvalue #define sethvalue2s sethvalue #define setptvalue2s setptvalue /* from table to same table */ #define setobjt2t setobj /* to new object */ #define setobj2n setobj #define setsvalue2n setsvalue /* to table (define it as an expression to be used in macros) */ #define setobj2t(L,o1,o2) ((void)L, *(o1)=*(o2), checkliveness(L,(o1))) /* ** {====================================================== ** types and prototypes ** ======================================================= */ typedef TValue *StkId; /* index to stack elements */ /* ** Header for string value; string bytes follow the end of this structure ** (aligned according to 'UTString'; see next). */ typedef struct TString { CommonHeader; lu_byte extra; /* reserved words for short strings; "has hash" for longs */ lu_byte shrlen; /* length for short strings */ unsigned int hash; union { size_t lnglen; /* length for long strings */ struct TString *hnext; /* linked list for hash table */ } u; } TString; /* ** Ensures that address after this type is always fully aligned. */ typedef union UTString { L_Umaxalign dummy; /* ensures maximum alignment for strings */ TString tsv; } UTString; /* ** Get the actual string (array of bytes) from a 'TString'. ** (Access to 'extra' ensures that value is really a 'TString'.) */ #define getstr(ts) \ check_exp(sizeof((ts)->extra), cast(char *, (ts)) + sizeof(UTString)) /* get the actual string (array of bytes) from a Lua value */ #define svalue(o) getstr(tsvalue(o)) /* get string length from 'TString *s' */ #define tsslen(s) ((s)->tt == LUA_TSHRSTR ? (s)->shrlen : (s)->u.lnglen) /* get string length from 'TValue *o' */ #define vslen(o) tsslen(tsvalue(o)) /* ** Header for userdata; memory area follows the end of this structure ** (aligned according to 'UUdata'; see next). */ typedef struct Udata { CommonHeader; lu_byte ttuv_; /* user value's tag */ struct Table *metatable; size_t len; /* number of bytes */ union Value user_; /* user value */ } Udata; /* ** Ensures that address after this type is always fully aligned. */ typedef union UUdata { L_Umaxalign dummy; /* ensures maximum alignment for 'local' udata */ Udata uv; } UUdata; /* ** Get the address of memory block inside 'Udata'. ** (Access to 'ttuv_' ensures that value is really a 'Udata'.) */ #define getudatamem(u) \ check_exp(sizeof((u)->ttuv_), (cast(char*, (u)) + sizeof(UUdata))) #define setuservalue(L,u,o) \ { const TValue *io=(o); Udata *iu = (u); \ iu->user_ = io->value_; iu->ttuv_ = rttype(io); \ checkliveness(L,io); } #define getuservalue(L,u,o) \ { TValue *io=(o); const Udata *iu = (u); \ io->value_ = iu->user_; settt_(io, iu->ttuv_); \ checkliveness(L,io); } /* ** Description of an upvalue for function prototypes */ typedef struct Upvaldesc { TString *name; /* upvalue name (for debug information) */ lu_byte instack; /* whether it is in stack (register) */ lu_byte idx; /* index of upvalue (in stack or in outer function's list) */ } Upvaldesc; /* ** Description of a local variable for function prototypes ** (used for debug information) */ typedef struct LocVar { TString *varname; int startpc; /* first point where variable is active */ int endpc; /* first point where variable is dead */ } LocVar; /* ** Function Prototypes */ typedef struct Proto { CommonHeader; lu_byte numparams; /* number of fixed parameters */ lu_byte is_vararg; /* 2: declared vararg; 1: uses vararg */ lu_byte maxstacksize; /* number of registers needed by this function */ int sizeupvalues; /* size of 'upvalues' */ int sizek; /* size of 'k' */ int sizecode; int sizelineinfo; int sizep; /* size of 'p' */ int sizelocvars; int linedefined; /* debug information */ int lastlinedefined; /* debug information */ TValue *k; /* constants used by the function */ Instruction *code; /* opcodes */ struct Proto **p; /* functions defined inside the function */ int *lineinfo; /* map from opcodes to source lines (debug information) */ LocVar *locvars; /* information about local variables (debug information) */ Upvaldesc *upvalues; /* upvalue information */ struct LClosure *cache; /* last-created closure with this prototype */ TString *source; /* used for debug information */ GCObject *gclist; } Proto; /* ** Lua Upvalues */ typedef struct UpVal UpVal; /* ** Closures */ #define ClosureHeader \ CommonHeader; lu_byte nupvalues; GCObject *gclist typedef struct CClosure { ClosureHeader; lua_CFunction f; TValue upvalue[1]; /* list of upvalues */ } CClosure; typedef struct LClosure { ClosureHeader; struct Proto *p; UpVal *upvals[1]; /* list of upvalues */ } LClosure; typedef union Closure { CClosure c; LClosure l; } Closure; #define isLfunction(o) ttisLclosure(o) #define getproto(o) (clLvalue(o)->p) /* ** Tables */ typedef union TKey { struct { TValuefields; int next; /* for chaining (offset for next node) */ } nk; TValue tvk; } TKey; /* copy a value into a key without messing up field 'next' */ #define setnodekey(L,key,obj) \ { TKey *k_=(key); const TValue *io_=(obj); \ k_->nk.value_ = io_->value_; k_->nk.tt_ = io_->tt_; \ (void)L; checkliveness(L,io_); } typedef struct Node { TValue i_val; TKey i_key; } Node; typedef struct Table { CommonHeader; lu_byte flags; /* 1<

lsizenode)) /* ** (address of) a fixed nil value */ #define luaO_nilobject (&luaO_nilobject_) LUAI_DDEC const TValue luaO_nilobject_; /* size of buffer for 'luaO_utf8esc' function */ #define UTF8BUFFSZ 8 LUAI_FUNC int luaO_int2fb (unsigned int x); LUAI_FUNC int luaO_fb2int (int x); LUAI_FUNC int luaO_utf8esc (char *buff, unsigned long x); LUAI_FUNC int luaO_ceillog2 (unsigned int x); LUAI_FUNC void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2, TValue *res); LUAI_FUNC size_t luaO_str2num (const char *s, TValue *o); LUAI_FUNC int luaO_hexavalue (int c); LUAI_FUNC void luaO_tostring (lua_State *L, StkId obj); LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp); LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...); LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t len); #endif wcc-0.0.2/src/wsh/lua/src/ldblib.c0000644000175000017500000003074713110675433015311 0ustar philphil/* ** $Id: ldblib.c,v 1.151 2015/11/23 11:29:43 roberto Exp $ ** Interface from Lua to its debug API ** See Copyright Notice in lua.h */ #define ldblib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" /* ** The hook table at registry[&HOOKKEY] maps threads to their current ** hook function. (We only need the unique address of 'HOOKKEY'.) */ static const int HOOKKEY = 0; /* ** If L1 != L, L1 can be in any state, and therefore there are no ** guarantees about its stack space; any push in L1 must be ** checked. */ static void checkstack (lua_State *L, lua_State *L1, int n) { if (L != L1 && !lua_checkstack(L1, n)) luaL_error(L, "stack overflow"); } static int db_getregistry (lua_State *L) { lua_pushvalue(L, LUA_REGISTRYINDEX); return 1; } static int db_getmetatable (lua_State *L) { luaL_checkany(L, 1); if (!lua_getmetatable(L, 1)) { lua_pushnil(L); /* no metatable */ } return 1; } static int db_setmetatable (lua_State *L) { int t = lua_type(L, 2); luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table expected"); lua_settop(L, 2); lua_setmetatable(L, 1); return 1; /* return 1st argument */ } static int db_getuservalue (lua_State *L) { if (lua_type(L, 1) != LUA_TUSERDATA) lua_pushnil(L); else lua_getuservalue(L, 1); return 1; } static int db_setuservalue (lua_State *L) { luaL_checktype(L, 1, LUA_TUSERDATA); luaL_checkany(L, 2); lua_settop(L, 2); lua_setuservalue(L, 1); return 1; } /* ** Auxiliary function used by several library functions: check for ** an optional thread as function's first argument and set 'arg' with ** 1 if this argument is present (so that functions can skip it to ** access their other arguments) */ static lua_State *getthread (lua_State *L, int *arg) { if (lua_isthread(L, 1)) { *arg = 1; return lua_tothread(L, 1); } else { *arg = 0; return L; /* function will operate over current thread */ } } /* ** Variations of 'lua_settable', used by 'db_getinfo' to put results ** from 'lua_getinfo' into result table. Key is always a string; ** value can be a string, an int, or a boolean. */ static void settabss (lua_State *L, const char *k, const char *v) { lua_pushstring(L, v); lua_setfield(L, -2, k); } static void settabsi (lua_State *L, const char *k, int v) { lua_pushinteger(L, v); lua_setfield(L, -2, k); } static void settabsb (lua_State *L, const char *k, int v) { lua_pushboolean(L, v); lua_setfield(L, -2, k); } /* ** In function 'db_getinfo', the call to 'lua_getinfo' may push ** results on the stack; later it creates the result table to put ** these objects. Function 'treatstackoption' puts the result from ** 'lua_getinfo' on top of the result table so that it can call ** 'lua_setfield'. */ static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) { if (L == L1) lua_rotate(L, -2, 1); /* exchange object and table */ else lua_xmove(L1, L, 1); /* move object to the "main" stack */ lua_setfield(L, -2, fname); /* put object into table */ } /* ** Calls 'lua_getinfo' and collects all results in a new table. ** L1 needs stack space for an optional input (function) plus ** two optional outputs (function and line table) from function ** 'lua_getinfo'. */ static int db_getinfo (lua_State *L) { lua_Debug ar; int arg; lua_State *L1 = getthread(L, &arg); const char *options = luaL_optstring(L, arg+2, "flnStu"); checkstack(L, L1, 3); if (lua_isfunction(L, arg + 1)) { /* info about a function? */ options = lua_pushfstring(L, ">%s", options); /* add '>' to 'options' */ lua_pushvalue(L, arg + 1); /* move function to 'L1' stack */ lua_xmove(L, L1, 1); } else { /* stack level */ if (!lua_getstack(L1, (int)luaL_checkinteger(L, arg + 1), &ar)) { lua_pushnil(L); /* level out of range */ return 1; } } if (!lua_getinfo(L1, options, &ar)) return luaL_argerror(L, arg+2, "invalid option"); lua_newtable(L); /* table to collect results */ if (strchr(options, 'S')) { settabss(L, "source", ar.source); settabss(L, "short_src", ar.short_src); settabsi(L, "linedefined", ar.linedefined); settabsi(L, "lastlinedefined", ar.lastlinedefined); settabss(L, "what", ar.what); } if (strchr(options, 'l')) settabsi(L, "currentline", ar.currentline); if (strchr(options, 'u')) { settabsi(L, "nups", ar.nups); settabsi(L, "nparams", ar.nparams); settabsb(L, "isvararg", ar.isvararg); } if (strchr(options, 'n')) { settabss(L, "name", ar.name); settabss(L, "namewhat", ar.namewhat); } if (strchr(options, 't')) settabsb(L, "istailcall", ar.istailcall); if (strchr(options, 'L')) treatstackoption(L, L1, "activelines"); if (strchr(options, 'f')) treatstackoption(L, L1, "func"); return 1; /* return table */ } static int db_getlocal (lua_State *L) { int arg; lua_State *L1 = getthread(L, &arg); lua_Debug ar; const char *name; int nvar = (int)luaL_checkinteger(L, arg + 2); /* local-variable index */ if (lua_isfunction(L, arg + 1)) { /* function argument? */ lua_pushvalue(L, arg + 1); /* push function */ lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */ return 1; /* return only name (there is no value) */ } else { /* stack-level argument */ int level = (int)luaL_checkinteger(L, arg + 1); if (!lua_getstack(L1, level, &ar)) /* out of range? */ return luaL_argerror(L, arg+1, "level out of range"); checkstack(L, L1, 1); name = lua_getlocal(L1, &ar, nvar); if (name) { lua_xmove(L1, L, 1); /* move local value */ lua_pushstring(L, name); /* push name */ lua_rotate(L, -2, 1); /* re-order */ return 2; } else { lua_pushnil(L); /* no name (nor value) */ return 1; } } } static int db_setlocal (lua_State *L) { int arg; const char *name; lua_State *L1 = getthread(L, &arg); lua_Debug ar; int level = (int)luaL_checkinteger(L, arg + 1); int nvar = (int)luaL_checkinteger(L, arg + 2); if (!lua_getstack(L1, level, &ar)) /* out of range? */ return luaL_argerror(L, arg+1, "level out of range"); luaL_checkany(L, arg+3); lua_settop(L, arg+3); checkstack(L, L1, 1); lua_xmove(L, L1, 1); name = lua_setlocal(L1, &ar, nvar); if (name == NULL) lua_pop(L1, 1); /* pop value (if not popped by 'lua_setlocal') */ lua_pushstring(L, name); return 1; } /* ** get (if 'get' is true) or set an upvalue from a closure */ static int auxupvalue (lua_State *L, int get) { const char *name; int n = (int)luaL_checkinteger(L, 2); /* upvalue index */ luaL_checktype(L, 1, LUA_TFUNCTION); /* closure */ name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n); if (name == NULL) return 0; lua_pushstring(L, name); lua_insert(L, -(get+1)); /* no-op if get is false */ return get + 1; } static int db_getupvalue (lua_State *L) { return auxupvalue(L, 1); } static int db_setupvalue (lua_State *L) { luaL_checkany(L, 3); return auxupvalue(L, 0); } /* ** Check whether a given upvalue from a given closure exists and ** returns its index */ static int checkupval (lua_State *L, int argf, int argnup) { int nup = (int)luaL_checkinteger(L, argnup); /* upvalue index */ luaL_checktype(L, argf, LUA_TFUNCTION); /* closure */ luaL_argcheck(L, (lua_getupvalue(L, argf, nup) != NULL), argnup, "invalid upvalue index"); return nup; } static int db_upvalueid (lua_State *L) { int n = checkupval(L, 1, 2); lua_pushlightuserdata(L, lua_upvalueid(L, 1, n)); return 1; } static int db_upvaluejoin (lua_State *L) { int n1 = checkupval(L, 1, 2); int n2 = checkupval(L, 3, 4); luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected"); luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected"); lua_upvaluejoin(L, 1, n1, 3, n2); return 0; } /* ** Call hook function registered at hook table for the current ** thread (if there is one) */ static void hookf (lua_State *L, lua_Debug *ar) { static const char *const hooknames[] = {"call", "return", "line", "count", "tail call"}; lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY); lua_pushthread(L); if (lua_rawget(L, -2) == LUA_TFUNCTION) { /* is there a hook function? */ lua_pushstring(L, hooknames[(int)ar->event]); /* push event name */ if (ar->currentline >= 0) lua_pushinteger(L, ar->currentline); /* push current line */ else lua_pushnil(L); lua_assert(lua_getinfo(L, "lS", ar)); lua_call(L, 2, 0); /* call hook function */ } } /* ** Convert a string mask (for 'sethook') into a bit mask */ static int makemask (const char *smask, int count) { int mask = 0; if (strchr(smask, 'c')) mask |= LUA_MASKCALL; if (strchr(smask, 'r')) mask |= LUA_MASKRET; if (strchr(smask, 'l')) mask |= LUA_MASKLINE; if (count > 0) mask |= LUA_MASKCOUNT; return mask; } /* ** Convert a bit mask (for 'gethook') into a string mask */ static char *unmakemask (int mask, char *smask) { int i = 0; if (mask & LUA_MASKCALL) smask[i++] = 'c'; if (mask & LUA_MASKRET) smask[i++] = 'r'; if (mask & LUA_MASKLINE) smask[i++] = 'l'; smask[i] = '\0'; return smask; } static int db_sethook (lua_State *L) { int arg, mask, count; lua_Hook func; lua_State *L1 = getthread(L, &arg); if (lua_isnoneornil(L, arg+1)) { /* no hook? */ lua_settop(L, arg+1); func = NULL; mask = 0; count = 0; /* turn off hooks */ } else { const char *smask = luaL_checkstring(L, arg+2); luaL_checktype(L, arg+1, LUA_TFUNCTION); count = (int)luaL_optinteger(L, arg + 3, 0); func = hookf; mask = makemask(smask, count); } if (lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY) == LUA_TNIL) { lua_createtable(L, 0, 2); /* create a hook table */ lua_pushvalue(L, -1); lua_rawsetp(L, LUA_REGISTRYINDEX, &HOOKKEY); /* set it in position */ lua_pushstring(L, "k"); lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */ lua_pushvalue(L, -1); lua_setmetatable(L, -2); /* setmetatable(hooktable) = hooktable */ } checkstack(L, L1, 1); lua_pushthread(L1); lua_xmove(L1, L, 1); /* key (thread) */ lua_pushvalue(L, arg + 1); /* value (hook function) */ lua_rawset(L, -3); /* hooktable[L1] = new Lua hook */ lua_sethook(L1, func, mask, count); return 0; } static int db_gethook (lua_State *L) { int arg; lua_State *L1 = getthread(L, &arg); char buff[5]; int mask = lua_gethookmask(L1); lua_Hook hook = lua_gethook(L1); if (hook == NULL) /* no hook? */ lua_pushnil(L); else if (hook != hookf) /* external hook? */ lua_pushliteral(L, "external hook"); else { /* hook table must exist */ lua_rawgetp(L, LUA_REGISTRYINDEX, &HOOKKEY); checkstack(L, L1, 1); lua_pushthread(L1); lua_xmove(L1, L, 1); lua_rawget(L, -2); /* 1st result = hooktable[L1] */ lua_remove(L, -2); /* remove hook table */ } lua_pushstring(L, unmakemask(mask, buff)); /* 2nd result = mask */ lua_pushinteger(L, lua_gethookcount(L1)); /* 3rd result = count */ return 3; } static int db_debug (lua_State *L) { for (;;) { char buffer[250]; lua_writestringerror("%s", "lua_debug> "); if (fgets(buffer, sizeof(buffer), stdin) == 0 || strcmp(buffer, "cont\n") == 0) return 0; if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") || lua_pcall(L, 0, 0, 0)) lua_writestringerror("%s\n", lua_tostring(L, -1)); lua_settop(L, 0); /* remove eventual returns */ } } static int db_traceback (lua_State *L) { int arg; lua_State *L1 = getthread(L, &arg); const char *msg = lua_tostring(L, arg + 1); if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */ lua_pushvalue(L, arg + 1); /* return it untouched */ else { int level = (int)luaL_optinteger(L, arg + 2, (L == L1) ? 1 : 0); luaL_traceback(L, L1, msg, level); } return 1; } static const luaL_Reg dblib[] = { {"debug", db_debug}, {"getuservalue", db_getuservalue}, {"gethook", db_gethook}, {"getinfo", db_getinfo}, {"getlocal", db_getlocal}, {"getregistry", db_getregistry}, {"getmetatable", db_getmetatable}, {"getupvalue", db_getupvalue}, {"upvaluejoin", db_upvaluejoin}, {"upvalueid", db_upvalueid}, {"setuservalue", db_setuservalue}, {"sethook", db_sethook}, {"setlocal", db_setlocal}, {"setmetatable", db_setmetatable}, {"setupvalue", db_setupvalue}, {"traceback", db_traceback}, {NULL, NULL} }; LUAMOD_API int luaopen_debug (lua_State *L) { luaL_newlib(L, dblib); return 1; } wcc-0.0.2/src/wsh/lua/src/llex.h0000644000175000017500000000441413110675433015022 0ustar philphil/* ** $Id: llex.h,v 1.78 2014/10/29 15:38:24 roberto Exp $ ** Lexical Analyzer ** See Copyright Notice in lua.h */ #ifndef llex_h #define llex_h #include "lobject.h" #include "lzio.h" #define FIRST_RESERVED 257 #if !defined(LUA_ENV) #define LUA_ENV "_ENV" #endif /* * WARNING: if you change the order of this enumeration, * grep "ORDER RESERVED" */ enum RESERVED { /* terminal symbols denoted by reserved words */ TK_AND = FIRST_RESERVED, TK_BREAK, TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION, TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT, TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE, /* other terminal symbols */ TK_IDIV, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_SHL, TK_SHR, TK_DBCOLON, TK_EOS, TK_FLT, TK_INT, TK_NAME, TK_STRING }; /* number of reserved words */ #define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1)) typedef union { lua_Number r; lua_Integer i; TString *ts; } SemInfo; /* semantics information */ typedef struct Token { int token; SemInfo seminfo; } Token; /* state of the lexer plus state of the parser when shared by all functions */ typedef struct LexState { int current; /* current character (charint) */ int linenumber; /* input line counter */ int lastline; /* line of last token 'consumed' */ Token t; /* current token */ Token lookahead; /* look ahead token */ struct FuncState *fs; /* current function (parser) */ struct lua_State *L; ZIO *z; /* input stream */ Mbuffer *buff; /* buffer for tokens */ Table *h; /* to avoid collection/reuse strings */ struct Dyndata *dyd; /* dynamic structures used by the parser */ TString *source; /* current source name */ TString *envn; /* environment variable name */ char decpoint; /* locale decimal point */ } LexState; LUAI_FUNC void luaX_init (lua_State *L); LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source, int firstchar); LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l); LUAI_FUNC void luaX_next (LexState *ls); LUAI_FUNC int luaX_lookahead (LexState *ls); LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s); LUAI_FUNC const char *luaX_token2str (LexState *ls, int token); #endif wcc-0.0.2/src/wsh/lua/src/lparser.c0000644000175000017500000013235613110675433015530 0ustar philphil/* ** $Id: lparser.c,v 2.149 2015/11/02 16:09:30 roberto Exp $ ** Lua Parser ** See Copyright Notice in lua.h */ #define lparser_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "lcode.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "llex.h" #include "lmem.h" #include "lobject.h" #include "lopcodes.h" #include "lparser.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" /* maximum number of local variables per function (must be smaller than 250, due to the bytecode format) */ #define MAXVARS 200 #define hasmultret(k) ((k) == VCALL || (k) == VVARARG) /* because all strings are unified by the scanner, the parser can use pointer equality for string equality */ #define eqstr(a,b) ((a) == (b)) /* ** nodes for block list (list of active blocks) */ typedef struct BlockCnt { struct BlockCnt *previous; /* chain */ int firstlabel; /* index of first label in this block */ int firstgoto; /* index of first pending goto in this block */ lu_byte nactvar; /* # active locals outside the block */ lu_byte upval; /* true if some variable in the block is an upvalue */ lu_byte isloop; /* true if 'block' is a loop */ } BlockCnt; /* ** prototypes for recursive non-terminal functions */ static void statement (LexState *ls); static void expr (LexState *ls, expdesc *v); /* semantic error */ static l_noret semerror (LexState *ls, const char *msg) { ls->t.token = 0; /* remove "near " from final message */ luaX_syntaxerror(ls, msg); } static l_noret error_expected (LexState *ls, int token) { luaX_syntaxerror(ls, luaO_pushfstring(ls->L, "%s expected", luaX_token2str(ls, token))); } static l_noret errorlimit (FuncState *fs, int limit, const char *what) { lua_State *L = fs->ls->L; const char *msg; int line = fs->f->linedefined; const char *where = (line == 0) ? "main function" : luaO_pushfstring(L, "function at line %d", line); msg = luaO_pushfstring(L, "too many %s (limit is %d) in %s", what, limit, where); luaX_syntaxerror(fs->ls, msg); } static void checklimit (FuncState *fs, int v, int l, const char *what) { if (v > l) errorlimit(fs, l, what); } static int testnext (LexState *ls, int c) { if (ls->t.token == c) { luaX_next(ls); return 1; } else return 0; } static void check (LexState *ls, int c) { if (ls->t.token != c) error_expected(ls, c); } static void checknext (LexState *ls, int c) { check(ls, c); luaX_next(ls); } #define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); } static void check_match (LexState *ls, int what, int who, int where) { if (!testnext(ls, what)) { if (where == ls->linenumber) error_expected(ls, what); else { luaX_syntaxerror(ls, luaO_pushfstring(ls->L, "%s expected (to close %s at line %d)", luaX_token2str(ls, what), luaX_token2str(ls, who), where)); } } } static TString *str_checkname (LexState *ls) { TString *ts; check(ls, TK_NAME); ts = ls->t.seminfo.ts; luaX_next(ls); return ts; } static void init_exp (expdesc *e, expkind k, int i) { e->f = e->t = NO_JUMP; e->k = k; e->u.info = i; } static void codestring (LexState *ls, expdesc *e, TString *s) { init_exp(e, VK, luaK_stringK(ls->fs, s)); } static void checkname (LexState *ls, expdesc *e) { codestring(ls, e, str_checkname(ls)); } static int registerlocalvar (LexState *ls, TString *varname) { FuncState *fs = ls->fs; Proto *f = fs->f; int oldsize = f->sizelocvars; luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars, LocVar, SHRT_MAX, "local variables"); while (oldsize < f->sizelocvars) f->locvars[oldsize++].varname = NULL; f->locvars[fs->nlocvars].varname = varname; luaC_objbarrier(ls->L, f, varname); return fs->nlocvars++; } static void new_localvar (LexState *ls, TString *name) { FuncState *fs = ls->fs; Dyndata *dyd = ls->dyd; int reg = registerlocalvar(ls, name); checklimit(fs, dyd->actvar.n + 1 - fs->firstlocal, MAXVARS, "local variables"); luaM_growvector(ls->L, dyd->actvar.arr, dyd->actvar.n + 1, dyd->actvar.size, Vardesc, MAX_INT, "local variables"); dyd->actvar.arr[dyd->actvar.n++].idx = cast(short, reg); } static void new_localvarliteral_ (LexState *ls, const char *name, size_t sz) { new_localvar(ls, luaX_newstring(ls, name, sz)); } #define new_localvarliteral(ls,v) \ new_localvarliteral_(ls, "" v, (sizeof(v)/sizeof(char))-1) static LocVar *getlocvar (FuncState *fs, int i) { int idx = fs->ls->dyd->actvar.arr[fs->firstlocal + i].idx; lua_assert(idx < fs->nlocvars); return &fs->f->locvars[idx]; } static void adjustlocalvars (LexState *ls, int nvars) { FuncState *fs = ls->fs; fs->nactvar = cast_byte(fs->nactvar + nvars); for (; nvars; nvars--) { getlocvar(fs, fs->nactvar - nvars)->startpc = fs->pc; } } static void removevars (FuncState *fs, int tolevel) { fs->ls->dyd->actvar.n -= (fs->nactvar - tolevel); while (fs->nactvar > tolevel) getlocvar(fs, --fs->nactvar)->endpc = fs->pc; } static int searchupvalue (FuncState *fs, TString *name) { int i; Upvaldesc *up = fs->f->upvalues; for (i = 0; i < fs->nups; i++) { if (eqstr(up[i].name, name)) return i; } return -1; /* not found */ } static int newupvalue (FuncState *fs, TString *name, expdesc *v) { Proto *f = fs->f; int oldsize = f->sizeupvalues; checklimit(fs, fs->nups + 1, MAXUPVAL, "upvalues"); luaM_growvector(fs->ls->L, f->upvalues, fs->nups, f->sizeupvalues, Upvaldesc, MAXUPVAL, "upvalues"); while (oldsize < f->sizeupvalues) f->upvalues[oldsize++].name = NULL; f->upvalues[fs->nups].instack = (v->k == VLOCAL); f->upvalues[fs->nups].idx = cast_byte(v->u.info); f->upvalues[fs->nups].name = name; luaC_objbarrier(fs->ls->L, f, name); return fs->nups++; } static int searchvar (FuncState *fs, TString *n) { int i; for (i = cast_int(fs->nactvar) - 1; i >= 0; i--) { if (eqstr(n, getlocvar(fs, i)->varname)) return i; } return -1; /* not found */ } /* Mark block where variable at given level was defined (to emit close instructions later). */ static void markupval (FuncState *fs, int level) { BlockCnt *bl = fs->bl; while (bl->nactvar > level) bl = bl->previous; bl->upval = 1; } /* Find variable with given name 'n'. If it is an upvalue, add this upvalue into all intermediate functions. */ static int singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) { if (fs == NULL) /* no more levels? */ return VVOID; /* default is global */ else { int v = searchvar(fs, n); /* look up locals at current level */ if (v >= 0) { /* found? */ init_exp(var, VLOCAL, v); /* variable is local */ if (!base) markupval(fs, v); /* local will be used as an upval */ return VLOCAL; } else { /* not found as local at current level; try upvalues */ int idx = searchupvalue(fs, n); /* try existing upvalues */ if (idx < 0) { /* not found? */ if (singlevaraux(fs->prev, n, var, 0) == VVOID) /* try upper levels */ return VVOID; /* not found; is a global */ /* else was LOCAL or UPVAL */ idx = newupvalue(fs, n, var); /* will be a new upvalue */ } init_exp(var, VUPVAL, idx); return VUPVAL; } } } static void singlevar (LexState *ls, expdesc *var) { TString *varname = str_checkname(ls); FuncState *fs = ls->fs; if (singlevaraux(fs, varname, var, 1) == VVOID) { /* global name? */ expdesc key; singlevaraux(fs, ls->envn, var, 1); /* get environment variable */ lua_assert(var->k == VLOCAL || var->k == VUPVAL); codestring(ls, &key, varname); /* key is variable name */ luaK_indexed(fs, var, &key); /* env[varname] */ } } static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) { FuncState *fs = ls->fs; int extra = nvars - nexps; if (hasmultret(e->k)) { extra++; /* includes call itself */ if (extra < 0) extra = 0; luaK_setreturns(fs, e, extra); /* last exp. provides the difference */ if (extra > 1) luaK_reserveregs(fs, extra-1); } else { if (e->k != VVOID) luaK_exp2nextreg(fs, e); /* close last expression */ if (extra > 0) { int reg = fs->freereg; luaK_reserveregs(fs, extra); luaK_nil(fs, reg, extra); } } } static void enterlevel (LexState *ls) { lua_State *L = ls->L; ++L->nCcalls; checklimit(ls->fs, L->nCcalls, LUAI_MAXCCALLS, "C levels"); } #define leavelevel(ls) ((ls)->L->nCcalls--) static void closegoto (LexState *ls, int g, Labeldesc *label) { int i; FuncState *fs = ls->fs; Labellist *gl = &ls->dyd->gt; Labeldesc *gt = &gl->arr[g]; lua_assert(eqstr(gt->name, label->name)); if (gt->nactvar < label->nactvar) { TString *vname = getlocvar(fs, gt->nactvar)->varname; const char *msg = luaO_pushfstring(ls->L, " at line %d jumps into the scope of local '%s'", getstr(gt->name), gt->line, getstr(vname)); semerror(ls, msg); } luaK_patchlist(fs, gt->pc, label->pc); /* remove goto from pending list */ for (i = g; i < gl->n - 1; i++) gl->arr[i] = gl->arr[i + 1]; gl->n--; } /* ** try to close a goto with existing labels; this solves backward jumps */ static int findlabel (LexState *ls, int g) { int i; BlockCnt *bl = ls->fs->bl; Dyndata *dyd = ls->dyd; Labeldesc *gt = &dyd->gt.arr[g]; /* check labels in current block for a match */ for (i = bl->firstlabel; i < dyd->label.n; i++) { Labeldesc *lb = &dyd->label.arr[i]; if (eqstr(lb->name, gt->name)) { /* correct label? */ if (gt->nactvar > lb->nactvar && (bl->upval || dyd->label.n > bl->firstlabel)) luaK_patchclose(ls->fs, gt->pc, lb->nactvar); closegoto(ls, g, lb); /* close it */ return 1; } } return 0; /* label not found; cannot close goto */ } static int newlabelentry (LexState *ls, Labellist *l, TString *name, int line, int pc) { int n = l->n; luaM_growvector(ls->L, l->arr, n, l->size, Labeldesc, SHRT_MAX, "labels/gotos"); l->arr[n].name = name; l->arr[n].line = line; l->arr[n].nactvar = ls->fs->nactvar; l->arr[n].pc = pc; l->n = n + 1; return n; } /* ** check whether new label 'lb' matches any pending gotos in current ** block; solves forward jumps */ static void findgotos (LexState *ls, Labeldesc *lb) { Labellist *gl = &ls->dyd->gt; int i = ls->fs->bl->firstgoto; while (i < gl->n) { if (eqstr(gl->arr[i].name, lb->name)) closegoto(ls, i, lb); else i++; } } /* ** export pending gotos to outer level, to check them against ** outer labels; if the block being exited has upvalues, and ** the goto exits the scope of any variable (which can be the ** upvalue), close those variables being exited. */ static void movegotosout (FuncState *fs, BlockCnt *bl) { int i = bl->firstgoto; Labellist *gl = &fs->ls->dyd->gt; /* correct pending gotos to current block and try to close it with visible labels */ while (i < gl->n) { Labeldesc *gt = &gl->arr[i]; if (gt->nactvar > bl->nactvar) { if (bl->upval) luaK_patchclose(fs, gt->pc, bl->nactvar); gt->nactvar = bl->nactvar; } if (!findlabel(fs->ls, i)) i++; /* move to next one */ } } static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isloop) { bl->isloop = isloop; bl->nactvar = fs->nactvar; bl->firstlabel = fs->ls->dyd->label.n; bl->firstgoto = fs->ls->dyd->gt.n; bl->upval = 0; bl->previous = fs->bl; fs->bl = bl; lua_assert(fs->freereg == fs->nactvar); } /* ** create a label named 'break' to resolve break statements */ static void breaklabel (LexState *ls) { TString *n = luaS_new(ls->L, "break"); int l = newlabelentry(ls, &ls->dyd->label, n, 0, ls->fs->pc); findgotos(ls, &ls->dyd->label.arr[l]); } /* ** generates an error for an undefined 'goto'; choose appropriate ** message when label name is a reserved word (which can only be 'break') */ static l_noret undefgoto (LexState *ls, Labeldesc *gt) { const char *msg = isreserved(gt->name) ? "<%s> at line %d not inside a loop" : "no visible label '%s' for at line %d"; msg = luaO_pushfstring(ls->L, msg, getstr(gt->name), gt->line); semerror(ls, msg); } static void leaveblock (FuncState *fs) { BlockCnt *bl = fs->bl; LexState *ls = fs->ls; if (bl->previous && bl->upval) { /* create a 'jump to here' to close upvalues */ int j = luaK_jump(fs); luaK_patchclose(fs, j, bl->nactvar); luaK_patchtohere(fs, j); } if (bl->isloop) breaklabel(ls); /* close pending breaks */ fs->bl = bl->previous; removevars(fs, bl->nactvar); lua_assert(bl->nactvar == fs->nactvar); fs->freereg = fs->nactvar; /* free registers */ ls->dyd->label.n = bl->firstlabel; /* remove local labels */ if (bl->previous) /* inner block? */ movegotosout(fs, bl); /* update pending gotos to outer block */ else if (bl->firstgoto < ls->dyd->gt.n) /* pending gotos in outer block? */ undefgoto(ls, &ls->dyd->gt.arr[bl->firstgoto]); /* error */ } /* ** adds a new prototype into list of prototypes */ static Proto *addprototype (LexState *ls) { Proto *clp; lua_State *L = ls->L; FuncState *fs = ls->fs; Proto *f = fs->f; /* prototype of current function */ if (fs->np >= f->sizep) { int oldsize = f->sizep; luaM_growvector(L, f->p, fs->np, f->sizep, Proto *, MAXARG_Bx, "functions"); while (oldsize < f->sizep) f->p[oldsize++] = NULL; } f->p[fs->np++] = clp = luaF_newproto(L); luaC_objbarrier(L, f, clp); return clp; } /* ** codes instruction to create new closure in parent function. ** The OP_CLOSURE instruction must use the last available register, ** so that, if it invokes the GC, the GC knows which registers ** are in use at that time. */ static void codeclosure (LexState *ls, expdesc *v) { FuncState *fs = ls->fs->prev; init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np - 1)); luaK_exp2nextreg(fs, v); /* fix it at the last register */ } static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) { Proto *f; fs->prev = ls->fs; /* linked list of funcstates */ fs->ls = ls; ls->fs = fs; fs->pc = 0; fs->lasttarget = 0; fs->jpc = NO_JUMP; fs->freereg = 0; fs->nk = 0; fs->np = 0; fs->nups = 0; fs->nlocvars = 0; fs->nactvar = 0; fs->firstlocal = ls->dyd->actvar.n; fs->bl = NULL; f = fs->f; f->source = ls->source; f->maxstacksize = 2; /* registers 0/1 are always valid */ enterblock(fs, bl, 0); } static void close_func (LexState *ls) { lua_State *L = ls->L; FuncState *fs = ls->fs; Proto *f = fs->f; luaK_ret(fs, 0, 0); /* final return */ leaveblock(fs); luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction); f->sizecode = fs->pc; luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int); f->sizelineinfo = fs->pc; luaM_reallocvector(L, f->k, f->sizek, fs->nk, TValue); f->sizek = fs->nk; luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *); f->sizep = fs->np; luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar); f->sizelocvars = fs->nlocvars; luaM_reallocvector(L, f->upvalues, f->sizeupvalues, fs->nups, Upvaldesc); f->sizeupvalues = fs->nups; lua_assert(fs->bl == NULL); ls->fs = fs->prev; luaC_checkGC(L); } /*============================================================*/ /* GRAMMAR RULES */ /*============================================================*/ /* ** check whether current token is in the follow set of a block. ** 'until' closes syntactical blocks, but do not close scope, ** so it is handled in separate. */ static int block_follow (LexState *ls, int withuntil) { switch (ls->t.token) { case TK_ELSE: case TK_ELSEIF: case TK_END: case TK_EOS: return 1; case TK_UNTIL: return withuntil; default: return 0; } } static void statlist (LexState *ls) { /* statlist -> { stat [';'] } */ while (!block_follow(ls, 1)) { if (ls->t.token == TK_RETURN) { statement(ls); return; /* 'return' must be last statement */ } statement(ls); } } static void fieldsel (LexState *ls, expdesc *v) { /* fieldsel -> ['.' | ':'] NAME */ FuncState *fs = ls->fs; expdesc key; luaK_exp2anyregup(fs, v); luaX_next(ls); /* skip the dot or colon */ checkname(ls, &key); luaK_indexed(fs, v, &key); } static void yindex (LexState *ls, expdesc *v) { /* index -> '[' expr ']' */ luaX_next(ls); /* skip the '[' */ expr(ls, v); luaK_exp2val(ls->fs, v); checknext(ls, ']'); } /* ** {====================================================================== ** Rules for Constructors ** ======================================================================= */ struct ConsControl { expdesc v; /* last list item read */ expdesc *t; /* table descriptor */ int nh; /* total number of 'record' elements */ int na; /* total number of array elements */ int tostore; /* number of array elements pending to be stored */ }; static void recfield (LexState *ls, struct ConsControl *cc) { /* recfield -> (NAME | '['exp1']') = exp1 */ FuncState *fs = ls->fs; int reg = ls->fs->freereg; expdesc key, val; int rkkey; if (ls->t.token == TK_NAME) { checklimit(fs, cc->nh, MAX_INT, "items in a constructor"); checkname(ls, &key); } else /* ls->t.token == '[' */ yindex(ls, &key); cc->nh++; checknext(ls, '='); rkkey = luaK_exp2RK(fs, &key); expr(ls, &val); luaK_codeABC(fs, OP_SETTABLE, cc->t->u.info, rkkey, luaK_exp2RK(fs, &val)); fs->freereg = reg; /* free registers */ } static void closelistfield (FuncState *fs, struct ConsControl *cc) { if (cc->v.k == VVOID) return; /* there is no list item */ luaK_exp2nextreg(fs, &cc->v); cc->v.k = VVOID; if (cc->tostore == LFIELDS_PER_FLUSH) { luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); /* flush */ cc->tostore = 0; /* no more items pending */ } } static void lastlistfield (FuncState *fs, struct ConsControl *cc) { if (cc->tostore == 0) return; if (hasmultret(cc->v.k)) { luaK_setmultret(fs, &cc->v); luaK_setlist(fs, cc->t->u.info, cc->na, LUA_MULTRET); cc->na--; /* do not count last expression (unknown number of elements) */ } else { if (cc->v.k != VVOID) luaK_exp2nextreg(fs, &cc->v); luaK_setlist(fs, cc->t->u.info, cc->na, cc->tostore); } } static void listfield (LexState *ls, struct ConsControl *cc) { /* listfield -> exp */ expr(ls, &cc->v); checklimit(ls->fs, cc->na, MAX_INT, "items in a constructor"); cc->na++; cc->tostore++; } static void field (LexState *ls, struct ConsControl *cc) { /* field -> listfield | recfield */ switch(ls->t.token) { case TK_NAME: { /* may be 'listfield' or 'recfield' */ if (luaX_lookahead(ls) != '=') /* expression? */ listfield(ls, cc); else recfield(ls, cc); break; } case '[': { recfield(ls, cc); break; } default: { listfield(ls, cc); break; } } } static void constructor (LexState *ls, expdesc *t) { /* constructor -> '{' [ field { sep field } [sep] ] '}' sep -> ',' | ';' */ FuncState *fs = ls->fs; int line = ls->linenumber; int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0); struct ConsControl cc; cc.na = cc.nh = cc.tostore = 0; cc.t = t; init_exp(t, VRELOCABLE, pc); init_exp(&cc.v, VVOID, 0); /* no value (yet) */ luaK_exp2nextreg(ls->fs, t); /* fix it at stack top */ checknext(ls, '{'); do { lua_assert(cc.v.k == VVOID || cc.tostore > 0); if (ls->t.token == '}') break; closelistfield(fs, &cc); field(ls, &cc); } while (testnext(ls, ',') || testnext(ls, ';')); check_match(ls, '}', '{', line); lastlistfield(fs, &cc); SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */ SETARG_C(fs->f->code[pc], luaO_int2fb(cc.nh)); /* set initial table size */ } /* }====================================================================== */ static void parlist (LexState *ls) { /* parlist -> [ param { ',' param } ] */ FuncState *fs = ls->fs; Proto *f = fs->f; int nparams = 0; f->is_vararg = 0; if (ls->t.token != ')') { /* is 'parlist' not empty? */ do { switch (ls->t.token) { case TK_NAME: { /* param -> NAME */ new_localvar(ls, str_checkname(ls)); nparams++; break; } case TK_DOTS: { /* param -> '...' */ luaX_next(ls); f->is_vararg = 2; /* declared vararg */ break; } default: luaX_syntaxerror(ls, " or '...' expected"); } } while (!f->is_vararg && testnext(ls, ',')); } adjustlocalvars(ls, nparams); f->numparams = cast_byte(fs->nactvar); luaK_reserveregs(fs, fs->nactvar); /* reserve register for parameters */ } static void body (LexState *ls, expdesc *e, int ismethod, int line) { /* body -> '(' parlist ')' block END */ FuncState new_fs; BlockCnt bl; new_fs.f = addprototype(ls); new_fs.f->linedefined = line; open_func(ls, &new_fs, &bl); checknext(ls, '('); if (ismethod) { new_localvarliteral(ls, "self"); /* create 'self' parameter */ adjustlocalvars(ls, 1); } parlist(ls); checknext(ls, ')'); statlist(ls); new_fs.f->lastlinedefined = ls->linenumber; check_match(ls, TK_END, TK_FUNCTION, line); codeclosure(ls, e); close_func(ls); } static int explist (LexState *ls, expdesc *v) { /* explist -> expr { ',' expr } */ int n = 1; /* at least one expression */ expr(ls, v); while (testnext(ls, ',')) { luaK_exp2nextreg(ls->fs, v); expr(ls, v); n++; } return n; } static void funcargs (LexState *ls, expdesc *f, int line) { FuncState *fs = ls->fs; expdesc args; int base, nparams; switch (ls->t.token) { case '(': { /* funcargs -> '(' [ explist ] ')' */ luaX_next(ls); if (ls->t.token == ')') /* arg list is empty? */ args.k = VVOID; else { explist(ls, &args); luaK_setmultret(fs, &args); } check_match(ls, ')', '(', line); break; } case '{': { /* funcargs -> constructor */ constructor(ls, &args); break; } case TK_STRING: { /* funcargs -> STRING */ codestring(ls, &args, ls->t.seminfo.ts); luaX_next(ls); /* must use 'seminfo' before 'next' */ break; } default: { luaX_syntaxerror(ls, "function arguments expected"); } } lua_assert(f->k == VNONRELOC); base = f->u.info; /* base register for call */ if (hasmultret(args.k)) nparams = LUA_MULTRET; /* open call */ else { if (args.k != VVOID) luaK_exp2nextreg(fs, &args); /* close last argument */ nparams = fs->freereg - (base+1); } init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2)); luaK_fixline(fs, line); fs->freereg = base+1; /* call remove function and arguments and leaves (unless changed) one result */ } /* ** {====================================================================== ** Expression parsing ** ======================================================================= */ static void primaryexp (LexState *ls, expdesc *v) { /* primaryexp -> NAME | '(' expr ')' */ switch (ls->t.token) { case '(': { int line = ls->linenumber; luaX_next(ls); expr(ls, v); check_match(ls, ')', '(', line); luaK_dischargevars(ls->fs, v); return; } case TK_NAME: { singlevar(ls, v); return; } default: { luaX_syntaxerror(ls, "unexpected symbol"); } } } static void suffixedexp (LexState *ls, expdesc *v) { /* suffixedexp -> primaryexp { '.' NAME | '[' exp ']' | ':' NAME funcargs | funcargs } */ FuncState *fs = ls->fs; int line = ls->linenumber; primaryexp(ls, v); for (;;) { switch (ls->t.token) { case '.': { /* fieldsel */ fieldsel(ls, v); break; } case '[': { /* '[' exp1 ']' */ expdesc key; luaK_exp2anyregup(fs, v); yindex(ls, &key); luaK_indexed(fs, v, &key); break; } case ':': { /* ':' NAME funcargs */ expdesc key; luaX_next(ls); checkname(ls, &key); luaK_self(fs, v, &key); funcargs(ls, v, line); break; } case '(': case TK_STRING: case '{': { /* funcargs */ luaK_exp2nextreg(fs, v); funcargs(ls, v, line); break; } default: return; } } } static void simpleexp (LexState *ls, expdesc *v) { /* simpleexp -> FLT | INT | STRING | NIL | TRUE | FALSE | ... | constructor | FUNCTION body | suffixedexp */ switch (ls->t.token) { case TK_FLT: { init_exp(v, VKFLT, 0); v->u.nval = ls->t.seminfo.r; break; } case TK_INT: { init_exp(v, VKINT, 0); v->u.ival = ls->t.seminfo.i; break; } case TK_STRING: { codestring(ls, v, ls->t.seminfo.ts); break; } case TK_NIL: { init_exp(v, VNIL, 0); break; } case TK_TRUE: { init_exp(v, VTRUE, 0); break; } case TK_FALSE: { init_exp(v, VFALSE, 0); break; } case TK_DOTS: { /* vararg */ FuncState *fs = ls->fs; check_condition(ls, fs->f->is_vararg, "cannot use '...' outside a vararg function"); fs->f->is_vararg = 1; /* function actually uses vararg */ init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 1, 0)); break; } case '{': { /* constructor */ constructor(ls, v); return; } case TK_FUNCTION: { luaX_next(ls); body(ls, v, 0, ls->linenumber); return; } default: { suffixedexp(ls, v); return; } } luaX_next(ls); } static UnOpr getunopr (int op) { switch (op) { case TK_NOT: return OPR_NOT; case '-': return OPR_MINUS; case '~': return OPR_BNOT; case '#': return OPR_LEN; default: return OPR_NOUNOPR; } } static BinOpr getbinopr (int op) { switch (op) { case '+': return OPR_ADD; case '-': return OPR_SUB; case '*': return OPR_MUL; case '%': return OPR_MOD; case '^': return OPR_POW; case '/': return OPR_DIV; case TK_IDIV: return OPR_IDIV; case '&': return OPR_BAND; case '|': return OPR_BOR; case '~': return OPR_BXOR; case TK_SHL: return OPR_SHL; case TK_SHR: return OPR_SHR; case TK_CONCAT: return OPR_CONCAT; case TK_NE: return OPR_NE; case TK_EQ: return OPR_EQ; case '<': return OPR_LT; case TK_LE: return OPR_LE; case '>': return OPR_GT; case TK_GE: return OPR_GE; case TK_AND: return OPR_AND; case TK_OR: return OPR_OR; default: return OPR_NOBINOPR; } } static const struct { lu_byte left; /* left priority for each binary operator */ lu_byte right; /* right priority */ } priority[] = { /* ORDER OPR */ {10, 10}, {10, 10}, /* '+' '-' */ {11, 11}, {11, 11}, /* '*' '%' */ {14, 13}, /* '^' (right associative) */ {11, 11}, {11, 11}, /* '/' '//' */ {6, 6}, {4, 4}, {5, 5}, /* '&' '|' '~' */ {7, 7}, {7, 7}, /* '<<' '>>' */ {9, 8}, /* '..' (right associative) */ {3, 3}, {3, 3}, {3, 3}, /* ==, <, <= */ {3, 3}, {3, 3}, {3, 3}, /* ~=, >, >= */ {2, 2}, {1, 1} /* and, or */ }; #define UNARY_PRIORITY 12 /* priority for unary operators */ /* ** subexpr -> (simpleexp | unop subexpr) { binop subexpr } ** where 'binop' is any binary operator with a priority higher than 'limit' */ static BinOpr subexpr (LexState *ls, expdesc *v, int limit) { BinOpr op; UnOpr uop; enterlevel(ls); uop = getunopr(ls->t.token); if (uop != OPR_NOUNOPR) { int line = ls->linenumber; luaX_next(ls); subexpr(ls, v, UNARY_PRIORITY); luaK_prefix(ls->fs, uop, v, line); } else simpleexp(ls, v); /* expand while operators have priorities higher than 'limit' */ op = getbinopr(ls->t.token); while (op != OPR_NOBINOPR && priority[op].left > limit) { expdesc v2; BinOpr nextop; int line = ls->linenumber; luaX_next(ls); luaK_infix(ls->fs, op, v); /* read sub-expression with higher priority */ nextop = subexpr(ls, &v2, priority[op].right); luaK_posfix(ls->fs, op, v, &v2, line); op = nextop; } leavelevel(ls); return op; /* return first untreated operator */ } static void expr (LexState *ls, expdesc *v) { subexpr(ls, v, 0); } /* }==================================================================== */ /* ** {====================================================================== ** Rules for Statements ** ======================================================================= */ static void block (LexState *ls) { /* block -> statlist */ FuncState *fs = ls->fs; BlockCnt bl; enterblock(fs, &bl, 0); statlist(ls); leaveblock(fs); } /* ** structure to chain all variables in the left-hand side of an ** assignment */ struct LHS_assign { struct LHS_assign *prev; expdesc v; /* variable (global, local, upvalue, or indexed) */ }; /* ** check whether, in an assignment to an upvalue/local variable, the ** upvalue/local variable is begin used in a previous assignment to a ** table. If so, save original upvalue/local value in a safe place and ** use this safe copy in the previous assignment. */ static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) { FuncState *fs = ls->fs; int extra = fs->freereg; /* eventual position to save local variable */ int conflict = 0; for (; lh; lh = lh->prev) { /* check all previous assignments */ if (lh->v.k == VINDEXED) { /* assigning to a table? */ /* table is the upvalue/local being assigned now? */ if (lh->v.u.ind.vt == v->k && lh->v.u.ind.t == v->u.info) { conflict = 1; lh->v.u.ind.vt = VLOCAL; lh->v.u.ind.t = extra; /* previous assignment will use safe copy */ } /* index is the local being assigned? (index cannot be upvalue) */ if (v->k == VLOCAL && lh->v.u.ind.idx == v->u.info) { conflict = 1; lh->v.u.ind.idx = extra; /* previous assignment will use safe copy */ } } } if (conflict) { /* copy upvalue/local value to a temporary (in position 'extra') */ OpCode op = (v->k == VLOCAL) ? OP_MOVE : OP_GETUPVAL; luaK_codeABC(fs, op, extra, v->u.info, 0); luaK_reserveregs(fs, 1); } } static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) { expdesc e; check_condition(ls, vkisvar(lh->v.k), "syntax error"); if (testnext(ls, ',')) { /* assignment -> ',' suffixedexp assignment */ struct LHS_assign nv; nv.prev = lh; suffixedexp(ls, &nv.v); if (nv.v.k != VINDEXED) check_conflict(ls, lh, &nv.v); checklimit(ls->fs, nvars + ls->L->nCcalls, LUAI_MAXCCALLS, "C levels"); assignment(ls, &nv, nvars+1); } else { /* assignment -> '=' explist */ int nexps; checknext(ls, '='); nexps = explist(ls, &e); if (nexps != nvars) { adjust_assign(ls, nvars, nexps, &e); if (nexps > nvars) ls->fs->freereg -= nexps - nvars; /* remove extra values */ } else { luaK_setoneret(ls->fs, &e); /* close last expression */ luaK_storevar(ls->fs, &lh->v, &e); return; /* avoid default */ } } init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */ luaK_storevar(ls->fs, &lh->v, &e); } static int cond (LexState *ls) { /* cond -> exp */ expdesc v; expr(ls, &v); /* read condition */ if (v.k == VNIL) v.k = VFALSE; /* 'falses' are all equal here */ luaK_goiftrue(ls->fs, &v); return v.f; } static void gotostat (LexState *ls, int pc) { int line = ls->linenumber; TString *label; int g; if (testnext(ls, TK_GOTO)) label = str_checkname(ls); else { luaX_next(ls); /* skip break */ label = luaS_new(ls->L, "break"); } g = newlabelentry(ls, &ls->dyd->gt, label, line, pc); findlabel(ls, g); /* close it if label already defined */ } /* check for repeated labels on the same block */ static void checkrepeated (FuncState *fs, Labellist *ll, TString *label) { int i; for (i = fs->bl->firstlabel; i < ll->n; i++) { if (eqstr(label, ll->arr[i].name)) { const char *msg = luaO_pushfstring(fs->ls->L, "label '%s' already defined on line %d", getstr(label), ll->arr[i].line); semerror(fs->ls, msg); } } } /* skip no-op statements */ static void skipnoopstat (LexState *ls) { while (ls->t.token == ';' || ls->t.token == TK_DBCOLON) statement(ls); } static void labelstat (LexState *ls, TString *label, int line) { /* label -> '::' NAME '::' */ FuncState *fs = ls->fs; Labellist *ll = &ls->dyd->label; int l; /* index of new label being created */ checkrepeated(fs, ll, label); /* check for repeated labels */ checknext(ls, TK_DBCOLON); /* skip double colon */ /* create new entry for this label */ l = newlabelentry(ls, ll, label, line, fs->pc); skipnoopstat(ls); /* skip other no-op statements */ if (block_follow(ls, 0)) { /* label is last no-op statement in the block? */ /* assume that locals are already out of scope */ ll->arr[l].nactvar = fs->bl->nactvar; } findgotos(ls, &ll->arr[l]); } static void whilestat (LexState *ls, int line) { /* whilestat -> WHILE cond DO block END */ FuncState *fs = ls->fs; int whileinit; int condexit; BlockCnt bl; luaX_next(ls); /* skip WHILE */ whileinit = luaK_getlabel(fs); condexit = cond(ls); enterblock(fs, &bl, 1); checknext(ls, TK_DO); block(ls); luaK_jumpto(fs, whileinit); check_match(ls, TK_END, TK_WHILE, line); leaveblock(fs); luaK_patchtohere(fs, condexit); /* false conditions finish the loop */ } static void repeatstat (LexState *ls, int line) { /* repeatstat -> REPEAT block UNTIL cond */ int condexit; FuncState *fs = ls->fs; int repeat_init = luaK_getlabel(fs); BlockCnt bl1, bl2; enterblock(fs, &bl1, 1); /* loop block */ enterblock(fs, &bl2, 0); /* scope block */ luaX_next(ls); /* skip REPEAT */ statlist(ls); check_match(ls, TK_UNTIL, TK_REPEAT, line); condexit = cond(ls); /* read condition (inside scope block) */ if (bl2.upval) /* upvalues? */ luaK_patchclose(fs, condexit, bl2.nactvar); leaveblock(fs); /* finish scope */ luaK_patchlist(fs, condexit, repeat_init); /* close the loop */ leaveblock(fs); /* finish loop */ } static int exp1 (LexState *ls) { expdesc e; int reg; expr(ls, &e); luaK_exp2nextreg(ls->fs, &e); lua_assert(e.k == VNONRELOC); reg = e.u.info; return reg; } static void forbody (LexState *ls, int base, int line, int nvars, int isnum) { /* forbody -> DO block */ BlockCnt bl; FuncState *fs = ls->fs; int prep, endfor; adjustlocalvars(ls, 3); /* control variables */ checknext(ls, TK_DO); prep = isnum ? luaK_codeAsBx(fs, OP_FORPREP, base, NO_JUMP) : luaK_jump(fs); enterblock(fs, &bl, 0); /* scope for declared variables */ adjustlocalvars(ls, nvars); luaK_reserveregs(fs, nvars); block(ls); leaveblock(fs); /* end of scope for declared variables */ luaK_patchtohere(fs, prep); if (isnum) /* numeric for? */ endfor = luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP); else { /* generic for */ luaK_codeABC(fs, OP_TFORCALL, base, 0, nvars); luaK_fixline(fs, line); endfor = luaK_codeAsBx(fs, OP_TFORLOOP, base + 2, NO_JUMP); } luaK_patchlist(fs, endfor, prep + 1); luaK_fixline(fs, line); } static void fornum (LexState *ls, TString *varname, int line) { /* fornum -> NAME = exp1,exp1[,exp1] forbody */ FuncState *fs = ls->fs; int base = fs->freereg; new_localvarliteral(ls, "(for index)"); new_localvarliteral(ls, "(for limit)"); new_localvarliteral(ls, "(for step)"); new_localvar(ls, varname); checknext(ls, '='); exp1(ls); /* initial value */ checknext(ls, ','); exp1(ls); /* limit */ if (testnext(ls, ',')) exp1(ls); /* optional step */ else { /* default step = 1 */ luaK_codek(fs, fs->freereg, luaK_intK(fs, 1)); luaK_reserveregs(fs, 1); } forbody(ls, base, line, 1, 1); } static void forlist (LexState *ls, TString *indexname) { /* forlist -> NAME {,NAME} IN explist forbody */ FuncState *fs = ls->fs; expdesc e; int nvars = 4; /* gen, state, control, plus at least one declared var */ int line; int base = fs->freereg; /* create control variables */ new_localvarliteral(ls, "(for generator)"); new_localvarliteral(ls, "(for state)"); new_localvarliteral(ls, "(for control)"); /* create declared variables */ new_localvar(ls, indexname); while (testnext(ls, ',')) { new_localvar(ls, str_checkname(ls)); nvars++; } checknext(ls, TK_IN); line = ls->linenumber; adjust_assign(ls, 3, explist(ls, &e), &e); luaK_checkstack(fs, 3); /* extra space to call generator */ forbody(ls, base, line, nvars - 3, 0); } static void forstat (LexState *ls, int line) { /* forstat -> FOR (fornum | forlist) END */ FuncState *fs = ls->fs; TString *varname; BlockCnt bl; enterblock(fs, &bl, 1); /* scope for loop and control variables */ luaX_next(ls); /* skip 'for' */ varname = str_checkname(ls); /* first variable name */ switch (ls->t.token) { case '=': fornum(ls, varname, line); break; case ',': case TK_IN: forlist(ls, varname); break; default: luaX_syntaxerror(ls, "'=' or 'in' expected"); } check_match(ls, TK_END, TK_FOR, line); leaveblock(fs); /* loop scope ('break' jumps to this point) */ } static void test_then_block (LexState *ls, int *escapelist) { /* test_then_block -> [IF | ELSEIF] cond THEN block */ BlockCnt bl; FuncState *fs = ls->fs; expdesc v; int jf; /* instruction to skip 'then' code (if condition is false) */ luaX_next(ls); /* skip IF or ELSEIF */ expr(ls, &v); /* read condition */ checknext(ls, TK_THEN); if (ls->t.token == TK_GOTO || ls->t.token == TK_BREAK) { luaK_goiffalse(ls->fs, &v); /* will jump to label if condition is true */ enterblock(fs, &bl, 0); /* must enter block before 'goto' */ gotostat(ls, v.t); /* handle goto/break */ skipnoopstat(ls); /* skip other no-op statements */ if (block_follow(ls, 0)) { /* 'goto' is the entire block? */ leaveblock(fs); return; /* and that is it */ } else /* must skip over 'then' part if condition is false */ jf = luaK_jump(fs); } else { /* regular case (not goto/break) */ luaK_goiftrue(ls->fs, &v); /* skip over block if condition is false */ enterblock(fs, &bl, 0); jf = v.f; } statlist(ls); /* 'then' part */ leaveblock(fs); if (ls->t.token == TK_ELSE || ls->t.token == TK_ELSEIF) /* followed by 'else'/'elseif'? */ luaK_concat(fs, escapelist, luaK_jump(fs)); /* must jump over it */ luaK_patchtohere(fs, jf); } static void ifstat (LexState *ls, int line) { /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */ FuncState *fs = ls->fs; int escapelist = NO_JUMP; /* exit list for finished parts */ test_then_block(ls, &escapelist); /* IF cond THEN block */ while (ls->t.token == TK_ELSEIF) test_then_block(ls, &escapelist); /* ELSEIF cond THEN block */ if (testnext(ls, TK_ELSE)) block(ls); /* 'else' part */ check_match(ls, TK_END, TK_IF, line); luaK_patchtohere(fs, escapelist); /* patch escape list to 'if' end */ } static void localfunc (LexState *ls) { expdesc b; FuncState *fs = ls->fs; new_localvar(ls, str_checkname(ls)); /* new local variable */ adjustlocalvars(ls, 1); /* enter its scope */ body(ls, &b, 0, ls->linenumber); /* function created in next register */ /* debug information will only see the variable after this point! */ getlocvar(fs, b.u.info)->startpc = fs->pc; } static void localstat (LexState *ls) { /* stat -> LOCAL NAME {',' NAME} ['=' explist] */ int nvars = 0; int nexps; expdesc e; do { new_localvar(ls, str_checkname(ls)); nvars++; } while (testnext(ls, ',')); if (testnext(ls, '=')) nexps = explist(ls, &e); else { e.k = VVOID; nexps = 0; } adjust_assign(ls, nvars, nexps, &e); adjustlocalvars(ls, nvars); } static int funcname (LexState *ls, expdesc *v) { /* funcname -> NAME {fieldsel} [':' NAME] */ int ismethod = 0; singlevar(ls, v); while (ls->t.token == '.') fieldsel(ls, v); if (ls->t.token == ':') { ismethod = 1; fieldsel(ls, v); } return ismethod; } static void funcstat (LexState *ls, int line) { /* funcstat -> FUNCTION funcname body */ int ismethod; expdesc v, b; luaX_next(ls); /* skip FUNCTION */ ismethod = funcname(ls, &v); body(ls, &b, ismethod, line); luaK_storevar(ls->fs, &v, &b); luaK_fixline(ls->fs, line); /* definition "happens" in the first line */ } static void exprstat (LexState *ls) { /* stat -> func | assignment */ FuncState *fs = ls->fs; struct LHS_assign v; suffixedexp(ls, &v.v); if (ls->t.token == '=' || ls->t.token == ',') { /* stat -> assignment ? */ v.prev = NULL; assignment(ls, &v, 1); } else { /* stat -> func */ check_condition(ls, v.v.k == VCALL, "syntax error"); SETARG_C(getcode(fs, &v.v), 1); /* call statement uses no results */ } } static void retstat (LexState *ls) { /* stat -> RETURN [explist] [';'] */ FuncState *fs = ls->fs; expdesc e; int first, nret; /* registers with returned values */ if (block_follow(ls, 1) || ls->t.token == ';') first = nret = 0; /* return no values */ else { nret = explist(ls, &e); /* optional return values */ if (hasmultret(e.k)) { luaK_setmultret(fs, &e); if (e.k == VCALL && nret == 1) { /* tail call? */ SET_OPCODE(getcode(fs,&e), OP_TAILCALL); lua_assert(GETARG_A(getcode(fs,&e)) == fs->nactvar); } first = fs->nactvar; nret = LUA_MULTRET; /* return all values */ } else { if (nret == 1) /* only one single value? */ first = luaK_exp2anyreg(fs, &e); else { luaK_exp2nextreg(fs, &e); /* values must go to the stack */ first = fs->nactvar; /* return all active values */ lua_assert(nret == fs->freereg - first); } } } luaK_ret(fs, first, nret); testnext(ls, ';'); /* skip optional semicolon */ } static void statement (LexState *ls) { int line = ls->linenumber; /* may be needed for error messages */ enterlevel(ls); switch (ls->t.token) { case ';': { /* stat -> ';' (empty statement) */ luaX_next(ls); /* skip ';' */ break; } case TK_IF: { /* stat -> ifstat */ ifstat(ls, line); break; } case TK_WHILE: { /* stat -> whilestat */ whilestat(ls, line); break; } case TK_DO: { /* stat -> DO block END */ luaX_next(ls); /* skip DO */ block(ls); check_match(ls, TK_END, TK_DO, line); break; } case TK_FOR: { /* stat -> forstat */ forstat(ls, line); break; } case TK_REPEAT: { /* stat -> repeatstat */ repeatstat(ls, line); break; } case TK_FUNCTION: { /* stat -> funcstat */ funcstat(ls, line); break; } case TK_LOCAL: { /* stat -> localstat */ luaX_next(ls); /* skip LOCAL */ if (testnext(ls, TK_FUNCTION)) /* local function? */ localfunc(ls); else localstat(ls); break; } case TK_DBCOLON: { /* stat -> label */ luaX_next(ls); /* skip double colon */ labelstat(ls, str_checkname(ls), line); break; } case TK_RETURN: { /* stat -> retstat */ luaX_next(ls); /* skip RETURN */ retstat(ls); break; } case TK_BREAK: /* stat -> breakstat */ case TK_GOTO: { /* stat -> 'goto' NAME */ gotostat(ls, luaK_jump(ls->fs)); break; } default: { /* stat -> func | assignment */ exprstat(ls); break; } } lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg && ls->fs->freereg >= ls->fs->nactvar); ls->fs->freereg = ls->fs->nactvar; /* free registers */ leavelevel(ls); } /* }====================================================================== */ /* ** compiles the main function, which is a regular vararg function with an ** upvalue named LUA_ENV */ static void mainfunc (LexState *ls, FuncState *fs) { BlockCnt bl; expdesc v; open_func(ls, fs, &bl); fs->f->is_vararg = 2; /* main function is always declared vararg */ init_exp(&v, VLOCAL, 0); /* create and... */ newupvalue(fs, ls->envn, &v); /* ...set environment upvalue */ luaX_next(ls); /* read first token */ statlist(ls); /* parse main body */ check(ls, TK_EOS); close_func(ls); } LClosure *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, Dyndata *dyd, const char *name, int firstchar) { LexState lexstate; FuncState funcstate; LClosure *cl = luaF_newLclosure(L, 1); /* create main closure */ setclLvalue(L, L->top, cl); /* anchor it (to avoid being collected) */ luaD_inctop(L); lexstate.h = luaH_new(L); /* create table for scanner */ sethvalue(L, L->top, lexstate.h); /* anchor it */ luaD_inctop(L); funcstate.f = cl->p = luaF_newproto(L); funcstate.f->source = luaS_new(L, name); /* create and anchor TString */ lua_assert(iswhite(funcstate.f)); /* do not need barrier here */ lexstate.buff = buff; lexstate.dyd = dyd; dyd->actvar.n = dyd->gt.n = dyd->label.n = 0; luaX_setinput(L, &lexstate, z, funcstate.f->source, firstchar); mainfunc(&lexstate, &funcstate); lua_assert(!funcstate.prev && funcstate.nups == 1 && !lexstate.fs); /* all scopes should be correctly finished */ lua_assert(dyd->actvar.n == 0 && dyd->gt.n == 0 && dyd->label.n == 0); L->top--; /* remove scanner's table */ return cl; /* closure is on the stack, too */ } wcc-0.0.2/src/wsh/lua/src/lstring.h0000644000175000017500000000265313110675433015543 0ustar philphil/* ** $Id: lstring.h,v 1.61 2015/11/03 15:36:01 roberto Exp $ ** String table (keep all strings handled by Lua) ** See Copyright Notice in lua.h */ #ifndef lstring_h #define lstring_h #include "lgc.h" #include "lobject.h" #include "lstate.h" #define sizelstring(l) (sizeof(union UTString) + ((l) + 1) * sizeof(char)) #define sizeludata(l) (sizeof(union UUdata) + (l)) #define sizeudata(u) sizeludata((u)->len) #define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \ (sizeof(s)/sizeof(char))-1)) /* ** test whether a string is a reserved word */ #define isreserved(s) ((s)->tt == LUA_TSHRSTR && (s)->extra > 0) /* ** equality for short strings, which are always internalized */ #define eqshrstr(a,b) check_exp((a)->tt == LUA_TSHRSTR, (a) == (b)) LUAI_FUNC unsigned int luaS_hash (const char *str, size_t l, unsigned int seed); LUAI_FUNC unsigned int luaS_hashlongstr (TString *ts); LUAI_FUNC int luaS_eqlngstr (TString *a, TString *b); LUAI_FUNC void luaS_resize (lua_State *L, int newsize); LUAI_FUNC void luaS_clearcache (global_State *g); LUAI_FUNC void luaS_init (lua_State *L); LUAI_FUNC void luaS_remove (lua_State *L, TString *ts); LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s); LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l); LUAI_FUNC TString *luaS_new (lua_State *L, const char *str); LUAI_FUNC TString *luaS_createlngstrobj (lua_State *L, size_t l); #endif wcc-0.0.2/src/wsh/lua/src/ldo.h0000644000175000017500000000377013110675433014640 0ustar philphil/* ** $Id: ldo.h,v 2.28 2015/11/23 11:29:43 roberto Exp $ ** Stack and Call structure of Lua ** See Copyright Notice in lua.h */ #ifndef ldo_h #define ldo_h #include "lobject.h" #include "lstate.h" #include "lzio.h" /* ** Macro to check stack size and grow stack if needed. Parameters ** 'pre'/'pos' allow the macro to preserve a pointer into the ** stack across reallocations, doing the work only when needed. ** 'condmovestack' is used in heavy tests to force a stack reallocation ** at every check. */ #define luaD_checkstackaux(L,n,pre,pos) \ if (L->stack_last - L->top <= (n)) \ { pre; luaD_growstack(L, n); pos; } else { condmovestack(L,pre,pos); } /* In general, 'pre'/'pos' are empty (nothing to save) */ #define luaD_checkstack(L,n) luaD_checkstackaux(L,n,,) #define savestack(L,p) ((char *)(p) - (char *)L->stack) #define restorestack(L,n) ((TValue *)((char *)L->stack + (n))) /* type of protected functions, to be ran by 'runprotected' */ typedef void (*Pfunc) (lua_State *L, void *ud); LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name, const char *mode); LUAI_FUNC void luaD_hook (lua_State *L, int event, int line); LUAI_FUNC int luaD_precall (lua_State *L, StkId func, int nresults); LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults); LUAI_FUNC void luaD_callnoyield (lua_State *L, StkId func, int nResults); LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u, ptrdiff_t oldtop, ptrdiff_t ef); LUAI_FUNC int luaD_poscall (lua_State *L, CallInfo *ci, StkId firstResult, int nres); LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize); LUAI_FUNC void luaD_growstack (lua_State *L, int n); LUAI_FUNC void luaD_shrinkstack (lua_State *L); LUAI_FUNC void luaD_inctop (lua_State *L); LUAI_FUNC l_noret luaD_throw (lua_State *L, int errcode); LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud); #endif wcc-0.0.2/src/wsh/lua/src/lapi.h0000644000175000017500000000103513110675433014777 0ustar philphil/* ** $Id: lapi.h,v 2.9 2015/03/06 19:49:50 roberto Exp $ ** Auxiliary functions from Lua API ** See Copyright Notice in lua.h */ #ifndef lapi_h #define lapi_h #include "llimits.h" #include "lstate.h" #define api_incr_top(L) {L->top++; api_check(L, L->top <= L->ci->top, \ "stack overflow");} #define adjustresults(L,nres) \ { if ((nres) == LUA_MULTRET && L->ci->top < L->top) L->ci->top = L->top; } #define api_checknelems(L,n) api_check(L, (n) < (L->top - L->ci->func), \ "not enough elements in the stack") #endif wcc-0.0.2/src/wsh/lua/src/lundump.c0000644000175000017500000001403713110675433015537 0ustar philphil/* ** $Id: lundump.c,v 2.44 2015/11/02 16:09:30 roberto Exp $ ** load precompiled Lua chunks ** See Copyright Notice in lua.h */ #define lundump_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lmem.h" #include "lobject.h" #include "lstring.h" #include "lundump.h" #include "lzio.h" #if !defined(luai_verifycode) #define luai_verifycode(L,b,f) /* empty */ #endif typedef struct { lua_State *L; ZIO *Z; const char *name; } LoadState; static l_noret error(LoadState *S, const char *why) { luaO_pushfstring(S->L, "%s: %s precompiled chunk", S->name, why); luaD_throw(S->L, LUA_ERRSYNTAX); } /* ** All high-level loads go through LoadVector; you can change it to ** adapt to the endianness of the input */ #define LoadVector(S,b,n) LoadBlock(S,b,(n)*sizeof((b)[0])) static void LoadBlock (LoadState *S, void *b, size_t size) { if (luaZ_read(S->Z, b, size) != 0) error(S, "truncated"); } #define LoadVar(S,x) LoadVector(S,&x,1) static lu_byte LoadByte (LoadState *S) { lu_byte x; LoadVar(S, x); return x; } static int LoadInt (LoadState *S) { int x; LoadVar(S, x); return x; } static lua_Number LoadNumber (LoadState *S) { lua_Number x; LoadVar(S, x); return x; } static lua_Integer LoadInteger (LoadState *S) { lua_Integer x; LoadVar(S, x); return x; } static TString *LoadString (LoadState *S) { size_t size = LoadByte(S); if (size == 0xFF) LoadVar(S, size); if (size == 0) return NULL; else if (--size <= LUAI_MAXSHORTLEN) { /* short string? */ char buff[LUAI_MAXSHORTLEN]; LoadVector(S, buff, size); return luaS_newlstr(S->L, buff, size); } else { /* long string */ TString *ts = luaS_createlngstrobj(S->L, size); LoadVector(S, getstr(ts), size); /* load directly in final place */ return ts; } } static void LoadCode (LoadState *S, Proto *f) { int n = LoadInt(S); f->code = luaM_newvector(S->L, n, Instruction); f->sizecode = n; LoadVector(S, f->code, n); } static void LoadFunction(LoadState *S, Proto *f, TString *psource); static void LoadConstants (LoadState *S, Proto *f) { int i; int n = LoadInt(S); f->k = luaM_newvector(S->L, n, TValue); f->sizek = n; for (i = 0; i < n; i++) setnilvalue(&f->k[i]); for (i = 0; i < n; i++) { TValue *o = &f->k[i]; int t = LoadByte(S); switch (t) { case LUA_TNIL: setnilvalue(o); break; case LUA_TBOOLEAN: setbvalue(o, LoadByte(S)); break; case LUA_TNUMFLT: setfltvalue(o, LoadNumber(S)); break; case LUA_TNUMINT: setivalue(o, LoadInteger(S)); break; case LUA_TSHRSTR: case LUA_TLNGSTR: setsvalue2n(S->L, o, LoadString(S)); break; default: lua_assert(0); } } } static void LoadProtos (LoadState *S, Proto *f) { int i; int n = LoadInt(S); f->p = luaM_newvector(S->L, n, Proto *); f->sizep = n; for (i = 0; i < n; i++) f->p[i] = NULL; for (i = 0; i < n; i++) { f->p[i] = luaF_newproto(S->L); LoadFunction(S, f->p[i], f->source); } } static void LoadUpvalues (LoadState *S, Proto *f) { int i, n; n = LoadInt(S); f->upvalues = luaM_newvector(S->L, n, Upvaldesc); f->sizeupvalues = n; for (i = 0; i < n; i++) f->upvalues[i].name = NULL; for (i = 0; i < n; i++) { f->upvalues[i].instack = LoadByte(S); f->upvalues[i].idx = LoadByte(S); } } static void LoadDebug (LoadState *S, Proto *f) { int i, n; n = LoadInt(S); f->lineinfo = luaM_newvector(S->L, n, int); f->sizelineinfo = n; LoadVector(S, f->lineinfo, n); n = LoadInt(S); f->locvars = luaM_newvector(S->L, n, LocVar); f->sizelocvars = n; for (i = 0; i < n; i++) f->locvars[i].varname = NULL; for (i = 0; i < n; i++) { f->locvars[i].varname = LoadString(S); f->locvars[i].startpc = LoadInt(S); f->locvars[i].endpc = LoadInt(S); } n = LoadInt(S); for (i = 0; i < n; i++) f->upvalues[i].name = LoadString(S); } static void LoadFunction (LoadState *S, Proto *f, TString *psource) { f->source = LoadString(S); if (f->source == NULL) /* no source in dump? */ f->source = psource; /* reuse parent's source */ f->linedefined = LoadInt(S); f->lastlinedefined = LoadInt(S); f->numparams = LoadByte(S); f->is_vararg = LoadByte(S); f->maxstacksize = LoadByte(S); LoadCode(S, f); LoadConstants(S, f); LoadUpvalues(S, f); LoadProtos(S, f); LoadDebug(S, f); } static void checkliteral (LoadState *S, const char *s, const char *msg) { char buff[sizeof(LUA_SIGNATURE) + sizeof(LUAC_DATA)]; /* larger than both */ size_t len = strlen(s); LoadVector(S, buff, len); if (memcmp(s, buff, len) != 0) error(S, msg); } static void fchecksize (LoadState *S, size_t size, const char *tname) { if (LoadByte(S) != size) error(S, luaO_pushfstring(S->L, "%s size mismatch in", tname)); } #define checksize(S,t) fchecksize(S,sizeof(t),#t) static void checkHeader (LoadState *S) { checkliteral(S, LUA_SIGNATURE + 1, "not a"); /* 1st char already checked */ if (LoadByte(S) != LUAC_VERSION) error(S, "version mismatch in"); if (LoadByte(S) != LUAC_FORMAT) error(S, "format mismatch in"); checkliteral(S, LUAC_DATA, "corrupted"); checksize(S, int); checksize(S, size_t); checksize(S, Instruction); checksize(S, lua_Integer); checksize(S, lua_Number); if (LoadInteger(S) != LUAC_INT) error(S, "endianness mismatch in"); if (LoadNumber(S) != LUAC_NUM) error(S, "float format mismatch in"); } /* ** load precompiled chunk */ LClosure *luaU_undump(lua_State *L, ZIO *Z, const char *name) { LoadState S; LClosure *cl; if (*name == '@' || *name == '=') S.name = name + 1; else if (*name == LUA_SIGNATURE[0]) S.name = "binary string"; else S.name = name; S.L = L; S.Z = Z; checkHeader(&S); cl = luaF_newLclosure(L, LoadByte(&S)); setclLvalue(L, L->top, cl); luaD_inctop(L); cl->p = luaF_newproto(L); LoadFunction(&S, cl->p, NULL); lua_assert(cl->nupvalues == cl->p->sizeupvalues); luai_verifycode(L, buff, cl->p); return cl; } wcc-0.0.2/src/wsh/lua/src/loslib.c0000644000175000017500000002364013110675433015337 0ustar philphil/* ** $Id: loslib.c,v 1.60 2015/11/19 19:16:22 roberto Exp $ ** Standard Operating System library ** See Copyright Notice in lua.h */ #define loslib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" /* ** {================================================================== ** list of valid conversion specifiers for the 'strftime' function ** =================================================================== */ #if !defined(LUA_STRFTIMEOPTIONS) /* { */ #if defined(LUA_USE_C89) #define LUA_STRFTIMEOPTIONS { "aAbBcdHIjmMpSUwWxXyYz%", "" } #else /* C99 specification */ #define LUA_STRFTIMEOPTIONS \ { "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%", "", \ "E", "cCxXyY", \ "O", "deHImMSuUVwWy" } #endif #endif /* } */ /* }================================================================== */ /* ** {================================================================== ** Configuration for time-related stuff ** =================================================================== */ #if !defined(l_time_t) /* { */ /* ** type to represent time_t in Lua */ #define l_timet lua_Integer #define l_pushtime(L,t) lua_pushinteger(L,(lua_Integer)(t)) static time_t l_checktime (lua_State *L, int arg) { lua_Integer t = luaL_checkinteger(L, arg); luaL_argcheck(L, (time_t)t == t, arg, "time out-of-bounds"); return (time_t)t; } #endif /* } */ #if !defined(l_gmtime) /* { */ /* ** By default, Lua uses gmtime/localtime, except when POSIX is available, ** where it uses gmtime_r/localtime_r */ #if defined(LUA_USE_POSIX) /* { */ #define l_gmtime(t,r) gmtime_r(t,r) #define l_localtime(t,r) localtime_r(t,r) #else /* }{ */ /* ISO C definitions */ #define l_gmtime(t,r) ((void)(r)->tm_sec, gmtime(t)) #define l_localtime(t,r) ((void)(r)->tm_sec, localtime(t)) #endif /* } */ #endif /* } */ /* }================================================================== */ /* ** {================================================================== ** Configuration for 'tmpnam': ** By default, Lua uses tmpnam except when POSIX is available, where ** it uses mkstemp. ** =================================================================== */ #if !defined(lua_tmpnam) /* { */ #if defined(LUA_USE_POSIX) /* { */ #include #define LUA_TMPNAMBUFSIZE 32 #if !defined(LUA_TMPNAMTEMPLATE) #define LUA_TMPNAMTEMPLATE "/tmp/lua_XXXXXX" #endif #define lua_tmpnam(b,e) { \ strcpy(b, LUA_TMPNAMTEMPLATE); \ e = mkstemp(b); \ if (e != -1) close(e); \ e = (e == -1); } #else /* }{ */ /* ISO C definitions */ #define LUA_TMPNAMBUFSIZE L_tmpnam #define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); } #endif /* } */ #endif /* } */ /* }================================================================== */ static int os_execute (lua_State *L) { const char *cmd = luaL_optstring(L, 1, NULL); int stat = system(cmd); if (cmd != NULL) return luaL_execresult(L, stat); else { lua_pushboolean(L, stat); /* true if there is a shell */ return 1; } } static int os_remove (lua_State *L) { const char *filename = luaL_checkstring(L, 1); return luaL_fileresult(L, remove(filename) == 0, filename); } static int os_rename (lua_State *L) { const char *fromname = luaL_checkstring(L, 1); const char *toname = luaL_checkstring(L, 2); return luaL_fileresult(L, rename(fromname, toname) == 0, NULL); } static int os_tmpname (lua_State *L) { char buff[LUA_TMPNAMBUFSIZE]; int err; lua_tmpnam(buff, err); if (err) return luaL_error(L, "unable to generate a unique filename"); lua_pushstring(L, buff); return 1; } static int os_getenv (lua_State *L) { lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */ return 1; } static int os_clock (lua_State *L) { lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC); return 1; } /* ** {====================================================== ** Time/Date operations ** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S, ** wday=%w+1, yday=%j, isdst=? } ** ======================================================= */ static void setfield (lua_State *L, const char *key, int value) { lua_pushinteger(L, value); lua_setfield(L, -2, key); } static void setboolfield (lua_State *L, const char *key, int value) { if (value < 0) /* undefined? */ return; /* does not set field */ lua_pushboolean(L, value); lua_setfield(L, -2, key); } static int getboolfield (lua_State *L, const char *key) { int res; res = (lua_getfield(L, -1, key) == LUA_TNIL) ? -1 : lua_toboolean(L, -1); lua_pop(L, 1); return res; } /* maximum value for date fields (to avoid arithmetic overflows with 'int') */ #if !defined(L_MAXDATEFIELD) #define L_MAXDATEFIELD (INT_MAX / 2) #endif static int getfield (lua_State *L, const char *key, int d, int delta) { int isnum; int t = lua_getfield(L, -1, key); lua_Integer res = lua_tointegerx(L, -1, &isnum); if (!isnum) { /* field is not a number? */ if (t != LUA_TNIL) /* some other value? */ return luaL_error(L, "field '%s' not an integer", key); else if (d < 0) /* absent field; no default? */ return luaL_error(L, "field '%s' missing in date table", key); res = d; } else { if (!(-L_MAXDATEFIELD <= res && res <= L_MAXDATEFIELD)) return luaL_error(L, "field '%s' out-of-bounds", key); res -= delta; } lua_pop(L, 1); return (int)res; } static const char *checkoption (lua_State *L, const char *conv, char *buff) { static const char *const options[] = LUA_STRFTIMEOPTIONS; unsigned int i; for (i = 0; i < sizeof(options)/sizeof(options[0]); i += 2) { if (*conv != '\0' && strchr(options[i], *conv) != NULL) { buff[1] = *conv; if (*options[i + 1] == '\0') { /* one-char conversion specifier? */ buff[2] = '\0'; /* end buffer */ return conv + 1; } else if (*(conv + 1) != '\0' && strchr(options[i + 1], *(conv + 1)) != NULL) { buff[2] = *(conv + 1); /* valid two-char conversion specifier */ buff[3] = '\0'; /* end buffer */ return conv + 2; } } } luaL_argerror(L, 1, lua_pushfstring(L, "invalid conversion specifier '%%%s'", conv)); return conv; /* to avoid warnings */ } /* maximum size for an individual 'strftime' item */ #define SIZETIMEFMT 250 static int os_date (lua_State *L) { const char *s = luaL_optstring(L, 1, "%c"); time_t t = luaL_opt(L, l_checktime, 2, time(NULL)); struct tm tmr, *stm; if (*s == '!') { /* UTC? */ stm = l_gmtime(&t, &tmr); s++; /* skip '!' */ } else stm = l_localtime(&t, &tmr); if (stm == NULL) /* invalid date? */ luaL_error(L, "time result cannot be represented in this installation"); if (strcmp(s, "*t") == 0) { lua_createtable(L, 0, 9); /* 9 = number of fields */ setfield(L, "sec", stm->tm_sec); setfield(L, "min", stm->tm_min); setfield(L, "hour", stm->tm_hour); setfield(L, "day", stm->tm_mday); setfield(L, "month", stm->tm_mon+1); setfield(L, "year", stm->tm_year+1900); setfield(L, "wday", stm->tm_wday+1); setfield(L, "yday", stm->tm_yday+1); setboolfield(L, "isdst", stm->tm_isdst); } else { char cc[4]; luaL_Buffer b; cc[0] = '%'; luaL_buffinit(L, &b); while (*s) { if (*s != '%') /* not a conversion specifier? */ luaL_addchar(&b, *s++); else { size_t reslen; char *buff = luaL_prepbuffsize(&b, SIZETIMEFMT); s = checkoption(L, s + 1, cc); reslen = strftime(buff, SIZETIMEFMT, cc, stm); luaL_addsize(&b, reslen); } } luaL_pushresult(&b); } return 1; } static int os_time (lua_State *L) { time_t t; if (lua_isnoneornil(L, 1)) /* called without args? */ t = time(NULL); /* get current time */ else { struct tm ts; luaL_checktype(L, 1, LUA_TTABLE); lua_settop(L, 1); /* make sure table is at the top */ ts.tm_sec = getfield(L, "sec", 0, 0); ts.tm_min = getfield(L, "min", 0, 0); ts.tm_hour = getfield(L, "hour", 12, 0); ts.tm_mday = getfield(L, "day", -1, 0); ts.tm_mon = getfield(L, "month", -1, 1); ts.tm_year = getfield(L, "year", -1, 1900); ts.tm_isdst = getboolfield(L, "isdst"); t = mktime(&ts); } if (t != (time_t)(l_timet)t || t == (time_t)(-1)) luaL_error(L, "time result cannot be represented in this installation"); l_pushtime(L, t); return 1; } static int os_difftime (lua_State *L) { time_t t1 = l_checktime(L, 1); time_t t2 = l_checktime(L, 2); lua_pushnumber(L, (lua_Number)difftime(t1, t2)); return 1; } /* }====================================================== */ static int os_setlocale (lua_State *L) { static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC, LC_TIME}; static const char *const catnames[] = {"all", "collate", "ctype", "monetary", "numeric", "time", NULL}; const char *l = luaL_optstring(L, 1, NULL); int op = luaL_checkoption(L, 2, "all", catnames); lua_pushstring(L, setlocale(cat[op], l)); return 1; } static int os_exit (lua_State *L) { int status; if (lua_isboolean(L, 1)) status = (lua_toboolean(L, 1) ? EXIT_SUCCESS : EXIT_FAILURE); else status = (int)luaL_optinteger(L, 1, EXIT_SUCCESS); if (lua_toboolean(L, 2)) lua_close(L); if (L) exit(status); /* 'if' to avoid warnings for unreachable 'return' */ return 0; } static const luaL_Reg syslib[] = { {"clock", os_clock}, {"date", os_date}, {"difftime", os_difftime}, {"execute", os_execute}, {"exit", os_exit}, {"getenv", os_getenv}, {"remove", os_remove}, {"rename", os_rename}, {"setlocale", os_setlocale}, {"time", os_time}, {"tmpname", os_tmpname}, {NULL, NULL} }; /* }====================================================== */ LUAMOD_API int luaopen_os (lua_State *L) { luaL_newlib(L, syslib); return 1; } wcc-0.0.2/src/wsh/lua/src/lzio.h0000644000175000017500000000270513110675433015034 0ustar philphil/* ** $Id: lzio.h,v 1.31 2015/09/08 15:41:05 roberto Exp $ ** Buffered streams ** See Copyright Notice in lua.h */ #ifndef lzio_h #define lzio_h #include "lua.h" #include "lmem.h" #define EOZ (-1) /* end of stream */ typedef struct Zio ZIO; #define zgetc(z) (((z)->n--)>0 ? cast_uchar(*(z)->p++) : luaZ_fill(z)) typedef struct Mbuffer { char *buffer; size_t n; size_t buffsize; } Mbuffer; #define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0) #define luaZ_buffer(buff) ((buff)->buffer) #define luaZ_sizebuffer(buff) ((buff)->buffsize) #define luaZ_bufflen(buff) ((buff)->n) #define luaZ_buffremove(buff,i) ((buff)->n -= (i)) #define luaZ_resetbuffer(buff) ((buff)->n = 0) #define luaZ_resizebuffer(L, buff, size) \ ((buff)->buffer = luaM_reallocvchar(L, (buff)->buffer, \ (buff)->buffsize, size), \ (buff)->buffsize = size) #define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0) LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data); LUAI_FUNC size_t luaZ_read (ZIO* z, void *b, size_t n); /* read next n bytes */ /* --------- Private Part ------------------ */ struct Zio { size_t n; /* bytes still unread */ const char *p; /* current position in buffer */ lua_Reader reader; /* reader function */ void *data; /* additional data */ lua_State *L; /* Lua state (for reader) */ }; LUAI_FUNC int luaZ_fill (ZIO *z); #endif wcc-0.0.2/src/wsh/lua/src/ldump.c0000644000175000017500000001057213110675433015174 0ustar philphil/* ** $Id: ldump.c,v 2.37 2015/10/08 15:53:49 roberto Exp $ ** save precompiled Lua chunks ** See Copyright Notice in lua.h */ #define ldump_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "lobject.h" #include "lstate.h" #include "lundump.h" typedef struct { lua_State *L; lua_Writer writer; void *data; int strip; int status; } DumpState; /* ** All high-level dumps go through DumpVector; you can change it to ** change the endianness of the result */ #define DumpVector(v,n,D) DumpBlock(v,(n)*sizeof((v)[0]),D) #define DumpLiteral(s,D) DumpBlock(s, sizeof(s) - sizeof(char), D) static void DumpBlock (const void *b, size_t size, DumpState *D) { if (D->status == 0 && size > 0) { lua_unlock(D->L); D->status = (*D->writer)(D->L, b, size, D->data); lua_lock(D->L); } } #define DumpVar(x,D) DumpVector(&x,1,D) static void DumpByte (int y, DumpState *D) { lu_byte x = (lu_byte)y; DumpVar(x, D); } static void DumpInt (int x, DumpState *D) { DumpVar(x, D); } static void DumpNumber (lua_Number x, DumpState *D) { DumpVar(x, D); } static void DumpInteger (lua_Integer x, DumpState *D) { DumpVar(x, D); } static void DumpString (const TString *s, DumpState *D) { if (s == NULL) DumpByte(0, D); else { size_t size = tsslen(s) + 1; /* include trailing '\0' */ const char *str = getstr(s); if (size < 0xFF) DumpByte(cast_int(size), D); else { DumpByte(0xFF, D); DumpVar(size, D); } DumpVector(str, size - 1, D); /* no need to save '\0' */ } } static void DumpCode (const Proto *f, DumpState *D) { DumpInt(f->sizecode, D); DumpVector(f->code, f->sizecode, D); } static void DumpFunction(const Proto *f, TString *psource, DumpState *D); static void DumpConstants (const Proto *f, DumpState *D) { int i; int n = f->sizek; DumpInt(n, D); for (i = 0; i < n; i++) { const TValue *o = &f->k[i]; DumpByte(ttype(o), D); switch (ttype(o)) { case LUA_TNIL: break; case LUA_TBOOLEAN: DumpByte(bvalue(o), D); break; case LUA_TNUMFLT: DumpNumber(fltvalue(o), D); break; case LUA_TNUMINT: DumpInteger(ivalue(o), D); break; case LUA_TSHRSTR: case LUA_TLNGSTR: DumpString(tsvalue(o), D); break; default: lua_assert(0); } } } static void DumpProtos (const Proto *f, DumpState *D) { int i; int n = f->sizep; DumpInt(n, D); for (i = 0; i < n; i++) DumpFunction(f->p[i], f->source, D); } static void DumpUpvalues (const Proto *f, DumpState *D) { int i, n = f->sizeupvalues; DumpInt(n, D); for (i = 0; i < n; i++) { DumpByte(f->upvalues[i].instack, D); DumpByte(f->upvalues[i].idx, D); } } static void DumpDebug (const Proto *f, DumpState *D) { int i, n; n = (D->strip) ? 0 : f->sizelineinfo; DumpInt(n, D); DumpVector(f->lineinfo, n, D); n = (D->strip) ? 0 : f->sizelocvars; DumpInt(n, D); for (i = 0; i < n; i++) { DumpString(f->locvars[i].varname, D); DumpInt(f->locvars[i].startpc, D); DumpInt(f->locvars[i].endpc, D); } n = (D->strip) ? 0 : f->sizeupvalues; DumpInt(n, D); for (i = 0; i < n; i++) DumpString(f->upvalues[i].name, D); } static void DumpFunction (const Proto *f, TString *psource, DumpState *D) { if (D->strip || f->source == psource) DumpString(NULL, D); /* no debug info or same source as its parent */ else DumpString(f->source, D); DumpInt(f->linedefined, D); DumpInt(f->lastlinedefined, D); DumpByte(f->numparams, D); DumpByte(f->is_vararg, D); DumpByte(f->maxstacksize, D); DumpCode(f, D); DumpConstants(f, D); DumpUpvalues(f, D); DumpProtos(f, D); DumpDebug(f, D); } static void DumpHeader (DumpState *D) { DumpLiteral(LUA_SIGNATURE, D); DumpByte(LUAC_VERSION, D); DumpByte(LUAC_FORMAT, D); DumpLiteral(LUAC_DATA, D); DumpByte(sizeof(int), D); DumpByte(sizeof(size_t), D); DumpByte(sizeof(Instruction), D); DumpByte(sizeof(lua_Integer), D); DumpByte(sizeof(lua_Number), D); DumpInteger(LUAC_INT, D); DumpNumber(LUAC_NUM, D); } /* ** dump Lua function as precompiled chunk */ int luaU_dump(lua_State *L, const Proto *f, lua_Writer w, void *data, int strip) { DumpState D; D.L = L; D.writer = w; D.data = data; D.strip = strip; D.status = 0; DumpHeader(&D); DumpByte(f->sizeupvalues, &D); DumpFunction(f, NULL, &D); return D.status; } wcc-0.0.2/src/wsh/lua/src/lstring.c0000644000175000017500000001466213110675433015541 0ustar philphil/* ** $Id: lstring.c,v 2.56 2015/11/23 11:32:51 roberto Exp $ ** String table (keeps all strings handled by Lua) ** See Copyright Notice in lua.h */ #define lstring_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" #include "lstring.h" #define MEMERRMSG "not enough memory" /* ** Lua will use at most ~(2^LUAI_HASHLIMIT) bytes from a string to ** compute its hash */ #if !defined(LUAI_HASHLIMIT) #define LUAI_HASHLIMIT 5 #endif /* ** equality for long strings */ int luaS_eqlngstr (TString *a, TString *b) { size_t len = a->u.lnglen; lua_assert(a->tt == LUA_TLNGSTR && b->tt == LUA_TLNGSTR); return (a == b) || /* same instance or... */ ((len == b->u.lnglen) && /* equal length and ... */ (memcmp(getstr(a), getstr(b), len) == 0)); /* equal contents */ } unsigned int luaS_hash (const char *str, size_t l, unsigned int seed) { unsigned int h = seed ^ cast(unsigned int, l); size_t step = (l >> LUAI_HASHLIMIT) + 1; for (; l >= step; l -= step) h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1])); return h; } unsigned int luaS_hashlongstr (TString *ts) { lua_assert(ts->tt == LUA_TLNGSTR); if (ts->extra == 0) { /* no hash? */ ts->hash = luaS_hash(getstr(ts), ts->u.lnglen, ts->hash); ts->extra = 1; /* now it has its hash */ } return ts->hash; } /* ** resizes the string table */ void luaS_resize (lua_State *L, int newsize) { int i; stringtable *tb = &G(L)->strt; if (newsize > tb->size) { /* grow table if needed */ luaM_reallocvector(L, tb->hash, tb->size, newsize, TString *); for (i = tb->size; i < newsize; i++) tb->hash[i] = NULL; } for (i = 0; i < tb->size; i++) { /* rehash */ TString *p = tb->hash[i]; tb->hash[i] = NULL; while (p) { /* for each node in the list */ TString *hnext = p->u.hnext; /* save next */ unsigned int h = lmod(p->hash, newsize); /* new position */ p->u.hnext = tb->hash[h]; /* chain it */ tb->hash[h] = p; p = hnext; } } if (newsize < tb->size) { /* shrink table if needed */ /* vanishing slice should be empty */ lua_assert(tb->hash[newsize] == NULL && tb->hash[tb->size - 1] == NULL); luaM_reallocvector(L, tb->hash, tb->size, newsize, TString *); } tb->size = newsize; } /* ** Clear API string cache. (Entries cannot be empty, so fill them with ** a non-collectable string.) */ void luaS_clearcache (global_State *g) { int i, j; for (i = 0; i < STRCACHE_N; i++) for (j = 0; j < STRCACHE_M; j++) { if (iswhite(g->strcache[i][j])) /* will entry be collected? */ g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */ } } /* ** Initialize the string table and the string cache */ void luaS_init (lua_State *L) { global_State *g = G(L); int i, j; luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */ /* pre-create memory-error message */ g->memerrmsg = luaS_newliteral(L, MEMERRMSG); luaC_fix(L, obj2gco(g->memerrmsg)); /* it should never be collected */ for (i = 0; i < STRCACHE_N; i++) /* fill cache with valid strings */ for (j = 0; j < STRCACHE_M; j++) g->strcache[i][j] = g->memerrmsg; } /* ** creates a new string object */ static TString *createstrobj (lua_State *L, size_t l, int tag, unsigned int h) { TString *ts; GCObject *o; size_t totalsize; /* total size of TString object */ totalsize = sizelstring(l); o = luaC_newobj(L, tag, totalsize); ts = gco2ts(o); ts->hash = h; ts->extra = 0; getstr(ts)[l] = '\0'; /* ending 0 */ return ts; } TString *luaS_createlngstrobj (lua_State *L, size_t l) { TString *ts = createstrobj(L, l, LUA_TLNGSTR, G(L)->seed); ts->u.lnglen = l; return ts; } void luaS_remove (lua_State *L, TString *ts) { stringtable *tb = &G(L)->strt; TString **p = &tb->hash[lmod(ts->hash, tb->size)]; while (*p != ts) /* find previous element */ p = &(*p)->u.hnext; *p = (*p)->u.hnext; /* remove element from its list */ tb->nuse--; } /* ** checks whether short string exists and reuses it or creates a new one */ static TString *internshrstr (lua_State *L, const char *str, size_t l) { TString *ts; global_State *g = G(L); unsigned int h = luaS_hash(str, l, g->seed); TString **list = &g->strt.hash[lmod(h, g->strt.size)]; lua_assert(str != NULL); /* otherwise 'memcmp'/'memcpy' are undefined */ for (ts = *list; ts != NULL; ts = ts->u.hnext) { if (l == ts->shrlen && (memcmp(str, getstr(ts), l * sizeof(char)) == 0)) { /* found! */ if (isdead(g, ts)) /* dead (but not collected yet)? */ changewhite(ts); /* resurrect it */ return ts; } } if (g->strt.nuse >= g->strt.size && g->strt.size <= MAX_INT/2) { luaS_resize(L, g->strt.size * 2); list = &g->strt.hash[lmod(h, g->strt.size)]; /* recompute with new size */ } ts = createstrobj(L, l, LUA_TSHRSTR, h); memcpy(getstr(ts), str, l * sizeof(char)); ts->shrlen = cast_byte(l); ts->u.hnext = *list; *list = ts; g->strt.nuse++; return ts; } /* ** new string (with explicit length) */ TString *luaS_newlstr (lua_State *L, const char *str, size_t l) { if (l <= LUAI_MAXSHORTLEN) /* short string? */ return internshrstr(L, str, l); else { TString *ts; if (l >= (MAX_SIZE - sizeof(TString))/sizeof(char)) luaM_toobig(L); ts = luaS_createlngstrobj(L, l); memcpy(getstr(ts), str, l * sizeof(char)); return ts; } } /* ** Create or reuse a zero-terminated string, first checking in the ** cache (using the string address as a key). The cache can contain ** only zero-terminated strings, so it is safe to use 'strcmp' to ** check hits. */ TString *luaS_new (lua_State *L, const char *str) { unsigned int i = point2uint(str) % STRCACHE_N; /* hash */ int j; TString **p = G(L)->strcache[i]; for (j = 0; j < STRCACHE_M; j++) { if (strcmp(str, getstr(p[j])) == 0) /* hit? */ return p[j]; /* that is it */ } /* normal route */ for (j = STRCACHE_M - 1; j > 0; j--) p[j] = p[j - 1]; /* move out last element */ /* new element is first in the list */ p[0] = luaS_newlstr(L, str, strlen(str)); return p[0]; } Udata *luaS_newudata (lua_State *L, size_t s) { Udata *u; GCObject *o; if (s > MAX_SIZE - sizeof(Udata)) luaM_toobig(L); o = luaC_newobj(L, LUA_TUSERDATA, sizeludata(s)); u = gco2u(o); u->len = s; u->metatable = NULL; setuservalue(L, u, luaO_nilobject); return u; } wcc-0.0.2/src/wsh/lua/src/lgc.c0000644000175000017500000010747413110675433014630 0ustar philphil/* ** $Id: lgc.c,v 2.210 2015/11/03 18:10:44 roberto Exp $ ** Garbage Collector ** See Copyright Notice in lua.h */ #define lgc_c #define LUA_CORE #include "lprefix.h" #include #include "lua.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "ltm.h" /* ** internal state for collector while inside the atomic phase. The ** collector should never be in this state while running regular code. */ #define GCSinsideatomic (GCSpause + 1) /* ** cost of sweeping one element (the size of a small object divided ** by some adjust for the sweep speed) */ #define GCSWEEPCOST ((sizeof(TString) + 4) / 4) /* maximum number of elements to sweep in each single step */ #define GCSWEEPMAX (cast_int((GCSTEPSIZE / GCSWEEPCOST) / 4)) /* cost of calling one finalizer */ #define GCFINALIZECOST GCSWEEPCOST /* ** macro to adjust 'stepmul': 'stepmul' is actually used like ** 'stepmul / STEPMULADJ' (value chosen by tests) */ #define STEPMULADJ 200 /* ** macro to adjust 'pause': 'pause' is actually used like ** 'pause / PAUSEADJ' (value chosen by tests) */ #define PAUSEADJ 100 /* ** 'makewhite' erases all color bits then sets only the current white ** bit */ #define maskcolors (~(bitmask(BLACKBIT) | WHITEBITS)) #define makewhite(g,x) \ (x->marked = cast_byte((x->marked & maskcolors) | luaC_white(g))) #define white2gray(x) resetbits(x->marked, WHITEBITS) #define black2gray(x) resetbit(x->marked, BLACKBIT) #define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x))) #define checkdeadkey(n) lua_assert(!ttisdeadkey(gkey(n)) || ttisnil(gval(n))) #define checkconsistency(obj) \ lua_longassert(!iscollectable(obj) || righttt(obj)) #define markvalue(g,o) { checkconsistency(o); \ if (valiswhite(o)) reallymarkobject(g,gcvalue(o)); } #define markobject(g,t) { if (iswhite(t)) reallymarkobject(g, obj2gco(t)); } /* ** mark an object that can be NULL (either because it is really optional, ** or it was stripped as debug info, or inside an uncompleted structure) */ #define markobjectN(g,t) { if (t) markobject(g,t); } static void reallymarkobject (global_State *g, GCObject *o); /* ** {====================================================== ** Generic functions ** ======================================================= */ /* ** one after last element in a hash array */ #define gnodelast(h) gnode(h, cast(size_t, sizenode(h))) /* ** link collectable object 'o' into list pointed by 'p' */ #define linkgclist(o,p) ((o)->gclist = (p), (p) = obj2gco(o)) /* ** If key is not marked, mark its entry as dead. This allows key to be ** collected, but keeps its entry in the table. A dead node is needed ** when Lua looks up for a key (it may be part of a chain) and when ** traversing a weak table (key might be removed from the table during ** traversal). Other places never manipulate dead keys, because its ** associated nil value is enough to signal that the entry is logically ** empty. */ static void removeentry (Node *n) { lua_assert(ttisnil(gval(n))); if (valiswhite(gkey(n))) setdeadvalue(wgkey(n)); /* unused and unmarked key; remove it */ } /* ** tells whether a key or value can be cleared from a weak ** table. Non-collectable objects are never removed from weak ** tables. Strings behave as 'values', so are never removed too. for ** other objects: if really collected, cannot keep them; for objects ** being finalized, keep them in keys, but not in values */ static int iscleared (global_State *g, const TValue *o) { if (!iscollectable(o)) return 0; else if (ttisstring(o)) { markobject(g, tsvalue(o)); /* strings are 'values', so are never weak */ return 0; } else return iswhite(gcvalue(o)); } /* ** barrier that moves collector forward, that is, mark the white object ** being pointed by a black object. (If in sweep phase, clear the black ** object to white [sweep it] to avoid other barrier calls for this ** same object.) */ void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) { global_State *g = G(L); lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o)); if (keepinvariant(g)) /* must keep invariant? */ reallymarkobject(g, v); /* restore invariant */ else { /* sweep phase */ lua_assert(issweepphase(g)); makewhite(g, o); /* mark main obj. as white to avoid other barriers */ } } /* ** barrier that moves collector backward, that is, mark the black object ** pointing to a white object as gray again. */ void luaC_barrierback_ (lua_State *L, Table *t) { global_State *g = G(L); lua_assert(isblack(t) && !isdead(g, t)); black2gray(t); /* make table gray (again) */ linkgclist(t, g->grayagain); } /* ** barrier for assignments to closed upvalues. Because upvalues are ** shared among closures, it is impossible to know the color of all ** closures pointing to it. So, we assume that the object being assigned ** must be marked. */ void luaC_upvalbarrier_ (lua_State *L, UpVal *uv) { global_State *g = G(L); GCObject *o = gcvalue(uv->v); lua_assert(!upisopen(uv)); /* ensured by macro luaC_upvalbarrier */ if (keepinvariant(g)) markobject(g, o); } void luaC_fix (lua_State *L, GCObject *o) { global_State *g = G(L); lua_assert(g->allgc == o); /* object must be 1st in 'allgc' list! */ white2gray(o); /* they will be gray forever */ g->allgc = o->next; /* remove object from 'allgc' list */ o->next = g->fixedgc; /* link it to 'fixedgc' list */ g->fixedgc = o; } /* ** create a new collectable object (with given type and size) and link ** it to 'allgc' list. */ GCObject *luaC_newobj (lua_State *L, int tt, size_t sz) { global_State *g = G(L); GCObject *o = cast(GCObject *, luaM_newobject(L, novariant(tt), sz)); o->marked = luaC_white(g); o->tt = tt; o->next = g->allgc; g->allgc = o; return o; } /* }====================================================== */ /* ** {====================================================== ** Mark functions ** ======================================================= */ /* ** mark an object. Userdata, strings, and closed upvalues are visited ** and turned black here. Other objects are marked gray and added ** to appropriate list to be visited (and turned black) later. (Open ** upvalues are already linked in 'headuv' list.) */ static void reallymarkobject (global_State *g, GCObject *o) { reentry: white2gray(o); switch (o->tt) { case LUA_TSHRSTR: { gray2black(o); g->GCmemtrav += sizelstring(gco2ts(o)->shrlen); break; } case LUA_TLNGSTR: { gray2black(o); g->GCmemtrav += sizelstring(gco2ts(o)->u.lnglen); break; } case LUA_TUSERDATA: { TValue uvalue; markobjectN(g, gco2u(o)->metatable); /* mark its metatable */ gray2black(o); g->GCmemtrav += sizeudata(gco2u(o)); getuservalue(g->mainthread, gco2u(o), &uvalue); if (valiswhite(&uvalue)) { /* markvalue(g, &uvalue); */ o = gcvalue(&uvalue); goto reentry; } break; } case LUA_TLCL: { linkgclist(gco2lcl(o), g->gray); break; } case LUA_TCCL: { linkgclist(gco2ccl(o), g->gray); break; } case LUA_TTABLE: { linkgclist(gco2t(o), g->gray); break; } case LUA_TTHREAD: { linkgclist(gco2th(o), g->gray); break; } case LUA_TPROTO: { linkgclist(gco2p(o), g->gray); break; } default: lua_assert(0); break; } } /* ** mark metamethods for basic types */ static void markmt (global_State *g) { int i; for (i=0; i < LUA_NUMTAGS; i++) markobjectN(g, g->mt[i]); } /* ** mark all objects in list of being-finalized */ static void markbeingfnz (global_State *g) { GCObject *o; for (o = g->tobefnz; o != NULL; o = o->next) markobject(g, o); } /* ** Mark all values stored in marked open upvalues from non-marked threads. ** (Values from marked threads were already marked when traversing the ** thread.) Remove from the list threads that no longer have upvalues and ** not-marked threads. */ static void remarkupvals (global_State *g) { lua_State *thread; lua_State **p = &g->twups; while ((thread = *p) != NULL) { lua_assert(!isblack(thread)); /* threads are never black */ if (isgray(thread) && thread->openupval != NULL) p = &thread->twups; /* keep marked thread with upvalues in the list */ else { /* thread is not marked or without upvalues */ UpVal *uv; *p = thread->twups; /* remove thread from the list */ thread->twups = thread; /* mark that it is out of list */ for (uv = thread->openupval; uv != NULL; uv = uv->u.open.next) { if (uv->u.open.touched) { markvalue(g, uv->v); /* remark upvalue's value */ uv->u.open.touched = 0; } } } } } /* ** mark root set and reset all gray lists, to start a new collection */ static void restartcollection (global_State *g) { g->gray = g->grayagain = NULL; g->weak = g->allweak = g->ephemeron = NULL; markobject(g, g->mainthread); markvalue(g, &g->l_registry); markmt(g); markbeingfnz(g); /* mark any finalizing object left from previous cycle */ } /* }====================================================== */ /* ** {====================================================== ** Traverse functions ** ======================================================= */ /* ** Traverse a table with weak values and link it to proper list. During ** propagate phase, keep it in 'grayagain' list, to be revisited in the ** atomic phase. In the atomic phase, if table has any white value, ** put it in 'weak' list, to be cleared. */ static void traverseweakvalue (global_State *g, Table *h) { Node *n, *limit = gnodelast(h); /* if there is array part, assume it may have white values (it is not worth traversing it now just to check) */ int hasclears = (h->sizearray > 0); for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */ checkdeadkey(n); if (ttisnil(gval(n))) /* entry is empty? */ removeentry(n); /* remove it */ else { lua_assert(!ttisnil(gkey(n))); markvalue(g, gkey(n)); /* mark key */ if (!hasclears && iscleared(g, gval(n))) /* is there a white value? */ hasclears = 1; /* table will have to be cleared */ } } if (g->gcstate == GCSpropagate) linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */ else if (hasclears) linkgclist(h, g->weak); /* has to be cleared later */ } /* ** Traverse an ephemeron table and link it to proper list. Returns true ** iff any object was marked during this traversal (which implies that ** convergence has to continue). During propagation phase, keep table ** in 'grayagain' list, to be visited again in the atomic phase. In ** the atomic phase, if table has any white->white entry, it has to ** be revisited during ephemeron convergence (as that key may turn ** black). Otherwise, if it has any white key, table has to be cleared ** (in the atomic phase). */ static int traverseephemeron (global_State *g, Table *h) { int marked = 0; /* true if an object is marked in this traversal */ int hasclears = 0; /* true if table has white keys */ int hasww = 0; /* true if table has entry "white-key -> white-value" */ Node *n, *limit = gnodelast(h); unsigned int i; /* traverse array part */ for (i = 0; i < h->sizearray; i++) { if (valiswhite(&h->array[i])) { marked = 1; reallymarkobject(g, gcvalue(&h->array[i])); } } /* traverse hash part */ for (n = gnode(h, 0); n < limit; n++) { checkdeadkey(n); if (ttisnil(gval(n))) /* entry is empty? */ removeentry(n); /* remove it */ else if (iscleared(g, gkey(n))) { /* key is not marked (yet)? */ hasclears = 1; /* table must be cleared */ if (valiswhite(gval(n))) /* value not marked yet? */ hasww = 1; /* white-white entry */ } else if (valiswhite(gval(n))) { /* value not marked yet? */ marked = 1; reallymarkobject(g, gcvalue(gval(n))); /* mark it now */ } } /* link table into proper list */ if (g->gcstate == GCSpropagate) linkgclist(h, g->grayagain); /* must retraverse it in atomic phase */ else if (hasww) /* table has white->white entries? */ linkgclist(h, g->ephemeron); /* have to propagate again */ else if (hasclears) /* table has white keys? */ linkgclist(h, g->allweak); /* may have to clean white keys */ return marked; } static void traversestrongtable (global_State *g, Table *h) { Node *n, *limit = gnodelast(h); unsigned int i; for (i = 0; i < h->sizearray; i++) /* traverse array part */ markvalue(g, &h->array[i]); for (n = gnode(h, 0); n < limit; n++) { /* traverse hash part */ checkdeadkey(n); if (ttisnil(gval(n))) /* entry is empty? */ removeentry(n); /* remove it */ else { lua_assert(!ttisnil(gkey(n))); markvalue(g, gkey(n)); /* mark key */ markvalue(g, gval(n)); /* mark value */ } } } static lu_mem traversetable (global_State *g, Table *h) { const char *weakkey, *weakvalue; const TValue *mode = gfasttm(g, h->metatable, TM_MODE); markobjectN(g, h->metatable); if (mode && ttisstring(mode) && /* is there a weak mode? */ ((weakkey = strchr(svalue(mode), 'k')), (weakvalue = strchr(svalue(mode), 'v')), (weakkey || weakvalue))) { /* is really weak? */ black2gray(h); /* keep table gray */ if (!weakkey) /* strong keys? */ traverseweakvalue(g, h); else if (!weakvalue) /* strong values? */ traverseephemeron(g, h); else /* all weak */ linkgclist(h, g->allweak); /* nothing to traverse now */ } else /* not weak */ traversestrongtable(g, h); return sizeof(Table) + sizeof(TValue) * h->sizearray + sizeof(Node) * cast(size_t, sizenode(h)); } /* ** Traverse a prototype. (While a prototype is being build, its ** arrays can be larger than needed; the extra slots are filled with ** NULL, so the use of 'markobjectN') */ static int traverseproto (global_State *g, Proto *f) { int i; if (f->cache && iswhite(f->cache)) f->cache = NULL; /* allow cache to be collected */ markobjectN(g, f->source); for (i = 0; i < f->sizek; i++) /* mark literals */ markvalue(g, &f->k[i]); for (i = 0; i < f->sizeupvalues; i++) /* mark upvalue names */ markobjectN(g, f->upvalues[i].name); for (i = 0; i < f->sizep; i++) /* mark nested protos */ markobjectN(g, f->p[i]); for (i = 0; i < f->sizelocvars; i++) /* mark local-variable names */ markobjectN(g, f->locvars[i].varname); return sizeof(Proto) + sizeof(Instruction) * f->sizecode + sizeof(Proto *) * f->sizep + sizeof(TValue) * f->sizek + sizeof(int) * f->sizelineinfo + sizeof(LocVar) * f->sizelocvars + sizeof(Upvaldesc) * f->sizeupvalues; } static lu_mem traverseCclosure (global_State *g, CClosure *cl) { int i; for (i = 0; i < cl->nupvalues; i++) /* mark its upvalues */ markvalue(g, &cl->upvalue[i]); return sizeCclosure(cl->nupvalues); } /* ** open upvalues point to values in a thread, so those values should ** be marked when the thread is traversed except in the atomic phase ** (because then the value cannot be changed by the thread and the ** thread may not be traversed again) */ static lu_mem traverseLclosure (global_State *g, LClosure *cl) { int i; markobjectN(g, cl->p); /* mark its prototype */ for (i = 0; i < cl->nupvalues; i++) { /* mark its upvalues */ UpVal *uv = cl->upvals[i]; if (uv != NULL) { if (upisopen(uv) && g->gcstate != GCSinsideatomic) uv->u.open.touched = 1; /* can be marked in 'remarkupvals' */ else markvalue(g, uv->v); } } return sizeLclosure(cl->nupvalues); } static lu_mem traversethread (global_State *g, lua_State *th) { StkId o = th->stack; if (o == NULL) return 1; /* stack not completely built yet */ lua_assert(g->gcstate == GCSinsideatomic || th->openupval == NULL || isintwups(th)); for (; o < th->top; o++) /* mark live elements in the stack */ markvalue(g, o); if (g->gcstate == GCSinsideatomic) { /* final traversal? */ StkId lim = th->stack + th->stacksize; /* real end of stack */ for (; o < lim; o++) /* clear not-marked stack slice */ setnilvalue(o); /* 'remarkupvals' may have removed thread from 'twups' list */ if (!isintwups(th) && th->openupval != NULL) { th->twups = g->twups; /* link it back to the list */ g->twups = th; } } else if (g->gckind != KGC_EMERGENCY) luaD_shrinkstack(th); /* do not change stack in emergency cycle */ return (sizeof(lua_State) + sizeof(TValue) * th->stacksize + sizeof(CallInfo) * th->nci); } /* ** traverse one gray object, turning it to black (except for threads, ** which are always gray). */ static void propagatemark (global_State *g) { lu_mem size; GCObject *o = g->gray; lua_assert(isgray(o)); gray2black(o); switch (o->tt) { case LUA_TTABLE: { Table *h = gco2t(o); g->gray = h->gclist; /* remove from 'gray' list */ size = traversetable(g, h); break; } case LUA_TLCL: { LClosure *cl = gco2lcl(o); g->gray = cl->gclist; /* remove from 'gray' list */ size = traverseLclosure(g, cl); break; } case LUA_TCCL: { CClosure *cl = gco2ccl(o); g->gray = cl->gclist; /* remove from 'gray' list */ size = traverseCclosure(g, cl); break; } case LUA_TTHREAD: { lua_State *th = gco2th(o); g->gray = th->gclist; /* remove from 'gray' list */ linkgclist(th, g->grayagain); /* insert into 'grayagain' list */ black2gray(o); size = traversethread(g, th); break; } case LUA_TPROTO: { Proto *p = gco2p(o); g->gray = p->gclist; /* remove from 'gray' list */ size = traverseproto(g, p); break; } default: lua_assert(0); return; } g->GCmemtrav += size; } static void propagateall (global_State *g) { while (g->gray) propagatemark(g); } static void convergeephemerons (global_State *g) { int changed; do { GCObject *w; GCObject *next = g->ephemeron; /* get ephemeron list */ g->ephemeron = NULL; /* tables may return to this list when traversed */ changed = 0; while ((w = next) != NULL) { next = gco2t(w)->gclist; if (traverseephemeron(g, gco2t(w))) { /* traverse marked some value? */ propagateall(g); /* propagate changes */ changed = 1; /* will have to revisit all ephemeron tables */ } } } while (changed); } /* }====================================================== */ /* ** {====================================================== ** Sweep Functions ** ======================================================= */ /* ** clear entries with unmarked keys from all weaktables in list 'l' up ** to element 'f' */ static void clearkeys (global_State *g, GCObject *l, GCObject *f) { for (; l != f; l = gco2t(l)->gclist) { Table *h = gco2t(l); Node *n, *limit = gnodelast(h); for (n = gnode(h, 0); n < limit; n++) { if (!ttisnil(gval(n)) && (iscleared(g, gkey(n)))) { setnilvalue(gval(n)); /* remove value ... */ removeentry(n); /* and remove entry from table */ } } } } /* ** clear entries with unmarked values from all weaktables in list 'l' up ** to element 'f' */ static void clearvalues (global_State *g, GCObject *l, GCObject *f) { for (; l != f; l = gco2t(l)->gclist) { Table *h = gco2t(l); Node *n, *limit = gnodelast(h); unsigned int i; for (i = 0; i < h->sizearray; i++) { TValue *o = &h->array[i]; if (iscleared(g, o)) /* value was collected? */ setnilvalue(o); /* remove value */ } for (n = gnode(h, 0); n < limit; n++) { if (!ttisnil(gval(n)) && iscleared(g, gval(n))) { setnilvalue(gval(n)); /* remove value ... */ removeentry(n); /* and remove entry from table */ } } } } void luaC_upvdeccount (lua_State *L, UpVal *uv) { lua_assert(uv->refcount > 0); uv->refcount--; if (uv->refcount == 0 && !upisopen(uv)) luaM_free(L, uv); } static void freeLclosure (lua_State *L, LClosure *cl) { int i; for (i = 0; i < cl->nupvalues; i++) { UpVal *uv = cl->upvals[i]; if (uv) luaC_upvdeccount(L, uv); } luaM_freemem(L, cl, sizeLclosure(cl->nupvalues)); } static void freeobj (lua_State *L, GCObject *o) { switch (o->tt) { case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break; case LUA_TLCL: { freeLclosure(L, gco2lcl(o)); break; } case LUA_TCCL: { luaM_freemem(L, o, sizeCclosure(gco2ccl(o)->nupvalues)); break; } case LUA_TTABLE: luaH_free(L, gco2t(o)); break; case LUA_TTHREAD: luaE_freethread(L, gco2th(o)); break; case LUA_TUSERDATA: luaM_freemem(L, o, sizeudata(gco2u(o))); break; case LUA_TSHRSTR: luaS_remove(L, gco2ts(o)); /* remove it from hash table */ luaM_freemem(L, o, sizelstring(gco2ts(o)->shrlen)); break; case LUA_TLNGSTR: { luaM_freemem(L, o, sizelstring(gco2ts(o)->u.lnglen)); break; } default: lua_assert(0); } } #define sweepwholelist(L,p) sweeplist(L,p,MAX_LUMEM) static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count); /* ** sweep at most 'count' elements from a list of GCObjects erasing dead ** objects, where a dead object is one marked with the old (non current) ** white; change all non-dead objects back to white, preparing for next ** collection cycle. Return where to continue the traversal or NULL if ** list is finished. */ static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) { global_State *g = G(L); int ow = otherwhite(g); int white = luaC_white(g); /* current white */ while (*p != NULL && count-- > 0) { GCObject *curr = *p; int marked = curr->marked; if (isdeadm(ow, marked)) { /* is 'curr' dead? */ *p = curr->next; /* remove 'curr' from list */ freeobj(L, curr); /* erase 'curr' */ } else { /* change mark to 'white' */ curr->marked = cast_byte((marked & maskcolors) | white); p = &curr->next; /* go to next element */ } } return (*p == NULL) ? NULL : p; } /* ** sweep a list until a live object (or end of list) */ static GCObject **sweeptolive (lua_State *L, GCObject **p, int *n) { GCObject **old = p; int i = 0; do { i++; p = sweeplist(L, p, 1); } while (p == old); if (n) *n += i; return p; } /* }====================================================== */ /* ** {====================================================== ** Finalization ** ======================================================= */ /* ** If possible, shrink string table */ static void checkSizes (lua_State *L, global_State *g) { if (g->gckind != KGC_EMERGENCY) { l_mem olddebt = g->GCdebt; if (g->strt.nuse < g->strt.size / 4) /* string table too big? */ luaS_resize(L, g->strt.size / 2); /* shrink it a little */ g->GCestimate += g->GCdebt - olddebt; /* update estimate */ } } static GCObject *udata2finalize (global_State *g) { GCObject *o = g->tobefnz; /* get first element */ lua_assert(tofinalize(o)); g->tobefnz = o->next; /* remove it from 'tobefnz' list */ o->next = g->allgc; /* return it to 'allgc' list */ g->allgc = o; resetbit(o->marked, FINALIZEDBIT); /* object is "normal" again */ if (issweepphase(g)) makewhite(g, o); /* "sweep" object */ return o; } static void dothecall (lua_State *L, void *ud) { UNUSED(ud); luaD_callnoyield(L, L->top - 2, 0); } static void GCTM (lua_State *L, int propagateerrors) { global_State *g = G(L); const TValue *tm; TValue v; setgcovalue(L, &v, udata2finalize(g)); tm = luaT_gettmbyobj(L, &v, TM_GC); if (tm != NULL && ttisfunction(tm)) { /* is there a finalizer? */ int status; lu_byte oldah = L->allowhook; int running = g->gcrunning; L->allowhook = 0; /* stop debug hooks during GC metamethod */ g->gcrunning = 0; /* avoid GC steps */ setobj2s(L, L->top, tm); /* push finalizer... */ setobj2s(L, L->top + 1, &v); /* ... and its argument */ L->top += 2; /* and (next line) call the finalizer */ status = luaD_pcall(L, dothecall, NULL, savestack(L, L->top - 2), 0); L->allowhook = oldah; /* restore hooks */ g->gcrunning = running; /* restore state */ if (status != LUA_OK && propagateerrors) { /* error while running __gc? */ if (status == LUA_ERRRUN) { /* is there an error object? */ const char *msg = (ttisstring(L->top - 1)) ? svalue(L->top - 1) : "no message"; luaO_pushfstring(L, "error in __gc metamethod (%s)", msg); status = LUA_ERRGCMM; /* error in __gc metamethod */ } luaD_throw(L, status); /* re-throw error */ } } } /* ** call a few (up to 'g->gcfinnum') finalizers */ static int runafewfinalizers (lua_State *L) { global_State *g = G(L); unsigned int i; lua_assert(!g->tobefnz || g->gcfinnum > 0); for (i = 0; g->tobefnz && i < g->gcfinnum; i++) GCTM(L, 1); /* call one finalizer */ g->gcfinnum = (!g->tobefnz) ? 0 /* nothing more to finalize? */ : g->gcfinnum * 2; /* else call a few more next time */ return i; } /* ** call all pending finalizers */ static void callallpendingfinalizers (lua_State *L, int propagateerrors) { global_State *g = G(L); while (g->tobefnz) GCTM(L, propagateerrors); } /* ** find last 'next' field in list 'p' list (to add elements in its end) */ static GCObject **findlast (GCObject **p) { while (*p != NULL) p = &(*p)->next; return p; } /* ** move all unreachable objects (or 'all' objects) that need ** finalization from list 'finobj' to list 'tobefnz' (to be finalized) */ static void separatetobefnz (global_State *g, int all) { GCObject *curr; GCObject **p = &g->finobj; GCObject **lastnext = findlast(&g->tobefnz); while ((curr = *p) != NULL) { /* traverse all finalizable objects */ lua_assert(tofinalize(curr)); if (!(iswhite(curr) || all)) /* not being collected? */ p = &curr->next; /* don't bother with it */ else { *p = curr->next; /* remove 'curr' from 'finobj' list */ curr->next = *lastnext; /* link at the end of 'tobefnz' list */ *lastnext = curr; lastnext = &curr->next; } } } /* ** if object 'o' has a finalizer, remove it from 'allgc' list (must ** search the list to find it) and link it in 'finobj' list. */ void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt) { global_State *g = G(L); if (tofinalize(o) || /* obj. is already marked... */ gfasttm(g, mt, TM_GC) == NULL) /* or has no finalizer? */ return; /* nothing to be done */ else { /* move 'o' to 'finobj' list */ GCObject **p; if (issweepphase(g)) { makewhite(g, o); /* "sweep" object 'o' */ if (g->sweepgc == &o->next) /* should not remove 'sweepgc' object */ g->sweepgc = sweeptolive(L, g->sweepgc, NULL); /* change 'sweepgc' */ } /* search for pointer pointing to 'o' */ for (p = &g->allgc; *p != o; p = &(*p)->next) { /* empty */ } *p = o->next; /* remove 'o' from 'allgc' list */ o->next = g->finobj; /* link it in 'finobj' list */ g->finobj = o; l_setbit(o->marked, FINALIZEDBIT); /* mark it as such */ } } /* }====================================================== */ /* ** {====================================================== ** GC control ** ======================================================= */ /* ** Set a reasonable "time" to wait before starting a new GC cycle; cycle ** will start when memory use hits threshold. (Division by 'estimate' ** should be OK: it cannot be zero (because Lua cannot even start with ** less than PAUSEADJ bytes). */ static void setpause (global_State *g) { l_mem threshold, debt; l_mem estimate = g->GCestimate / PAUSEADJ; /* adjust 'estimate' */ lua_assert(estimate > 0); threshold = (g->gcpause < MAX_LMEM / estimate) /* overflow? */ ? estimate * g->gcpause /* no overflow */ : MAX_LMEM; /* overflow; truncate to maximum */ debt = gettotalbytes(g) - threshold; luaE_setdebt(g, debt); } /* ** Enter first sweep phase. ** The call to 'sweeptolive' makes pointer point to an object inside ** the list (instead of to the header), so that the real sweep do not ** need to skip objects created between "now" and the start of the real ** sweep. ** Returns how many objects it swept. */ static int entersweep (lua_State *L) { global_State *g = G(L); int n = 0; g->gcstate = GCSswpallgc; lua_assert(g->sweepgc == NULL); g->sweepgc = sweeptolive(L, &g->allgc, &n); return n; } void luaC_freeallobjects (lua_State *L) { global_State *g = G(L); separatetobefnz(g, 1); /* separate all objects with finalizers */ lua_assert(g->finobj == NULL); callallpendingfinalizers(L, 0); lua_assert(g->tobefnz == NULL); g->currentwhite = WHITEBITS; /* this "white" makes all objects look dead */ g->gckind = KGC_NORMAL; sweepwholelist(L, &g->finobj); sweepwholelist(L, &g->allgc); sweepwholelist(L, &g->fixedgc); /* collect fixed objects */ lua_assert(g->strt.nuse == 0); } static l_mem atomic (lua_State *L) { global_State *g = G(L); l_mem work; GCObject *origweak, *origall; GCObject *grayagain = g->grayagain; /* save original list */ lua_assert(g->ephemeron == NULL && g->weak == NULL); lua_assert(!iswhite(g->mainthread)); g->gcstate = GCSinsideatomic; g->GCmemtrav = 0; /* start counting work */ markobject(g, L); /* mark running thread */ /* registry and global metatables may be changed by API */ markvalue(g, &g->l_registry); markmt(g); /* mark global metatables */ /* remark occasional upvalues of (maybe) dead threads */ remarkupvals(g); propagateall(g); /* propagate changes */ work = g->GCmemtrav; /* stop counting (do not recount 'grayagain') */ g->gray = grayagain; propagateall(g); /* traverse 'grayagain' list */ g->GCmemtrav = 0; /* restart counting */ convergeephemerons(g); /* at this point, all strongly accessible objects are marked. */ /* Clear values from weak tables, before checking finalizers */ clearvalues(g, g->weak, NULL); clearvalues(g, g->allweak, NULL); origweak = g->weak; origall = g->allweak; work += g->GCmemtrav; /* stop counting (objects being finalized) */ separatetobefnz(g, 0); /* separate objects to be finalized */ g->gcfinnum = 1; /* there may be objects to be finalized */ markbeingfnz(g); /* mark objects that will be finalized */ propagateall(g); /* remark, to propagate 'resurrection' */ g->GCmemtrav = 0; /* restart counting */ convergeephemerons(g); /* at this point, all resurrected objects are marked. */ /* remove dead objects from weak tables */ clearkeys(g, g->ephemeron, NULL); /* clear keys from all ephemeron tables */ clearkeys(g, g->allweak, NULL); /* clear keys from all 'allweak' tables */ /* clear values from resurrected weak tables */ clearvalues(g, g->weak, origweak); clearvalues(g, g->allweak, origall); luaS_clearcache(g); g->currentwhite = cast_byte(otherwhite(g)); /* flip current white */ work += g->GCmemtrav; /* complete counting */ return work; /* estimate of memory marked by 'atomic' */ } static lu_mem sweepstep (lua_State *L, global_State *g, int nextstate, GCObject **nextlist) { if (g->sweepgc) { l_mem olddebt = g->GCdebt; g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX); g->GCestimate += g->GCdebt - olddebt; /* update estimate */ if (g->sweepgc) /* is there still something to sweep? */ return (GCSWEEPMAX * GCSWEEPCOST); } /* else enter next state */ g->gcstate = nextstate; g->sweepgc = nextlist; return 0; } static lu_mem singlestep (lua_State *L) { global_State *g = G(L); switch (g->gcstate) { case GCSpause: { g->GCmemtrav = g->strt.size * sizeof(GCObject*); restartcollection(g); g->gcstate = GCSpropagate; return g->GCmemtrav; } case GCSpropagate: { g->GCmemtrav = 0; lua_assert(g->gray); propagatemark(g); if (g->gray == NULL) /* no more gray objects? */ g->gcstate = GCSatomic; /* finish propagate phase */ return g->GCmemtrav; /* memory traversed in this step */ } case GCSatomic: { lu_mem work; int sw; propagateall(g); /* make sure gray list is empty */ work = atomic(L); /* work is what was traversed by 'atomic' */ sw = entersweep(L); g->GCestimate = gettotalbytes(g); /* first estimate */; return work + sw * GCSWEEPCOST; } case GCSswpallgc: { /* sweep "regular" objects */ return sweepstep(L, g, GCSswpfinobj, &g->finobj); } case GCSswpfinobj: { /* sweep objects with finalizers */ return sweepstep(L, g, GCSswptobefnz, &g->tobefnz); } case GCSswptobefnz: { /* sweep objects to be finalized */ return sweepstep(L, g, GCSswpend, NULL); } case GCSswpend: { /* finish sweeps */ makewhite(g, g->mainthread); /* sweep main thread */ checkSizes(L, g); g->gcstate = GCScallfin; return 0; } case GCScallfin: { /* call remaining finalizers */ if (g->tobefnz && g->gckind != KGC_EMERGENCY) { int n = runafewfinalizers(L); return (n * GCFINALIZECOST); } else { /* emergency mode or no more finalizers */ g->gcstate = GCSpause; /* finish collection */ return 0; } } default: lua_assert(0); return 0; } } /* ** advances the garbage collector until it reaches a state allowed ** by 'statemask' */ void luaC_runtilstate (lua_State *L, int statesmask) { global_State *g = G(L); while (!testbit(statesmask, g->gcstate)) singlestep(L); } /* ** get GC debt and convert it from Kb to 'work units' (avoid zero debt ** and overflows) */ static l_mem getdebt (global_State *g) { l_mem debt = g->GCdebt; int stepmul = g->gcstepmul; if (debt <= 0) return 0; /* minimal debt */ else { debt = (debt / STEPMULADJ) + 1; debt = (debt < MAX_LMEM / stepmul) ? debt * stepmul : MAX_LMEM; return debt; } } /* ** performs a basic GC step when collector is running */ void luaC_step (lua_State *L) { global_State *g = G(L); l_mem debt = getdebt(g); /* GC deficit (be paid now) */ if (!g->gcrunning) { /* not running? */ luaE_setdebt(g, -GCSTEPSIZE * 10); /* avoid being called too often */ return; } do { /* repeat until pause or enough "credit" (negative debt) */ lu_mem work = singlestep(L); /* perform one single step */ debt -= work; } while (debt > -GCSTEPSIZE && g->gcstate != GCSpause); if (g->gcstate == GCSpause) setpause(g); /* pause until next cycle */ else { debt = (debt / g->gcstepmul) * STEPMULADJ; /* convert 'work units' to Kb */ luaE_setdebt(g, debt); runafewfinalizers(L); } } /* ** Performs a full GC cycle; if 'isemergency', set a flag to avoid ** some operations which could change the interpreter state in some ** unexpected ways (running finalizers and shrinking some structures). ** Before running the collection, check 'keepinvariant'; if it is true, ** there may be some objects marked as black, so the collector has ** to sweep all objects to turn them back to white (as white has not ** changed, nothing will be collected). */ void luaC_fullgc (lua_State *L, int isemergency) { global_State *g = G(L); lua_assert(g->gckind == KGC_NORMAL); if (isemergency) g->gckind = KGC_EMERGENCY; /* set flag */ if (keepinvariant(g)) { /* black objects? */ entersweep(L); /* sweep everything to turn them back to white */ } /* finish any pending sweep phase to start a new cycle */ luaC_runtilstate(L, bitmask(GCSpause)); luaC_runtilstate(L, ~bitmask(GCSpause)); /* start new collection */ luaC_runtilstate(L, bitmask(GCScallfin)); /* run up to finalizers */ /* estimate must be correct after a full GC cycle */ lua_assert(g->GCestimate == gettotalbytes(g)); luaC_runtilstate(L, bitmask(GCSpause)); /* finish collection */ g->gckind = KGC_NORMAL; setpause(g); } /* }====================================================== */ wcc-0.0.2/src/wsh/lua/src/llimits.h0000644000175000017500000001677413110675433015547 0ustar philphil/* ** $Id: llimits.h,v 1.141 2015/11/19 19:16:22 roberto Exp $ ** Limits, basic types, and some other 'installation-dependent' definitions ** See Copyright Notice in lua.h */ #ifndef llimits_h #define llimits_h #include #include #include "lua.h" /* ** 'lu_mem' and 'l_mem' are unsigned/signed integers big enough to count ** the total memory used by Lua (in bytes). Usually, 'size_t' and ** 'ptrdiff_t' should work, but we use 'long' for 16-bit machines. */ #if defined(LUAI_MEM) /* { external definitions? */ typedef LUAI_UMEM lu_mem; typedef LUAI_MEM l_mem; #elif LUAI_BITSINT >= 32 /* }{ */ typedef size_t lu_mem; typedef ptrdiff_t l_mem; #else /* 16-bit ints */ /* }{ */ typedef unsigned long lu_mem; typedef long l_mem; #endif /* } */ /* chars used as small naturals (so that 'char' is reserved for characters) */ typedef unsigned char lu_byte; /* maximum value for size_t */ #define MAX_SIZET ((size_t)(~(size_t)0)) /* maximum size visible for Lua (must be representable in a lua_Integer */ #define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \ : (size_t)(LUA_MAXINTEGER)) #define MAX_LUMEM ((lu_mem)(~(lu_mem)0)) #define MAX_LMEM ((l_mem)(MAX_LUMEM >> 1)) #define MAX_INT INT_MAX /* maximum value of an int */ /* ** conversion of pointer to unsigned integer: ** this is for hashing only; there is no problem if the integer ** cannot hold the whole pointer value */ #define point2uint(p) ((unsigned int)((size_t)(p) & UINT_MAX)) /* type to ensure maximum alignment */ #if defined(LUAI_USER_ALIGNMENT_T) typedef LUAI_USER_ALIGNMENT_T L_Umaxalign; #else typedef union { lua_Number n; double u; void *s; lua_Integer i; long l; } L_Umaxalign; #endif /* types of 'usual argument conversions' for lua_Number and lua_Integer */ typedef LUAI_UACNUMBER l_uacNumber; typedef LUAI_UACINT l_uacInt; /* internal assertions for in-house debugging */ #if defined(lua_assert) #define check_exp(c,e) (lua_assert(c), (e)) /* to avoid problems with conditions too long */ #define lua_longassert(c) ((c) ? (void)0 : lua_assert(0)) #else #define lua_assert(c) ((void)0) #define check_exp(c,e) (e) #define lua_longassert(c) ((void)0) #endif /* ** assertion for checking API calls */ #if !defined(luai_apicheck) #define luai_apicheck(l,e) lua_assert(e) #endif #define api_check(l,e,msg) luai_apicheck(l,(e) && msg) /* macro to avoid warnings about unused variables */ #if !defined(UNUSED) #define UNUSED(x) ((void)(x)) #endif /* type casts (a macro highlights casts in the code) */ #define cast(t, exp) ((t)(exp)) #define cast_void(i) cast(void, (i)) #define cast_byte(i) cast(lu_byte, (i)) #define cast_num(i) cast(lua_Number, (i)) #define cast_int(i) cast(int, (i)) #define cast_uchar(i) cast(unsigned char, (i)) /* cast a signed lua_Integer to lua_Unsigned */ #if !defined(l_castS2U) #define l_castS2U(i) ((lua_Unsigned)(i)) #endif /* ** cast a lua_Unsigned to a signed lua_Integer; this cast is ** not strict ISO C, but two-complement architectures should ** work fine. */ #if !defined(l_castU2S) #define l_castU2S(i) ((lua_Integer)(i)) #endif /* ** non-return type */ #if defined(__GNUC__) #define l_noret void __attribute__((noreturn)) #elif defined(_MSC_VER) && _MSC_VER >= 1200 #define l_noret void __declspec(noreturn) #else #define l_noret void #endif /* ** maximum depth for nested C calls and syntactical nested non-terminals ** in a program. (Value must fit in an unsigned short int.) */ #if !defined(LUAI_MAXCCALLS) #define LUAI_MAXCCALLS 200 #endif /* ** type for virtual-machine instructions; ** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h) */ #if LUAI_BITSINT >= 32 typedef unsigned int Instruction; #else typedef unsigned long Instruction; #endif /* ** Maximum length for short strings, that is, strings that are ** internalized. (Cannot be smaller than reserved words or tags for ** metamethods, as these strings must be internalized; ** #("function") = 8, #("__newindex") = 10.) */ #if !defined(LUAI_MAXSHORTLEN) #define LUAI_MAXSHORTLEN 40 #endif /* ** Initial size for the string table (must be power of 2). ** The Lua core alone registers ~50 strings (reserved words + ** metaevent keys + a few others). Libraries would typically add ** a few dozens more. */ #if !defined(MINSTRTABSIZE) #define MINSTRTABSIZE 128 #endif /* ** Size of cache for strings in the API. 'N' is the number of ** sets (better be a prime) and "M" is the size of each set (M == 1 ** makes a direct cache.) */ #if !defined(STRCACHE_N) #define STRCACHE_N 53 #define STRCACHE_M 2 #endif /* minimum size for string buffer */ #if !defined(LUA_MINBUFFER) #define LUA_MINBUFFER 32 #endif /* ** macros that are executed whenever program enters the Lua core ** ('lua_lock') and leaves the core ('lua_unlock') */ #if !defined(lua_lock) #define lua_lock(L) ((void) 0) #define lua_unlock(L) ((void) 0) #endif /* ** macro executed during Lua functions at points where the ** function can yield. */ #if !defined(luai_threadyield) #define luai_threadyield(L) {lua_unlock(L); lua_lock(L);} #endif /* ** these macros allow user-specific actions on threads when you defined ** LUAI_EXTRASPACE and need to do something extra when a thread is ** created/deleted/resumed/yielded. */ #if !defined(luai_userstateopen) #define luai_userstateopen(L) ((void)L) #endif #if !defined(luai_userstateclose) #define luai_userstateclose(L) ((void)L) #endif #if !defined(luai_userstatethread) #define luai_userstatethread(L,L1) ((void)L) #endif #if !defined(luai_userstatefree) #define luai_userstatefree(L,L1) ((void)L) #endif #if !defined(luai_userstateresume) #define luai_userstateresume(L,n) ((void)L) #endif #if !defined(luai_userstateyield) #define luai_userstateyield(L,n) ((void)L) #endif /* ** The luai_num* macros define the primitive operations over numbers. */ /* floor division (defined as 'floor(a/b)') */ #if !defined(luai_numidiv) #define luai_numidiv(L,a,b) ((void)L, l_floor(luai_numdiv(L,a,b))) #endif /* float division */ #if !defined(luai_numdiv) #define luai_numdiv(L,a,b) ((a)/(b)) #endif /* ** modulo: defined as 'a - floor(a/b)*b'; this definition gives NaN when ** 'b' is huge, but the result should be 'a'. 'fmod' gives the result of ** 'a - trunc(a/b)*b', and therefore must be corrected when 'trunc(a/b) ** ~= floor(a/b)'. That happens when the division has a non-integer ** negative result, which is equivalent to the test below. */ #if !defined(luai_nummod) #define luai_nummod(L,a,b,m) \ { (m) = l_mathop(fmod)(a,b); if ((m)*(b) < 0) (m) += (b); } #endif /* exponentiation */ #if !defined(luai_numpow) #define luai_numpow(L,a,b) ((void)L, l_mathop(pow)(a,b)) #endif /* the others are quite standard operations */ #if !defined(luai_numadd) #define luai_numadd(L,a,b) ((a)+(b)) #define luai_numsub(L,a,b) ((a)-(b)) #define luai_nummul(L,a,b) ((a)*(b)) #define luai_numunm(L,a) (-(a)) #define luai_numeq(a,b) ((a)==(b)) #define luai_numlt(a,b) ((a)<(b)) #define luai_numle(a,b) ((a)<=(b)) #define luai_numisnan(a) (!luai_numeq((a), (a))) #endif /* ** macro to control inclusion of some hard tests on stack reallocation */ #if !defined(HARDSTACKTESTS) #define condmovestack(L,pre,pos) ((void)0) #else /* realloc stack keeping its size */ #define condmovestack(L,pre,pos) \ { int sz_ = (L)->stacksize; pre; luaD_reallocstack((L), sz_); pos; } #endif #if !defined(HARDMEMTESTS) #define condchangemem(L,pre,pos) ((void)0) #else #define condchangemem(L,pre,pos) \ { if (G(L)->gcrunning) { pre; luaC_fullgc(L, 0); pos; } } #endif #endif wcc-0.0.2/src/wsh/lua/src/liolib.c0000644000175000017500000004705713110675433015335 0ustar philphil/* ** $Id: liolib.c,v 2.148 2015/11/23 11:36:11 roberto Exp $ ** Standard I/O (and system) library ** See Copyright Notice in lua.h */ #define liolib_c #define LUA_LIB #include "lprefix.h" #include #include #include #include #include #include #include "lua.h" #include "lauxlib.h" #include "lualib.h" /* ** Change this macro to accept other modes for 'fopen' besides ** the standard ones. */ #if !defined(l_checkmode) /* accepted extensions to 'mode' in 'fopen' */ #if !defined(L_MODEEXT) #define L_MODEEXT "b" #endif /* Check whether 'mode' matches '[rwa]%+?[L_MODEEXT]*' */ #define l_checkmode(mode) \ (*mode != '\0' && strchr("rwa", *(mode++)) != NULL && \ (*mode != '+' || (++mode, 1)) && /* skip if char is '+' */ \ (strspn(mode, L_MODEEXT) == strlen(mode))) #endif /* ** {====================================================== ** l_popen spawns a new process connected to the current ** one through the file streams. ** ======================================================= */ #if !defined(l_popen) /* { */ #if defined(LUA_USE_POSIX) /* { */ #define l_popen(L,c,m) (fflush(NULL), popen(c,m)) #define l_pclose(L,file) (pclose(file)) #elif defined(LUA_USE_WINDOWS) /* }{ */ #define l_popen(L,c,m) (_popen(c,m)) #define l_pclose(L,file) (_pclose(file)) #else /* }{ */ /* ISO C definitions */ #define l_popen(L,c,m) \ ((void)((void)c, m), \ luaL_error(L, "'popen' not supported"), \ (FILE*)0) #define l_pclose(L,file) ((void)L, (void)file, -1) #endif /* } */ #endif /* } */ /* }====================================================== */ #if !defined(l_getc) /* { */ #if defined(LUA_USE_POSIX) #define l_getc(f) getc_unlocked(f) #define l_lockfile(f) flockfile(f) #define l_unlockfile(f) funlockfile(f) #else #define l_getc(f) getc(f) #define l_lockfile(f) ((void)0) #define l_unlockfile(f) ((void)0) #endif #endif /* } */ /* ** {====================================================== ** l_fseek: configuration for longer offsets ** ======================================================= */ #if !defined(l_fseek) /* { */ #if defined(LUA_USE_POSIX) /* { */ #include #define l_fseek(f,o,w) fseeko(f,o,w) #define l_ftell(f) ftello(f) #define l_seeknum off_t #elif defined(LUA_USE_WINDOWS) && !defined(_CRTIMP_TYPEINFO) \ && defined(_MSC_VER) && (_MSC_VER >= 1400) /* }{ */ /* Windows (but not DDK) and Visual C++ 2005 or higher */ #define l_fseek(f,o,w) _fseeki64(f,o,w) #define l_ftell(f) _ftelli64(f) #define l_seeknum __int64 #else /* }{ */ /* ISO C definitions */ #define l_fseek(f,o,w) fseek(f,o,w) #define l_ftell(f) ftell(f) #define l_seeknum long #endif /* } */ #endif /* } */ /* }====================================================== */ #define IO_PREFIX "_IO_" #define IOPREF_LEN (sizeof(IO_PREFIX)/sizeof(char) - 1) #define IO_INPUT (IO_PREFIX "input") #define IO_OUTPUT (IO_PREFIX "output") typedef luaL_Stream LStream; #define tolstream(L) ((LStream *)luaL_checkudata(L, 1, LUA_FILEHANDLE)) #define isclosed(p) ((p)->closef == NULL) static int io_type (lua_State *L) { LStream *p; luaL_checkany(L, 1); p = (LStream *)luaL_testudata(L, 1, LUA_FILEHANDLE); if (p == NULL) lua_pushnil(L); /* not a file */ else if (isclosed(p)) lua_pushliteral(L, "closed file"); else lua_pushliteral(L, "file"); return 1; } static int f_tostring (lua_State *L) { LStream *p = tolstream(L); if (isclosed(p)) lua_pushliteral(L, "file (closed)"); else lua_pushfstring(L, "file (%p)", p->f); return 1; } static FILE *tofile (lua_State *L) { LStream *p = tolstream(L); if (isclosed(p)) luaL_error(L, "attempt to use a closed file"); lua_assert(p->f); return p->f; } /* ** When creating file handles, always creates a 'closed' file handle ** before opening the actual file; so, if there is a memory error, the ** handle is in a consistent state. */ static LStream *newprefile (lua_State *L) { LStream *p = (LStream *)lua_newuserdata(L, sizeof(LStream)); p->closef = NULL; /* mark file handle as 'closed' */ luaL_setmetatable(L, LUA_FILEHANDLE); return p; } /* ** Calls the 'close' function from a file handle. The 'volatile' avoids ** a bug in some versions of the Clang compiler (e.g., clang 3.0 for ** 32 bits). */ static int aux_close (lua_State *L) { LStream *p = tolstream(L); volatile lua_CFunction cf = p->closef; p->closef = NULL; /* mark stream as closed */ return (*cf)(L); /* close it */ } static int io_close (lua_State *L) { if (lua_isnone(L, 1)) /* no argument? */ lua_getfield(L, LUA_REGISTRYINDEX, IO_OUTPUT); /* use standard output */ tofile(L); /* make sure argument is an open stream */ return aux_close(L); } static int f_gc (lua_State *L) { LStream *p = tolstream(L); if (!isclosed(p) && p->f != NULL) aux_close(L); /* ignore closed and incompletely open files */ return 0; } /* ** function to close regular files */ static int io_fclose (lua_State *L) { LStream *p = tolstream(L); int res = fclose(p->f); return luaL_fileresult(L, (res == 0), NULL); } static LStream *newfile (lua_State *L) { LStream *p = newprefile(L); p->f = NULL; p->closef = &io_fclose; return p; } static void opencheck (lua_State *L, const char *fname, const char *mode) { LStream *p = newfile(L); p->f = fopen(fname, mode); if (p->f == NULL) luaL_error(L, "cannot open file '%s' (%s)", fname, strerror(errno)); } static int io_open (lua_State *L) { const char *filename = luaL_checkstring(L, 1); const char *mode = luaL_optstring(L, 2, "r"); LStream *p = newfile(L); const char *md = mode; /* to traverse/check mode */ luaL_argcheck(L, l_checkmode(md), 2, "invalid mode"); p->f = fopen(filename, mode); return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1; } /* ** function to close 'popen' files */ static int io_pclose (lua_State *L) { LStream *p = tolstream(L); return luaL_execresult(L, l_pclose(L, p->f)); } static int io_popen (lua_State *L) { const char *filename = luaL_checkstring(L, 1); const char *mode = luaL_optstring(L, 2, "r"); LStream *p = newprefile(L); p->f = l_popen(L, filename, mode); p->closef = &io_pclose; return (p->f == NULL) ? luaL_fileresult(L, 0, filename) : 1; } static int io_tmpfile (lua_State *L) { LStream *p = newfile(L); p->f = tmpfile(); return (p->f == NULL) ? luaL_fileresult(L, 0, NULL) : 1; } static FILE *getiofile (lua_State *L, const char *findex) { LStream *p; lua_getfield(L, LUA_REGISTRYINDEX, findex); p = (LStream *)lua_touserdata(L, -1); if (isclosed(p)) luaL_error(L, "standard %s file is closed", findex + IOPREF_LEN); return p->f; } static int g_iofile (lua_State *L, const char *f, const char *mode) { if (!lua_isnoneornil(L, 1)) { const char *filename = lua_tostring(L, 1); if (filename) opencheck(L, filename, mode); else { tofile(L); /* check that it's a valid file handle */ lua_pushvalue(L, 1); } lua_setfield(L, LUA_REGISTRYINDEX, f); } /* return current value */ lua_getfield(L, LUA_REGISTRYINDEX, f); return 1; } static int io_input (lua_State *L) { return g_iofile(L, IO_INPUT, "r"); } static int io_output (lua_State *L) { return g_iofile(L, IO_OUTPUT, "w"); } static int io_readline (lua_State *L); /* ** maximum number of arguments to 'f:lines'/'io.lines' (it + 3 must fit ** in the limit for upvalues of a closure) */ #define MAXARGLINE 250 static void aux_lines (lua_State *L, int toclose) { int n = lua_gettop(L) - 1; /* number of arguments to read */ luaL_argcheck(L, n <= MAXARGLINE, MAXARGLINE + 2, "too many arguments"); lua_pushinteger(L, n); /* number of arguments to read */ lua_pushboolean(L, toclose); /* close/not close file when finished */ lua_rotate(L, 2, 2); /* move 'n' and 'toclose' to their positions */ lua_pushcclosure(L, io_readline, 3 + n); } static int f_lines (lua_State *L) { tofile(L); /* check that it's a valid file handle */ aux_lines(L, 0); return 1; } static int io_lines (lua_State *L) { int toclose; if (lua_isnone(L, 1)) lua_pushnil(L); /* at least one argument */ if (lua_isnil(L, 1)) { /* no file name? */ lua_getfield(L, LUA_REGISTRYINDEX, IO_INPUT); /* get default input */ lua_replace(L, 1); /* put it at index 1 */ tofile(L); /* check that it's a valid file handle */ toclose = 0; /* do not close it after iteration */ } else { /* open a new file */ const char *filename = luaL_checkstring(L, 1); opencheck(L, filename, "r"); lua_replace(L, 1); /* put file at index 1 */ toclose = 1; /* close it after iteration */ } aux_lines(L, toclose); return 1; } /* ** {====================================================== ** READ ** ======================================================= */ /* maximum length of a numeral */ #define MAXRN 200 /* auxiliary structure used by 'read_number' */ typedef struct { FILE *f; /* file being read */ int c; /* current character (look ahead) */ int n; /* number of elements in buffer 'buff' */ char buff[MAXRN + 1]; /* +1 for ending '\0' */ } RN; /* ** Add current char to buffer (if not out of space) and read next one */ static int nextc (RN *rn) { if (rn->n >= MAXRN) { /* buffer overflow? */ rn->buff[0] = '\0'; /* invalidate result */ return 0; /* fail */ } else { rn->buff[rn->n++] = rn->c; /* save current char */ rn->c = l_getc(rn->f); /* read next one */ return 1; } } /* ** Accept current char if it is in 'set' (of size 1 or 2) */ static int test2 (RN *rn, const char *set) { if (rn->c == set[0] || (rn->c == set[1] && rn->c != '\0')) return nextc(rn); else return 0; } /* ** Read a sequence of (hex)digits */ static int readdigits (RN *rn, int hex) { int count = 0; while ((hex ? isxdigit(rn->c) : isdigit(rn->c)) && nextc(rn)) count++; return count; } /* ** Read a number: first reads a valid prefix of a numeral into a buffer. ** Then it calls 'lua_stringtonumber' to check whether the format is ** correct and to convert it to a Lua number */ static int read_number (lua_State *L, FILE *f) { RN rn; int count = 0; int hex = 0; char decp[2]; rn.f = f; rn.n = 0; decp[0] = lua_getlocaledecpoint(); /* get decimal point from locale */ decp[1] = '\0'; l_lockfile(rn.f); do { rn.c = l_getc(rn.f); } while (isspace(rn.c)); /* skip spaces */ test2(&rn, "-+"); /* optional signal */ if (test2(&rn, "0")) { if (test2(&rn, "xX")) hex = 1; /* numeral is hexadecimal */ else count = 1; /* count initial '0' as a valid digit */ } count += readdigits(&rn, hex); /* integral part */ if (test2(&rn, decp)) /* decimal point? */ count += readdigits(&rn, hex); /* fractional part */ if (count > 0 && test2(&rn, (hex ? "pP" : "eE"))) { /* exponent mark? */ test2(&rn, "-+"); /* exponent signal */ readdigits(&rn, 0); /* exponent digits */ } ungetc(rn.c, rn.f); /* unread look-ahead char */ l_unlockfile(rn.f); rn.buff[rn.n] = '\0'; /* finish string */ if (lua_stringtonumber(L, rn.buff)) /* is this a valid number? */ return 1; /* ok */ else { /* invalid format */ lua_pushnil(L); /* "result" to be removed */ return 0; /* read fails */ } } static int test_eof (lua_State *L, FILE *f) { int c = getc(f); ungetc(c, f); /* no-op when c == EOF */ lua_pushliteral(L, ""); return (c != EOF); } static int read_line (lua_State *L, FILE *f, int chop) { luaL_Buffer b; int c = '\0'; luaL_buffinit(L, &b); while (c != EOF && c != '\n') { /* repeat until end of line */ char *buff = luaL_prepbuffer(&b); /* preallocate buffer */ int i = 0; l_lockfile(f); /* no memory errors can happen inside the lock */ while (i < LUAL_BUFFERSIZE && (c = l_getc(f)) != EOF && c != '\n') buff[i++] = c; l_unlockfile(f); luaL_addsize(&b, i); } if (!chop && c == '\n') /* want a newline and have one? */ luaL_addchar(&b, c); /* add ending newline to result */ luaL_pushresult(&b); /* close buffer */ /* return ok if read something (either a newline or something else) */ return (c == '\n' || lua_rawlen(L, -1) > 0); } static void read_all (lua_State *L, FILE *f) { size_t nr; luaL_Buffer b; luaL_buffinit(L, &b); do { /* read file in chunks of LUAL_BUFFERSIZE bytes */ char *p = luaL_prepbuffer(&b); nr = fread(p, sizeof(char), LUAL_BUFFERSIZE, f); luaL_addsize(&b, nr); } while (nr == LUAL_BUFFERSIZE); luaL_pushresult(&b); /* close buffer */ } static int read_chars (lua_State *L, FILE *f, size_t n) { size_t nr; /* number of chars actually read */ char *p; luaL_Buffer b; luaL_buffinit(L, &b); p = luaL_prepbuffsize(&b, n); /* prepare buffer to read whole block */ nr = fread(p, sizeof(char), n, f); /* try to read 'n' chars */ luaL_addsize(&b, nr); luaL_pushresult(&b); /* close buffer */ return (nr > 0); /* true iff read something */ } static int g_read (lua_State *L, FILE *f, int first) { int nargs = lua_gettop(L) - 1; int success; int n; clearerr(f); if (nargs == 0) { /* no arguments? */ success = read_line(L, f, 1); n = first+1; /* to return 1 result */ } else { /* ensure stack space for all results and for auxlib's buffer */ luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments"); success = 1; for (n = first; nargs-- && success; n++) { if (lua_type(L, n) == LUA_TNUMBER) { size_t l = (size_t)luaL_checkinteger(L, n); success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l); } else { const char *p = luaL_checkstring(L, n); if (*p == '*') p++; /* skip optional '*' (for compatibility) */ switch (*p) { case 'n': /* number */ success = read_number(L, f); break; case 'l': /* line */ success = read_line(L, f, 1); break; case 'L': /* line with end-of-line */ success = read_line(L, f, 0); break; case 'a': /* file */ read_all(L, f); /* read entire file */ success = 1; /* always success */ break; default: return luaL_argerror(L, n, "invalid format"); } } } } if (ferror(f)) return luaL_fileresult(L, 0, NULL); if (!success) { lua_pop(L, 1); /* remove last result */ lua_pushnil(L); /* push nil instead */ } return n - first; } static int io_read (lua_State *L) { return g_read(L, getiofile(L, IO_INPUT), 1); } static int f_read (lua_State *L) { return g_read(L, tofile(L), 2); } static int io_readline (lua_State *L) { LStream *p = (LStream *)lua_touserdata(L, lua_upvalueindex(1)); int i; int n = (int)lua_tointeger(L, lua_upvalueindex(2)); if (isclosed(p)) /* file is already closed? */ return luaL_error(L, "file is already closed"); lua_settop(L , 1); luaL_checkstack(L, n, "too many arguments"); for (i = 1; i <= n; i++) /* push arguments to 'g_read' */ lua_pushvalue(L, lua_upvalueindex(3 + i)); n = g_read(L, p->f, 2); /* 'n' is number of results */ lua_assert(n > 0); /* should return at least a nil */ if (lua_toboolean(L, -n)) /* read at least one value? */ return n; /* return them */ else { /* first result is nil: EOF or error */ if (n > 1) { /* is there error information? */ /* 2nd result is error message */ return luaL_error(L, "%s", lua_tostring(L, -n + 1)); } if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */ lua_settop(L, 0); lua_pushvalue(L, lua_upvalueindex(1)); aux_close(L); /* close it */ } return 0; } } /* }====================================================== */ static int g_write (lua_State *L, FILE *f, int arg) { int nargs = lua_gettop(L) - arg; int status = 1; for (; nargs--; arg++) { if (lua_type(L, arg) == LUA_TNUMBER) { /* optimization: could be done exactly as for strings */ int len = lua_isinteger(L, arg) ? fprintf(f, LUA_INTEGER_FMT, lua_tointeger(L, arg)) : fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)); status = status && (len > 0); } else { size_t l; const char *s = luaL_checklstring(L, arg, &l); status = status && (fwrite(s, sizeof(char), l, f) == l); } } if (status) return 1; /* file handle already on stack top */ else return luaL_fileresult(L, status, NULL); } static int io_write (lua_State *L) { return g_write(L, getiofile(L, IO_OUTPUT), 1); } static int f_write (lua_State *L) { FILE *f = tofile(L); lua_pushvalue(L, 1); /* push file at the stack top (to be returned) */ return g_write(L, f, 2); } static int f_seek (lua_State *L) { static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END}; static const char *const modenames[] = {"set", "cur", "end", NULL}; FILE *f = tofile(L); int op = luaL_checkoption(L, 2, "cur", modenames); lua_Integer p3 = luaL_optinteger(L, 3, 0); l_seeknum offset = (l_seeknum)p3; luaL_argcheck(L, (lua_Integer)offset == p3, 3, "not an integer in proper range"); op = l_fseek(f, offset, mode[op]); if (op) return luaL_fileresult(L, 0, NULL); /* error */ else { lua_pushinteger(L, (lua_Integer)l_ftell(f)); return 1; } } static int f_setvbuf (lua_State *L) { static const int mode[] = {_IONBF, _IOFBF, _IOLBF}; static const char *const modenames[] = {"no", "full", "line", NULL}; FILE *f = tofile(L); int op = luaL_checkoption(L, 2, NULL, modenames); lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE); int res = setvbuf(f, NULL, mode[op], (size_t)sz); return luaL_fileresult(L, res == 0, NULL); } static int io_flush (lua_State *L) { return luaL_fileresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL); } static int f_flush (lua_State *L) { return luaL_fileresult(L, fflush(tofile(L)) == 0, NULL); } /* ** functions for 'io' library */ static const luaL_Reg iolib[] = { {"close", io_close}, {"flush", io_flush}, {"input", io_input}, {"lines", io_lines}, {"open", io_open}, {"output", io_output}, {"popen", io_popen}, {"read", io_read}, {"tmpfile", io_tmpfile}, {"type", io_type}, {"write", io_write}, {NULL, NULL} }; /* ** methods for file handles */ static const luaL_Reg flib[] = { {"close", io_close}, {"flush", f_flush}, {"lines", f_lines}, {"read", f_read}, {"seek", f_seek}, {"setvbuf", f_setvbuf}, {"write", f_write}, {"__gc", f_gc}, {"__tostring", f_tostring}, {NULL, NULL} }; static void createmeta (lua_State *L) { luaL_newmetatable(L, LUA_FILEHANDLE); /* create metatable for file handles */ lua_pushvalue(L, -1); /* push metatable */ lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ luaL_setfuncs(L, flib, 0); /* add file methods to new metatable */ lua_pop(L, 1); /* pop new metatable */ } /* ** function to (not) close the standard files stdin, stdout, and stderr */ static int io_noclose (lua_State *L) { LStream *p = tolstream(L); p->closef = &io_noclose; /* keep file opened */ lua_pushnil(L); lua_pushliteral(L, "cannot close standard file"); return 2; } static void createstdfile (lua_State *L, FILE *f, const char *k, const char *fname) { LStream *p = newprefile(L); p->f = f; p->closef = &io_noclose; if (k != NULL) { lua_pushvalue(L, -1); lua_setfield(L, LUA_REGISTRYINDEX, k); /* add file to registry */ } lua_setfield(L, -2, fname); /* add file to module */ } LUAMOD_API int luaopen_io (lua_State *L) { luaL_newlib(L, iolib); /* new module */ createmeta(L); /* create (and set) default files */ createstdfile(L, stdin, IO_INPUT, "stdin"); createstdfile(L, stdout, IO_OUTPUT, "stdout"); createstdfile(L, stderr, NULL, "stderr"); return 1; } wcc-0.0.2/src/wsh/lua/src/llex.c0000644000175000017500000004125613110675433015022 0ustar philphil/* ** $Id: llex.c,v 2.95 2015/11/19 19:16:22 roberto Exp $ ** Lexical Analyzer ** See Copyright Notice in lua.h */ #define llex_c #define LUA_CORE #include "lprefix.h" #include #include #include "lua.h" #include "lctype.h" #include "ldebug.h" #include "ldo.h" #include "lgc.h" #include "llex.h" #include "lobject.h" #include "lparser.h" #include "lstate.h" #include "lstring.h" #include "ltable.h" #include "lzio.h" #define next(ls) (ls->current = zgetc(ls->z)) #define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r') /* ORDER RESERVED */ static const char *const luaX_tokens [] = { "and", "break", "do", "else", "elseif", "end", "false", "for", "function", "goto", "if", "in", "local", "nil", "not", "or", "repeat", "return", "then", "true", "until", "while", "//", "..", "...", "==", ">=", "<=", "~=", "<<", ">>", "::", "", "", "", "", "" }; #define save_and_next(ls) (save(ls, ls->current), next(ls)) static l_noret lexerror (LexState *ls, const char *msg, int token); static void save (LexState *ls, int c) { Mbuffer *b = ls->buff; if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) { size_t newsize; if (luaZ_sizebuffer(b) >= MAX_SIZE/2) lexerror(ls, "lexical element too long", 0); newsize = luaZ_sizebuffer(b) * 2; luaZ_resizebuffer(ls->L, b, newsize); } b->buffer[luaZ_bufflen(b)++] = cast(char, c); } void luaX_init (lua_State *L) { int i; TString *e = luaS_newliteral(L, LUA_ENV); /* create env name */ luaC_fix(L, obj2gco(e)); /* never collect this name */ for (i=0; iextra = cast_byte(i+1); /* reserved word */ } } const char *luaX_token2str (LexState *ls, int token) { if (token < FIRST_RESERVED) { /* single-byte symbols? */ lua_assert(token == cast_uchar(token)); return luaO_pushfstring(ls->L, "'%c'", token); } else { const char *s = luaX_tokens[token - FIRST_RESERVED]; if (token < TK_EOS) /* fixed format (symbols and reserved words)? */ return luaO_pushfstring(ls->L, "'%s'", s); else /* names, strings, and numerals */ return s; } } static const char *txtToken (LexState *ls, int token) { switch (token) { case TK_NAME: case TK_STRING: case TK_FLT: case TK_INT: save(ls, '\0'); return luaO_pushfstring(ls->L, "'%s'", luaZ_buffer(ls->buff)); default: return luaX_token2str(ls, token); } } static l_noret lexerror (LexState *ls, const char *msg, int token) { msg = luaG_addinfo(ls->L, msg, ls->source, ls->linenumber); if (token) luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token)); luaD_throw(ls->L, LUA_ERRSYNTAX); } l_noret luaX_syntaxerror (LexState *ls, const char *msg) { lexerror(ls, msg, ls->t.token); } /* ** creates a new string and anchors it in scanner's table so that ** it will not be collected until the end of the compilation ** (by that time it should be anchored somewhere) */ TString *luaX_newstring (LexState *ls, const char *str, size_t l) { lua_State *L = ls->L; TValue *o; /* entry for 'str' */ TString *ts = luaS_newlstr(L, str, l); /* create new string */ setsvalue2s(L, L->top++, ts); /* temporarily anchor it in stack */ o = luaH_set(L, ls->h, L->top - 1); if (ttisnil(o)) { /* not in use yet? */ /* boolean value does not need GC barrier; table has no metatable, so it does not need to invalidate cache */ setbvalue(o, 1); /* t[string] = true */ luaC_checkGC(L); } else { /* string already present */ ts = tsvalue(keyfromval(o)); /* re-use value previously stored */ } L->top--; /* remove string from stack */ return ts; } /* ** increment line number and skips newline sequence (any of ** \n, \r, \n\r, or \r\n) */ static void inclinenumber (LexState *ls) { int old = ls->current; lua_assert(currIsNewline(ls)); next(ls); /* skip '\n' or '\r' */ if (currIsNewline(ls) && ls->current != old) next(ls); /* skip '\n\r' or '\r\n' */ if (++ls->linenumber >= MAX_INT) lexerror(ls, "chunk has too many lines", 0); } void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source, int firstchar) { ls->t.token = 0; ls->decpoint = '.'; ls->L = L; ls->current = firstchar; ls->lookahead.token = TK_EOS; /* no look-ahead token */ ls->z = z; ls->fs = NULL; ls->linenumber = 1; ls->lastline = 1; ls->source = source; ls->envn = luaS_newliteral(L, LUA_ENV); /* get env name */ luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */ } /* ** ======================================================= ** LEXICAL ANALYZER ** ======================================================= */ static int check_next1 (LexState *ls, int c) { if (ls->current == c) { next(ls); return 1; } else return 0; } /* ** Check whether current char is in set 'set' (with two chars) and ** saves it */ static int check_next2 (LexState *ls, const char *set) { lua_assert(set[2] == '\0'); if (ls->current == set[0] || ls->current == set[1]) { save_and_next(ls); return 1; } else return 0; } /* ** change all characters 'from' in buffer to 'to' */ static void buffreplace (LexState *ls, char from, char to) { if (from != to) { size_t n = luaZ_bufflen(ls->buff); char *p = luaZ_buffer(ls->buff); while (n--) if (p[n] == from) p[n] = to; } } /* ** in case of format error, try to change decimal point separator to ** the one defined in the current locale and check again */ static void trydecpoint (LexState *ls, TValue *o) { char old = ls->decpoint; ls->decpoint = lua_getlocaledecpoint(); buffreplace(ls, old, ls->decpoint); /* try new decimal separator */ if (luaO_str2num(luaZ_buffer(ls->buff), o) == 0) { /* format error with correct decimal point: no more options */ buffreplace(ls, ls->decpoint, '.'); /* undo change (for error message) */ lexerror(ls, "malformed number", TK_FLT); } } /* LUA_NUMBER */ /* ** this function is quite liberal in what it accepts, as 'luaO_str2num' ** will reject ill-formed numerals. */ static int read_numeral (LexState *ls, SemInfo *seminfo) { TValue obj; const char *expo = "Ee"; int first = ls->current; lua_assert(lisdigit(ls->current)); save_and_next(ls); if (first == '0' && check_next2(ls, "xX")) /* hexadecimal? */ expo = "Pp"; for (;;) { if (check_next2(ls, expo)) /* exponent part? */ check_next2(ls, "-+"); /* optional exponent sign */ if (lisxdigit(ls->current)) save_and_next(ls); else if (ls->current == '.') save_and_next(ls); else break; } save(ls, '\0'); buffreplace(ls, '.', ls->decpoint); /* follow locale for decimal point */ if (luaO_str2num(luaZ_buffer(ls->buff), &obj) == 0) /* format error? */ trydecpoint(ls, &obj); /* try to update decimal point separator */ if (ttisinteger(&obj)) { seminfo->i = ivalue(&obj); return TK_INT; } else { lua_assert(ttisfloat(&obj)); seminfo->r = fltvalue(&obj); return TK_FLT; } } /* ** skip a sequence '[=*[' or ']=*]'; if sequence is well formed, return ** its number of '='s; otherwise, return a negative number (-1 iff there ** are no '='s after initial bracket) */ static int skip_sep (LexState *ls) { int count = 0; int s = ls->current; lua_assert(s == '[' || s == ']'); save_and_next(ls); while (ls->current == '=') { save_and_next(ls); count++; } return (ls->current == s) ? count : (-count) - 1; } static void read_long_string (LexState *ls, SemInfo *seminfo, int sep) { int line = ls->linenumber; /* initial line (for error message) */ save_and_next(ls); /* skip 2nd '[' */ if (currIsNewline(ls)) /* string starts with a newline? */ inclinenumber(ls); /* skip it */ for (;;) { switch (ls->current) { case EOZ: { /* error */ const char *what = (seminfo ? "string" : "comment"); const char *msg = luaO_pushfstring(ls->L, "unfinished long %s (starting at line %d)", what, line); lexerror(ls, msg, TK_EOS); break; /* to avoid warnings */ } case ']': { if (skip_sep(ls) == sep) { save_and_next(ls); /* skip 2nd ']' */ goto endloop; } break; } case '\n': case '\r': { save(ls, '\n'); inclinenumber(ls); if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */ break; } default: { if (seminfo) save_and_next(ls); else next(ls); } } } endloop: if (seminfo) seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + (2 + sep), luaZ_bufflen(ls->buff) - 2*(2 + sep)); } static void esccheck (LexState *ls, int c, const char *msg) { if (!c) { if (ls->current != EOZ) save_and_next(ls); /* add current to buffer for error message */ lexerror(ls, msg, TK_STRING); } } static int gethexa (LexState *ls) { save_and_next(ls); esccheck (ls, lisxdigit(ls->current), "hexadecimal digit expected"); return luaO_hexavalue(ls->current); } static int readhexaesc (LexState *ls) { int r = gethexa(ls); r = (r << 4) + gethexa(ls); luaZ_buffremove(ls->buff, 2); /* remove saved chars from buffer */ return r; } static unsigned long readutf8esc (LexState *ls) { unsigned long r; int i = 4; /* chars to be removed: '\', 'u', '{', and first digit */ save_and_next(ls); /* skip 'u' */ esccheck(ls, ls->current == '{', "missing '{'"); r = gethexa(ls); /* must have at least one digit */ while ((save_and_next(ls), lisxdigit(ls->current))) { i++; r = (r << 4) + luaO_hexavalue(ls->current); esccheck(ls, r <= 0x10FFFF, "UTF-8 value too large"); } esccheck(ls, ls->current == '}', "missing '}'"); next(ls); /* skip '}' */ luaZ_buffremove(ls->buff, i); /* remove saved chars from buffer */ return r; } static void utf8esc (LexState *ls) { char buff[UTF8BUFFSZ]; int n = luaO_utf8esc(buff, readutf8esc(ls)); for (; n > 0; n--) /* add 'buff' to string */ save(ls, buff[UTF8BUFFSZ - n]); } static int readdecesc (LexState *ls) { int i; int r = 0; /* result accumulator */ for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */ r = 10*r + ls->current - '0'; save_and_next(ls); } esccheck(ls, r <= UCHAR_MAX, "decimal escape too large"); luaZ_buffremove(ls->buff, i); /* remove read digits from buffer */ return r; } static void read_string (LexState *ls, int del, SemInfo *seminfo) { save_and_next(ls); /* keep delimiter (for error messages) */ while (ls->current != del) { switch (ls->current) { case EOZ: lexerror(ls, "unfinished string", TK_EOS); break; /* to avoid warnings */ case '\n': case '\r': lexerror(ls, "unfinished string", TK_STRING); break; /* to avoid warnings */ case '\\': { /* escape sequences */ int c; /* final character to be saved */ save_and_next(ls); /* keep '\\' for error messages */ switch (ls->current) { case 'a': c = '\a'; goto read_save; case 'b': c = '\b'; goto read_save; case 'f': c = '\f'; goto read_save; case 'n': c = '\n'; goto read_save; case 'r': c = '\r'; goto read_save; case 't': c = '\t'; goto read_save; case 'v': c = '\v'; goto read_save; case 'x': c = readhexaesc(ls); goto read_save; case 'u': utf8esc(ls); goto no_save; case '\n': case '\r': inclinenumber(ls); c = '\n'; goto only_save; case '\\': case '\"': case '\'': c = ls->current; goto read_save; case EOZ: goto no_save; /* will raise an error next loop */ case 'z': { /* zap following span of spaces */ luaZ_buffremove(ls->buff, 1); /* remove '\\' */ next(ls); /* skip the 'z' */ while (lisspace(ls->current)) { if (currIsNewline(ls)) inclinenumber(ls); else next(ls); } goto no_save; } default: { esccheck(ls, lisdigit(ls->current), "invalid escape sequence"); c = readdecesc(ls); /* digital escape '\ddd' */ goto only_save; } } read_save: next(ls); /* go through */ only_save: luaZ_buffremove(ls->buff, 1); /* remove '\\' */ save(ls, c); /* go through */ no_save: break; } default: save_and_next(ls); } } save_and_next(ls); /* skip delimiter */ seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1, luaZ_bufflen(ls->buff) - 2); } static int llex (LexState *ls, SemInfo *seminfo) { luaZ_resetbuffer(ls->buff); for (;;) { switch (ls->current) { case '\n': case '\r': { /* line breaks */ inclinenumber(ls); break; } case ' ': case '\f': case '\t': case '\v': { /* spaces */ next(ls); break; } case '-': { /* '-' or '--' (comment) */ next(ls); if (ls->current != '-') return '-'; /* else is a comment */ next(ls); if (ls->current == '[') { /* long comment? */ int sep = skip_sep(ls); luaZ_resetbuffer(ls->buff); /* 'skip_sep' may dirty the buffer */ if (sep >= 0) { read_long_string(ls, NULL, sep); /* skip long comment */ luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */ break; } } /* else short comment */ while (!currIsNewline(ls) && ls->current != EOZ) next(ls); /* skip until end of line (or end of file) */ break; } case '[': { /* long string or simply '[' */ int sep = skip_sep(ls); if (sep >= 0) { read_long_string(ls, seminfo, sep); return TK_STRING; } else if (sep != -1) /* '[=...' missing second bracket */ lexerror(ls, "invalid long string delimiter", TK_STRING); return '['; } case '=': { next(ls); if (check_next1(ls, '=')) return TK_EQ; else return '='; } case '<': { next(ls); if (check_next1(ls, '=')) return TK_LE; else if (check_next1(ls, '<')) return TK_SHL; else return '<'; } case '>': { next(ls); if (check_next1(ls, '=')) return TK_GE; else if (check_next1(ls, '>')) return TK_SHR; else return '>'; } case '/': { next(ls); if (check_next1(ls, '/')) return TK_IDIV; else return '/'; } case '~': { next(ls); if (check_next1(ls, '=')) return TK_NE; else return '~'; } case ':': { next(ls); if (check_next1(ls, ':')) return TK_DBCOLON; else return ':'; } case '"': case '\'': { /* short literal strings */ read_string(ls, ls->current, seminfo); return TK_STRING; } case '.': { /* '.', '..', '...', or number */ save_and_next(ls); if (check_next1(ls, '.')) { if (check_next1(ls, '.')) return TK_DOTS; /* '...' */ else return TK_CONCAT; /* '..' */ } else if (!lisdigit(ls->current)) return '.'; else return read_numeral(ls, seminfo); } case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { return read_numeral(ls, seminfo); } case EOZ: { return TK_EOS; } default: { if (lislalpha(ls->current)) { /* identifier or reserved word? */ TString *ts; do { save_and_next(ls); } while (lislalnum(ls->current)); ts = luaX_newstring(ls, luaZ_buffer(ls->buff), luaZ_bufflen(ls->buff)); seminfo->ts = ts; if (isreserved(ts)) /* reserved word? */ return ts->extra - 1 + FIRST_RESERVED; else { return TK_NAME; } } else { /* single-char tokens (+ - / ...) */ int c = ls->current; next(ls); return c; } } } } } void luaX_next (LexState *ls) { ls->lastline = ls->linenumber; if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */ ls->t = ls->lookahead; /* use this one */ ls->lookahead.token = TK_EOS; /* and discharge it */ } else ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */ } int luaX_lookahead (LexState *ls) { lua_assert(ls->lookahead.token == TK_EOS); ls->lookahead.token = llex(ls, &ls->lookahead.seminfo); return ls->lookahead.token; } wcc-0.0.2/src/wsh/lua/README0000644000175000017500000000022713110675433013774 0ustar philphil This is Lua 5.3.2, released on 25 Nov 2015. For installation instructions, license details, and further information about Lua, see doc/readme.html. wcc-0.0.2/src/wsh/lua/doc/0000755000175000017500000000000013110675433013660 5ustar philphilwcc-0.0.2/src/wsh/lua/doc/contents.html0000644000175000017500000007230013110675433016405 0ustar philphil Lua 5.3 Reference Manual - contents

Lua Lua 5.3 Reference Manual

The reference manual is the official definition of the Lua language.
For a complete introduction to Lua programming, see the book Programming in Lua.

Copyright © 2015 Lua.org, PUC-Rio. Freely available under the terms of the Lua license.

Contents

Index

wcc-0.0.2/src/wsh/lua/doc/lua.css0000644000175000017500000000430613110675433015156 0ustar philphilhtml { background-color: #F8F8F8 ; } body { background-color: #FFFFFF ; color: #000000 ; font-family: Helvetica, Arial, sans-serif ; text-align: justify ; line-height: 1.25 ; margin: 16px auto ; padding: 32px ; border: solid #a0a0a0 1px ; border-radius: 20px ; max-width: 70em ; width: 90% ; } h1, h2, h3, h4 { color: #000080 ; font-family: Verdana, Geneva, sans-serif ; font-weight: normal ; font-style: normal ; text-align: left ; } h1 { font-size: 28pt ; } h1 img { vertical-align: text-bottom ; } h2:before { content: "\2756" ; padding-right: 0.5em ; } a { text-decoration: none ; } a:link { color: #000080 ; } a:link:hover, a:visited:hover { background-color: #D0D0FF ; color: #000080 ; border-radius: 4px ; } a:link:active, a:visited:active { color: #FF0000 ; } div.menubar { padding-bottom: 0.5em ; } p.menubar { margin-left: 2.5em ; } .menubar a:hover { margin: -3px -3px -3px -3px ; padding: 3px 3px 3px 3px ; border-radius: 4px ; } :target { background-color: #F0F0F0 ; margin: -8px ; padding: 8px ; border-radius: 8px ; outline: none ; } hr { display: none ; } table hr { background-color: #a0a0a0 ; color: #a0a0a0 ; border: 0 ; height: 1px ; display: block ; } .footer { color: gray ; font-size: x-small ; } input[type=text] { border: solid #a0a0a0 2px ; border-radius: 2em ; background-image: url('images/search.png') ; background-repeat: no-repeat ; background-position: 4px center ; padding-left: 20px ; height: 2em ; } pre.session { background-color: #F8F8F8 ; padding: 1em ; border-radius: 8px ; } td.gutter { width: 4% ; } table.columns { border: none ; border-spacing: 0 ; border-collapse: collapse ; } table.columns td { vertical-align: top ; padding: 0 ; padding-bottom: 1em ; text-align: justify ; line-height: 1.25 ; } p.logos a:link:hover, p.logos a:visited:hover { background-color: inherit ; } table.book { border: none ; border-spacing: 0 ; border-collapse: collapse ; } table.book td { padding: 0 ; vertical-align: top ; } table.book td.cover { padding-right: 1em ; } table.book img { border: solid #000080 1px ; } table.book span { font-size: small ; text-align: left ; display: block ; margin-top: 0.25em ; } wcc-0.0.2/src/wsh/lua/doc/manual.css0000644000175000017500000000040013110675433015641 0ustar philphilh3 code { font-family: inherit ; font-size: inherit ; } pre, code { font-size: 12pt ; } span.apii { color: gray ; float: right ; font-family: inherit ; font-style: normal ; font-size: small ; } h2:before { content: "" ; padding-right: 0em ; } wcc-0.0.2/src/wsh/lua/doc/manual.html0000644000175000017500000116454613110675433016044 0ustar philphil Lua 5.3 Reference Manual

Lua Lua 5.3 Reference Manual

by Roberto Ierusalimschy, Luiz Henrique de Figueiredo, Waldemar Celes

Copyright © 2015 Lua.org, PUC-Rio. Freely available under the terms of the Lua license.

1 – Introduction

Lua is an extension programming language designed to support general procedural programming with data description facilities. Lua also offers good support for object-oriented programming, functional programming, and data-driven programming. Lua is intended to be used as a powerful, lightweight, embeddable scripting language for any program that needs one. Lua is implemented as a library, written in clean C, the common subset of Standard C and C++.

As an extension language, Lua has no notion of a "main" program: it only works embedded in a host client, called the embedding program or simply the host. The host program can invoke functions to execute a piece of Lua code, can write and read Lua variables, and can register C functions to be called by Lua code. Through the use of C functions, Lua can be augmented to cope with a wide range of different domains, thus creating customized programming languages sharing a syntactical framework. The Lua distribution includes a sample host program called lua, which uses the Lua library to offer a complete, standalone Lua interpreter, for interactive or batch use.

Lua is free software, and is provided as usual with no guarantees, as stated in its license. The implementation described in this manual is available at Lua's official web site, www.lua.org.

Like any other reference manual, this document is dry in places. For a discussion of the decisions behind the design of Lua, see the technical papers available at Lua's web site. For a detailed introduction to programming in Lua, see Roberto's book, Programming in Lua.

2 – Basic Concepts

This section describes the basic concepts of the language.

2.1 – Values and Types

Lua is a dynamically typed language. This means that variables do not have types; only values do. There are no type definitions in the language. All values carry their own type.

All values in Lua are first-class values. This means that all values can be stored in variables, passed as arguments to other functions, and returned as results.

There are eight basic types in Lua: nil, boolean, number, string, function, userdata, thread, and table. The type nil has one single value, nil, whose main property is to be different from any other value; it usually represents the absence of a useful value. The type boolean has two values, false and true. Both nil and false make a condition false; any other value makes it true. The type number represents both integer numbers and real (floating-point) numbers. The type string represents immutable sequences of bytes. Lua is 8-bit clean: strings can contain any 8-bit value, including embedded zeros ('\0'). Lua is also encoding-agnostic; it makes no assumptions about the contents of a string.

The type number uses two internal representations, or two subtypes, one called integer and the other called float. Lua has explicit rules about when each representation is used, but it also converts between them automatically as needed (see §3.4.3). Therefore, the programmer may choose to mostly ignore the difference between integers and floats or to assume complete control over the representation of each number. Standard Lua uses 64-bit integers and double-precision (64-bit) floats, but you can also compile Lua so that it uses 32-bit integers and/or single-precision (32-bit) floats. The option with 32 bits for both integers and floats is particularly attractive for small machines and embedded systems. (See macro LUA_32BITS in file luaconf.h.)

Lua can call (and manipulate) functions written in Lua and functions written in C (see §3.4.10). Both are represented by the type function.

The type userdata is provided to allow arbitrary C data to be stored in Lua variables. A userdata value represents a block of raw memory. There are two kinds of userdata: full userdata, which is an object with a block of memory managed by Lua, and light userdata, which is simply a C pointer value. Userdata has no predefined operations in Lua, except assignment and identity test. By using metatables, the programmer can define operations for full userdata values (see §2.4). Userdata values cannot be created or modified in Lua, only through the C API. This guarantees the integrity of data owned by the host program.

The type thread represents independent threads of execution and it is used to implement coroutines (see §2.6). Lua threads are not related to operating-system threads. Lua supports coroutines on all systems, even those that do not support threads natively.

The type table implements associative arrays, that is, arrays that can be indexed not only with numbers, but with any Lua value except nil and NaN. (Not a Number is a special value used to represent undefined or unrepresentable numerical results, such as 0/0.) Tables can be heterogeneous; that is, they can contain values of all types (except nil). Any key with value nil is not considered part of the table. Conversely, any key that is not part of a table has an associated value nil.

Tables are the sole data-structuring mechanism in Lua; they can be used to represent ordinary arrays, sequences, symbol tables, sets, records, graphs, trees, etc. To represent records, Lua uses the field name as an index. The language supports this representation by providing a.name as syntactic sugar for a["name"]. There are several convenient ways to create tables in Lua (see §3.4.9).

We use the term sequence to denote a table where the set of all positive numeric keys is equal to {1..n} for some non-negative integer n, which is called the length of the sequence (see §3.4.7).

Like indices, the values of table fields can be of any type. In particular, because functions are first-class values, table fields can contain functions. Thus tables can also carry methods (see §3.4.11).

The indexing of tables follows the definition of raw equality in the language. The expressions a[i] and a[j] denote the same table element if and only if i and j are raw equal (that is, equal without metamethods). In particular, floats with integral values are equal to their respective integers (e.g., 1.0 == 1). To avoid ambiguities, any float with integral value used as a key is converted to its respective integer. For instance, if you write a[2.0] = true, the actual key inserted into the table will be the integer 2. (On the other hand, 2 and "2" are different Lua values and therefore denote different table entries.)

Tables, functions, threads, and (full) userdata values are objects: variables do not actually contain these values, only references to them. Assignment, parameter passing, and function returns always manipulate references to such values; these operations do not imply any kind of copy.

The library function type returns a string describing the type of a given value (see §6.1).

2.2 – Environments and the Global Environment

As will be discussed in §3.2 and §3.3.3, any reference to a free name (that is, a name not bound to any declaration) var is syntactically translated to _ENV.var. Moreover, every chunk is compiled in the scope of an external local variable named _ENV (see §3.3.2), so _ENV itself is never a free name in a chunk.

Despite the existence of this external _ENV variable and the translation of free names, _ENV is a completely regular name. In particular, you can define new variables and parameters with that name. Each reference to a free name uses the _ENV that is visible at that point in the program, following the usual visibility rules of Lua (see §3.5).

Any table used as the value of _ENV is called an environment.

Lua keeps a distinguished environment called the global environment. This value is kept at a special index in the C registry (see §4.5). In Lua, the global variable _G is initialized with this same value. (_G is never used internally.)

When Lua loads a chunk, the default value for its _ENV upvalue is the global environment (see load). Therefore, by default, free names in Lua code refer to entries in the global environment (and, therefore, they are also called global variables). Moreover, all standard libraries are loaded in the global environment and some functions there operate on that environment. You can use load (or loadfile) to load a chunk with a different environment. (In C, you have to load the chunk and then change the value of its first upvalue.)

2.3 – Error Handling

Because Lua is an embedded extension language, all Lua actions start from C code in the host program calling a function from the Lua library. (When you use Lua standalone, the lua application is the host program.) Whenever an error occurs during the compilation or execution of a Lua chunk, control returns to the host, which can take appropriate measures (such as printing an error message).

Lua code can explicitly generate an error by calling the error function. If you need to catch errors in Lua, you can use pcall or xpcall to call a given function in protected mode.

Whenever there is an error, an error object (also called an error message) is propagated with information about the error. Lua itself only generates errors whose error object is a string, but programs may generate errors with any value as the error object. It is up to the Lua program or its host to handle such error objects.

When you use xpcall or lua_pcall, you may give a message handler to be called in case of errors. This function is called with the original error message and returns a new error message. It is called before the error unwinds the stack, so that it can gather more information about the error, for instance by inspecting the stack and creating a stack traceback. This message handler is still protected by the protected call; so, an error inside the message handler will call the message handler again. If this loop goes on for too long, Lua breaks it and returns an appropriate message.

2.4 – Metatables and Metamethods

Every value in Lua can have a metatable. This metatable is an ordinary Lua table that defines the behavior of the original value under certain special operations. You can change several aspects of the behavior of operations over a value by setting specific fields in its metatable. For instance, when a non-numeric value is the operand of an addition, Lua checks for a function in the field "__add" of the value's metatable. If it finds one, Lua calls this function to perform the addition.

The keys in a metatable are derived from the event names; the corresponding values are called metamethods. In the previous example, the event is "add" and the metamethod is the function that performs the addition.

You can query the metatable of any value using the getmetatable function.

You can replace the metatable of tables using the setmetatable function. You cannot change the metatable of other types from Lua code (except by using the debug library (§6.10)); you should use the C API for that.

Tables and full userdata have individual metatables (although multiple tables and userdata can share their metatables). Values of all other types share one single metatable per type; that is, there is one single metatable for all numbers, one for all strings, etc. By default, a value has no metatable, but the string library sets a metatable for the string type (see §6.4).

A metatable controls how an object behaves in arithmetic operations, bitwise operations, order comparisons, concatenation, length operation, calls, and indexing. A metatable also can define a function to be called when a userdata or a table is garbage collected (§2.5).

A detailed list of events controlled by metatables is given next. Each operation is identified by its corresponding event name. The key for each event is a string with its name prefixed by two underscores, '__'; for instance, the key for operation "add" is the string "__add". Note that queries for metamethods are always raw; the access to a metamethod does not invoke other metamethods.

For the unary operators (negation, length, and bitwise not), the metamethod is computed and called with a dummy second operand, equal to the first one. This extra operand is only to simplify Lua's internals (by making these operators behave like a binary operation) and may be removed in future versions. (For most uses this extra operand is irrelevant.)

  • "add": the + operation. If any operand for an addition is not a number (nor a string coercible to a number), Lua will try to call a metamethod. First, Lua will check the first operand (even if it is valid). If that operand does not define a metamethod for the "__add" event, then Lua will check the second operand. If Lua can find a metamethod, it calls the metamethod with the two operands as arguments, and the result of the call (adjusted to one value) is the result of the operation. Otherwise, it raises an error.
  • "sub": the - operation. Behavior similar to the "add" operation.
  • "mul": the * operation. Behavior similar to the "add" operation.
  • "div": the / operation. Behavior similar to the "add" operation.
  • "mod": the % operation. Behavior similar to the "add" operation.
  • "pow": the ^ (exponentiation) operation. Behavior similar to the "add" operation.
  • "unm": the - (unary minus) operation. Behavior similar to the "add" operation.
  • "idiv": the // (floor division) operation. Behavior similar to the "add" operation.
  • "band": the & (bitwise and) operation. Behavior similar to the "add" operation, except that Lua will try a metamethod if any operand is neither an integer nor a value coercible to an integer (see §3.4.3).
  • "bor": the | (bitwise or) operation. Behavior similar to the "band" operation.
  • "bxor": the ~ (bitwise exclusive or) operation. Behavior similar to the "band" operation.
  • "bnot": the ~ (bitwise unary not) operation. Behavior similar to the "band" operation.
  • "shl": the << (bitwise left shift) operation. Behavior similar to the "band" operation.
  • "shr": the >> (bitwise right shift) operation. Behavior similar to the "band" operation.
  • "concat": the .. (concatenation) operation. Behavior similar to the "add" operation, except that Lua will try a metamethod if any operand is neither a string nor a number (which is always coercible to a string).
  • "len": the # (length) operation. If the object is not a string, Lua will try its metamethod. If there is a metamethod, Lua calls it with the object as argument, and the result of the call (always adjusted to one value) is the result of the operation. If there is no metamethod but the object is a table, then Lua uses the table length operation (see §3.4.7). Otherwise, Lua raises an error.
  • "eq": the == (equal) operation. Behavior similar to the "add" operation, except that Lua will try a metamethod only when the values being compared are either both tables or both full userdata and they are not primitively equal. The result of the call is always converted to a boolean.
  • "lt": the < (less than) operation. Behavior similar to the "add" operation, except that Lua will try a metamethod only when the values being compared are neither both numbers nor both strings. The result of the call is always converted to a boolean.
  • "le": the <= (less equal) operation. Unlike other operations, the less-equal operation can use two different events. First, Lua looks for the "__le" metamethod in both operands, like in the "lt" operation. If it cannot find such a metamethod, then it will try the "__lt" event, assuming that a <= b is equivalent to not (b < a). As with the other comparison operators, the result is always a boolean. (This use of the "__lt" event can be removed in future versions; it is also slower than a real "__le" metamethod.)
  • "index": The indexing access table[key]. This event happens when table is not a table or when key is not present in table. The metamethod is looked up in table.

    Despite the name, the metamethod for this event can be either a function or a table. If it is a function, it is called with table and key as arguments. If it is a table, the final result is the result of indexing this table with key. (This indexing is regular, not raw, and therefore can trigger another metamethod.)

  • "newindex": The indexing assignment table[key] = value. Like the index event, this event happens when table is not a table or when key is not present in table. The metamethod is looked up in table.

    Like with indexing, the metamethod for this event can be either a function or a table. If it is a function, it is called with table, key, and value as arguments. If it is a table, Lua does an indexing assignment to this table with the same key and value. (This assignment is regular, not raw, and therefore can trigger another metamethod.)

    Whenever there is a "newindex" metamethod, Lua does not perform the primitive assignment. (If necessary, the metamethod itself can call rawset to do the assignment.)

  • "call": The call operation func(args). This event happens when Lua tries to call a non-function value (that is, func is not a function). The metamethod is looked up in func. If present, the metamethod is called with func as its first argument, followed by the arguments of the original call (args).

It is a good practice to add all needed metamethods to a table before setting it as a metatable of some object. In particular, the "__gc" metamethod works only when this order is followed (see §2.5.1).

2.5 – Garbage Collection

Lua performs automatic memory management. This means that you do not have to worry about allocating memory for new objects or freeing it when the objects are no longer needed. Lua manages memory automatically by running a garbage collector to collect all dead objects (that is, objects that are no longer accessible from Lua). All memory used by Lua is subject to automatic management: strings, tables, userdata, functions, threads, internal structures, etc.

Lua implements an incremental mark-and-sweep collector. It uses two numbers to control its garbage-collection cycles: the garbage-collector pause and the garbage-collector step multiplier. Both use percentage points as units (e.g., a value of 100 means an internal value of 1).

The garbage-collector pause controls how long the collector waits before starting a new cycle. Larger values make the collector less aggressive. Values smaller than 100 mean the collector will not wait to start a new cycle. A value of 200 means that the collector waits for the total memory in use to double before starting a new cycle.

The garbage-collector step multiplier controls the relative speed of the collector relative to memory allocation. Larger values make the collector more aggressive but also increase the size of each incremental step. You should not use values smaller than 100, because they make the collector too slow and can result in the collector never finishing a cycle. The default is 200, which means that the collector runs at "twice" the speed of memory allocation.

If you set the step multiplier to a very large number (larger than 10% of the maximum number of bytes that the program may use), the collector behaves like a stop-the-world collector. If you then set the pause to 200, the collector behaves as in old Lua versions, doing a complete collection every time Lua doubles its memory usage.

You can change these numbers by calling lua_gc in C or collectgarbage in Lua. You can also use these functions to control the collector directly (e.g., stop and restart it).

2.5.1 – Garbage-Collection Metamethods

You can set garbage-collector metamethods for tables and, using the C API, for full userdata (see §2.4). These metamethods are also called finalizers. Finalizers allow you to coordinate Lua's garbage collection with external resource management (such as closing files, network or database connections, or freeing your own memory).

For an object (table or userdata) to be finalized when collected, you must mark it for finalization. You mark an object for finalization when you set its metatable and the metatable has a field indexed by the string "__gc". Note that if you set a metatable without a __gc field and later create that field in the metatable, the object will not be marked for finalization.

When a marked object becomes garbage, it is not collected immediately by the garbage collector. Instead, Lua puts it in a list. After the collection, Lua goes through that list. For each object in the list, it checks the object's __gc metamethod: If it is a function, Lua calls it with the object as its single argument; if the metamethod is not a function, Lua simply ignores it.

At the end of each garbage-collection cycle, the finalizers for objects are called in the reverse order that the objects were marked for finalization, among those collected in that cycle; that is, the first finalizer to be called is the one associated with the object marked last in the program. The execution of each finalizer may occur at any point during the execution of the regular code.

Because the object being collected must still be used by the finalizer, that object (and other objects accessible only through it) must be resurrected by Lua. Usually, this resurrection is transient, and the object memory is freed in the next garbage-collection cycle. However, if the finalizer stores the object in some global place (e.g., a global variable), then the resurrection is permanent. Moreover, if the finalizer marks a finalizing object for finalization again, its finalizer will be called again in the next cycle where the object is unreachable. In any case, the object memory is freed only in a GC cycle where the object is unreachable and not marked for finalization.

When you close a state (see lua_close), Lua calls the finalizers of all objects marked for finalization, following the reverse order that they were marked. If any finalizer marks objects for collection during that phase, these marks have no effect.

2.5.2 – Weak Tables

A weak table is a table whose elements are weak references. A weak reference is ignored by the garbage collector. In other words, if the only references to an object are weak references, then the garbage collector will collect that object.

A weak table can have weak keys, weak values, or both. A table with weak values allows the collection of its values, but prevents the collection of its keys. A table with both weak keys and weak values allows the collection of both keys and values. In any case, if either the key or the value is collected, the whole pair is removed from the table. The weakness of a table is controlled by the __mode field of its metatable. If the __mode field is a string containing the character 'k', the keys in the table are weak. If __mode contains 'v', the values in the table are weak.

A table with weak keys and strong values is also called an ephemeron table. In an ephemeron table, a value is considered reachable only if its key is reachable. In particular, if the only reference to a key comes through its value, the pair is removed.

Any change in the weakness of a table may take effect only at the next collect cycle. In particular, if you change the weakness to a stronger mode, Lua may still collect some items from that table before the change takes effect.

Only objects that have an explicit construction are removed from weak tables. Values, such as numbers and light C functions, are not subject to garbage collection, and therefore are not removed from weak tables (unless their associated values are collected). Although strings are subject to garbage collection, they do not have an explicit construction, and therefore are not removed from weak tables.

Resurrected objects (that is, objects being finalized and objects accessible only through objects being finalized) have a special behavior in weak tables. They are removed from weak values before running their finalizers, but are removed from weak keys only in the next collection after running their finalizers, when such objects are actually freed. This behavior allows the finalizer to access properties associated with the object through weak tables.

If a weak table is among the resurrected objects in a collection cycle, it may not be properly cleared until the next cycle.

2.6 – Coroutines

Lua supports coroutines, also called collaborative multithreading. A coroutine in Lua represents an independent thread of execution. Unlike threads in multithread systems, however, a coroutine only suspends its execution by explicitly calling a yield function.

You create a coroutine by calling coroutine.create. Its sole argument is a function that is the main function of the coroutine. The create function only creates a new coroutine and returns a handle to it (an object of type thread); it does not start the coroutine.

You execute a coroutine by calling coroutine.resume. When you first call coroutine.resume, passing as its first argument a thread returned by coroutine.create, the coroutine starts its execution by calling its main function. Extra arguments passed to coroutine.resume are passed as arguments to that function. After the coroutine starts running, it runs until it terminates or yields.

A coroutine can terminate its execution in two ways: normally, when its main function returns (explicitly or implicitly, after the last instruction); and abnormally, if there is an unprotected error. In case of normal termination, coroutine.resume returns true, plus any values returned by the coroutine main function. In case of errors, coroutine.resume returns false plus an error message.

A coroutine yields by calling coroutine.yield. When a coroutine yields, the corresponding coroutine.resume returns immediately, even if the yield happens inside nested function calls (that is, not in the main function, but in a function directly or indirectly called by the main function). In the case of a yield, coroutine.resume also returns true, plus any values passed to coroutine.yield. The next time you resume the same coroutine, it continues its execution from the point where it yielded, with the call to coroutine.yield returning any extra arguments passed to coroutine.resume.

Like coroutine.create, the coroutine.wrap function also creates a coroutine, but instead of returning the coroutine itself, it returns a function that, when called, resumes the coroutine. Any arguments passed to this function go as extra arguments to coroutine.resume. coroutine.wrap returns all the values returned by coroutine.resume, except the first one (the boolean error code). Unlike coroutine.resume, coroutine.wrap does not catch errors; any error is propagated to the caller.

As an example of how coroutines work, consider the following code:

     function foo (a)
       print("foo", a)
       return coroutine.yield(2*a)
     end
     
     co = coroutine.create(function (a,b)
           print("co-body", a, b)
           local r = foo(a+1)
           print("co-body", r)
           local r, s = coroutine.yield(a+b, a-b)
           print("co-body", r, s)
           return b, "end"
     end)
     
     print("main", coroutine.resume(co, 1, 10))
     print("main", coroutine.resume(co, "r"))
     print("main", coroutine.resume(co, "x", "y"))
     print("main", coroutine.resume(co, "x", "y"))

When you run it, it produces the following output:

     co-body 1       10
     foo     2
     main    true    4
     co-body r
     main    true    11      -9
     co-body x       y
     main    true    10      end
     main    false   cannot resume dead coroutine

You can also create and manipulate coroutines through the C API: see functions lua_newthread, lua_resume, and lua_yield.

3 – The Language

This section describes the lexis, the syntax, and the semantics of Lua. In other words, this section describes which tokens are valid, how they can be combined, and what their combinations mean.

Language constructs will be explained using the usual extended BNF notation, in which {a} means 0 or more a's, and [a] means an optional a. Non-terminals are shown like non-terminal, keywords are shown like kword, and other terminal symbols are shown like ‘=’. The complete syntax of Lua can be found in §9 at the end of this manual.

3.1 – Lexical Conventions

Lua is a free-form language. It ignores spaces (including new lines) and comments between lexical elements (tokens), except as delimiters between names and keywords.

Names (also called identifiers) in Lua can be any string of letters, digits, and underscores, not beginning with a digit and not being a reserved word. Identifiers are used to name variables, table fields, and labels.

The following keywords are reserved and cannot be used as names:

     and       break     do        else      elseif    end
     false     for       function  goto      if        in
     local     nil       not       or        repeat    return
     then      true      until     while

Lua is a case-sensitive language: and is a reserved word, but And and AND are two different, valid names. As a convention, programs should avoid creating names that start with an underscore followed by one or more uppercase letters (such as _VERSION).

The following strings denote other tokens:

     +     -     *     /     %     ^     #
     &     ~     |     <<    >>    //
     ==    ~=    <=    >=    <     >     =
     (     )     {     }     [     ]     ::
     ;     :     ,     .     ..    ...

Literal strings can be delimited by matching single or double quotes, and can contain the following C-like escape sequences: '\a' (bell), '\b' (backspace), '\f' (form feed), '\n' (newline), '\r' (carriage return), '\t' (horizontal tab), '\v' (vertical tab), '\\' (backslash), '\"' (quotation mark [double quote]), and '\'' (apostrophe [single quote]). A backslash followed by a real newline results in a newline in the string. The escape sequence '\z' skips the following span of white-space characters, including line breaks; it is particularly useful to break and indent a long literal string into multiple lines without adding the newlines and spaces into the string contents.

Strings in Lua can contain any 8-bit value, including embedded zeros, which can be specified as '\0'. More generally, we can specify any byte in a literal string by its numeric value. This can be done with the escape sequence \xXX, where XX is a sequence of exactly two hexadecimal digits, or with the escape sequence \ddd, where ddd is a sequence of up to three decimal digits. (Note that if a decimal escape sequence is to be followed by a digit, it must be expressed using exactly three digits.)

The UTF-8 encoding of a Unicode character can be inserted in a literal string with the escape sequence \u{XXX} (note the mandatory enclosing brackets), where XXX is a sequence of one or more hexadecimal digits representing the character code point.

Literal strings can also be defined using a long format enclosed by long brackets. We define an opening long bracket of level n as an opening square bracket followed by n equal signs followed by another opening square bracket. So, an opening long bracket of level 0 is written as [[, an opening long bracket of level 1 is written as [=[, and so on. A closing long bracket is defined similarly; for instance, a closing long bracket of level 4 is written as ]====]. A long literal starts with an opening long bracket of any level and ends at the first closing long bracket of the same level. It can contain any text except a closing bracket of the same level. Literals in this bracketed form can run for several lines, do not interpret any escape sequences, and ignore long brackets of any other level. Any kind of end-of-line sequence (carriage return, newline, carriage return followed by newline, or newline followed by carriage return) is converted to a simple newline.

Any byte in a literal string not explicitly affected by the previous rules represents itself. However, Lua opens files for parsing in text mode, and the system file functions may have problems with some control characters. So, it is safer to represent non-text data as a quoted literal with explicit escape sequences for non-text characters.

For convenience, when the opening long bracket is immediately followed by a newline, the newline is not included in the string. As an example, in a system using ASCII (in which 'a' is coded as 97, newline is coded as 10, and '1' is coded as 49), the five literal strings below denote the same string:

     a = 'alo\n123"'
     a = "alo\n123\""
     a = '\97lo\10\04923"'
     a = [[alo
     123"]]
     a = [==[
     alo
     123"]==]

A numeric constant (or numeral) can be written with an optional fractional part and an optional decimal exponent, marked by a letter 'e' or 'E'. Lua also accepts hexadecimal constants, which start with 0x or 0X. Hexadecimal constants also accept an optional fractional part plus an optional binary exponent, marked by a letter 'p' or 'P'. A numeric constant with a fractional dot or an exponent denotes a float; otherwise it denotes an integer. Examples of valid integer constants are

     3   345   0xff   0xBEBADA

Examples of valid float constants are

     3.0     3.1416     314.16e-2     0.31416E1     34e1
     0x0.1E  0xA23p-4   0X1.921FB54442D18P+1

A comment starts with a double hyphen (--) anywhere outside a string. If the text immediately after -- is not an opening long bracket, the comment is a short comment, which runs until the end of the line. Otherwise, it is a long comment, which runs until the corresponding closing long bracket. Long comments are frequently used to disable code temporarily.

3.2 – Variables

Variables are places that store values. There are three kinds of variables in Lua: global variables, local variables, and table fields.

A single name can denote a global variable or a local variable (or a function's formal parameter, which is a particular kind of local variable):

	var ::= Name

Name denotes identifiers, as defined in §3.1.

Any variable name is assumed to be global unless explicitly declared as a local (see §3.3.7). Local variables are lexically scoped: local variables can be freely accessed by functions defined inside their scope (see §3.5).

Before the first assignment to a variable, its value is nil.

Square brackets are used to index a table:

	var ::= prefixexp ‘[’ exp ‘]

The meaning of accesses to table fields can be changed via metatables. An access to an indexed variable t[i] is equivalent to a call gettable_event(t,i). (See §2.4 for a complete description of the gettable_event function. This function is not defined or callable in Lua. We use it here only for explanatory purposes.)

The syntax var.Name is just syntactic sugar for var["Name"]:

	var ::= prefixexp ‘.’ Name

An access to a global variable x is equivalent to _ENV.x. Due to the way that chunks are compiled, _ENV is never a global name (see §2.2).

3.3 – Statements

Lua supports an almost conventional set of statements, similar to those in Pascal or C. This set includes assignments, control structures, function calls, and variable declarations.

3.3.1 – Blocks

A block is a list of statements, which are executed sequentially:

	block ::= {stat}

Lua has empty statements that allow you to separate statements with semicolons, start a block with a semicolon or write two semicolons in sequence:

	stat ::= ‘;

Function calls and assignments can start with an open parenthesis. This possibility leads to an ambiguity in Lua's grammar. Consider the following fragment:

     a = b + c
     (print or io.write)('done')

The grammar could see it in two ways:

     a = b + c(print or io.write)('done')
     
     a = b + c; (print or io.write)('done')

The current parser always sees such constructions in the first way, interpreting the open parenthesis as the start of the arguments to a call. To avoid this ambiguity, it is a good practice to always precede with a semicolon statements that start with a parenthesis:

     ;(print or io.write)('done')

A block can be explicitly delimited to produce a single statement:

	stat ::= do block end

Explicit blocks are useful to control the scope of variable declarations. Explicit blocks are also sometimes used to add a return statement in the middle of another block (see §3.3.4).

3.3.2 – Chunks

The unit of compilation of Lua is called a chunk. Syntactically, a chunk is simply a block:

	chunk ::= block

Lua handles a chunk as the body of an anonymous function with a variable number of arguments (see §3.4.11). As such, chunks can define local variables, receive arguments, and return values. Moreover, such anonymous function is compiled as in the scope of an external local variable called _ENV (see §2.2). The resulting function always has _ENV as its only upvalue, even if it does not use that variable.

A chunk can be stored in a file or in a string inside the host program. To execute a chunk, Lua first loads it, precompiling the chunk's code into instructions for a virtual machine, and then Lua executes the compiled code with an interpreter for the virtual machine.

Chunks can also be precompiled into binary form; see program luac and function string.dump for details. Programs in source and compiled forms are interchangeable; Lua automatically detects the file type and acts accordingly (see load).

3.3.3 – Assignment

Lua allows multiple assignments. Therefore, the syntax for assignment defines a list of variables on the left side and a list of expressions on the right side. The elements in both lists are separated by commas:

	stat ::= varlist ‘=’ explist
	varlist ::= var {‘,’ var}
	explist ::= exp {‘,’ exp}

Expressions are discussed in §3.4.

Before the assignment, the list of values is adjusted to the length of the list of variables. If there are more values than needed, the excess values are thrown away. If there are fewer values than needed, the list is extended with as many nil's as needed. If the list of expressions ends with a function call, then all values returned by that call enter the list of values, before the adjustment (except when the call is enclosed in parentheses; see §3.4).

The assignment statement first evaluates all its expressions and only then the assignments are performed. Thus the code

     i = 3
     i, a[i] = i+1, 20

sets a[3] to 20, without affecting a[4] because the i in a[i] is evaluated (to 3) before it is assigned 4. Similarly, the line

     x, y = y, x

exchanges the values of x and y, and

     x, y, z = y, z, x

cyclically permutes the values of x, y, and z.

The meaning of assignments to global variables and table fields can be changed via metatables. An assignment to an indexed variable t[i] = val is equivalent to settable_event(t,i,val). (See §2.4 for a complete description of the settable_event function. This function is not defined or callable in Lua. We use it here only for explanatory purposes.)

An assignment to a global name x = val is equivalent to the assignment _ENV.x = val (see §2.2).

3.3.4 – Control Structures

The control structures if, while, and repeat have the usual meaning and familiar syntax:

	stat ::= while exp do block end
	stat ::= repeat block until exp
	stat ::= if exp then block {elseif exp then block} [else block] end

Lua also has a for statement, in two flavors (see §3.3.5).

The condition expression of a control structure can return any value. Both false and nil are considered false. All values different from nil and false are considered true (in particular, the number 0 and the empty string are also true).

In the repeatuntil loop, the inner block does not end at the until keyword, but only after the condition. So, the condition can refer to local variables declared inside the loop block.

The goto statement transfers the program control to a label. For syntactical reasons, labels in Lua are considered statements too:

	stat ::= goto Name
	stat ::= label
	label ::= ‘::’ Name ‘::

A label is visible in the entire block where it is defined, except inside nested blocks where a label with the same name is defined and inside nested functions. A goto may jump to any visible label as long as it does not enter into the scope of a local variable.

Labels and empty statements are called void statements, as they perform no actions.

The break statement terminates the execution of a while, repeat, or for loop, skipping to the next statement after the loop:

	stat ::= break

A break ends the innermost enclosing loop.

The return statement is used to return values from a function or a chunk (which is an anonymous function). Functions can return more than one value, so the syntax for the return statement is

	stat ::= return [explist] [‘;’]

The return statement can only be written as the last statement of a block. If it is really necessary to return in the middle of a block, then an explicit inner block can be used, as in the idiom do return end, because now return is the last statement in its (inner) block.

3.3.5 – For Statement

The for statement has two forms: one numerical and one generic.

The numerical for loop repeats a block of code while a control variable runs through an arithmetic progression. It has the following syntax:

	stat ::= for Name ‘=’ exp ‘,’ exp [‘,’ exp] do block end

The block is repeated for name starting at the value of the first exp, until it passes the second exp by steps of the third exp. More precisely, a for statement like

     for v = e1, e2, e3 do block end

is equivalent to the code:

     do
       local var, limit, step = tonumber(e1), tonumber(e2), tonumber(e3)
       if not (var and limit and step) then error() end
       var = var - step
       while true do
         var = var + step
         if (step >= 0 and var > limit) or (step < 0 and var < limit) then
           break
         end
         local v = var
         block
       end
     end

Note the following:

  • All three control expressions are evaluated only once, before the loop starts. They must all result in numbers.
  • var, limit, and step are invisible variables. The names shown here are for explanatory purposes only.
  • If the third expression (the step) is absent, then a step of 1 is used.
  • You can use break and goto to exit a for loop.
  • The loop variable v is local to the loop body. If you need its value after the loop, assign it to another variable before exiting the loop.

The generic for statement works over functions, called iterators. On each iteration, the iterator function is called to produce a new value, stopping when this new value is nil. The generic for loop has the following syntax:

	stat ::= for namelist in explist do block end
	namelist ::= Name {‘,’ Name}

A for statement like

     for var_1, ···, var_n in explist do block end

is equivalent to the code:

     do
       local f, s, var = explist
       while true do
         local var_1, ···, var_n = f(s, var)
         if var_1 == nil then break end
         var = var_1
         block
       end
     end

Note the following:

  • explist is evaluated only once. Its results are an iterator function, a state, and an initial value for the first iterator variable.
  • f, s, and var are invisible variables. The names are here for explanatory purposes only.
  • You can use break to exit a for loop.
  • The loop variables var_i are local to the loop; you cannot use their values after the for ends. If you need these values, then assign them to other variables before breaking or exiting the loop.

3.3.6 – Function Calls as Statements

To allow possible side-effects, function calls can be executed as statements:

	stat ::= functioncall

In this case, all returned values are thrown away. Function calls are explained in §3.4.10.

3.3.7 – Local Declarations

Local variables can be declared anywhere inside a block. The declaration can include an initial assignment:

	stat ::= local namelist [‘=’ explist]

If present, an initial assignment has the same semantics of a multiple assignment (see §3.3.3). Otherwise, all variables are initialized with nil.

A chunk is also a block (see §3.3.2), and so local variables can be declared in a chunk outside any explicit block.

The visibility rules for local variables are explained in §3.5.

3.4 – Expressions

The basic expressions in Lua are the following:

	exp ::= prefixexp
	exp ::= nil | false | true
	exp ::= Numeral
	exp ::= LiteralString
	exp ::= functiondef
	exp ::= tableconstructor
	exp ::= ‘...’
	exp ::= exp binop exp
	exp ::= unop exp
	prefixexp ::= var | functioncall | ‘(’ exp ‘)

Numerals and literal strings are explained in §3.1; variables are explained in §3.2; function definitions are explained in §3.4.11; function calls are explained in §3.4.10; table constructors are explained in §3.4.9. Vararg expressions, denoted by three dots ('...'), can only be used when directly inside a vararg function; they are explained in §3.4.11.

Binary operators comprise arithmetic operators (see §3.4.1), bitwise operators (see §3.4.2), relational operators (see §3.4.4), logical operators (see §3.4.5), and the concatenation operator (see §3.4.6). Unary operators comprise the unary minus (see §3.4.1), the unary bitwise not (see §3.4.2), the unary logical not (see §3.4.5), and the unary length operator (see §3.4.7).

Both function calls and vararg expressions can result in multiple values. If a function call is used as a statement (see §3.3.6), then its return list is adjusted to zero elements, thus discarding all returned values. If an expression is used as the last (or the only) element of a list of expressions, then no adjustment is made (unless the expression is enclosed in parentheses). In all other contexts, Lua adjusts the result list to one element, either discarding all values except the first one or adding a single nil if there are no values.

Here are some examples:

     f()                -- adjusted to 0 results
     g(f(), x)          -- f() is adjusted to 1 result
     g(x, f())          -- g gets x plus all results from f()
     a,b,c = f(), x     -- f() is adjusted to 1 result (c gets nil)
     a,b = ...          -- a gets the first vararg parameter, b gets
                        -- the second (both a and b can get nil if there
                        -- is no corresponding vararg parameter)
     
     a,b,c = x, f()     -- f() is adjusted to 2 results
     a,b,c = f()        -- f() is adjusted to 3 results
     return f()         -- returns all results from f()
     return ...         -- returns all received vararg parameters
     return x,y,f()     -- returns x, y, and all results from f()
     {f()}              -- creates a list with all results from f()
     {...}              -- creates a list with all vararg parameters
     {f(), nil}         -- f() is adjusted to 1 result

Any expression enclosed in parentheses always results in only one value. Thus, (f(x,y,z)) is always a single value, even if f returns several values. (The value of (f(x,y,z)) is the first value returned by f or nil if f does not return any values.)

3.4.1 – Arithmetic Operators

Lua supports the following arithmetic operators:

  • +: addition
  • -: subtraction
  • *: multiplication
  • /: float division
  • //: floor division
  • %: modulo
  • ^: exponentiation
  • -: unary minus

With the exception of exponentiation and float division, the arithmetic operators work as follows: If both operands are integers, the operation is performed over integers and the result is an integer. Otherwise, if both operands are numbers or strings that can be converted to numbers (see §3.4.3), then they are converted to floats, the operation is performed following the usual rules for floating-point arithmetic (usually the IEEE 754 standard), and the result is a float.

Exponentiation and float division (/) always convert their operands to floats and the result is always a float. Exponentiation uses the ISO C function pow, so that it works for non-integer exponents too.

Floor division (//) is a division that rounds the quotient towards minus infinity, that is, the floor of the division of its operands.

Modulo is defined as the remainder of a division that rounds the quotient towards minus infinity (floor division).

In case of overflows in integer arithmetic, all operations wrap around, according to the usual rules of two-complement arithmetic. (In other words, they return the unique representable integer that is equal modulo 264 to the mathematical result.)

3.4.2 – Bitwise Operators

Lua supports the following bitwise operators:

  • &: bitwise and
  • |: bitwise or
  • ~: bitwise exclusive or
  • >>: right shift
  • <<: left shift
  • ~: unary bitwise not

All bitwise operations convert its operands to integers (see §3.4.3), operate on all bits of those integers, and result in an integer.

Both right and left shifts fill the vacant bits with zeros. Negative displacements shift to the other direction; displacements with absolute values equal to or higher than the number of bits in an integer result in zero (as all bits are shifted out).

3.4.3 – Coercions and Conversions

Lua provides some automatic conversions between some types and representations at run time. Bitwise operators always convert float operands to integers. Exponentiation and float division always convert integer operands to floats. All other arithmetic operations applied to mixed numbers (integers and floats) convert the integer operand to a float; this is called the usual rule. The C API also converts both integers to floats and floats to integers, as needed. Moreover, string concatenation accepts numbers as arguments, besides strings.

Lua also converts strings to numbers, whenever a number is expected.

In a conversion from integer to float, if the integer value has an exact representation as a float, that is the result. Otherwise, the conversion gets the nearest higher or the nearest lower representable value. This kind of conversion never fails.

The conversion from float to integer checks whether the float has an exact representation as an integer (that is, the float has an integral value and it is in the range of integer representation). If it does, that representation is the result. Otherwise, the conversion fails.

The conversion from strings to numbers goes as follows: First, the string is converted to an integer or a float, following its syntax and the rules of the Lua lexer. (The string may have also leading and trailing spaces and a sign.) Then, the resulting number (float or integer) is converted to the type (float or integer) required by the context (e.g., the operation that forced the conversion).

The conversion from numbers to strings uses a non-specified human-readable format. For complete control over how numbers are converted to strings, use the format function from the string library (see string.format).

3.4.4 – Relational Operators

Lua supports the following relational operators:

  • ==: equality
  • ~=: inequality
  • <: less than
  • >: greater than
  • <=: less or equal
  • >=: greater or equal

These operators always result in false or true.

Equality (==) first compares the type of its operands. If the types are different, then the result is false. Otherwise, the values of the operands are compared. Strings are compared in the obvious way. Numbers are equal if they denote the same mathematical value.

Tables, userdata, and threads are compared by reference: two objects are considered equal only if they are the same object. Every time you create a new object (a table, userdata, or thread), this new object is different from any previously existing object. Closures with the same reference are always equal. Closures with any detectable difference (different behavior, different definition) are always different.

You can change the way that Lua compares tables and userdata by using the "eq" metamethod (see §2.4).

Equality comparisons do not convert strings to numbers or vice versa. Thus, "0"==0 evaluates to false, and t[0] and t["0"] denote different entries in a table.

The operator ~= is exactly the negation of equality (==).

The order operators work as follows. If both arguments are numbers, then they are compared according to their mathematical values (regardless of their subtypes). Otherwise, if both arguments are strings, then their values are compared according to the current locale. Otherwise, Lua tries to call the "lt" or the "le" metamethod (see §2.4). A comparison a > b is translated to b < a and a >= b is translated to b <= a.

Following the IEEE 754 standard, NaN is considered neither smaller than, nor equal to, nor greater than any value (including itself).

3.4.5 – Logical Operators

The logical operators in Lua are and, or, and not. Like the control structures (see §3.3.4), all logical operators consider both false and nil as false and anything else as true.

The negation operator not always returns false or true. The conjunction operator and returns its first argument if this value is false or nil; otherwise, and returns its second argument. The disjunction operator or returns its first argument if this value is different from nil and false; otherwise, or returns its second argument. Both and and or use short-circuit evaluation; that is, the second operand is evaluated only if necessary. Here are some examples:

     10 or 20            --> 10
     10 or error()       --> 10
     nil or "a"          --> "a"
     nil and 10          --> nil
     false and error()   --> false
     false and nil       --> false
     false or nil        --> nil
     10 and 20           --> 20

(In this manual, --> indicates the result of the preceding expression.)

3.4.6 – Concatenation

The string concatenation operator in Lua is denoted by two dots ('..'). If both operands are strings or numbers, then they are converted to strings according to the rules described in §3.4.3. Otherwise, the __concat metamethod is called (see §2.4).

3.4.7 – The Length Operator

The length operator is denoted by the unary prefix operator #. The length of a string is its number of bytes (that is, the usual meaning of string length when each character is one byte).

A program can modify the behavior of the length operator for any value but strings through the __len metamethod (see §2.4).

Unless a __len metamethod is given, the length of a table t is only defined if the table is a sequence, that is, the set of its positive numeric keys is equal to {1..n} for some non-negative integer n. In that case, n is its length. Note that a table like

     {10, 20, nil, 40}

is not a sequence, because it has the key 4 but does not have the key 3. (So, there is no n such that the set {1..n} is equal to the set of positive numeric keys of that table.) Note, however, that non-numeric keys do not interfere with whether a table is a sequence.

3.4.8 – Precedence

Operator precedence in Lua follows the table below, from lower to higher priority:

     or
     and
     <     >     <=    >=    ~=    ==
     |
     ~
     &
     <<    >>
     ..
     +     -
     *     /     //    %
     unary operators (not   #     -     ~)
     ^

As usual, you can use parentheses to change the precedences of an expression. The concatenation ('..') and exponentiation ('^') operators are right associative. All other binary operators are left associative.

3.4.9 – Table Constructors

Table constructors are expressions that create tables. Every time a constructor is evaluated, a new table is created. A constructor can be used to create an empty table or to create a table and initialize some of its fields. The general syntax for constructors is

	tableconstructor ::= ‘{’ [fieldlist] ‘}’
	fieldlist ::= field {fieldsep field} [fieldsep]
	field ::= ‘[’ exp ‘]’ ‘=’ exp | Name ‘=’ exp | exp
	fieldsep ::= ‘,’ | ‘;

Each field of the form [exp1] = exp2 adds to the new table an entry with key exp1 and value exp2. A field of the form name = exp is equivalent to ["name"] = exp. Finally, fields of the form exp are equivalent to [i] = exp, where i are consecutive integers starting with 1. Fields in the other formats do not affect this counting. For example,

     a = { [f(1)] = g; "x", "y"; x = 1, f(x), [30] = 23; 45 }

is equivalent to

     do
       local t = {}
       t[f(1)] = g
       t[1] = "x"         -- 1st exp
       t[2] = "y"         -- 2nd exp
       t.x = 1            -- t["x"] = 1
       t[3] = f(x)        -- 3rd exp
       t[30] = 23
       t[4] = 45          -- 4th exp
       a = t
     end

The order of the assignments in a constructor is undefined. (This order would be relevant only when there are repeated keys.)

If the last field in the list has the form exp and the expression is a function call or a vararg expression, then all values returned by this expression enter the list consecutively (see §3.4.10).

The field list can have an optional trailing separator, as a convenience for machine-generated code.

3.4.10 – Function Calls

A function call in Lua has the following syntax:

	functioncall ::= prefixexp args

In a function call, first prefixexp and args are evaluated. If the value of prefixexp has type function, then this function is called with the given arguments. Otherwise, the prefixexp "call" metamethod is called, having as first parameter the value of prefixexp, followed by the original call arguments (see §2.4).

The form

	functioncall ::= prefixexp ‘:’ Name args

can be used to call "methods". A call v:name(args) is syntactic sugar for v.name(v,args), except that v is evaluated only once.

Arguments have the following syntax:

	args ::= ‘(’ [explist] ‘)’
	args ::= tableconstructor
	args ::= LiteralString

All argument expressions are evaluated before the call. A call of the form f{fields} is syntactic sugar for f({fields}); that is, the argument list is a single new table. A call of the form f'string' (or f"string" or f[[string]]) is syntactic sugar for f('string'); that is, the argument list is a single literal string.

A call of the form return functioncall is called a tail call. Lua implements proper tail calls (or proper tail recursion): in a tail call, the called function reuses the stack entry of the calling function. Therefore, there is no limit on the number of nested tail calls that a program can execute. However, a tail call erases any debug information about the calling function. Note that a tail call only happens with a particular syntax, where the return has one single function call as argument; this syntax makes the calling function return exactly the returns of the called function. So, none of the following examples are tail calls:

     return (f(x))        -- results adjusted to 1
     return 2 * f(x)
     return x, f(x)       -- additional results
     f(x); return         -- results discarded
     return x or f(x)     -- results adjusted to 1

3.4.11 – Function Definitions

The syntax for function definition is

	functiondef ::= function funcbody
	funcbody ::= ‘(’ [parlist] ‘)’ block end

The following syntactic sugar simplifies function definitions:

	stat ::= function funcname funcbody
	stat ::= local function Name funcbody
	funcname ::= Name {‘.’ Name} [‘:’ Name]

The statement

     function f () body end

translates to

     f = function () body end

The statement

     function t.a.b.c.f () body end

translates to

     t.a.b.c.f = function () body end

The statement

     local function f () body end

translates to

     local f; f = function () body end

not to

     local f = function () body end

(This only makes a difference when the body of the function contains references to f.)

A function definition is an executable expression, whose value has type function. When Lua precompiles a chunk, all its function bodies are precompiled too. Then, whenever Lua executes the function definition, the function is instantiated (or closed). This function instance (or closure) is the final value of the expression.

Parameters act as local variables that are initialized with the argument values:

	parlist ::= namelist [‘,’ ‘...’] | ‘...

When a function is called, the list of arguments is adjusted to the length of the list of parameters, unless the function is a vararg function, which is indicated by three dots ('...') at the end of its parameter list. A vararg function does not adjust its argument list; instead, it collects all extra arguments and supplies them to the function through a vararg expression, which is also written as three dots. The value of this expression is a list of all actual extra arguments, similar to a function with multiple results. If a vararg expression is used inside another expression or in the middle of a list of expressions, then its return list is adjusted to one element. If the expression is used as the last element of a list of expressions, then no adjustment is made (unless that last expression is enclosed in parentheses).

As an example, consider the following definitions:

     function f(a, b) end
     function g(a, b, ...) end
     function r() return 1,2,3 end

Then, we have the following mapping from arguments to parameters and to the vararg expression:

     CALL            PARAMETERS
     
     f(3)             a=3, b=nil
     f(3, 4)          a=3, b=4
     f(3, 4, 5)       a=3, b=4
     f(r(), 10)       a=1, b=10
     f(r())           a=1, b=2
     
     g(3)             a=3, b=nil, ... -->  (nothing)
     g(3, 4)          a=3, b=4,   ... -->  (nothing)
     g(3, 4, 5, 8)    a=3, b=4,   ... -->  5  8
     g(5, r())        a=5, b=1,   ... -->  2  3

Results are returned using the return statement (see §3.3.4). If control reaches the end of a function without encountering a return statement, then the function returns with no results.

There is a system-dependent limit on the number of values that a function may return. This limit is guaranteed to be larger than 1000.

The colon syntax is used for defining methods, that is, functions that have an implicit extra parameter self. Thus, the statement

     function t.a.b.c:f (params) body end

is syntactic sugar for

     t.a.b.c.f = function (self, params) body end

3.5 – Visibility Rules

Lua is a lexically scoped language. The scope of a local variable begins at the first statement after its declaration and lasts until the last non-void statement of the innermost block that includes the declaration. Consider the following example:

     x = 10                -- global variable
     do                    -- new block
       local x = x         -- new 'x', with value 10
       print(x)            --> 10
       x = x+1
       do                  -- another block
         local x = x+1     -- another 'x'
         print(x)          --> 12
       end
       print(x)            --> 11
     end
     print(x)              --> 10  (the global one)

Notice that, in a declaration like local x = x, the new x being declared is not in scope yet, and so the second x refers to the outside variable.

Because of the lexical scoping rules, local variables can be freely accessed by functions defined inside their scope. A local variable used by an inner function is called an upvalue, or external local variable, inside the inner function.

Notice that each execution of a local statement defines new local variables. Consider the following example:

     a = {}
     local x = 20
     for i=1,10 do
       local y = 0
       a[i] = function () y=y+1; return x+y end
     end

The loop creates ten closures (that is, ten instances of the anonymous function). Each of these closures uses a different y variable, while all of them share the same x.

4 – The Application Program Interface

This section describes the C API for Lua, that is, the set of C functions available to the host program to communicate with Lua. All API functions and related types and constants are declared in the header file lua.h.

Even when we use the term "function", any facility in the API may be provided as a macro instead. Except where stated otherwise, all such macros use each of their arguments exactly once (except for the first argument, which is always a Lua state), and so do not generate any hidden side-effects.

As in most C libraries, the Lua API functions do not check their arguments for validity or consistency. However, you can change this behavior by compiling Lua with the macro LUA_USE_APICHECK defined.

4.1 – The Stack

Lua uses a virtual stack to pass values to and from C. Each element in this stack represents a Lua value (nil, number, string, etc.).

Whenever Lua calls C, the called function gets a new stack, which is independent of previous stacks and of stacks of C functions that are still active. This stack initially contains any arguments to the C function and it is where the C function pushes its results to be returned to the caller (see lua_CFunction).

For convenience, most query operations in the API do not follow a strict stack discipline. Instead, they can refer to any element in the stack by using an index: A positive index represents an absolute stack position (starting at 1); a negative index represents an offset relative to the top of the stack. More specifically, if the stack has n elements, then index 1 represents the first element (that is, the element that was pushed onto the stack first) and index n represents the last element; index -1 also represents the last element (that is, the element at the top) and index -n represents the first element.

4.2 – Stack Size

When you interact with the Lua API, you are responsible for ensuring consistency. In particular, you are responsible for controlling stack overflow. You can use the function lua_checkstack to ensure that the stack has enough space for pushing new elements.

Whenever Lua calls C, it ensures that the stack has space for at least LUA_MINSTACK extra slots. LUA_MINSTACK is defined as 20, so that usually you do not have to worry about stack space unless your code has loops pushing elements onto the stack.

When you call a Lua function without a fixed number of results (see lua_call), Lua ensures that the stack has enough space for all results, but it does not ensure any extra space. So, before pushing anything in the stack after such a call you should use lua_checkstack.

4.3 – Valid and Acceptable Indices

Any function in the API that receives stack indices works only with valid indices or acceptable indices.

A valid index is an index that refers to a position that stores a modifiable Lua value. It comprises stack indices between 1 and the stack top (1 ≤ abs(index) ≤ top) plus pseudo-indices, which represent some positions that are accessible to C code but that are not in the stack. Pseudo-indices are used to access the registry (see §4.5) and the upvalues of a C function (see §4.4).

Functions that do not need a specific mutable position, but only a value (e.g., query functions), can be called with acceptable indices. An acceptable index can be any valid index, but it also can be any positive index after the stack top within the space allocated for the stack, that is, indices up to the stack size. (Note that 0 is never an acceptable index.) Except when noted otherwise, functions in the API work with acceptable indices.

Acceptable indices serve to avoid extra tests against the stack top when querying the stack. For instance, a C function can query its third argument without the need to first check whether there is a third argument, that is, without the need to check whether 3 is a valid index.

For functions that can be called with acceptable indices, any non-valid index is treated as if it contains a value of a virtual type LUA_TNONE, which behaves like a nil value.

4.4 – C Closures

When a C function is created, it is possible to associate some values with it, thus creating a C closure (see lua_pushcclosure); these values are called upvalues and are accessible to the function whenever it is called.

Whenever a C function is called, its upvalues are located at specific pseudo-indices. These pseudo-indices are produced by the macro lua_upvalueindex. The first upvalue associated with a function is at index lua_upvalueindex(1), and so on. Any access to lua_upvalueindex(n), where n is greater than the number of upvalues of the current function (but not greater than 256, which is one plus the maximum number of upvalues in a closure), produces an acceptable but invalid index.

4.5 – Registry

Lua provides a registry, a predefined table that can be used by any C code to store whatever Lua values it needs to store. The registry table is always located at pseudo-index LUA_REGISTRYINDEX. Any C library can store data into this table, but it must take care to choose keys that are different from those used by other libraries, to avoid collisions. Typically, you should use as key a string containing your library name, or a light userdata with the address of a C object in your code, or any Lua object created by your code. As with variable names, string keys starting with an underscore followed by uppercase letters are reserved for Lua.

The integer keys in the registry are used by the reference mechanism (see luaL_ref) and by some predefined values. Therefore, integer keys must not be used for other purposes.

When you create a new Lua state, its registry comes with some predefined values. These predefined values are indexed with integer keys defined as constants in lua.h. The following constants are defined:

  • LUA_RIDX_MAINTHREAD: At this index the registry has the main thread of the state. (The main thread is the one created together with the state.)
  • LUA_RIDX_GLOBALS: At this index the registry has the global environment.

4.6 – Error Handling in C

Internally, Lua uses the C longjmp facility to handle errors. (Lua will use exceptions if you compile it as C++; search for LUAI_THROW in the source code for details.) When Lua faces any error (such as a memory allocation error, type errors, syntax errors, and runtime errors) it raises an error; that is, it does a long jump. A protected environment uses setjmp to set a recovery point; any error jumps to the most recent active recovery point.

If an error happens outside any protected environment, Lua calls a panic function (see lua_atpanic) and then calls abort, thus exiting the host application. Your panic function can avoid this exit by never returning (e.g., doing a long jump to your own recovery point outside Lua).

The panic function runs as if it were a message handler (see §2.3); in particular, the error message is at the top of the stack. However, there is no guarantee about stack space. To push anything on the stack, the panic function must first check the available space (see §4.2).

Most functions in the API can raise an error, for instance due to a memory allocation error. The documentation for each function indicates whether it can raise errors.

Inside a C function you can raise an error by calling lua_error.

4.7 – Handling Yields in C

Internally, Lua uses the C longjmp facility to yield a coroutine. Therefore, if a C function foo calls an API function and this API function yields (directly or indirectly by calling another function that yields), Lua cannot return to foo any more, because the longjmp removes its frame from the C stack.

To avoid this kind of problem, Lua raises an error whenever it tries to yield across an API call, except for three functions: lua_yieldk, lua_callk, and lua_pcallk. All those functions receive a continuation function (as a parameter named k) to continue execution after a yield.

We need to set some terminology to explain continuations. We have a C function called from Lua which we will call the original function. This original function then calls one of those three functions in the C API, which we will call the callee function, that then yields the current thread. (This can happen when the callee function is lua_yieldk, or when the callee function is either lua_callk or lua_pcallk and the function called by them yields.)

Suppose the running thread yields while executing the callee function. After the thread resumes, it eventually will finish running the callee function. However, the callee function cannot return to the original function, because its frame in the C stack was destroyed by the yield. Instead, Lua calls a continuation function, which was given as an argument to the callee function. As the name implies, the continuation function should continue the task of the original function.

As an illustration, consider the following function:

     int original_function (lua_State *L) {
       ...     /* code 1 */
       status = lua_pcall(L, n, m, h);  /* calls Lua */
       ...     /* code 2 */
     }

Now we want to allow the Lua code being run by lua_pcall to yield. First, we can rewrite our function like here:

     int k (lua_State *L, int status, lua_KContext ctx) {
       ...  /* code 2 */
     }
     
     int original_function (lua_State *L) {
       ...     /* code 1 */
       return k(L, lua_pcall(L, n, m, h), ctx);
     }

In the above code, the new function k is a continuation function (with type lua_KFunction), which should do all the work that the original function was doing after calling lua_pcall. Now, we must inform Lua that it must call k if the Lua code being executed by lua_pcall gets interrupted in some way (errors or yielding), so we rewrite the code as here, replacing lua_pcall by lua_pcallk:

     int original_function (lua_State *L) {
       ...     /* code 1 */
       return k(L, lua_pcallk(L, n, m, h, ctx2, k), ctx1);
     }

Note the external, explicit call to the continuation: Lua will call the continuation only if needed, that is, in case of errors or resuming after a yield. If the called function returns normally without ever yielding, lua_pcallk (and lua_callk) will also return normally. (Of course, instead of calling the continuation in that case, you can do the equivalent work directly inside the original function.)

Besides the Lua state, the continuation function has two other parameters: the final status of the call plus the context value (ctx) that was passed originally to lua_pcallk. (Lua does not use this context value; it only passes this value from the original function to the continuation function.) For lua_pcallk, the status is the same value that would be returned by lua_pcallk, except that it is LUA_YIELD when being executed after a yield (instead of LUA_OK). For lua_yieldk and lua_callk, the status is always LUA_YIELD when Lua calls the continuation. (For these two functions, Lua will not call the continuation in case of errors, because they do not handle errors.) Similarly, when using lua_callk, you should call the continuation function with LUA_OK as the status. (For lua_yieldk, there is not much point in calling directly the continuation function, because lua_yieldk usually does not return.)

Lua treats the continuation function as if it were the original function. The continuation function receives the same Lua stack from the original function, in the same state it would be if the callee function had returned. (For instance, after a lua_callk the function and its arguments are removed from the stack and replaced by the results from the call.) It also has the same upvalues. Whatever it returns is handled by Lua as if it were the return of the original function.

4.8 – Functions and Types

Here we list all functions and types from the C API in alphabetical order. Each function has an indicator like this: [-o, +p, x]

The first field, o, is how many elements the function pops from the stack. The second field, p, is how many elements the function pushes onto the stack. (Any function always pushes its results after popping its arguments.) A field in the form x|y means the function can push (or pop) x or y elements, depending on the situation; an interrogation mark '?' means that we cannot know how many elements the function pops/pushes by looking only at its arguments (e.g., they may depend on what is on the stack). The third field, x, tells whether the function may raise errors: '-' means the function never raises any error; 'm' means the function may raise memory errors; 'e' means the function may raise errors; 'v' means the function may raise an error on purpose.


lua_absindex

[-0, +0, –]

int lua_absindex (lua_State *L, int idx);

Converts the acceptable index idx into an equivalent absolute index (that is, one that does not depend on the stack top).


lua_Alloc

typedef void * (*lua_Alloc) (void *ud,
                             void *ptr,
                             size_t osize,
                             size_t nsize);

The type of the memory-allocation function used by Lua states. The allocator function must provide a functionality similar to realloc, but not exactly the same. Its arguments are ud, an opaque pointer passed to lua_newstate; ptr, a pointer to the block being allocated/reallocated/freed; osize, the original size of the block or some code about what is being allocated; and nsize, the new size of the block.

When ptr is not NULL, osize is the size of the block pointed by ptr, that is, the size given when it was allocated or reallocated.

When ptr is NULL, osize encodes the kind of object that Lua is allocating. osize is any of LUA_TSTRING, LUA_TTABLE, LUA_TFUNCTION, LUA_TUSERDATA, or LUA_TTHREAD when (and only when) Lua is creating a new object of that type. When osize is some other value, Lua is allocating memory for something else.

Lua assumes the following behavior from the allocator function:

When nsize is zero, the allocator must behave like free and return NULL.

When nsize is not zero, the allocator must behave like realloc. The allocator returns NULL if and only if it cannot fulfill the request. Lua assumes that the allocator never fails when osize >= nsize.

Here is a simple implementation for the allocator function. It is used in the auxiliary library by luaL_newstate.

     static void *l_alloc (void *ud, void *ptr, size_t osize,
                                                size_t nsize) {
       (void)ud;  (void)osize;  /* not used */
       if (nsize == 0) {
         free(ptr);
         return NULL;
       }
       else
         return realloc(ptr, nsize);
     }

Note that Standard C ensures that free(NULL) has no effect and that realloc(NULL,size) is equivalent to malloc(size). This code assumes that realloc does not fail when shrinking a block. (Although Standard C does not ensure this behavior, it seems to be a safe assumption.)


lua_arith

[-(2|1), +1, e]

void lua_arith (lua_State *L, int op);

Performs an arithmetic or bitwise operation over the two values (or one, in the case of negations) at the top of the stack, with the value at the top being the second operand, pops these values, and pushes the result of the operation. The function follows the semantics of the corresponding Lua operator (that is, it may call metamethods).

The value of op must be one of the following constants:


lua_atpanic

[-0, +0, –]

lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf);

Sets a new panic function and returns the old one (see §4.6).


lua_call

[-(nargs+1), +nresults, e]

void lua_call (lua_State *L, int nargs, int nresults);

Calls a function.

To call a function you must use the following protocol: first, the function to be called is pushed onto the stack; then, the arguments to the function are pushed in direct order; that is, the first argument is pushed first. Finally you call lua_call; nargs is the number of arguments that you pushed onto the stack. All arguments and the function value are popped from the stack when the function is called. The function results are pushed onto the stack when the function returns. The number of results is adjusted to nresults, unless nresults is LUA_MULTRET. In this case, all results from the function are pushed. Lua takes care that the returned values fit into the stack space, but it does not ensure any extra space in the stack. The function results are pushed onto the stack in direct order (the first result is pushed first), so that after the call the last result is on the top of the stack.

Any error inside the called function is propagated upwards (with a longjmp).

The following example shows how the host program can do the equivalent to this Lua code:

     a = f("how", t.x, 14)

Here it is in C:

     lua_getglobal(L, "f");                  /* function to be called */
     lua_pushliteral(L, "how");                       /* 1st argument */
     lua_getglobal(L, "t");                    /* table to be indexed */
     lua_getfield(L, -1, "x");        /* push result of t.x (2nd arg) */
     lua_remove(L, -2);                  /* remove 't' from the stack */
     lua_pushinteger(L, 14);                          /* 3rd argument */
     lua_call(L, 3, 1);     /* call 'f' with 3 arguments and 1 result */
     lua_setglobal(L, "a");                         /* set global 'a' */

Note that the code above is balanced: at its end, the stack is back to its original configuration. This is considered good programming practice.


lua_callk

[-(nargs + 1), +nresults, e]

void lua_callk (lua_State *L,
                int nargs,
                int nresults,
                lua_KContext ctx,
                lua_KFunction k);

This function behaves exactly like lua_call, but allows the called function to yield (see §4.7).


lua_CFunction

typedef int (*lua_CFunction) (lua_State *L);

Type for C functions.

In order to communicate properly with Lua, a C function must use the following protocol, which defines the way parameters and results are passed: a C function receives its arguments from Lua in its stack in direct order (the first argument is pushed first). So, when the function starts, lua_gettop(L) returns the number of arguments received by the function. The first argument (if any) is at index 1 and its last argument is at index lua_gettop(L). To return values to Lua, a C function just pushes them onto the stack, in direct order (the first result is pushed first), and returns the number of results. Any other value in the stack below the results will be properly discarded by Lua. Like a Lua function, a C function called by Lua can also return many results.

As an example, the following function receives a variable number of numeric arguments and returns their average and their sum:

     static int foo (lua_State *L) {
       int n = lua_gettop(L);    /* number of arguments */
       lua_Number sum = 0.0;
       int i;
       for (i = 1; i <= n; i++) {
         if (!lua_isnumber(L, i)) {
           lua_pushliteral(L, "incorrect argument");
           lua_error(L);
         }
         sum += lua_tonumber(L, i);
       }
       lua_pushnumber(L, sum/n);        /* first result */
       lua_pushnumber(L, sum);         /* second result */
       return 2;                   /* number of results */
     }

lua_checkstack

[-0, +0, –]

int lua_checkstack (lua_State *L, int n);

Ensures that the stack has space for at least n extra slots (that is, that you can safely push up to n values into it). It returns false if it cannot fulfill the request, either because it would cause the stack to be larger than a fixed maximum size (typically at least several thousand elements) or because it cannot allocate memory for the extra space. This function never shrinks the stack; if the stack already has space for the extra slots, it is left unchanged.


lua_close

[-0, +0, –]

void lua_close (lua_State *L);

Destroys all objects in the given Lua state (calling the corresponding garbage-collection metamethods, if any) and frees all dynamic memory used by this state. On several platforms, you may not need to call this function, because all resources are naturally released when the host program ends. On the other hand, long-running programs that create multiple states, such as daemons or web servers, will probably need to close states as soon as they are not needed.


lua_compare

[-0, +0, e]

int lua_compare (lua_State *L, int index1, int index2, int op);

Compares two Lua values. Returns 1 if the value at index index1 satisfies op when compared with the value at index index2, following the semantics of the corresponding Lua operator (that is, it may call metamethods). Otherwise returns 0. Also returns 0 if any of the indices is not valid.

The value of op must be one of the following constants:


lua_concat

[-n, +1, e]

void lua_concat (lua_State *L, int n);

Concatenates the n values at the top of the stack, pops them, and leaves the result at the top. If n is 1, the result is the single value on the stack (that is, the function does nothing); if n is 0, the result is the empty string. Concatenation is performed following the usual semantics of Lua (see §3.4.6).


lua_copy

[-0, +0, –]

void lua_copy (lua_State *L, int fromidx, int toidx);

Copies the element at index fromidx into the valid index toidx, replacing the value at that position. Values at other positions are not affected.


lua_createtable

[-0, +1, m]

void lua_createtable (lua_State *L, int narr, int nrec);

Creates a new empty table and pushes it onto the stack. Parameter narr is a hint for how many elements the table will have as a sequence; parameter nrec is a hint for how many other elements the table will have. Lua may use these hints to preallocate memory for the new table. This preallocation is useful for performance when you know in advance how many elements the table will have. Otherwise you can use the function lua_newtable.


lua_dump

[-0, +0, –]

int lua_dump (lua_State *L,
                        lua_Writer writer,
                        void *data,
                        int strip);

Dumps a function as a binary chunk. Receives a Lua function on the top of the stack and produces a binary chunk that, if loaded again, results in a function equivalent to the one dumped. As it produces parts of the chunk, lua_dump calls function writer (see lua_Writer) with the given data to write them.

If strip is true, the binary representation may not include all debug information about the function, to save space.

The value returned is the error code returned by the last call to the writer; 0 means no errors.

This function does not pop the Lua function from the stack.


lua_error

[-1, +0, v]

int lua_error (lua_State *L);

Generates a Lua error, using the value at the top of the stack as the error object. This function does a long jump, and therefore never returns (see luaL_error).


lua_gc

[-0, +0, e]

int lua_gc (lua_State *L, int what, int data);

Controls the garbage collector.

This function performs several tasks, according to the value of the parameter what:

  • LUA_GCSTOP: stops the garbage collector.
  • LUA_GCRESTART: restarts the garbage collector.
  • LUA_GCCOLLECT: performs a full garbage-collection cycle.
  • LUA_GCCOUNT: returns the current amount of memory (in Kbytes) in use by Lua.
  • LUA_GCCOUNTB: returns the remainder of dividing the current amount of bytes of memory in use by Lua by 1024.
  • LUA_GCSTEP: performs an incremental step of garbage collection.
  • LUA_GCSETPAUSE: sets data as the new value for the pause of the collector (see §2.5) and returns the previous value of the pause.
  • LUA_GCSETSTEPMUL: sets data as the new value for the step multiplier of the collector (see §2.5) and returns the previous value of the step multiplier.
  • LUA_GCISRUNNING: returns a boolean that tells whether the collector is running (i.e., not stopped).

For more details about these options, see collectgarbage.


lua_getallocf

[-0, +0, –]

lua_Alloc lua_getallocf (lua_State *L, void **ud);

Returns the memory-allocation function of a given state. If ud is not NULL, Lua stores in *ud the opaque pointer given when the memory-allocator function was set.


lua_getfield

[-0, +1, e]

int lua_getfield (lua_State *L, int index, const char *k);

Pushes onto the stack the value t[k], where t is the value at the given index. As in Lua, this function may trigger a metamethod for the "index" event (see §2.4).

Returns the type of the pushed value.


lua_getextraspace

[-0, +0, –]

void *lua_getextraspace (lua_State *L);

Returns a pointer to a raw memory area associated with the given Lua state. The application can use this area for any purpose; Lua does not use it for anything.

Each new thread has this area initialized with a copy of the area of the main thread.

By default, this area has the size of a pointer to void, but you can recompile Lua with a different size for this area. (See LUA_EXTRASPACE in luaconf.h.)


lua_getglobal

[-0, +1, e]

int lua_getglobal (lua_State *L, const char *name);

Pushes onto the stack the value of the global name. Returns the type of that value.


lua_geti

[-0, +1, e]

int lua_geti (lua_State *L, int index, lua_Integer i);

Pushes onto the stack the value t[i], where t is the value at the given index. As in Lua, this function may trigger a metamethod for the "index" event (see §2.4).

Returns the type of the pushed value.


lua_getmetatable

[-0, +(0|1), –]

int lua_getmetatable (lua_State *L, int index);

If the value at the given index has a metatable, the function pushes that metatable onto the stack and returns 1. Otherwise, the function returns 0 and pushes nothing on the stack.


lua_gettable

[-1, +1, e]

int lua_gettable (lua_State *L, int index);

Pushes onto the stack the value t[k], where t is the value at the given index and k is the value at the top of the stack.

This function pops the key from the stack, pushing the resulting value in its place. As in Lua, this function may trigger a metamethod for the "index" event (see §2.4).

Returns the type of the pushed value.


lua_gettop

[-0, +0, –]

int lua_gettop (lua_State *L);

Returns the index of the top element in the stack. Because indices start at 1, this result is equal to the number of elements in the stack; in particular, 0 means an empty stack.


lua_getuservalue

[-0, +1, –]

int lua_getuservalue (lua_State *L, int index);

Pushes onto the stack the Lua value associated with the userdata at the given index.

Returns the type of the pushed value.


lua_insert

[-1, +1, –]

void lua_insert (lua_State *L, int index);

Moves the top element into the given valid index, shifting up the elements above this index to open space. This function cannot be called with a pseudo-index, because a pseudo-index is not an actual stack position.


lua_Integer

typedef ... lua_Integer;

The type of integers in Lua.

By default this type is long long, (usually a 64-bit two-complement integer), but that can be changed to long or int (usually a 32-bit two-complement integer). (See LUA_INT_TYPE in luaconf.h.)

Lua also defines the constants LUA_MININTEGER and LUA_MAXINTEGER, with the minimum and the maximum values that fit in this type.


lua_isboolean

[-0, +0, –]

int lua_isboolean (lua_State *L, int index);

Returns 1 if the value at the given index is a boolean, and 0 otherwise.


lua_iscfunction

[-0, +0, –]

int lua_iscfunction (lua_State *L, int index);

Returns 1 if the value at the given index is a C function, and 0 otherwise.


lua_isfunction

[-0, +0, –]

int lua_isfunction (lua_State *L, int index);

Returns 1 if the value at the given index is a function (either C or Lua), and 0 otherwise.


lua_isinteger

[-0, +0, –]

int lua_isinteger (lua_State *L, int index);

Returns 1 if the value at the given index is an integer (that is, the value is a number and is represented as an integer), and 0 otherwise.


lua_islightuserdata

[-0, +0, –]

int lua_islightuserdata (lua_State *L, int index);

Returns 1 if the value at the given index is a light userdata, and 0 otherwise.


lua_isnil

[-0, +0, –]

int lua_isnil (lua_State *L, int index);

Returns 1 if the value at the given index is nil, and 0 otherwise.


lua_isnone

[-0, +0, –]

int lua_isnone (lua_State *L, int index);

Returns 1 if the given index is not valid, and 0 otherwise.


lua_isnoneornil

[-0, +0, –]

int lua_isnoneornil (lua_State *L, int index);

Returns 1 if the given index is not valid or if the value at this index is nil, and 0 otherwise.


lua_isnumber

[-0, +0, –]

int lua_isnumber (lua_State *L, int index);

Returns 1 if the value at the given index is a number or a string convertible to a number, and 0 otherwise.


lua_isstring

[-0, +0, –]

int lua_isstring (lua_State *L, int index);

Returns 1 if the value at the given index is a string or a number (which is always convertible to a string), and 0 otherwise.


lua_istable

[-0, +0, –]

int lua_istable (lua_State *L, int index);

Returns 1 if the value at the given index is a table, and 0 otherwise.


lua_isthread

[-0, +0, –]

int lua_isthread (lua_State *L, int index);

Returns 1 if the value at the given index is a thread, and 0 otherwise.


lua_isuserdata

[-0, +0, –]

int lua_isuserdata (lua_State *L, int index);

Returns 1 if the value at the given index is a userdata (either full or light), and 0 otherwise.


lua_isyieldable

[-0, +0, –]

int lua_isyieldable (lua_State *L);

Returns 1 if the given coroutine can yield, and 0 otherwise.


lua_KContext

typedef ... lua_KContext;

The type for continuation-function contexts. It must be a numeric type. This type is defined as intptr_t when intptr_t is available, so that it can store pointers too. Otherwise, it is defined as ptrdiff_t.


lua_KFunction

typedef int (*lua_KFunction) (lua_State *L, int status, lua_KContext ctx);

Type for continuation functions (see §4.7).


lua_len

[-0, +1, e]

void lua_len (lua_State *L, int index);

Returns the length of the value at the given index. It is equivalent to the '#' operator in Lua (see §3.4.7) and may trigger a metamethod for the "length" event (see §2.4). The result is pushed on the stack.


lua_load

[-0, +1, –]

int lua_load (lua_State *L,
              lua_Reader reader,
              void *data,
              const char *chunkname,
              const char *mode);

Loads a Lua chunk without running it. If there are no errors, lua_load pushes the compiled chunk as a Lua function on top of the stack. Otherwise, it pushes an error message.

The return values of lua_load are:

  • LUA_OK: no errors;
  • LUA_ERRSYNTAX: syntax error during precompilation;
  • LUA_ERRMEM: memory allocation error;
  • LUA_ERRGCMM: error while running a __gc metamethod. (This error has no relation with the chunk being loaded. It is generated by the garbage collector.)

The lua_load function uses a user-supplied reader function to read the chunk (see lua_Reader). The data argument is an opaque value passed to the reader function.

The chunkname argument gives a name to the chunk, which is used for error messages and in debug information (see §4.9).

lua_load automatically detects whether the chunk is text or binary and loads it accordingly (see program luac). The string mode works as in function load, with the addition that a NULL value is equivalent to the string "bt".

lua_load uses the stack internally, so the reader function must always leave the stack unmodified when returning.

If the resulting function has upvalues, its first upvalue is set to the value of the global environment stored at index LUA_RIDX_GLOBALS in the registry (see §4.5). When loading main chunks, this upvalue will be the _ENV variable (see §2.2). Other upvalues are initialized with nil.


lua_newstate

[-0, +0, –]

lua_State *lua_newstate (lua_Alloc f, void *ud);

Creates a new thread running in a new, independent state. Returns NULL if it cannot create the thread or the state (due to lack of memory). The argument f is the allocator function; Lua does all memory allocation for this state through this function. The second argument, ud, is an opaque pointer that Lua passes to the allocator in every call.


lua_newtable

[-0, +1, m]

void lua_newtable (lua_State *L);

Creates a new empty table and pushes it onto the stack. It is equivalent to lua_createtable(L, 0, 0).


lua_newthread

[-0, +1, m]

lua_State *lua_newthread (lua_State *L);

Creates a new thread, pushes it on the stack, and returns a pointer to a lua_State that represents this new thread. The new thread returned by this function shares with the original thread its global environment, but has an independent execution stack.

There is no explicit function to close or to destroy a thread. Threads are subject to garbage collection, like any Lua object.


lua_newuserdata

[-0, +1, m]

void *lua_newuserdata (lua_State *L, size_t size);

This function allocates a new block of memory with the given size, pushes onto the stack a new full userdata with the block address, and returns this address. The host program can freely use this memory.


lua_next

[-1, +(2|0), e]

int lua_next (lua_State *L, int index);

Pops a key from the stack, and pushes a key–value pair from the table at the given index (the "next" pair after the given key). If there are no more elements in the table, then lua_next returns 0 (and pushes nothing).

A typical traversal looks like this:

     /* table is in the stack at index 't' */
     lua_pushnil(L);  /* first key */
     while (lua_next(L, t) != 0) {
       /* uses 'key' (at index -2) and 'value' (at index -1) */
       printf("%s - %s\n",
              lua_typename(L, lua_type(L, -2)),
              lua_typename(L, lua_type(L, -1)));
       /* removes 'value'; keeps 'key' for next iteration */
       lua_pop(L, 1);
     }

While traversing a table, do not call lua_tolstring directly on a key, unless you know that the key is actually a string. Recall that lua_tolstring may change the value at the given index; this confuses the next call to lua_next.

See function next for the caveats of modifying the table during its traversal.


lua_Number

typedef ... lua_Number;

The type of floats in Lua.

By default this type is double, but that can be changed to a single float or a long double. (See LUA_FLOAT_TYPE in luaconf.h.)


lua_numbertointeger

int lua_numbertointeger (lua_Number n, lua_Integer *p);

Converts a Lua float to a Lua integer. This macro assumes that n has an integral value. If that value is within the range of Lua integers, it is converted to an integer and assigned to *p. The macro results in a boolean indicating whether the conversion was successful. (Note that this range test can be tricky to do correctly without this macro, due to roundings.)

This macro may evaluate its arguments more than once.


lua_pcall

[-(nargs + 1), +(nresults|1), –]

int lua_pcall (lua_State *L, int nargs, int nresults, int msgh);

Calls a function in protected mode.

Both nargs and nresults have the same meaning as in lua_call. If there are no errors during the call, lua_pcall behaves exactly like lua_call. However, if there is any error, lua_pcall catches it, pushes a single value on the stack (the error message), and returns an error code. Like lua_call, lua_pcall always removes the function and its arguments from the stack.

If msgh is 0, then the error message returned on the stack is exactly the original error message. Otherwise, msgh is the stack index of a message handler. (This index cannot be a pseudo-index.) In case of runtime errors, this function will be called with the error message and its return value will be the message returned on the stack by lua_pcall.

Typically, the message handler is used to add more debug information to the error message, such as a stack traceback. Such information cannot be gathered after the return of lua_pcall, since by then the stack has unwound.

The lua_pcall function returns one of the following constants (defined in lua.h):

  • LUA_OK (0): success.
  • LUA_ERRRUN: a runtime error.
  • LUA_ERRMEM: memory allocation error. For such errors, Lua does not call the message handler.
  • LUA_ERRERR: error while running the message handler.
  • LUA_ERRGCMM: error while running a __gc metamethod. (This error typically has no relation with the function being called.)

lua_pcallk

[-(nargs + 1), +(nresults|1), –]

int lua_pcallk (lua_State *L,
                int nargs,
                int nresults,
                int msgh,
                lua_KContext ctx,
                lua_KFunction k);

This function behaves exactly like lua_pcall, but allows the called function to yield (see §4.7).


lua_pop

[-n, +0, –]

void lua_pop (lua_State *L, int n);

Pops n elements from the stack.


lua_pushboolean

[-0, +1, –]

void lua_pushboolean (lua_State *L, int b);

Pushes a boolean value with value b onto the stack.


lua_pushcclosure

[-n, +1, m]

void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n);

Pushes a new C closure onto the stack.

When a C function is created, it is possible to associate some values with it, thus creating a C closure (see §4.4); these values are then accessible to the function whenever it is called. To associate values with a C function, first these values must be pushed onto the stack (when there are multiple values, the first value is pushed first). Then lua_pushcclosure is called to create and push the C function onto the stack, with the argument n telling how many values will be associated with the function. lua_pushcclosure also pops these values from the stack.

The maximum value for n is 255.

When n is zero, this function creates a light C function, which is just a pointer to the C function. In that case, it never raises a memory error.


lua_pushcfunction

[-0, +1, –]

void lua_pushcfunction (lua_State *L, lua_CFunction f);

Pushes a C function onto the stack. This function receives a pointer to a C function and pushes onto the stack a Lua value of type function that, when called, invokes the corresponding C function.

Any function to be callable by Lua must follow the correct protocol to receive its parameters and return its results (see lua_CFunction).


lua_pushfstring

[-0, +1, m]

const char *lua_pushfstring (lua_State *L, const char *fmt, ...);

Pushes onto the stack a formatted string and returns a pointer to this string. It is similar to the ISO C function sprintf, but has some important differences:

  • You do not have to allocate space for the result: the result is a Lua string and Lua takes care of memory allocation (and deallocation, through garbage collection).
  • The conversion specifiers are quite restricted. There are no flags, widths, or precisions. The conversion specifiers can only be '%%' (inserts the character '%'), '%s' (inserts a zero-terminated string, with no size restrictions), '%f' (inserts a lua_Number), '%I' (inserts a lua_Integer), '%p' (inserts a pointer as a hexadecimal numeral), '%d' (inserts an int), '%c' (inserts an int as a one-byte character), and '%U' (inserts a long int as a UTF-8 byte sequence).

lua_pushglobaltable

[-0, +1, –]

void lua_pushglobaltable (lua_State *L);

Pushes the global environment onto the stack.


lua_pushinteger

[-0, +1, –]

void lua_pushinteger (lua_State *L, lua_Integer n);

Pushes an integer with value n onto the stack.


lua_pushlightuserdata

[-0, +1, –]

void lua_pushlightuserdata (lua_State *L, void *p);

Pushes a light userdata onto the stack.

Userdata represent C values in Lua. A light userdata represents a pointer, a void*. It is a value (like a number): you do not create it, it has no individual metatable, and it is not collected (as it was never created). A light userdata is equal to "any" light userdata with the same C address.


lua_pushliteral

[-0, +1, m]

const char *lua_pushliteral (lua_State *L, const char *s);

This macro is equivalent to lua_pushstring, but should be used only when s is a literal string.


lua_pushlstring

[-0, +1, m]

const char *lua_pushlstring (lua_State *L, const char *s, size_t len);

Pushes the string pointed to by s with size len onto the stack. Lua makes (or reuses) an internal copy of the given string, so the memory at s can be freed or reused immediately after the function returns. The string can contain any binary data, including embedded zeros.

Returns a pointer to the internal copy of the string.


lua_pushnil

[-0, +1, –]

void lua_pushnil (lua_State *L);

Pushes a nil value onto the stack.


lua_pushnumber

[-0, +1, –]

void lua_pushnumber (lua_State *L, lua_Number n);

Pushes a float with value n onto the stack.


lua_pushstring

[-0, +1, m]

const char *lua_pushstring (lua_State *L, const char *s);

Pushes the zero-terminated string pointed to by s onto the stack. Lua makes (or reuses) an internal copy of the given string, so the memory at s can be freed or reused immediately after the function returns.

Returns a pointer to the internal copy of the string.

If s is NULL, pushes nil and returns NULL.


lua_pushthread

[-0, +1, –]

int lua_pushthread (lua_State *L);

Pushes the thread represented by L onto the stack. Returns 1 if this thread is the main thread of its state.


lua_pushvalue

[-0, +1, –]

void lua_pushvalue (lua_State *L, int index);

Pushes a copy of the element at the given index onto the stack.


lua_pushvfstring

[-0, +1, m]

const char *lua_pushvfstring (lua_State *L,
                              const char *fmt,
                              va_list argp);

Equivalent to lua_pushfstring, except that it receives a va_list instead of a variable number of arguments.


lua_rawequal

[-0, +0, –]

int lua_rawequal (lua_State *L, int index1, int index2);

Returns 1 if the two values in indices index1 and index2 are primitively equal (that is, without calling metamethods). Otherwise returns 0. Also returns 0 if any of the indices are not valid.


lua_rawget

[-1, +1, –]

int lua_rawget (lua_State *L, int index);

Similar to lua_gettable, but does a raw access (i.e., without metamethods).


lua_rawgeti

[-0, +1, –]

int lua_rawgeti (lua_State *L, int index, lua_Integer n);

Pushes onto the stack the value t[n], where t is the table at the given index. The access is raw; that is, it does not invoke metamethods.

Returns the type of the pushed value.


lua_rawgetp

[-0, +1, –]

int lua_rawgetp (lua_State *L, int index, const void *p);

Pushes onto the stack the value t[k], where t is the table at the given index and k is the pointer p represented as a light userdata. The access is raw; that is, it does not invoke metamethods.

Returns the type of the pushed value.


lua_rawlen

[-0, +0, –]

size_t lua_rawlen (lua_State *L, int index);

Returns the raw "length" of the value at the given index: for strings, this is the string length; for tables, this is the result of the length operator ('#') with no metamethods; for userdata, this is the size of the block of memory allocated for the userdata; for other values, it is 0.


lua_rawset

[-2, +0, m]

void lua_rawset (lua_State *L, int index);

Similar to lua_settable, but does a raw assignment (i.e., without metamethods).


lua_rawseti

[-1, +0, m]

void lua_rawseti (lua_State *L, int index, lua_Integer i);

Does the equivalent of t[i] = v, where t is the table at the given index and v is the value at the top of the stack.

This function pops the value from the stack. The assignment is raw; that is, it does not invoke metamethods.


lua_rawsetp

[-1, +0, m]

void lua_rawsetp (lua_State *L, int index, const void *p);

Does the equivalent of t[p] = v, where t is the table at the given index, p is encoded as a light userdata, and v is the value at the top of the stack.

This function pops the value from the stack. The assignment is raw; that is, it does not invoke metamethods.


lua_Reader

typedef const char * (*lua_Reader) (lua_State *L,
                                    void *data,
                                    size_t *size);

The reader function used by lua_load. Every time it needs another piece of the chunk, lua_load calls the reader, passing along its data parameter. The reader must return a pointer to a block of memory with a new piece of the chunk and set size to the block size. The block must exist until the reader function is called again. To signal the end of the chunk, the reader must return NULL or set size to zero. The reader function may return pieces of any size greater than zero.


lua_register

[-0, +0, e]

void lua_register (lua_State *L, const char *name, lua_CFunction f);

Sets the C function f as the new value of global name. It is defined as a macro:

     #define lua_register(L,n,f) \
            (lua_pushcfunction(L, f), lua_setglobal(L, n))

lua_remove

[-1, +0, –]

void lua_remove (lua_State *L, int index);

Removes the element at the given valid index, shifting down the elements above this index to fill the gap. This function cannot be called with a pseudo-index, because a pseudo-index is not an actual stack position.


lua_replace

[-1, +0, –]

void lua_replace (lua_State *L, int index);

Moves the top element into the given valid index without shifting any element (therefore replacing the value at that given index), and then pops the top element.


lua_resume

[-?, +?, –]

int lua_resume (lua_State *L, lua_State *from, int nargs);

Starts and resumes a coroutine in the given thread L.

To start a coroutine, you push onto the thread stack the main function plus any arguments; then you call lua_resume, with nargs being the number of arguments. This call returns when the coroutine suspends or finishes its execution. When it returns, the stack contains all values passed to lua_yield, or all values returned by the body function. lua_resume returns LUA_YIELD if the coroutine yields, LUA_OK if the coroutine finishes its execution without errors, or an error code in case of errors (see lua_pcall).

In case of errors, the stack is not unwound, so you can use the debug API over it. The error message is on the top of the stack.

To resume a coroutine, you remove any results from the last lua_yield, put on its stack only the values to be passed as results from yield, and then call lua_resume.

The parameter from represents the coroutine that is resuming L. If there is no such coroutine, this parameter can be NULL.


lua_rotate

[-0, +0, –]

void lua_rotate (lua_State *L, int idx, int n);

Rotates the stack elements between the valid index idx and the top of the stack. The elements are rotated n positions in the direction of the top, for a positive n, or -n positions in the direction of the bottom, for a negative n. The absolute value of n must not be greater than the size of the slice being rotated. This function cannot be called with a pseudo-index, because a pseudo-index is not an actual stack position.


lua_setallocf

[-0, +0, –]

void lua_setallocf (lua_State *L, lua_Alloc f, void *ud);

Changes the allocator function of a given state to f with user data ud.


lua_setfield

[-1, +0, e]

void lua_setfield (lua_State *L, int index, const char *k);

Does the equivalent to t[k] = v, where t is the value at the given index and v is the value at the top of the stack.

This function pops the value from the stack. As in Lua, this function may trigger a metamethod for the "newindex" event (see §2.4).


lua_setglobal

[-1, +0, e]

void lua_setglobal (lua_State *L, const char *name);

Pops a value from the stack and sets it as the new value of global name.


lua_seti

[-1, +0, e]

void lua_seti (lua_State *L, int index, lua_Integer n);

Does the equivalent to t[n] = v, where t is the value at the given index and v is the value at the top of the stack.

This function pops the value from the stack. As in Lua, this function may trigger a metamethod for the "newindex" event (see §2.4).


lua_setmetatable

[-1, +0, –]

void lua_setmetatable (lua_State *L, int index);

Pops a table from the stack and sets it as the new metatable for the value at the given index.


lua_settable

[-2, +0, e]

void lua_settable (lua_State *L, int index);

Does the equivalent to t[k] = v, where t is the value at the given index, v is the value at the top of the stack, and k is the value just below the top.

This function pops both the key and the value from the stack. As in Lua, this function may trigger a metamethod for the "newindex" event (see §2.4).


lua_settop

[-?, +?, –]

void lua_settop (lua_State *L, int index);

Accepts any index, or 0, and sets the stack top to this index. If the new top is larger than the old one, then the new elements are filled with nil. If index is 0, then all stack elements are removed.


lua_setuservalue

[-1, +0, –]

void lua_setuservalue (lua_State *L, int index);

Pops a value from the stack and sets it as the new value associated to the userdata at the given index.


lua_State

typedef struct lua_State lua_State;

An opaque structure that points to a thread and indirectly (through the thread) to the whole state of a Lua interpreter. The Lua library is fully reentrant: it has no global variables. All information about a state is accessible through this structure.

A pointer to this structure must be passed as the first argument to every function in the library, except to lua_newstate, which creates a Lua state from scratch.


lua_status

[-0, +0, –]

int lua_status (lua_State *L);

Returns the status of the thread L.

The status can be 0 (LUA_OK) for a normal thread, an error code if the thread finished the execution of a lua_resume with an error, or LUA_YIELD if the thread is suspended.

You can only call functions in threads with status LUA_OK. You can resume threads with status LUA_OK (to start a new coroutine) or LUA_YIELD (to resume a coroutine).


lua_stringtonumber

[-0, +1, –]

size_t lua_stringtonumber (lua_State *L, const char *s);

Converts the zero-terminated string s to a number, pushes that number into the stack, and returns the total size of the string, that is, its length plus one. The conversion can result in an integer or a float, according to the lexical conventions of Lua (see §3.1). The string may have leading and trailing spaces and a sign. If the string is not a valid numeral, returns 0 and pushes nothing. (Note that the result can be used as a boolean, true if the conversion succeeds.)


lua_toboolean

[-0, +0, –]

int lua_toboolean (lua_State *L, int index);

Converts the Lua value at the given index to a C boolean value (0 or 1). Like all tests in Lua, lua_toboolean returns true for any Lua value different from false and nil; otherwise it returns false. (If you want to accept only actual boolean values, use lua_isboolean to test the value's type.)


lua_tocfunction

[-0, +0, –]

lua_CFunction lua_tocfunction (lua_State *L, int index);

Converts a value at the given index to a C function. That value must be a C function; otherwise, returns NULL.


lua_tointeger

[-0, +0, –]

lua_Integer lua_tointeger (lua_State *L, int index);

Equivalent to lua_tointegerx with isnum equal to NULL.


lua_tointegerx

[-0, +0, –]

lua_Integer lua_tointegerx (lua_State *L, int index, int *isnum);

Converts the Lua value at the given index to the signed integral type lua_Integer. The Lua value must be an integer, or a number or string convertible to an integer (see §3.4.3); otherwise, lua_tointegerx returns 0.

If isnum is not NULL, its referent is assigned a boolean value that indicates whether the operation succeeded.


lua_tolstring

[-0, +0, m]

const char *lua_tolstring (lua_State *L, int index, size_t *len);

Converts the Lua value at the given index to a C string. If len is not NULL, it sets *len with the string length. The Lua value must be a string or a number; otherwise, the function returns NULL. If the value is a number, then lua_tolstring also changes the actual value in the stack to a string. (This change confuses lua_next when lua_tolstring is applied to keys during a table traversal.)

lua_tolstring returns a pointer to a string inside the Lua state. This string always has a zero ('\0') after its last character (as in C), but can contain other zeros in its body.

Because Lua has garbage collection, there is no guarantee that the pointer returned by lua_tolstring will be valid after the corresponding Lua value is removed from the stack.


lua_tonumber

[-0, +0, –]

lua_Number lua_tonumber (lua_State *L, int index);

Equivalent to lua_tonumberx with isnum equal to NULL.


lua_tonumberx

[-0, +0, –]

lua_Number lua_tonumberx (lua_State *L, int index, int *isnum);

Converts the Lua value at the given index to the C type lua_Number (see lua_Number). The Lua value must be a number or a string convertible to a number (see §3.4.3); otherwise, lua_tonumberx returns 0.

If isnum is not NULL, its referent is assigned a boolean value that indicates whether the operation succeeded.


lua_topointer

[-0, +0, –]

const void *lua_topointer (lua_State *L, int index);

Converts the value at the given index to a generic C pointer (void*). The value can be a userdata, a table, a thread, or a function; otherwise, lua_topointer returns NULL. Different objects will give different pointers. There is no way to convert the pointer back to its original value.

Typically this function is used only for hashing and debug information.


lua_tostring

[-0, +0, m]

const char *lua_tostring (lua_State *L, int index);

Equivalent to lua_tolstring with len equal to NULL.


lua_tothread

[-0, +0, –]

lua_State *lua_tothread (lua_State *L, int index);

Converts the value at the given index to a Lua thread (represented as lua_State*). This value must be a thread; otherwise, the function returns NULL.


lua_touserdata

[-0, +0, –]

void *lua_touserdata (lua_State *L, int index);

If the value at the given index is a full userdata, returns its block address. If the value is a light userdata, returns its pointer. Otherwise, returns NULL.


lua_type

[-0, +0, –]

int lua_type (lua_State *L, int index);

Returns the type of the value in the given valid index, or LUA_TNONE for a non-valid (but acceptable) index. The types returned by lua_type are coded by the following constants defined in lua.h: LUA_TNIL (0), LUA_TNUMBER, LUA_TBOOLEAN, LUA_TSTRING, LUA_TTABLE, LUA_TFUNCTION, LUA_TUSERDATA, LUA_TTHREAD, and LUA_TLIGHTUSERDATA.


lua_typename

[-0, +0, –]

const char *lua_typename (lua_State *L, int tp);

Returns the name of the type encoded by the value tp, which must be one the values returned by lua_type.


lua_Unsigned

typedef ... lua_Unsigned;

The unsigned version of lua_Integer.


lua_upvalueindex

[-0, +0, –]

int lua_upvalueindex (int i);

Returns the pseudo-index that represents the i-th upvalue of the running function (see §4.4).


lua_version

[-0, +0, v]

const lua_Number *lua_version (lua_State *L);

Returns the address of the version number stored in the Lua core. When called with a valid lua_State, returns the address of the version used to create that state. When called with NULL, returns the address of the version running the call.


lua_Writer

typedef int (*lua_Writer) (lua_State *L,
                           const void* p,
                           size_t sz,
                           void* ud);

The type of the writer function used by lua_dump. Every time it produces another piece of chunk, lua_dump calls the writer, passing along the buffer to be written (p), its size (sz), and the data parameter supplied to lua_dump.

The writer returns an error code: 0 means no errors; any other value means an error and stops lua_dump from calling the writer again.


lua_xmove

[-?, +?, –]

void lua_xmove (lua_State *from, lua_State *to, int n);

Exchange values between different threads of the same state.

This function pops n values from the stack from, and pushes them onto the stack to.


lua_yield

[-?, +?, e]

int lua_yield (lua_State *L, int nresults);

This function is equivalent to lua_yieldk, but it has no continuation (see §4.7). Therefore, when the thread resumes, it continues the function that called the function calling lua_yield.


lua_yieldk

[-?, +?, e]

int lua_yieldk (lua_State *L,
                int nresults,
                lua_KContext ctx,
                lua_KFunction k);

Yields a coroutine (thread).

When a C function calls lua_yieldk, the running coroutine suspends its execution, and the call to lua_resume that started this coroutine returns. The parameter nresults is the number of values from the stack that will be passed as results to lua_resume.

When the coroutine is resumed again, Lua calls the given continuation function k to continue the execution of the C function that yielded (see §4.7). This continuation function receives the same stack from the previous function, with the n results removed and replaced by the arguments passed to lua_resume. Moreover, the continuation function receives the value ctx that was passed to lua_yieldk.

Usually, this function does not return; when the coroutine eventually resumes, it continues executing the continuation function. However, there is one special case, which is when this function is called from inside a line hook (see §4.9). In that case, lua_yieldk should be called with no continuation (probably in the form of lua_yield), and the hook should return immediately after the call. Lua will yield and, when the coroutine resumes again, it will continue the normal execution of the (Lua) function that triggered the hook.

This function can raise an error if it is called from a thread with a pending C call with no continuation function, or it is called from a thread that is not running inside a resume (e.g., the main thread).

4.9 – The Debug Interface

Lua has no built-in debugging facilities. Instead, it offers a special interface by means of functions and hooks. This interface allows the construction of different kinds of debuggers, profilers, and other tools that need "inside information" from the interpreter.


lua_Debug

typedef struct lua_Debug {
  int event;
  const char *name;           /* (n) */
  const char *namewhat;       /* (n) */
  const char *what;           /* (S) */
  const char *source;         /* (S) */
  int currentline;            /* (l) */
  int linedefined;            /* (S) */
  int lastlinedefined;        /* (S) */
  unsigned char nups;         /* (u) number of upvalues */
  unsigned char nparams;      /* (u) number of parameters */
  char isvararg;              /* (u) */
  char istailcall;            /* (t) */
  char short_src[LUA_IDSIZE]; /* (S) */
  /* private part */
  other fields
} lua_Debug;

A structure used to carry different pieces of information about a function or an activation record. lua_getstack fills only the private part of this structure, for later use. To fill the other fields of lua_Debug with useful information, call lua_getinfo.

The fields of lua_Debug have the following meaning:

  • source: the name of the chunk that created the function. If source starts with a '@', it means that the function was defined in a file where the file name follows the '@'. If source starts with a '=', the remainder of its contents describe the source in a user-dependent manner. Otherwise, the function was defined in a string where source is that string.
  • short_src: a "printable" version of source, to be used in error messages.
  • linedefined: the line number where the definition of the function starts.
  • lastlinedefined: the line number where the definition of the function ends.
  • what: the string "Lua" if the function is a Lua function, "C" if it is a C function, "main" if it is the main part of a chunk.
  • currentline: the current line where the given function is executing. When no line information is available, currentline is set to -1.
  • name: a reasonable name for the given function. Because functions in Lua are first-class values, they do not have a fixed name: some functions can be the value of multiple global variables, while others can be stored only in a table field. The lua_getinfo function checks how the function was called to find a suitable name. If it cannot find a name, then name is set to NULL.
  • namewhat: explains the name field. The value of namewhat can be "global", "local", "method", "field", "upvalue", or "" (the empty string), according to how the function was called. (Lua uses the empty string when no other option seems to apply.)
  • istailcall: true if this function invocation was called by a tail call. In this case, the caller of this level is not in the stack.
  • nups: the number of upvalues of the function.
  • nparams: the number of fixed parameters of the function (always 0 for C functions).
  • isvararg: true if the function is a vararg function (always true for C functions).

lua_gethook

[-0, +0, –]

lua_Hook lua_gethook (lua_State *L);

Returns the current hook function.


lua_gethookcount

[-0, +0, –]

int lua_gethookcount (lua_State *L);

Returns the current hook count.


lua_gethookmask

[-0, +0, –]

int lua_gethookmask (lua_State *L);

Returns the current hook mask.


lua_getinfo

[-(0|1), +(0|1|2), e]

int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar);

Gets information about a specific function or function invocation.

To get information about a function invocation, the parameter ar must be a valid activation record that was filled by a previous call to lua_getstack or given as argument to a hook (see lua_Hook).

To get information about a function you push it onto the stack and start the what string with the character '>'. (In that case, lua_getinfo pops the function from the top of the stack.) For instance, to know in which line a function f was defined, you can write the following code:

     lua_Debug ar;
     lua_getglobal(L, "f");  /* get global 'f' */
     lua_getinfo(L, ">S", &ar);
     printf("%d\n", ar.linedefined);

Each character in the string what selects some fields of the structure ar to be filled or a value to be pushed on the stack:

  • 'n': fills in the field name and namewhat;
  • 'S': fills in the fields source, short_src, linedefined, lastlinedefined, and what;
  • 'l': fills in the field currentline;
  • 't': fills in the field istailcall;
  • 'u': fills in the fields nups, nparams, and isvararg;
  • 'f': pushes onto the stack the function that is running at the given level;
  • 'L': pushes onto the stack a table whose indices are the numbers of the lines that are valid on the function. (A valid line is a line with some associated code, that is, a line where you can put a break point. Non-valid lines include empty lines and comments.)

    If this option is given together with option 'f', its table is pushed after the function.

This function returns 0 on error (for instance, an invalid option in what).


lua_getlocal

[-0, +(0|1), –]

const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n);

Gets information about a local variable of a given activation record or a given function.

In the first case, the parameter ar must be a valid activation record that was filled by a previous call to lua_getstack or given as argument to a hook (see lua_Hook). The index n selects which local variable to inspect; see debug.getlocal for details about variable indices and names.

lua_getlocal pushes the variable's value onto the stack and returns its name.

In the second case, ar must be NULL and the function to be inspected must be at the top of the stack. In this case, only parameters of Lua functions are visible (as there is no information about what variables are active) and no values are pushed onto the stack.

Returns NULL (and pushes nothing) when the index is greater than the number of active local variables.


lua_getstack

[-0, +0, –]

int lua_getstack (lua_State *L, int level, lua_Debug *ar);

Gets information about the interpreter runtime stack.

This function fills parts of a lua_Debug structure with an identification of the activation record of the function executing at a given level. Level 0 is the current running function, whereas level n+1 is the function that has called level n (except for tail calls, which do not count on the stack). When there are no errors, lua_getstack returns 1; when called with a level greater than the stack depth, it returns 0.


lua_getupvalue

[-0, +(0|1), –]

const char *lua_getupvalue (lua_State *L, int funcindex, int n);

Gets information about the n-th upvalue of the closure at index funcindex. It pushes the upvalue's value onto the stack and returns its name. Returns NULL (and pushes nothing) when the index n is greater than the number of upvalues.

For C functions, this function uses the empty string "" as a name for all upvalues. (For Lua functions, upvalues are the external local variables that the function uses, and that are consequently included in its closure.)

Upvalues have no particular order, as they are active through the whole function. They are numbered in an arbitrary order.


lua_Hook

typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);

Type for debugging hook functions.

Whenever a hook is called, its ar argument has its field event set to the specific event that triggered the hook. Lua identifies these events with the following constants: LUA_HOOKCALL, LUA_HOOKRET, LUA_HOOKTAILCALL, LUA_HOOKLINE, and LUA_HOOKCOUNT. Moreover, for line events, the field currentline is also set. To get the value of any other field in ar, the hook must call lua_getinfo.

For call events, event can be LUA_HOOKCALL, the normal value, or LUA_HOOKTAILCALL, for a tail call; in this case, there will be no corresponding return event.

While Lua is running a hook, it disables other calls to hooks. Therefore, if a hook calls back Lua to execute a function or a chunk, this execution occurs without any calls to hooks.

Hook functions cannot have continuations, that is, they cannot call lua_yieldk, lua_pcallk, or lua_callk with a non-null k.

Hook functions can yield under the following conditions: Only count and line events can yield; to yield, a hook function must finish its execution calling lua_yield with nresults equal to zero (that is, with no values).


lua_sethook

[-0, +0, –]

void lua_sethook (lua_State *L, lua_Hook f, int mask, int count);

Sets the debugging hook function.

Argument f is the hook function. mask specifies on which events the hook will be called: it is formed by a bitwise or of the constants LUA_MASKCALL, LUA_MASKRET, LUA_MASKLINE, and LUA_MASKCOUNT. The count argument is only meaningful when the mask includes LUA_MASKCOUNT. For each event, the hook is called as explained below:

  • The call hook: is called when the interpreter calls a function. The hook is called just after Lua enters the new function, before the function gets its arguments.
  • The return hook: is called when the interpreter returns from a function. The hook is called just before Lua leaves the function. There is no standard way to access the values to be returned by the function.
  • The line hook: is called when the interpreter is about to start the execution of a new line of code, or when it jumps back in the code (even to the same line). (This event only happens while Lua is executing a Lua function.)
  • The count hook: is called after the interpreter executes every count instructions. (This event only happens while Lua is executing a Lua function.)

A hook is disabled by setting mask to zero.


lua_setlocal

[-(0|1), +0, –]

const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n);

Sets the value of a local variable of a given activation record. It assigns the value at the top of the stack to the variable and returns its name. It also pops the value from the stack.

Returns NULL (and pops nothing) when the index is greater than the number of active local variables.

Parameters ar and n are as in function lua_getlocal.


lua_setupvalue

[-(0|1), +0, –]

const char *lua_setupvalue (lua_State *L, int funcindex, int n);

Sets the value of a closure's upvalue. It assigns the value at the top of the stack to the upvalue and returns its name. It also pops the value from the stack.

Returns NULL (and pops nothing) when the index n is greater than the number of upvalues.

Parameters funcindex and n are as in function lua_getupvalue.


lua_upvalueid

[-0, +0, –]

void *lua_upvalueid (lua_State *L, int funcindex, int n);

Returns a unique identifier for the upvalue numbered n from the closure at index funcindex.

These unique identifiers allow a program to check whether different closures share upvalues. Lua closures that share an upvalue (that is, that access a same external local variable) will return identical ids for those upvalue indices.

Parameters funcindex and n are as in function lua_getupvalue, but n cannot be greater than the number of upvalues.


lua_upvaluejoin

[-0, +0, –]

void lua_upvaluejoin (lua_State *L, int funcindex1, int n1,
                                    int funcindex2, int n2);

Make the n1-th upvalue of the Lua closure at index funcindex1 refer to the n2-th upvalue of the Lua closure at index funcindex2.

5 – The Auxiliary Library

The auxiliary library provides several convenient functions to interface C with Lua. While the basic API provides the primitive functions for all interactions between C and Lua, the auxiliary library provides higher-level functions for some common tasks.

All functions and types from the auxiliary library are defined in header file lauxlib.h and have a prefix luaL_.

All functions in the auxiliary library are built on top of the basic API, and so they provide nothing that cannot be done with that API. Nevertheless, the use of the auxiliary library ensures more consistency to your code.

Several functions in the auxiliary library use internally some extra stack slots. When a function in the auxiliary library uses less than five slots, it does not check the stack size; it simply assumes that there are enough slots.

Several functions in the auxiliary library are used to check C function arguments. Because the error message is formatted for arguments (e.g., "bad argument #1"), you should not use these functions for other stack values.

Functions called luaL_check* always raise an error if the check is not satisfied.

5.1 – Functions and Types

Here we list all functions and types from the auxiliary library in alphabetical order.


luaL_addchar

[-?, +?, m]

void luaL_addchar (luaL_Buffer *B, char c);

Adds the byte c to the buffer B (see luaL_Buffer).


luaL_addlstring

[-?, +?, m]

void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l);

Adds the string pointed to by s with length l to the buffer B (see luaL_Buffer). The string can contain embedded zeros.


luaL_addsize

[-?, +?, –]

void luaL_addsize (luaL_Buffer *B, size_t n);

Adds to the buffer B (see luaL_Buffer) a string of length n previously copied to the buffer area (see luaL_prepbuffer).


luaL_addstring

[-?, +?, m]

void luaL_addstring (luaL_Buffer *B, const char *s);

Adds the zero-terminated string pointed to by s to the buffer B (see luaL_Buffer).


luaL_addvalue

[-1, +?, m]

void luaL_addvalue (luaL_Buffer *B);

Adds the value at the top of the stack to the buffer B (see luaL_Buffer). Pops the value.

This is the only function on string buffers that can (and must) be called with an extra element on the stack, which is the value to be added to the buffer.


luaL_argcheck

[-0, +0, v]

void luaL_argcheck (lua_State *L,
                    int cond,
                    int arg,
                    const char *extramsg);

Checks whether cond is true. If it is not, raises an error with a standard message (see luaL_argerror).


luaL_argerror

[-0, +0, v]

int luaL_argerror (lua_State *L, int arg, const char *extramsg);

Raises an error reporting a problem with argument arg of the C function that called it, using a standard message that includes extramsg as a comment:

     bad argument #arg to 'funcname' (extramsg)

This function never returns.


luaL_Buffer

typedef struct luaL_Buffer luaL_Buffer;

Type for a string buffer.

A string buffer allows C code to build Lua strings piecemeal. Its pattern of use is as follows:

  • First declare a variable b of type luaL_Buffer.
  • Then initialize it with a call luaL_buffinit(L, &b).
  • Then add string pieces to the buffer calling any of the luaL_add* functions.
  • Finish by calling luaL_pushresult(&b). This call leaves the final string on the top of the stack.

If you know beforehand the total size of the resulting string, you can use the buffer like this:

  • First declare a variable b of type luaL_Buffer.
  • Then initialize it and preallocate a space of size sz with a call luaL_buffinitsize(L, &b, sz).
  • Then copy the string into that space.
  • Finish by calling luaL_pushresultsize(&b, sz), where sz is the total size of the resulting string copied into that space.

During its normal operation, a string buffer uses a variable number of stack slots. So, while using a buffer, you cannot assume that you know where the top of the stack is. You can use the stack between successive calls to buffer operations as long as that use is balanced; that is, when you call a buffer operation, the stack is at the same level it was immediately after the previous buffer operation. (The only exception to this rule is luaL_addvalue.) After calling luaL_pushresult the stack is back to its level when the buffer was initialized, plus the final string on its top.


luaL_buffinit

[-0, +0, –]

void luaL_buffinit (lua_State *L, luaL_Buffer *B);

Initializes a buffer B. This function does not allocate any space; the buffer must be declared as a variable (see luaL_Buffer).


luaL_buffinitsize

[-?, +?, m]

char *luaL_buffinitsize (lua_State *L, luaL_Buffer *B, size_t sz);

Equivalent to the sequence luaL_buffinit, luaL_prepbuffsize.


luaL_callmeta

[-0, +(0|1), e]

int luaL_callmeta (lua_State *L, int obj, const char *e);

Calls a metamethod.

If the object at index obj has a metatable and this metatable has a field e, this function calls this field passing the object as its only argument. In this case this function returns true and pushes onto the stack the value returned by the call. If there is no metatable or no metamethod, this function returns false (without pushing any value on the stack).


luaL_checkany

[-0, +0, v]

void luaL_checkany (lua_State *L, int arg);

Checks whether the function has an argument of any type (including nil) at position arg.


luaL_checkinteger

[-0, +0, v]

lua_Integer luaL_checkinteger (lua_State *L, int arg);

Checks whether the function argument arg is an integer (or can be converted to an integer) and returns this integer cast to a lua_Integer.


luaL_checklstring

[-0, +0, v]

const char *luaL_checklstring (lua_State *L, int arg, size_t *l);

Checks whether the function argument arg is a string and returns this string; if l is not NULL fills *l with the string's length.

This function uses lua_tolstring to get its result, so all conversions and caveats of that function apply here.


luaL_checknumber

[-0, +0, v]

lua_Number luaL_checknumber (lua_State *L, int arg);

Checks whether the function argument arg is a number and returns this number.


luaL_checkoption

[-0, +0, v]

int luaL_checkoption (lua_State *L,
                      int arg,
                      const char *def,
                      const char *const lst[]);

Checks whether the function argument arg is a string and searches for this string in the array lst (which must be NULL-terminated). Returns the index in the array where the string was found. Raises an error if the argument is not a string or if the string cannot be found.

If def is not NULL, the function uses def as a default value when there is no argument arg or when this argument is nil.

This is a useful function for mapping strings to C enums. (The usual convention in Lua libraries is to use strings instead of numbers to select options.)


luaL_checkstack

[-0, +0, v]

void luaL_checkstack (lua_State *L, int sz, const char *msg);

Grows the stack size to top + sz elements, raising an error if the stack cannot grow to that size. msg is an additional text to go into the error message (or NULL for no additional text).


luaL_checkstring

[-0, +0, v]

const char *luaL_checkstring (lua_State *L, int arg);

Checks whether the function argument arg is a string and returns this string.

This function uses lua_tolstring to get its result, so all conversions and caveats of that function apply here.


luaL_checktype

[-0, +0, v]

void luaL_checktype (lua_State *L, int arg, int t);

Checks whether the function argument arg has type t. See lua_type for the encoding of types for t.


luaL_checkudata

[-0, +0, v]

void *luaL_checkudata (lua_State *L, int arg, const char *tname);

Checks whether the function argument arg is a userdata of the type tname (see luaL_newmetatable) and returns the userdata address (see lua_touserdata).


luaL_checkversion

[-0, +0, –]

void luaL_checkversion (lua_State *L);

Checks whether the core running the call, the core that created the Lua state, and the code making the call are all using the same version of Lua. Also checks whether the core running the call and the core that created the Lua state are using the same address space.


luaL_dofile

[-0, +?, e]

int luaL_dofile (lua_State *L, const char *filename);

Loads and runs the given file. It is defined as the following macro:

     (luaL_loadfile(L, filename) || lua_pcall(L, 0, LUA_MULTRET, 0))

It returns false if there are no errors or true in case of errors.


luaL_dostring

[-0, +?, –]

int luaL_dostring (lua_State *L, const char *str);

Loads and runs the given string. It is defined as the following macro:

     (luaL_loadstring(L, str) || lua_pcall(L, 0, LUA_MULTRET, 0))

It returns false if there are no errors or true in case of errors.


luaL_error

[-0, +0, v]

int luaL_error (lua_State *L, const char *fmt, ...);

Raises an error. The error message format is given by fmt plus any extra arguments, following the same rules of lua_pushfstring. It also adds at the beginning of the message the file name and the line number where the error occurred, if this information is available.

This function never returns, but it is an idiom to use it in C functions as return luaL_error(args).


luaL_execresult

[-0, +3, m]

int luaL_execresult (lua_State *L, int stat);

This function produces the return values for process-related functions in the standard library (os.execute and io.close).


luaL_fileresult

[-0, +(1|3), m]

int luaL_fileresult (lua_State *L, int stat, const char *fname);

This function produces the return values for file-related functions in the standard library (io.open, os.rename, file:seek, etc.).


luaL_getmetafield

[-0, +(0|1), m]

int luaL_getmetafield (lua_State *L, int obj, const char *e);

Pushes onto the stack the field e from the metatable of the object at index obj and returns the type of pushed value. If the object does not have a metatable, or if the metatable does not have this field, pushes nothing and returns LUA_TNIL.


luaL_getmetatable

[-0, +1, m]

int luaL_getmetatable (lua_State *L, const char *tname);

Pushes onto the stack the metatable associated with name tname in the registry (see luaL_newmetatable) (nil if there is no metatable associated with that name). Returns the type of the pushed value.


luaL_getsubtable

[-0, +1, e]

int luaL_getsubtable (lua_State *L, int idx, const char *fname);

Ensures that the value t[fname], where t is the value at index idx, is a table, and pushes that table onto the stack. Returns true if it finds a previous table there and false if it creates a new table.


luaL_gsub

[-0, +1, m]

const char *luaL_gsub (lua_State *L,
                       const char *s,
                       const char *p,
                       const char *r);

Creates a copy of string s by replacing any occurrence of the string p with the string r. Pushes the resulting string on the stack and returns it.


luaL_len

[-0, +0, e]

lua_Integer luaL_len (lua_State *L, int index);

Returns the "length" of the value at the given index as a number; it is equivalent to the '#' operator in Lua (see §3.4.7). Raises an error if the result of the operation is not an integer. (This case only can happen through metamethods.)


luaL_loadbuffer

[-0, +1, –]

int luaL_loadbuffer (lua_State *L,
                     const char *buff,
                     size_t sz,
                     const char *name);

Equivalent to luaL_loadbufferx with mode equal to NULL.


luaL_loadbufferx

[-0, +1, –]

int luaL_loadbufferx (lua_State *L,
                      const char *buff,
                      size_t sz,
                      const char *name,
                      const char *mode);

Loads a buffer as a Lua chunk. This function uses lua_load to load the chunk in the buffer pointed to by buff with size sz.

This function returns the same results as lua_load. name is the chunk name, used for debug information and error messages. The string mode works as in function lua_load.


luaL_loadfile

[-0, +1, e]

int luaL_loadfile (lua_State *L, const char *filename);

Equivalent to luaL_loadfilex with mode equal to NULL.


luaL_loadfilex

[-0, +1, e]

int luaL_loadfilex (lua_State *L, const char *filename,
                                            const char *mode);

Loads a file as a Lua chunk. This function uses lua_load to load the chunk in the file named filename. If filename is NULL, then it loads from the standard input. The first line in the file is ignored if it starts with a #.

The string mode works as in function lua_load.

This function returns the same results as lua_load, but it has an extra error code LUA_ERRFILE if it cannot open/read the file or the file has a wrong mode.

As lua_load, this function only loads the chunk; it does not run it.


luaL_loadstring

[-0, +1, –]

int luaL_loadstring (lua_State *L, const char *s);

Loads a string as a Lua chunk. This function uses lua_load to load the chunk in the zero-terminated string s.

This function returns the same results as lua_load.

Also as lua_load, this function only loads the chunk; it does not run it.


luaL_newlib

[-0, +1, m]

void luaL_newlib (lua_State *L, const luaL_Reg l[]);

Creates a new table and registers there the functions in list l.

It is implemented as the following macro:

     (luaL_newlibtable(L,l), luaL_setfuncs(L,l,0))

The array l must be the actual array, not a pointer to it.


luaL_newlibtable

[-0, +1, m]

void luaL_newlibtable (lua_State *L, const luaL_Reg l[]);

Creates a new table with a size optimized to store all entries in the array l (but does not actually store them). It is intended to be used in conjunction with luaL_setfuncs (see luaL_newlib).

It is implemented as a macro. The array l must be the actual array, not a pointer to it.


luaL_newmetatable

[-0, +1, m]

int luaL_newmetatable (lua_State *L, const char *tname);

If the registry already has the key tname, returns 0. Otherwise, creates a new table to be used as a metatable for userdata, adds to this new table the pair __name = tname, adds to the registry the pair [tname] = new table, and returns 1. (The entry __name is used by some error-reporting functions.)

In both cases pushes onto the stack the final value associated with tname in the registry.


luaL_newstate

[-0, +0, –]

lua_State *luaL_newstate (void);

Creates a new Lua state. It calls lua_newstate with an allocator based on the standard C realloc function and then sets a panic function (see §4.6) that prints an error message to the standard error output in case of fatal errors.

Returns the new state, or NULL if there is a memory allocation error.


luaL_openlibs

[-0, +0, e]

void luaL_openlibs (lua_State *L);

Opens all standard Lua libraries into the given state.


luaL_optinteger

[-0, +0, v]

lua_Integer luaL_optinteger (lua_State *L,
                             int arg,
                             lua_Integer d);

If the function argument arg is an integer (or convertible to an integer), returns this integer. If this argument is absent or is nil, returns d. Otherwise, raises an error.


luaL_optlstring

[-0, +0, v]

const char *luaL_optlstring (lua_State *L,
                             int arg,
                             const char *d,
                             size_t *l);

If the function argument arg is a string, returns this string. If this argument is absent or is nil, returns d. Otherwise, raises an error.

If l is not NULL, fills the position *l with the result's length. If the result is NULL (only possible when returning d and d == NULL), its length is considered zero.


luaL_optnumber

[-0, +0, v]

lua_Number luaL_optnumber (lua_State *L, int arg, lua_Number d);

If the function argument arg is a number, returns this number. If this argument is absent or is nil, returns d. Otherwise, raises an error.


luaL_optstring

[-0, +0, v]

const char *luaL_optstring (lua_State *L,
                            int arg,
                            const char *d);

If the function argument arg is a string, returns this string. If this argument is absent or is nil, returns d. Otherwise, raises an error.


luaL_prepbuffer

[-?, +?, m]

char *luaL_prepbuffer (luaL_Buffer *B);

Equivalent to luaL_prepbuffsize with the predefined size LUAL_BUFFERSIZE.


luaL_prepbuffsize

[-?, +?, m]

char *luaL_prepbuffsize (luaL_Buffer *B, size_t sz);

Returns an address to a space of size sz where you can copy a string to be added to buffer B (see luaL_Buffer). After copying the string into this space you must call luaL_addsize with the size of the string to actually add it to the buffer.


luaL_pushresult

[-?, +1, m]

void luaL_pushresult (luaL_Buffer *B);

Finishes the use of buffer B leaving the final string on the top of the stack.


luaL_pushresultsize

[-?, +1, m]

void luaL_pushresultsize (luaL_Buffer *B, size_t sz);

Equivalent to the sequence luaL_addsize, luaL_pushresult.


luaL_ref

[-1, +0, m]

int luaL_ref (lua_State *L, int t);

Creates and returns a reference, in the table at index t, for the object at the top of the stack (and pops the object).

A reference is a unique integer key. As long as you do not manually add integer keys into table t, luaL_ref ensures the uniqueness of the key it returns. You can retrieve an object referred by reference r by calling lua_rawgeti(L, t, r). Function luaL_unref frees a reference and its associated object.

If the object at the top of the stack is nil, luaL_ref returns the constant LUA_REFNIL. The constant LUA_NOREF is guaranteed to be different from any reference returned by luaL_ref.


luaL_Reg

typedef struct luaL_Reg {
  const char *name;
  lua_CFunction func;
} luaL_Reg;

Type for arrays of functions to be registered by luaL_setfuncs. name is the function name and func is a pointer to the function. Any array of luaL_Reg must end with a sentinel entry in which both name and func are NULL.


luaL_requiref

[-0, +1, e]

void luaL_requiref (lua_State *L, const char *modname,
                    lua_CFunction openf, int glb);

If modname is not already present in package.loaded, calls function openf with string modname as an argument and sets the call result in package.loaded[modname], as if that function has been called through require.

If glb is true, also stores the module into global modname.

Leaves a copy of the module on the stack.


luaL_setfuncs

[-nup, +0, m]

void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup);

Registers all functions in the array l (see luaL_Reg) into the table on the top of the stack (below optional upvalues, see next).

When nup is not zero, all functions are created sharing nup upvalues, which must be previously pushed on the stack on top of the library table. These values are popped from the stack after the registration.


luaL_setmetatable

[-0, +0, –]

void luaL_setmetatable (lua_State *L, const char *tname);

Sets the metatable of the object at the top of the stack as the metatable associated with name tname in the registry (see luaL_newmetatable).


luaL_Stream

typedef struct luaL_Stream {
  FILE *f;
  lua_CFunction closef;
} luaL_Stream;

The standard representation for file handles, which is used by the standard I/O library.

A file handle is implemented as a full userdata, with a metatable called LUA_FILEHANDLE (where LUA_FILEHANDLE is a macro with the actual metatable's name). The metatable is created by the I/O library (see luaL_newmetatable).

This userdata must start with the structure luaL_Stream; it can contain other data after this initial structure. Field f points to the corresponding C stream (or it can be NULL to indicate an incompletely created handle). Field closef points to a Lua function that will be called to close the stream when the handle is closed or collected; this function receives the file handle as its sole argument and must return either true (in case of success) or nil plus an error message (in case of error). Once Lua calls this field, it changes the field value to NULL to signal that the handle is closed.


luaL_testudata

[-0, +0, m]

void *luaL_testudata (lua_State *L, int arg, const char *tname);

This function works like luaL_checkudata, except that, when the test fails, it returns NULL instead of raising an error.


luaL_tolstring

[-0, +1, e]

const char *luaL_tolstring (lua_State *L, int idx, size_t *len);

Converts any Lua value at the given index to a C string in a reasonable format. The resulting string is pushed onto the stack and also returned by the function. If len is not NULL, the function also sets *len with the string length.

If the value has a metatable with a "__tostring" field, then luaL_tolstring calls the corresponding metamethod with the value as argument, and uses the result of the call as its result.


luaL_traceback

[-0, +1, m]

void luaL_traceback (lua_State *L, lua_State *L1, const char *msg,
                     int level);

Creates and pushes a traceback of the stack L1. If msg is not NULL it is appended at the beginning of the traceback. The level parameter tells at which level to start the traceback.


luaL_typename

[-0, +0, –]

const char *luaL_typename (lua_State *L, int index);

Returns the name of the type of the value at the given index.


luaL_unref

[-0, +0, –]

void luaL_unref (lua_State *L, int t, int ref);

Releases reference ref from the table at index t (see luaL_ref). The entry is removed from the table, so that the referred object can be collected. The reference ref is also freed to be used again.

If ref is LUA_NOREF or LUA_REFNIL, luaL_unref does nothing.


luaL_where

[-0, +1, m]

void luaL_where (lua_State *L, int lvl);

Pushes onto the stack a string identifying the current position of the control at level lvl in the call stack. Typically this string has the following format:

     chunkname:currentline:

Level 0 is the running function, level 1 is the function that called the running function, etc.

This function is used to build a prefix for error messages.

6 – Standard Libraries

The standard Lua libraries provide useful functions that are implemented directly through the C API. Some of these functions provide essential services to the language (e.g., type and getmetatable); others provide access to "outside" services (e.g., I/O); and others could be implemented in Lua itself, but are quite useful or have critical performance requirements that deserve an implementation in C (e.g., table.sort).

All libraries are implemented through the official C API and are provided as separate C modules. Currently, Lua has the following standard libraries:

  • basic library (§6.1);
  • coroutine library (§6.2);
  • package library (§6.3);
  • string manipulation (§6.4);
  • basic UTF-8 support (§6.5);
  • table manipulation (§6.6);
  • mathematical functions (§6.7) (sin, log, etc.);
  • input and output (§6.8);
  • operating system facilities (§6.9);
  • debug facilities (§6.10).

Except for the basic and the package libraries, each library provides all its functions as fields of a global table or as methods of its objects.

To have access to these libraries, the C host program should call the luaL_openlibs function, which opens all standard libraries. Alternatively, the host program can open them individually by using luaL_requiref to call luaopen_base (for the basic library), luaopen_package (for the package library), luaopen_coroutine (for the coroutine library), luaopen_string (for the string library), luaopen_utf8 (for the UTF8 library), luaopen_table (for the table library), luaopen_math (for the mathematical library), luaopen_io (for the I/O library), luaopen_os (for the operating system library), and luaopen_debug (for the debug library). These functions are declared in lualib.h.

6.1 – Basic Functions

The basic library provides core functions to Lua. If you do not include this library in your application, you should check carefully whether you need to provide implementations for some of its facilities.


assert (v [, message])

Calls error if the value of its argument v is false (i.e., nil or false); otherwise, returns all its arguments. In case of error, message is the error object; when absent, it defaults to "assertion failed!"


collectgarbage ([opt [, arg]])

This function is a generic interface to the garbage collector. It performs different functions according to its first argument, opt:

  • "collect": performs a full garbage-collection cycle. This is the default option.
  • "stop": stops automatic execution of the garbage collector. The collector will run only when explicitly invoked, until a call to restart it.
  • "restart": restarts automatic execution of the garbage collector.
  • "count": returns the total memory in use by Lua in Kbytes. The value has a fractional part, so that it multiplied by 1024 gives the exact number of bytes in use by Lua (except for overflows).
  • "step": performs a garbage-collection step. The step "size" is controlled by arg. With a zero value, the collector will perform one basic (indivisible) step. For non-zero values, the collector will perform as if that amount of memory (in KBytes) had been allocated by Lua. Returns true if the step finished a collection cycle.
  • "setpause": sets arg as the new value for the pause of the collector (see §2.5). Returns the previous value for pause.
  • "setstepmul": sets arg as the new value for the step multiplier of the collector (see §2.5). Returns the previous value for step.
  • "isrunning": returns a boolean that tells whether the collector is running (i.e., not stopped).


dofile ([filename])

Opens the named file and executes its contents as a Lua chunk. When called without arguments, dofile executes the contents of the standard input (stdin). Returns all values returned by the chunk. In case of errors, dofile propagates the error to its caller (that is, dofile does not run in protected mode).


error (message [, level])

Terminates the last protected function called and returns message as the error object. Function error never returns.

Usually, error adds some information about the error position at the beginning of the message, if the message is a string. The level argument specifies how to get the error position. With level 1 (the default), the error position is where the error function was called. Level 2 points the error to where the function that called error was called; and so on. Passing a level 0 avoids the addition of error position information to the message.


_G

A global variable (not a function) that holds the global environment (see §2.2). Lua itself does not use this variable; changing its value does not affect any environment, nor vice versa.


getmetatable (object)

If object does not have a metatable, returns nil. Otherwise, if the object's metatable has a "__metatable" field, returns the associated value. Otherwise, returns the metatable of the given object.


ipairs (t)

Returns three values (an iterator function, the table t, and 0) so that the construction

     for i,v in ipairs(t) do body end

will iterate over the key–value pairs (1,t[1]), (2,t[2]), ..., up to the first nil value.


load (chunk [, chunkname [, mode [, env]]])

Loads a chunk.

If chunk is a string, the chunk is this string. If chunk is a function, load calls it repeatedly to get the chunk pieces. Each call to chunk must return a string that concatenates with previous results. A return of an empty string, nil, or no value signals the end of the chunk.

If there are no syntactic errors, returns the compiled chunk as a function; otherwise, returns nil plus the error message.

If the resulting function has upvalues, the first upvalue is set to the value of env, if that parameter is given, or to the value of the global environment. Other upvalues are initialized with nil. (When you load a main chunk, the resulting function will always have exactly one upvalue, the _ENV variable (see §2.2). However, when you load a binary chunk created from a function (see string.dump), the resulting function can have an arbitrary number of upvalues.) All upvalues are fresh, that is, they are not shared with any other function.

chunkname is used as the name of the chunk for error messages and debug information (see §4.9). When absent, it defaults to chunk, if chunk is a string, or to "=(load)" otherwise.

The string mode controls whether the chunk can be text or binary (that is, a precompiled chunk). It may be the string "b" (only binary chunks), "t" (only text chunks), or "bt" (both binary and text). The default is "bt".

Lua does not check the consistency of binary chunks. Maliciously crafted binary chunks can crash the interpreter.


loadfile ([filename [, mode [, env]]])

Similar to load, but gets the chunk from file filename or from the standard input, if no file name is given.


next (table [, index])

Allows a program to traverse all fields of a table. Its first argument is a table and its second argument is an index in this table. next returns the next index of the table and its associated value. When called with nil as its second argument, next returns an initial index and its associated value. When called with the last index, or with nil in an empty table, next returns nil. If the second argument is absent, then it is interpreted as nil. In particular, you can use next(t) to check whether a table is empty.

The order in which the indices are enumerated is not specified, even for numeric indices. (To traverse a table in numerical order, use a numerical for.)

The behavior of next is undefined if, during the traversal, you assign any value to a non-existent field in the table. You may however modify existing fields. In particular, you may clear existing fields.


pairs (t)

If t has a metamethod __pairs, calls it with t as argument and returns the first three results from the call.

Otherwise, returns three values: the next function, the table t, and nil, so that the construction

     for k,v in pairs(t) do body end

will iterate over all key–value pairs of table t.

See function next for the caveats of modifying the table during its traversal.


pcall (f [, arg1, ···])

Calls function f with the given arguments in protected mode. This means that any error inside f is not propagated; instead, pcall catches the error and returns a status code. Its first result is the status code (a boolean), which is true if the call succeeds without errors. In such case, pcall also returns all results from the call, after this first result. In case of any error, pcall returns false plus the error message.


print (···)

Receives any number of arguments and prints their values to stdout, using the tostring function to convert each argument to a string. print is not intended for formatted output, but only as a quick way to show a value, for instance for debugging. For complete control over the output, use string.format and io.write.


rawequal (v1, v2)

Checks whether v1 is equal to v2, without invoking any metamethod. Returns a boolean.


rawget (table, index)

Gets the real value of table[index], without invoking any metamethod. table must be a table; index may be any value.


rawlen (v)

Returns the length of the object v, which must be a table or a string, without invoking any metamethod. Returns an integer.


rawset (table, index, value)

Sets the real value of table[index] to value, without invoking any metamethod. table must be a table, index any value different from nil and NaN, and value any Lua value.

This function returns table.


select (index, ···)

If index is a number, returns all arguments after argument number index; a negative number indexes from the end (-1 is the last argument). Otherwise, index must be the string "#", and select returns the total number of extra arguments it received.


setmetatable (table, metatable)

Sets the metatable for the given table. (To change the metatable of other types from Lua code, you must use the debug library (§6.10).) If metatable is nil, removes the metatable of the given table. If the original metatable has a "__metatable" field, raises an error.

This function returns table.


tonumber (e [, base])

When called with no base, tonumber tries to convert its argument to a number. If the argument is already a number or a string convertible to a number, then tonumber returns this number; otherwise, it returns nil.

The conversion of strings can result in integers or floats, according to the lexical conventions of Lua (see §3.1). (The string may have leading and trailing spaces and a sign.)

When called with base, then e must be a string to be interpreted as an integer numeral in that base. The base may be any integer between 2 and 36, inclusive. In bases above 10, the letter 'A' (in either upper or lower case) represents 10, 'B' represents 11, and so forth, with 'Z' representing 35. If the string e is not a valid numeral in the given base, the function returns nil.


tostring (v)

Receives a value of any type and converts it to a string in a human-readable format. (For complete control of how numbers are converted, use string.format.)

If the metatable of v has a "__tostring" field, then tostring calls the corresponding value with v as argument, and uses the result of the call as its result.


type (v)

Returns the type of its only argument, coded as a string. The possible results of this function are "nil" (a string, not the value nil), "number", "string", "boolean", "table", "function", "thread", and "userdata".


_VERSION

A global variable (not a function) that holds a string containing the running Lua version. The current value of this variable is "Lua 5.3".


xpcall (f, msgh [, arg1, ···])

This function is similar to pcall, except that it sets a new message handler msgh.

6.2 – Coroutine Manipulation

This library comprises the operations to manipulate coroutines, which come inside the table coroutine. See §2.6 for a general description of coroutines.


coroutine.create (f)

Creates a new coroutine, with body f. f must be a function. Returns this new coroutine, an object with type "thread".


coroutine.isyieldable ()

Returns true when the running coroutine can yield.

A running coroutine is yieldable if it is not the main thread and it is not inside a non-yieldable C function.


coroutine.resume (co [, val1, ···])

Starts or continues the execution of coroutine co. The first time you resume a coroutine, it starts running its body. The values val1, ... are passed as the arguments to the body function. If the coroutine has yielded, resume restarts it; the values val1, ... are passed as the results from the yield.

If the coroutine runs without any errors, resume returns true plus any values passed to yield (when the coroutine yields) or any values returned by the body function (when the coroutine terminates). If there is any error, resume returns false plus the error message.


coroutine.running ()

Returns the running coroutine plus a boolean, true when the running coroutine is the main one.


coroutine.status (co)

Returns the status of coroutine co, as a string: "running", if the coroutine is running (that is, it called status); "suspended", if the coroutine is suspended in a call to yield, or if it has not started running yet; "normal" if the coroutine is active but not running (that is, it has resumed another coroutine); and "dead" if the coroutine has finished its body function, or if it has stopped with an error.


coroutine.wrap (f)

Creates a new coroutine, with body f. f must be a function. Returns a function that resumes the coroutine each time it is called. Any arguments passed to the function behave as the extra arguments to resume. Returns the same values returned by resume, except the first boolean. In case of error, propagates the error.


coroutine.yield (···)

Suspends the execution of the calling coroutine. Any arguments to yield are passed as extra results to resume.

6.3 – Modules

The package library provides basic facilities for loading modules in Lua. It exports one function directly in the global environment: require. Everything else is exported in a table package.


require (modname)

Loads the given module. The function starts by looking into the package.loaded table to determine whether modname is already loaded. If it is, then require returns the value stored at package.loaded[modname]. Otherwise, it tries to find a loader for the module.

To find a loader, require is guided by the package.searchers sequence. By changing this sequence, we can change how require looks for a module. The following explanation is based on the default configuration for package.searchers.

First require queries package.preload[modname]. If it has a value, this value (which must be a function) is the loader. Otherwise require searches for a Lua loader using the path stored in package.path. If that also fails, it searches for a C loader using the path stored in package.cpath. If that also fails, it tries an all-in-one loader (see package.searchers).

Once a loader is found, require calls the loader with two arguments: modname and an extra value dependent on how it got the loader. (If the loader came from a file, this extra value is the file name.) If the loader returns any non-nil value, require assigns the returned value to package.loaded[modname]. If the loader does not return a non-nil value and has not assigned any value to package.loaded[modname], then require assigns true to this entry. In any case, require returns the final value of package.loaded[modname].

If there is any error loading or running the module, or if it cannot find any loader for the module, then require raises an error.


package.config

A string describing some compile-time configurations for packages. This string is a sequence of lines:

  • The first line is the directory separator string. Default is '\' for Windows and '/' for all other systems.
  • The second line is the character that separates templates in a path. Default is ';'.
  • The third line is the string that marks the substitution points in a template. Default is '?'.
  • The fourth line is a string that, in a path in Windows, is replaced by the executable's directory. Default is '!'.
  • The fifth line is a mark to ignore all text after it when building the luaopen_ function name. Default is '-'.


package.cpath

The path used by require to search for a C loader.

Lua initializes the C path package.cpath in the same way it initializes the Lua path package.path, using the environment variable LUA_CPATH_5_3 or the environment variable LUA_CPATH or a default path defined in luaconf.h.


package.loaded

A table used by require to control which modules are already loaded. When you require a module modname and package.loaded[modname] is not false, require simply returns the value stored there.

This variable is only a reference to the real table; assignments to this variable do not change the table used by require.


package.loadlib (libname, funcname)

Dynamically links the host program with the C library libname.

If funcname is "*", then it only links with the library, making the symbols exported by the library available to other dynamically linked libraries. Otherwise, it looks for a function funcname inside the library and returns this function as a C function. So, funcname must follow the lua_CFunction prototype (see lua_CFunction).

This is a low-level function. It completely bypasses the package and module system. Unlike require, it does not perform any path searching and does not automatically adds extensions. libname must be the complete file name of the C library, including if necessary a path and an extension. funcname must be the exact name exported by the C library (which may depend on the C compiler and linker used).

This function is not supported by Standard C. As such, it is only available on some platforms (Windows, Linux, Mac OS X, Solaris, BSD, plus other Unix systems that support the dlfcn standard).


package.path

The path used by require to search for a Lua loader.

At start-up, Lua initializes this variable with the value of the environment variable LUA_PATH_5_3 or the environment variable LUA_PATH or with a default path defined in luaconf.h, if those environment variables are not defined. Any ";;" in the value of the environment variable is replaced by the default path.


package.preload

A table to store loaders for specific modules (see require).

This variable is only a reference to the real table; assignments to this variable do not change the table used by require.


package.searchers

A table used by require to control how to load modules.

Each entry in this table is a searcher function. When looking for a module, require calls each of these searchers in ascending order, with the module name (the argument given to require) as its sole parameter. The function can return another function (the module loader) plus an extra value that will be passed to that loader, or a string explaining why it did not find that module (or nil if it has nothing to say).

Lua initializes this table with four searcher functions.

The first searcher simply looks for a loader in the package.preload table.

The second searcher looks for a loader as a Lua library, using the path stored at package.path. The search is done as described in function package.searchpath.

The third searcher looks for a loader as a C library, using the path given by the variable package.cpath. Again, the search is done as described in function package.searchpath. For instance, if the C path is the string

     "./?.so;./?.dll;/usr/local/?/init.so"

the searcher for module foo will try to open the files ./foo.so, ./foo.dll, and /usr/local/foo/init.so, in that order. Once it finds a C library, this searcher first uses a dynamic link facility to link the application with the library. Then it tries to find a C function inside the library to be used as the loader. The name of this C function is the string "luaopen_" concatenated with a copy of the module name where each dot is replaced by an underscore. Moreover, if the module name has a hyphen, its suffix after (and including) the first hyphen is removed. For instance, if the module name is a.b.c-v2.1, the function name will be luaopen_a_b_c.

The fourth searcher tries an all-in-one loader. It searches the C path for a library for the root name of the given module. For instance, when requiring a.b.c, it will search for a C library for a. If found, it looks into it for an open function for the submodule; in our example, that would be luaopen_a_b_c. With this facility, a package can pack several C submodules into one single library, with each submodule keeping its original open function.

All searchers except the first one (preload) return as the extra value the file name where the module was found, as returned by package.searchpath. The first searcher returns no extra value.


package.searchpath (name, path [, sep [, rep]])

Searches for the given name in the given path.

A path is a string containing a sequence of templates separated by semicolons. For each template, the function replaces each interrogation mark (if any) in the template with a copy of name wherein all occurrences of sep (a dot, by default) were replaced by rep (the system's directory separator, by default), and then tries to open the resulting file name.

For instance, if the path is the string

     "./?.lua;./?.lc;/usr/local/?/init.lua"

the search for the name foo.a will try to open the files ./foo/a.lua, ./foo/a.lc, and /usr/local/foo/a/init.lua, in that order.

Returns the resulting name of the first file that it can open in read mode (after closing the file), or nil plus an error message if none succeeds. (This error message lists all file names it tried to open.)

6.4 – String Manipulation

This library provides generic functions for string manipulation, such as finding and extracting substrings, and pattern matching. When indexing a string in Lua, the first character is at position 1 (not at 0, as in C). Indices are allowed to be negative and are interpreted as indexing backwards, from the end of the string. Thus, the last character is at position -1, and so on.

The string library provides all its functions inside the table string. It also sets a metatable for strings where the __index field points to the string table. Therefore, you can use the string functions in object-oriented style. For instance, string.byte(s,i) can be written as s:byte(i).

The string library assumes one-byte character encodings.


string.byte (s [, i [, j]])

Returns the internal numeric codes of the characters s[i], s[i+1], ..., s[j]. The default value for i is 1; the default value for j is i. These indices are corrected following the same rules of function string.sub.

Numeric codes are not necessarily portable across platforms.


string.char (···)

Receives zero or more integers. Returns a string with length equal to the number of arguments, in which each character has the internal numeric code equal to its corresponding argument.

Numeric codes are not necessarily portable across platforms.


string.dump (function [, strip])

Returns a string containing a binary representation (a binary chunk) of the given function, so that a later load on this string returns a copy of the function (but with new upvalues). If strip is a true value, the binary representation may not include all debug information about the function, to save space.

Functions with upvalues have only their number of upvalues saved. When (re)loaded, those upvalues receive fresh instances containing nil. (You can use the debug library to serialize and reload the upvalues of a function in a way adequate to your needs.)


string.find (s, pattern [, init [, plain]])

Looks for the first match of pattern (see §6.4.1) in the string s. If it finds a match, then find returns the indices of s where this occurrence starts and ends; otherwise, it returns nil. A third, optional numeric argument init specifies where to start the search; its default value is 1 and can be negative. A value of true as a fourth, optional argument plain turns off the pattern matching facilities, so the function does a plain "find substring" operation, with no characters in pattern being considered magic. Note that if plain is given, then init must be given as well.

If the pattern has captures, then in a successful match the captured values are also returned, after the two indices.


string.format (formatstring, ···)

Returns a formatted version of its variable number of arguments following the description given in its first argument (which must be a string). The format string follows the same rules as the ISO C function sprintf. The only differences are that the options/modifiers *, h, L, l, n, and p are not supported and that there is an extra option, q. The q option formats a string between double quotes, using escape sequences when necessary to ensure that it can safely be read back by the Lua interpreter. For instance, the call

     string.format('%q', 'a string with "quotes" and \n new line')

may produce the string:

     "a string with \"quotes\" and \
      new line"

Options A, a, E, e, f, G, and g all expect a number as argument. Options c, d, i, o, u, X, and x expect an integer. Option q expects a string. Option s expects a string; if its argument is not a string, it is converted to one following the same rules of tostring. If the option has any modifier (flags, width, length), the string argument should not contain embedded zeros.

When Lua is compiled with a non-C99 compiler, options A and a (hexadecimal floats) do not support any modifier (flags, width, length).


string.gmatch (s, pattern)

Returns an iterator function that, each time it is called, returns the next captures from pattern (see §6.4.1) over the string s. If pattern specifies no captures, then the whole match is produced in each call.

As an example, the following loop will iterate over all the words from string s, printing one per line:

     s = "hello world from Lua"
     for w in string.gmatch(s, "%a+") do
       print(w)
     end

The next example collects all pairs key=value from the given string into a table:

     t = {}
     s = "from=world, to=Lua"
     for k, v in string.gmatch(s, "(%w+)=(%w+)") do
       t[k] = v
     end

For this function, a caret '^' at the start of a pattern does not work as an anchor, as this would prevent the iteration.


string.gsub (s, pattern, repl [, n])

Returns a copy of s in which all (or the first n, if given) occurrences of the pattern (see §6.4.1) have been replaced by a replacement string specified by repl, which can be a string, a table, or a function. gsub also returns, as its second value, the total number of matches that occurred. The name gsub comes from Global SUBstitution.

If repl is a string, then its value is used for replacement. The character % works as an escape character: any sequence in repl of the form %d, with d between 1 and 9, stands for the value of the d-th captured substring. The sequence %0 stands for the whole match. The sequence %% stands for a single %.

If repl is a table, then the table is queried for every match, using the first capture as the key.

If repl is a function, then this function is called every time a match occurs, with all captured substrings passed as arguments, in order.

In any case, if the pattern specifies no captures, then it behaves as if the whole pattern was inside a capture.

If the value returned by the table query or by the function call is a string or a number, then it is used as the replacement string; otherwise, if it is false or nil, then there is no replacement (that is, the original match is kept in the string).

Here are some examples:

     x = string.gsub("hello world", "(%w+)", "%1 %1")
     --> x="hello hello world world"
     
     x = string.gsub("hello world", "%w+", "%0 %0", 1)
     --> x="hello hello world"
     
     x = string.gsub("hello world from Lua", "(%w+)%s*(%w+)", "%2 %1")
     --> x="world hello Lua from"
     
     x = string.gsub("home = $HOME, user = $USER", "%$(%w+)", os.getenv)
     --> x="home = /home/roberto, user = roberto"
     
     x = string.gsub("4+5 = $return 4+5$", "%$(.-)%$", function (s)
           return load(s)()
         end)
     --> x="4+5 = 9"
     
     local t = {name="lua", version="5.3"}
     x = string.gsub("$name-$version.tar.gz", "%$(%w+)", t)
     --> x="lua-5.3.tar.gz"


string.len (s)

Receives a string and returns its length. The empty string "" has length 0. Embedded zeros are counted, so "a\000bc\000" has length 5.


string.lower (s)

Receives a string and returns a copy of this string with all uppercase letters changed to lowercase. All other characters are left unchanged. The definition of what an uppercase letter is depends on the current locale.


string.match (s, pattern [, init])

Looks for the first match of pattern (see §6.4.1) in the string s. If it finds one, then match returns the captures from the pattern; otherwise it returns nil. If pattern specifies no captures, then the whole match is returned. A third, optional numeric argument init specifies where to start the search; its default value is 1 and can be negative.


string.pack (fmt, v1, v2, ···)

Returns a binary string containing the values v1, v2, etc. packed (that is, serialized in binary form) according to the format string fmt (see §6.4.2).


string.packsize (fmt)

Returns the size of a string resulting from string.pack with the given format. The format string cannot have the variable-length options 's' or 'z' (see §6.4.2).


string.rep (s, n [, sep])

Returns a string that is the concatenation of n copies of the string s separated by the string sep. The default value for sep is the empty string (that is, no separator). Returns the empty string if n is not positive.

(Note that it is very easy to exhaust the memory of your machine with a single call to this function.)


string.reverse (s)

Returns a string that is the string s reversed.


string.sub (s, i [, j])

Returns the substring of s that starts at i and continues until j; i and j can be negative. If j is absent, then it is assumed to be equal to -1 (which is the same as the string length). In particular, the call string.sub(s,1,j) returns a prefix of s with length j, and string.sub(s, -i) returns a suffix of s with length i.

If, after the translation of negative indices, i is less than 1, it is corrected to 1. If j is greater than the string length, it is corrected to that length. If, after these corrections, i is greater than j, the function returns the empty string.


string.unpack (fmt, s [, pos])

Returns the values packed in string s (see string.pack) according to the format string fmt (see §6.4.2). An optional pos marks where to start reading in s (default is 1). After the read values, this function also returns the index of the first unread byte in s.


string.upper (s)

Receives a string and returns a copy of this string with all lowercase letters changed to uppercase. All other characters are left unchanged. The definition of what a lowercase letter is depends on the current locale.

6.4.1 – Patterns

Patterns in Lua are described by regular strings, which are interpreted as patterns by the pattern-matching functions string.find, string.gmatch, string.gsub, and string.match. This section describes the syntax and the meaning (that is, what they match) of these strings.

Character Class:

A character class is used to represent a set of characters. The following combinations are allowed in describing a character class:

  • x: (where x is not one of the magic characters ^$()%.[]*+-?) represents the character x itself.
  • .: (a dot) represents all characters.
  • %a: represents all letters.
  • %c: represents all control characters.
  • %d: represents all digits.
  • %g: represents all printable characters except space.
  • %l: represents all lowercase letters.
  • %p: represents all punctuation characters.
  • %s: represents all space characters.
  • %u: represents all uppercase letters.
  • %w: represents all alphanumeric characters.
  • %x: represents all hexadecimal digits.
  • %x: (where x is any non-alphanumeric character) represents the character x. This is the standard way to escape the magic characters. Any non-alphanumeric character (including all punctuation characters, even the non-magical) can be preceded by a '%' when used to represent itself in a pattern.
  • [set]: represents the class which is the union of all characters in set. A range of characters can be specified by separating the end characters of the range, in ascending order, with a '-'. All classes %x described above can also be used as components in set. All other characters in set represent themselves. For example, [%w_] (or [_%w]) represents all alphanumeric characters plus the underscore, [0-7] represents the octal digits, and [0-7%l%-] represents the octal digits plus the lowercase letters plus the '-' character.

    The interaction between ranges and classes is not defined. Therefore, patterns like [%a-z] or [a-%%] have no meaning.

  • [^set]: represents the complement of set, where set is interpreted as above.

For all classes represented by single letters (%a, %c, etc.), the corresponding uppercase letter represents the complement of the class. For instance, %S represents all non-space characters.

The definitions of letter, space, and other character groups depend on the current locale. In particular, the class [a-z] may not be equivalent to %l.

Pattern Item:

A pattern item can be

  • a single character class, which matches any single character in the class;
  • a single character class followed by '*', which matches zero or more repetitions of characters in the class. These repetition items will always match the longest possible sequence;
  • a single character class followed by '+', which matches one or more repetitions of characters in the class. These repetition items will always match the longest possible sequence;
  • a single character class followed by '-', which also matches zero or more repetitions of characters in the class. Unlike '*', these repetition items will always match the shortest possible sequence;
  • a single character class followed by '?', which matches zero or one occurrence of a character in the class. It always matches one occurrence if possible;
  • %n, for n between 1 and 9; such item matches a substring equal to the n-th captured string (see below);
  • %bxy, where x and y are two distinct characters; such item matches strings that start with x, end with y, and where the x and y are balanced. This means that, if one reads the string from left to right, counting +1 for an x and -1 for a y, the ending y is the first y where the count reaches 0. For instance, the item %b() matches expressions with balanced parentheses.
  • %f[set], a frontier pattern; such item matches an empty string at any position such that the next character belongs to set and the previous character does not belong to set. The set set is interpreted as previously described. The beginning and the end of the subject are handled as if they were the character '\0'.

Pattern:

A pattern is a sequence of pattern items. A caret '^' at the beginning of a pattern anchors the match at the beginning of the subject string. A '$' at the end of a pattern anchors the match at the end of the subject string. At other positions, '^' and '$' have no special meaning and represent themselves.

Captures:

A pattern can contain sub-patterns enclosed in parentheses; they describe captures. When a match succeeds, the substrings of the subject string that match captures are stored (captured) for future use. Captures are numbered according to their left parentheses. For instance, in the pattern "(a*(.)%w(%s*))", the part of the string matching "a*(.)%w(%s*)" is stored as the first capture (and therefore has number 1); the character matching "." is captured with number 2, and the part matching "%s*" has number 3.

As a special case, the empty capture () captures the current string position (a number). For instance, if we apply the pattern "()aa()" on the string "flaaap", there will be two captures: 3 and 5.

6.4.2 – Format Strings for Pack and Unpack

The first argument to string.pack, string.packsize, and string.unpack is a format string, which describes the layout of the structure being created or read.

A format string is a sequence of conversion options. The conversion options are as follows:

  • <: sets little endian
  • >: sets big endian
  • =: sets native endian
  • ![n]: sets maximum alignment to n (default is native alignment)
  • b: a signed byte (char)
  • B: an unsigned byte (char)
  • h: a signed short (native size)
  • H: an unsigned short (native size)
  • l: a signed long (native size)
  • L: an unsigned long (native size)
  • j: a lua_Integer
  • J: a lua_Unsigned
  • T: a size_t (native size)
  • i[n]: a signed int with n bytes (default is native size)
  • I[n]: an unsigned int with n bytes (default is native size)
  • f: a float (native size)
  • d: a double (native size)
  • n: a lua_Number
  • cn: a fixed-sized string with n bytes
  • z: a zero-terminated string
  • s[n]: a string preceded by its length coded as an unsigned integer with n bytes (default is a size_t)
  • x: one byte of padding
  • Xop: an empty item that aligns according to option op (which is otherwise ignored)
  • ' ': (empty space) ignored

(A "[n]" means an optional integral numeral.) Except for padding, spaces, and configurations (options "xX <=>!"), each option corresponds to an argument (in string.pack) or a result (in string.unpack).

For options "!n", "sn", "in", and "In", n can be any integer between 1 and 16. All integral options check overflows; string.pack checks whether the given value fits in the given size; string.unpack checks whether the read value fits in a Lua integer.

Any format string starts as if prefixed by "!1=", that is, with maximum alignment of 1 (no alignment) and native endianness.

Alignment works as follows: For each option, the format gets extra padding until the data starts at an offset that is a multiple of the minimum between the option size and the maximum alignment; this minimum must be a power of 2. Options "c" and "z" are not aligned; option "s" follows the alignment of its starting integer.

All padding is filled with zeros by string.pack (and ignored by string.unpack).

6.5 – UTF-8 Support

This library provides basic support for UTF-8 encoding. It provides all its functions inside the table utf8. This library does not provide any support for Unicode other than the handling of the encoding. Any operation that needs the meaning of a character, such as character classification, is outside its scope.

Unless stated otherwise, all functions that expect a byte position as a parameter assume that the given position is either the start of a byte sequence or one plus the length of the subject string. As in the string library, negative indices count from the end of the string.


utf8.char (···)

Receives zero or more integers, converts each one to its corresponding UTF-8 byte sequence and returns a string with the concatenation of all these sequences.


utf8.charpattern

The pattern (a string, not a function) "[\0-\x7F\xC2-\xF4][\x80-\xBF]*" (see §6.4.1), which matches exactly one UTF-8 byte sequence, assuming that the subject is a valid UTF-8 string.


utf8.codes (s)

Returns values so that the construction

     for p, c in utf8.codes(s) do body end

will iterate over all characters in string s, with p being the position (in bytes) and c the code point of each character. It raises an error if it meets any invalid byte sequence.


utf8.codepoint (s [, i [, j]])

Returns the codepoints (as integers) from all characters in s that start between byte position i and j (both included). The default for i is 1 and for j is i. It raises an error if it meets any invalid byte sequence.


utf8.len (s [, i [, j]])

Returns the number of UTF-8 characters in string s that start between positions i and j (both inclusive). The default for i is 1 and for j is -1. If it finds any invalid byte sequence, returns a false value plus the position of the first invalid byte.


utf8.offset (s, n [, i])

Returns the position (in bytes) where the encoding of the n-th character of s (counting from position i) starts. A negative n gets characters before position i. The default for i is 1 when n is non-negative and #s + 1 otherwise, so that utf8.offset(s, -n) gets the offset of the n-th character from the end of the string. If the specified character is neither in the subject nor right after its end, the function returns nil.

As a special case, when n is 0 the function returns the start of the encoding of the character that contains the i-th byte of s.

This function assumes that s is a valid UTF-8 string.

6.6 – Table Manipulation

This library provides generic functions for table manipulation. It provides all its functions inside the table table.

Remember that, whenever an operation needs the length of a table, the table must be a proper sequence or have a __len metamethod (see §3.4.7). All functions ignore non-numeric keys in the tables given as arguments.


table.concat (list [, sep [, i [, j]]])

Given a list where all elements are strings or numbers, returns the string list[i]..sep..list[i+1] ··· sep..list[j]. The default value for sep is the empty string, the default for i is 1, and the default for j is #list. If i is greater than j, returns the empty string.


table.insert (list, [pos,] value)

Inserts element value at position pos in list, shifting up the elements list[pos], list[pos+1], ···, list[#list]. The default value for pos is #list+1, so that a call table.insert(t,x) inserts x at the end of list t.


table.move (a1, f, e, t [,a2])

Moves elements from table a1 to table a2. This function performs the equivalent to the following multiple assignment: a2[t],··· = a1[f],···,a1[e]. The default for a2 is a1. The destination range can overlap with the source range. The number of elements to be moved must fit in a Lua integer.


table.pack (···)

Returns a new table with all parameters stored into keys 1, 2, etc. and with a field "n" with the total number of parameters. Note that the resulting table may not be a sequence.


table.remove (list [, pos])

Removes from list the element at position pos, returning the value of the removed element. When pos is an integer between 1 and #list, it shifts down the elements list[pos+1], list[pos+2], ···, list[#list] and erases element list[#list]; The index pos can also be 0 when #list is 0, or #list + 1; in those cases, the function erases the element list[pos].

The default value for pos is #list, so that a call table.remove(l) removes the last element of list l.


table.sort (list [, comp])

Sorts list elements in a given order, in-place, from list[1] to list[#list]. If comp is given, then it must be a function that receives two list elements and returns true when the first element must come before the second in the final order (so that, after the sort, i < j implies not comp(list[j],list[i])). If comp is not given, then the standard Lua operator < is used instead.

Note that the comp function must define a strict partial order over the elements in the list; that is, it must be asymmetric and transitive. Otherwise, no valid sort may be possible.

The sort algorithm is not stable; that is, elements not comparable by the given order (e.g., equal elements) may have their relative positions changed by the sort.


table.unpack (list [, i [, j]])

Returns the elements from the given list. This function is equivalent to

     return list[i], list[i+1], ···, list[j]

By default, i is 1 and j is #list.

6.7 – Mathematical Functions

This library provides basic mathematical functions. It provides all its functions and constants inside the table math. Functions with the annotation "integer/float" give integer results for integer arguments and float results for float (or mixed) arguments. Rounding functions (math.ceil, math.floor, and math.modf) return an integer when the result fits in the range of an integer, or a float otherwise.


math.abs (x)

Returns the absolute value of x. (integer/float)


math.acos (x)

Returns the arc cosine of x (in radians).


math.asin (x)

Returns the arc sine of x (in radians).


math.atan (y [, x])

Returns the arc tangent of y/x (in radians), but uses the signs of both parameters to find the quadrant of the result. (It also handles correctly the case of x being zero.)

The default value for x is 1, so that the call math.atan(y) returns the arc tangent of y.


math.ceil (x)

Returns the smallest integral value larger than or equal to x.


math.cos (x)

Returns the cosine of x (assumed to be in radians).


math.deg (x)

Converts the angle x from radians to degrees.


math.exp (x)

Returns the value ex (where e is the base of natural logarithms).


math.floor (x)

Returns the largest integral value smaller than or equal to x.


math.fmod (x, y)

Returns the remainder of the division of x by y that rounds the quotient towards zero. (integer/float)


math.huge

The float value HUGE_VAL, a value larger than any other numeric value.


math.log (x [, base])

Returns the logarithm of x in the given base. The default for base is e (so that the function returns the natural logarithm of x).


math.max (x, ···)

Returns the argument with the maximum value, according to the Lua operator <. (integer/float)


math.maxinteger

An integer with the maximum value for an integer.


math.min (x, ···)

Returns the argument with the minimum value, according to the Lua operator <. (integer/float)


math.mininteger

An integer with the minimum value for an integer.


math.modf (x)

Returns the integral part of x and the fractional part of x. Its second result is always a float.


math.pi

The value of π.


math.rad (x)

Converts the angle x from degrees to radians.


math.random ([m [, n]])

When called without arguments, returns a pseudo-random float with uniform distribution in the range [0,1). When called with two integers m and n, math.random returns a pseudo-random integer with uniform distribution in the range [m, n]. (The value n-m cannot be negative and must fit in a Lua integer.) The call math.random(n) is equivalent to math.random(1,n).

This function is an interface to the underling pseudo-random generator function provided by C.


math.randomseed (x)

Sets x as the "seed" for the pseudo-random generator: equal seeds produce equal sequences of numbers.


math.sin (x)

Returns the sine of x (assumed to be in radians).


math.sqrt (x)

Returns the square root of x. (You can also use the expression x^0.5 to compute this value.)


math.tan (x)

Returns the tangent of x (assumed to be in radians).


math.tointeger (x)

If the value x is convertible to an integer, returns that integer. Otherwise, returns nil.


math.type (x)

Returns "integer" if x is an integer, "float" if it is a float, or nil if x is not a number.


math.ult (m, n)

Returns a boolean, true if integer m is below integer n when they are compared as unsigned integers.

6.8 – Input and Output Facilities

The I/O library provides two different styles for file manipulation. The first one uses implicit file handles; that is, there are operations to set a default input file and a default output file, and all input/output operations are over these default files. The second style uses explicit file handles.

When using implicit file handles, all operations are supplied by table io. When using explicit file handles, the operation io.open returns a file handle and then all operations are supplied as methods of the file handle.

The table io also provides three predefined file handles with their usual meanings from C: io.stdin, io.stdout, and io.stderr. The I/O library never closes these files.

Unless otherwise stated, all I/O functions return nil on failure (plus an error message as a second result and a system-dependent error code as a third result) and some value different from nil on success. On non-POSIX systems, the computation of the error message and error code in case of errors may be not thread safe, because they rely on the global C variable errno.


io.close ([file])

Equivalent to file:close(). Without a file, closes the default output file.


io.flush ()

Equivalent to io.output():flush().


io.input ([file])

When called with a file name, it opens the named file (in text mode), and sets its handle as the default input file. When called with a file handle, it simply sets this file handle as the default input file. When called without parameters, it returns the current default input file.

In case of errors this function raises the error, instead of returning an error code.


io.lines ([filename, ···])

Opens the given file name in read mode and returns an iterator function that works like file:lines(···) over the opened file. When the iterator function detects the end of file, it returns no values (to finish the loop) and automatically closes the file.

The call io.lines() (with no file name) is equivalent to io.input():lines("*l"); that is, it iterates over the lines of the default input file. In this case it does not close the file when the loop ends.

In case of errors this function raises the error, instead of returning an error code.


io.open (filename [, mode])

This function opens a file, in the mode specified in the string mode. It returns a new file handle, or, in case of errors, nil plus an error message.

The mode string can be any of the following:

  • "r": read mode (the default);
  • "w": write mode;
  • "a": append mode;
  • "r+": update mode, all previous data is preserved;
  • "w+": update mode, all previous data is erased;
  • "a+": append update mode, previous data is preserved, writing is only allowed at the end of file.

The mode string can also have a 'b' at the end, which is needed in some systems to open the file in binary mode.


io.output ([file])

Similar to io.input, but operates over the default output file.


io.popen (prog [, mode])

This function is system dependent and is not available on all platforms.

Starts program prog in a separated process and returns a file handle that you can use to read data from this program (if mode is "r", the default) or to write data to this program (if mode is "w").


io.read (···)

Equivalent to io.input():read(···).


io.tmpfile ()

Returns a handle for a temporary file. This file is opened in update mode and it is automatically removed when the program ends.


io.type (obj)

Checks whether obj is a valid file handle. Returns the string "file" if obj is an open file handle, "closed file" if obj is a closed file handle, or nil if obj is not a file handle.


io.write (···)

Equivalent to io.output():write(···).


file:close ()

Closes file. Note that files are automatically closed when their handles are garbage collected, but that takes an unpredictable amount of time to happen.

When closing a file handle created with io.popen, file:close returns the same values returned by os.execute.


file:flush ()

Saves any written data to file.


file:lines (···)

Returns an iterator function that, each time it is called, reads the file according to the given formats. When no format is given, uses "l" as a default. As an example, the construction

     for c in file:lines(1) do body end

will iterate over all characters of the file, starting at the current position. Unlike io.lines, this function does not close the file when the loop ends.

In case of errors this function raises the error, instead of returning an error code.


file:read (···)

Reads the file file, according to the given formats, which specify what to read. For each format, the function returns a string or a number with the characters read, or nil if it cannot read data with the specified format. (In this latter case, the function does not read subsequent formats.) When called without formats, it uses a default format that reads the next line (see below).

The available formats are

  • "n": reads a numeral and returns it as a float or an integer, following the lexical conventions of Lua. (The numeral may have leading spaces and a sign.) This format always reads the longest input sequence that is a valid prefix for a numeral; if that prefix does not form a valid numeral (e.g., an empty string, "0x", or "3.4e-"), it is discarded and the function returns nil.
  • "a": reads the whole file, starting at the current position. On end of file, it returns the empty string.
  • "l": reads the next line skipping the end of line, returning nil on end of file. This is the default format.
  • "L": reads the next line keeping the end-of-line character (if present), returning nil on end of file.
  • number: reads a string with up to this number of bytes, returning nil on end of file. If number is zero, it reads nothing and returns an empty string, or nil on end of file.

The formats "l" and "L" should be used only for text files.


file:seek ([whence [, offset]])

Sets and gets the file position, measured from the beginning of the file, to the position given by offset plus a base specified by the string whence, as follows:

  • "set": base is position 0 (beginning of the file);
  • "cur": base is current position;
  • "end": base is end of file;

In case of success, seek returns the final file position, measured in bytes from the beginning of the file. If seek fails, it returns nil, plus a string describing the error.

The default value for whence is "cur", and for offset is 0. Therefore, the call file:seek() returns the current file position, without changing it; the call file:seek("set") sets the position to the beginning of the file (and returns 0); and the call file:seek("end") sets the position to the end of the file, and returns its size.


file:setvbuf (mode [, size])

Sets the buffering mode for an output file. There are three available modes:

  • "no": no buffering; the result of any output operation appears immediately.
  • "full": full buffering; output operation is performed only when the buffer is full or when you explicitly flush the file (see io.flush).
  • "line": line buffering; output is buffered until a newline is output or there is any input from some special files (such as a terminal device).

For the last two cases, size specifies the size of the buffer, in bytes. The default is an appropriate size.


file:write (···)

Writes the value of each of its arguments to file. The arguments must be strings or numbers.

In case of success, this function returns file. Otherwise it returns nil plus a string describing the error.

6.9 – Operating System Facilities

This library is implemented through table os.


os.clock ()

Returns an approximation of the amount in seconds of CPU time used by the program.


os.date ([format [, time]])

Returns a string or a table containing date and time, formatted according to the given string format.

If the time argument is present, this is the time to be formatted (see the os.time function for a description of this value). Otherwise, date formats the current time.

If format starts with '!', then the date is formatted in Coordinated Universal Time. After this optional character, if format is the string "*t", then date returns a table with the following fields: year, month (1–12), day (1–31), hour (0–23), min (0–59), sec (0–61), wday (weekday, Sunday is 1), yday (day of the year), and isdst (daylight saving flag, a boolean). This last field may be absent if the information is not available.

If format is not "*t", then date returns the date as a string, formatted according to the same rules as the ISO C function strftime.

When called without arguments, date returns a reasonable date and time representation that depends on the host system and on the current locale. (More specifically, os.date() is equivalent to os.date("%c").)

On non-POSIX systems, this function may be not thread safe because of its reliance on C function gmtime and C function localtime.


os.difftime (t2, t1)

Returns the difference, in seconds, from time t1 to time t2 (where the times are values returned by os.time). In POSIX, Windows, and some other systems, this value is exactly t2-t1.


os.execute ([command])

This function is equivalent to the ISO C function system. It passes command to be executed by an operating system shell. Its first result is true if the command terminated successfully, or nil otherwise. After this first result the function returns a string plus a number, as follows:

  • "exit": the command terminated normally; the following number is the exit status of the command.
  • "signal": the command was terminated by a signal; the following number is the signal that terminated the command.

When called without a command, os.execute returns a boolean that is true if a shell is available.


os.exit ([code [, close]])

Calls the ISO C function exit to terminate the host program. If code is true, the returned status is EXIT_SUCCESS; if code is false, the returned status is EXIT_FAILURE; if code is a number, the returned status is this number. The default value for code is true.

If the optional second argument close is true, closes the Lua state before exiting.


os.getenv (varname)

Returns the value of the process environment variable varname, or nil if the variable is not defined.


os.remove (filename)

Deletes the file (or empty directory, on POSIX systems) with the given name. If this function fails, it returns nil, plus a string describing the error and the error code.


os.rename (oldname, newname)

Renames file or directory named oldname to newname. If this function fails, it returns nil, plus a string describing the error and the error code.


os.setlocale (locale [, category])

Sets the current locale of the program. locale is a system-dependent string specifying a locale; category is an optional string describing which category to change: "all", "collate", "ctype", "monetary", "numeric", or "time"; the default category is "all". The function returns the name of the new locale, or nil if the request cannot be honored.

If locale is the empty string, the current locale is set to an implementation-defined native locale. If locale is the string "C", the current locale is set to the standard C locale.

When called with nil as the first argument, this function only returns the name of the current locale for the given category.

This function may be not thread safe because of its reliance on C function setlocale.


os.time ([table])

Returns the current time when called without arguments, or a time representing the local date and time specified by the given table. This table must have fields year, month, and day, and may have fields hour (default is 12), min (default is 0), sec (default is 0), and isdst (default is nil). Other fields are ignored. For a description of these fields, see the os.date function.

The values in these fields do not need to be inside their valid ranges. For instance, if sec is -10, it means -10 seconds from the time specified by the other fields; if hour is 1000, it means +1000 hours from the time specified by the other fields.

The returned value is a number, whose meaning depends on your system. In POSIX, Windows, and some other systems, this number counts the number of seconds since some given start time (the "epoch"). In other systems, the meaning is not specified, and the number returned by time can be used only as an argument to os.date and os.difftime.


os.tmpname ()

Returns a string with a file name that can be used for a temporary file. The file must be explicitly opened before its use and explicitly removed when no longer needed.

On POSIX systems, this function also creates a file with that name, to avoid security risks. (Someone else might create the file with wrong permissions in the time between getting the name and creating the file.) You still have to open the file to use it and to remove it (even if you do not use it).

When possible, you may prefer to use io.tmpfile, which automatically removes the file when the program ends.

6.10 – The Debug Library

This library provides the functionality of the debug interface (§4.9) to Lua programs. You should exert care when using this library. Several of its functions violate basic assumptions about Lua code (e.g., that variables local to a function cannot be accessed from outside; that userdata metatables cannot be changed by Lua code; that Lua programs do not crash) and therefore can compromise otherwise secure code. Moreover, some functions in this library may be slow.

All functions in this library are provided inside the debug table. All functions that operate over a thread have an optional first argument which is the thread to operate over. The default is always the current thread.


debug.debug ()

Enters an interactive mode with the user, running each string that the user enters. Using simple commands and other debug facilities, the user can inspect global and local variables, change their values, evaluate expressions, and so on. A line containing only the word cont finishes this function, so that the caller continues its execution.

Note that commands for debug.debug are not lexically nested within any function and so have no direct access to local variables.


debug.gethook ([thread])

Returns the current hook settings of the thread, as three values: the current hook function, the current hook mask, and the current hook count (as set by the debug.sethook function).


debug.getinfo ([thread,] f [, what])

Returns a table with information about a function. You can give the function directly or you can give a number as the value of f, which means the function running at level f of the call stack of the given thread: level 0 is the current function (getinfo itself); level 1 is the function that called getinfo (except for tail calls, which do not count on the stack); and so on. If f is a number larger than the number of active functions, then getinfo returns nil.

The returned table can contain all the fields returned by lua_getinfo, with the string what describing which fields to fill in. The default for what is to get all information available, except the table of valid lines. If present, the option 'f' adds a field named func with the function itself. If present, the option 'L' adds a field named activelines with the table of valid lines.

For instance, the expression debug.getinfo(1,"n").name returns a name for the current function, if a reasonable name can be found, and the expression debug.getinfo(print) returns a table with all available information about the print function.


debug.getlocal ([thread,] f, local)

This function returns the name and the value of the local variable with index local of the function at level f of the stack. This function accesses not only explicit local variables, but also parameters, temporaries, etc.

The first parameter or local variable has index 1, and so on, following the order that they are declared in the code, counting only the variables that are active in the current scope of the function. Negative indices refer to vararg parameters; -1 is the first vararg parameter. The function returns nil if there is no variable with the given index, and raises an error when called with a level out of range. (You can call debug.getinfo to check whether the level is valid.)

Variable names starting with '(' (open parenthesis) represent variables with no known names (internal variables such as loop control variables, and variables from chunks saved without debug information).

The parameter f may also be a function. In that case, getlocal returns only the name of function parameters.


debug.getmetatable (value)

Returns the metatable of the given value or nil if it does not have a metatable.


debug.getregistry ()

Returns the registry table (see §4.5).


debug.getupvalue (f, up)

This function returns the name and the value of the upvalue with index up of the function f. The function returns nil if there is no upvalue with the given index.

Variable names starting with '(' (open parenthesis) represent variables with no known names (variables from chunks saved without debug information).


debug.getuservalue (u)

Returns the Lua value associated to u. If u is not a userdata, returns nil.


debug.sethook ([thread,] hook, mask [, count])

Sets the given function as a hook. The string mask and the number count describe when the hook will be called. The string mask may have any combination of the following characters, with the given meaning:

  • 'c': the hook is called every time Lua calls a function;
  • 'r': the hook is called every time Lua returns from a function;
  • 'l': the hook is called every time Lua enters a new line of code.

Moreover, with a count different from zero, the hook is called also after every count instructions.

When called without arguments, debug.sethook turns off the hook.

When the hook is called, its first parameter is a string describing the event that has triggered its call: "call" (or "tail call"), "return", "line", and "count". For line events, the hook also gets the new line number as its second parameter. Inside a hook, you can call getinfo with level 2 to get more information about the running function (level 0 is the getinfo function, and level 1 is the hook function).


debug.setlocal ([thread,] level, local, value)

This function assigns the value value to the local variable with index local of the function at level level of the stack. The function returns nil if there is no local variable with the given index, and raises an error when called with a level out of range. (You can call getinfo to check whether the level is valid.) Otherwise, it returns the name of the local variable.

See debug.getlocal for more information about variable indices and names.


debug.setmetatable (value, table)

Sets the metatable for the given value to the given table (which can be nil). Returns value.


debug.setupvalue (f, up, value)

This function assigns the value value to the upvalue with index up of the function f. The function returns nil if there is no upvalue with the given index. Otherwise, it returns the name of the upvalue.


debug.setuservalue (udata, value)

Sets the given value as the Lua value associated to the given udata. udata must be a full userdata.

Returns udata.


debug.traceback ([thread,] [message [, level]])

If message is present but is neither a string nor nil, this function returns message without further processing. Otherwise, it returns a string with a traceback of the call stack. The optional message string is appended at the beginning of the traceback. An optional level number tells at which level to start the traceback (default is 1, the function calling traceback).


debug.upvalueid (f, n)

Returns a unique identifier (as a light userdata) for the upvalue numbered n from the given function.

These unique identifiers allow a program to check whether different closures share upvalues. Lua closures that share an upvalue (that is, that access a same external local variable) will return identical ids for those upvalue indices.


debug.upvaluejoin (f1, n1, f2, n2)

Make the n1-th upvalue of the Lua closure f1 refer to the n2-th upvalue of the Lua closure f2.

7 – Lua Standalone

Although Lua has been designed as an extension language, to be embedded in a host C program, it is also frequently used as a standalone language. An interpreter for Lua as a standalone language, called simply lua, is provided with the standard distribution. The standalone interpreter includes all standard libraries, including the debug library. Its usage is:

     lua [options] [script [args]]

The options are:

  • -e stat: executes string stat;
  • -l mod: "requires" mod;
  • -i: enters interactive mode after running script;
  • -v: prints version information;
  • -E: ignores environment variables;
  • --: stops handling options;
  • -: executes stdin as a file and stops handling options.

After handling its options, lua runs the given script. When called without arguments, lua behaves as lua -v -i when the standard input (stdin) is a terminal, and as lua - otherwise.

When called without option -E, the interpreter checks for an environment variable LUA_INIT_5_3 (or LUA_INIT if the versioned name is not defined) before running any argument. If the variable content has the format @filename, then lua executes the file. Otherwise, lua executes the string itself.

When called with option -E, besides ignoring LUA_INIT, Lua also ignores the values of LUA_PATH and LUA_CPATH, setting the values of package.path and package.cpath with the default paths defined in luaconf.h.

All options are handled in order, except -i and -E. For instance, an invocation like

     $ lua -e'a=1' -e 'print(a)' script.lua

will first set a to 1, then print the value of a, and finally run the file script.lua with no arguments. (Here $ is the shell prompt. Your prompt may be different.)

Before running any code, lua collects all command-line arguments in a global table called arg. The script name goes to index 0, the first argument after the script name goes to index 1, and so on. Any arguments before the script name (that is, the interpreter name plus its options) go to negative indices. For instance, in the call

     $ lua -la b.lua t1 t2

the table is like this:

     arg = { [-2] = "lua", [-1] = "-la",
             [0] = "b.lua",
             [1] = "t1", [2] = "t2" }

If there is no script in the call, the interpreter name goes to index 0, followed by the other arguments. For instance, the call

     $ lua -e "print(arg[1])"

will print "-e". If there is a script, the script is called with parameters arg[1], ···, arg[#arg]. (Like all chunks in Lua, the script is compiled as a vararg function.)

In interactive mode, Lua repeatedly prompts and waits for a line. After reading a line, Lua first try to interpret the line as an expression. If it succeeds, it prints its value. Otherwise, it interprets the line as a statement. If you write an incomplete statement, the interpreter waits for its completion by issuing a different prompt.

In case of unprotected errors in the script, the interpreter reports the error to the standard error stream. If the error object is not a string but has a metamethod __tostring, the interpreter calls this metamethod to produce the final message. Otherwise, the interpreter converts the error object to a string and adds a stack traceback to it.

When finishing normally, the interpreter closes its main Lua state (see lua_close). The script can avoid this step by calling os.exit to terminate.

To allow the use of Lua as a script interpreter in Unix systems, the standalone interpreter skips the first line of a chunk if it starts with #. Therefore, Lua scripts can be made into executable programs by using chmod +x and the #! form, as in

     #!/usr/local/bin/lua

(Of course, the location of the Lua interpreter may be different in your machine. If lua is in your PATH, then

     #!/usr/bin/env lua

is a more portable solution.)

8 – Incompatibilities with the Previous Version

Here we list the incompatibilities that you may find when moving a program from Lua 5.2 to Lua 5.3. You can avoid some incompatibilities by compiling Lua with appropriate options (see file luaconf.h). However, all these compatibility options will be removed in the future.

Lua versions can always change the C API in ways that do not imply source-code changes in a program, such as the numeric values for constants or the implementation of functions as macros. Therefore, you should not assume that binaries are compatible between different Lua versions. Always recompile clients of the Lua API when using a new version.

Similarly, Lua versions can always change the internal representation of precompiled chunks; precompiled chunks are not compatible between different Lua versions.

The standard paths in the official distribution may change between versions.

8.1 – Changes in the Language

  • The main difference between Lua 5.2 and Lua 5.3 is the introduction of an integer subtype for numbers. Although this change should not affect "normal" computations, some computations (mainly those that involve some kind of overflow) can give different results.

    You can fix these differences by forcing a number to be a float (in Lua 5.2 all numbers were float), in particular writing constants with an ending .0 or using x = x + 0.0 to convert a variable. (This recommendation is only for a quick fix for an occasional incompatibility; it is not a general guideline for good programming. For good programming, use floats where you need floats and integers where you need integers.)

  • The conversion of a float to a string now adds a .0 suffix to the result if it looks like an integer. (For instance, the float 2.0 will be printed as 2.0, not as 2.) You should always use an explicit format when you need a specific format for numbers.

    (Formally this is not an incompatibility, because Lua does not specify how numbers are formatted as strings, but some programs assumed a specific format.)

  • The generational mode for the garbage collector was removed. (It was an experimental feature in Lua 5.2.)

8.2 – Changes in the Libraries

  • The bit32 library has been deprecated. It is easy to require a compatible external library or, better yet, to replace its functions with appropriate bitwise operations. (Keep in mind that bit32 operates on 32-bit integers, while the bitwise operators in Lua 5.3 operate on Lua integers, which by default have 64 bits.)
  • The Table library now respects metamethods for setting and getting elements.
  • The ipairs iterator now respects metamethods and its __ipairs metamethod has been deprecated.
  • Option names in io.read do not have a starting '*' anymore. For compatibility, Lua will continue to accept (and ignore) this character.
  • The following functions were deprecated in the mathematical library: atan2, cosh, sinh, tanh, pow, frexp, and ldexp. You can replace math.pow(x,y) with x^y; you can replace math.atan2 with math.atan, which now accepts one or two parameters; you can replace math.ldexp(x,exp) with x * 2.0^exp. For the other operations, you can either use an external library or implement them in Lua.
  • The searcher for C loaders used by require changed the way it handles versioned names. Now, the version should come after the module name (as is usual in most other tools). For compatibility, that searcher still tries the old format if it cannot find an open function according to the new style. (Lua 5.2 already worked that way, but it did not document the change.)
  • The call collectgarbage("count") now returns only one result. (You can compute that second result from the fractional part of the first result.)

8.3 – Changes in the API

  • Continuation functions now receive as parameters what they needed to get through lua_getctx, so lua_getctx has been removed. Adapt your code accordingly.
  • Function lua_dump has an extra parameter, strip. Use 0 as the value of this parameter to get the old behavior.
  • Functions to inject/project unsigned integers (lua_pushunsigned, lua_tounsigned, lua_tounsignedx, luaL_checkunsigned, luaL_optunsigned) were deprecated. Use their signed equivalents with a type cast.
  • Macros to project non-default integer types (luaL_checkint, luaL_optint, luaL_checklong, luaL_optlong) were deprecated. Use their equivalent over lua_Integer with a type cast (or, when possible, use lua_Integer in your code).

9 – The Complete Syntax of Lua

Here is the complete syntax of Lua in extended BNF. As usual in extended BNF, {A} means 0 or more As, and [A] means an optional A. (For operator precedences, see §3.4.8; for a description of the terminals Name, Numeral, and LiteralString, see §3.1.)


	chunk ::= block

	block ::= {stat} [retstat]

	stat ::=  ‘;’ | 
		 varlist ‘=’ explist | 
		 functioncall | 
		 label | 
		 break | 
		 goto Name | 
		 do block end | 
		 while exp do block end | 
		 repeat block until exp | 
		 if exp then block {elseif exp then block} [else block] end | 
		 for Name ‘=’ exp ‘,’ exp [‘,’ exp] do block end | 
		 for namelist in explist do block end | 
		 function funcname funcbody | 
		 local function Name funcbody | 
		 local namelist [‘=’ explist] 

	retstat ::= return [explist] [‘;’]

	label ::= ‘::’ Name ‘::’

	funcname ::= Name {‘.’ Name} [‘:’ Name]

	varlist ::= var {‘,’ var}

	var ::=  Name | prefixexp ‘[’ exp ‘]’ | prefixexp ‘.’ Name 

	namelist ::= Name {‘,’ Name}

	explist ::= exp {‘,’ exp}

	exp ::=  nil | false | true | Numeral | LiteralString | ‘...’ | functiondef | 
		 prefixexp | tableconstructor | exp binop exp | unop exp 

	prefixexp ::= var | functioncall | ‘(’ exp ‘)’

	functioncall ::=  prefixexp args | prefixexp ‘:’ Name args 

	args ::=  ‘(’ [explist] ‘)’ | tableconstructor | LiteralString 

	functiondef ::= function funcbody

	funcbody ::= ‘(’ [parlist] ‘)’ block end

	parlist ::= namelist [‘,’ ‘...’] | ‘...’

	tableconstructor ::= ‘{’ [fieldlist] ‘}’

	fieldlist ::= field {fieldsep field} [fieldsep]

	field ::= ‘[’ exp ‘]’ ‘=’ exp | Name ‘=’ exp | exp

	fieldsep ::= ‘,’ | ‘;’

	binop ::=  ‘+’ | ‘-’ | ‘*’ | ‘/’ | ‘//’ | ‘^’ | ‘%’ | 
		 ‘&’ | ‘~’ | ‘|’ | ‘>>’ | ‘<<’ | ‘..’ | 
		 ‘<’ | ‘<=’ | ‘>’ | ‘>=’ | ‘==’ | ‘~=’ | 
		 and | or

	unop ::= ‘-’ | not | ‘#’ | ‘~

wcc-0.0.2/src/wsh/lua/doc/index.css0000644000175000017500000000036013110675433015500 0ustar philphilul { list-style-type: none ; } ul.contents { padding: 0 ; } table { border: none ; border-spacing: 0 ; border-collapse: collapse ; } td { vertical-align: top ; padding: 0 ; text-align: left ; line-height: 1.25 ; width: 15% ; } wcc-0.0.2/src/wsh/lua/doc/osi-certified-72x60.png0000644000175000017500000000727613110675433017714 0ustar philphil‰PNG  IHDRH<JK±b?QÈü ?ÿ"ÿ‹Ñ˜‚Q;vîë¿ÕU„$|3cpVYŠù g.8¤|¤)ç‰=h|ð‡‚ßO˜1çÎã[«ÁÂR¬G¨;1vÝn±Yœ¶ã<±}'÷™Å&Ï`w–z¾s…à¹Ò c?¹ïú§‹N; ÏIb·Þ.»Sê=î™XB—@äp•— 8ÏH¤0ƒ¹®\¯‰^ßþõ“ÕäB'½b~ñŸ7Fì+fé‘– qcazêz{Ú{ øn<w—ñ.ˆ@?Åî¡3Ø;ÜCU¨*¾Y¼tîR':CLoÔ—*K½#¼ajXpˆC˜ÚÌm74.²´ØW‚'Su¯¾¦üVY—‹> i<Ç…3œËÁ,æ»óøã¸%7K~9b›êmz?_éžàFµ©¥L•’µ-3×ÇݧÿÓ½ú{ïÿîý»ÅU! ƒ9brX#¹ù»ßoª±Sv—÷?éÌû±åGšOqEœá²D ªÖ\׬OÛðÛw¾Ì bBcNçŽõÓÜjaÌ`‘°£·£MÛæHgˆµ´7#1"8Äp©"‘®N7Ù7æ“uŸ ©àãî³ÿý¨›°tY9´'ÁóÄ\;²©Ô*'@:C¬SßÉó†Xš5¶÷-™½d„-3-|ºAÝ;¬D"†ÃhõZ'@:CÌd5Ü‘’T†b¸/R9²I²I–˾!ÄlŸ¥Ï ÎÅ1üÌH‹Ð3C çºÛ8%ÎòE ÅŒ @rI;‡ú±ågãGõ#‘›ÃNƘÀ„X(v¤3Ĥ^R»Ùùi ‡p/>wµÀj·g¤¦¡æÆ£îî#Ä –aIŠç9ΠΓù²}˜¡Ùá2#̰Þa^wÚîìýæÓ!zL=9¿û€ö DápÄB´™æc~x@¸ !Ʊqi †9F˜®+׆ßáïm?ú±Ñlüµ®Mõv^–²M9~ªß£ ™»,ã\Ç÷ïHgˆMžìÉ÷2µ›GðÔ,ź¹ø+&»|ì•?hzàhÿóå?§þÛ"e÷íÏmØ” 0Ɔ֞èà>ïHgˆy¹y%Ç%wÕé0ƒGÈÓ1ÝB\}Æ5?náq~ h6»µÛ¦œëÏuçŽpãF¢z)ûcÊéw+'¯-+æ¿ÂüØB#YÀ 6´æÅþ:Ì?ÌѲ8陇¬¯Ã4òÕ‘¨»ÎìüK›>yƼØ_wÔ<Æ0ü¢@™({½,9½¿ÍÓÍ3%>EW×=BC$²)Ý£î5‹×ºŠ\Cè$1¹Yò{½M½gh#Iô´ƒÜ‚’ã“·/š™Š»Áf°wD:îv&&d¦f:Fó4µñÕêëm”‘Bœ! bw7t'Å$ ùÂÁíñ‘ñî½Í½C†f‚Gô4õRÍTÞ†Bžði…ç”Q½Re/Ý”2³±¬™±²OL?"‘UoC=DêÌ´'z‰â´¤´îcgžØÆˆ‹ÌíuEë–e["e‘Uªª;uwZ;[Àf·˲vÚþ‰¹Š\l;2ÑuRciK±ƒ× !Ô]¯ˆž=eöÓ—Ï[.¢D掟ù’GX;­õ%«9Ût½º3egþ=ÿ m¶ºîîÑóG ¿ôOÅ?¿pb0Þgü‰NDˆ'ªŠê©^ŠàŽ×(ÆÆô6÷.žµ˜Ãâ’)‹œ1µ»Iï¨"\¢·ÙX_ÒôæÜ·öoù‚ý‚N](ËÃåÕõÕ¹þ—¦Ž¦ü’ü»uw bäôíö“³üg×6êé€ä“f­Ù“ô\×®]»xñ¢£¬Õj)Š¢i:%%%//cl³Ùt:Ý3¬Zµê½÷Þë¯lÅòòr•J¥P(Ξ= 6lËåW®\Q©TW¯^€õë×ggg@FFÆîÝ»çÏŸßß— ~vVÕjõ… hšV(QQQÐÐÐPTT$‹—,YâááÑÔÔb±¸²²’Ïç¿þúë3gÎdfÞ¼yb±¸¥¥åóÏ?­V«Óé¼¼¼ ´´´¦¦fòäÉý£«ÕêÊÊÊøøx‘H4Æ@I«ÕÀ”)SUOOÏèèhG»T*€O?ýtçÎÅÅÅF£q×®]sçÎuìä'özMMB¡P*•555ÉÉÉßÿ}uuuZZZCCCYYYJJŠN§»téÒÆ³³³êëëc†a‰D"¤R©F£!IR£Ñ?~¼¢¢"00póæÍr¹|ݺuûöí{óÍ7÷ìÙc0f̘1x–ˆ9Z»AGÙf³ùøø”””TTT”——?|ø°¢¢âĉmmm/^|b@ww·c©ÀqP»ººîß¿Ÿ——‡²X,‹Åf³%$$Èår‡EQý¹2BÈn·Ïœ9ÓÇÇgõêÕ±±±?üðI’z½ž¦écÇŽq8–eÅb±F£1 …<<<¦OŸn³ äÄx<žDK{{;ˆD"–e«««gÍšjµ:,,ìÖ­[ðÔér {zãââ.gõêÕ‰äÔ©Sƒ;²,;xBB ð,k6›û :È,Z´H(r8œõë×»¹¹Ùl¶þážwÀúôéÓy<ÞÙ³gO:UWW·wï^¥R)•Jããã<(—Ë3224Á`(++³Ûí‘‘‘ðßÛuðÍÍÍŽrcc£Ñh$IR ÄÆÆÆÆÆr8±XŒ1vttˆP(Ôh4Žiê75¸€1‰D&“iÒ¤Ir¹<** !äêêÊápª««j÷îÝ|E(Mœ8qÿþý¹¹¹™™?¥ä>>>_~ù¥‹‹KBBBxxx~~~~~¾ã“ŸŸß®]»€¢( iºßÎÛo¿™™¹}ûv.—{âĉӧOoÚ´)''‡¦éööö .\¾|™ GG‡¤§§/_¾|çÎï¾û.MÓÎv»ÝQp,L&KJJZ¹reZZZAAA@@ÀÉ“'·nÝš››ÛÕÕåˆ ?[ö'ÜÚÝ»wÏ;§ÕjÒÓÓCCCíz½¾  àÎ;4MËd²+V€J¥ºvíZttô´iÓúÜ¿ÿÌ™34M§¦¦&&&"„*** …BazzzTTTmmmkkëà€QYYY^^¾qãÆÒÒÒÄÄDŸóçÏ'%%I$’ÚÚZµZ½`Á»Ý~êÔ)•JºråJ777¨­­-++›:uª‹‹‹ÙlŽ‹‹šØK#/müboòÒû/ëÓà‰Œ"IEND®B`‚wcc-0.0.2/src/wsh/lua/doc/readme.html0000644000175000017500000002616513110675433016015 0ustar philphil Lua 5.3 readme

Lua Welcome to Lua 5.3

About Lua

Lua is a powerful, fast, lightweight, embeddable scripting language developed by a team at PUC-Rio, the Pontifical Catholic University of Rio de Janeiro in Brazil. Lua is free software used in many products and projects around the world.

Lua's official web site provides complete information about Lua, including an executive summary and updated documentation, especially the reference manual, which may differ slightly from the local copy distributed in this package.

Installing Lua

Lua is distributed in source form. You need to build it before using it. Building Lua should be straightforward because Lua is implemented in pure ANSI C and compiles unmodified in all known platforms that have an ANSI C compiler. Lua also compiles unmodified as C++. The instructions given below for building Lua are for Unix-like platforms. See also instructions for other systems and customization options.

If you don't have the time or the inclination to compile Lua yourself, get a binary from LuaBinaries. Try also LuaDist, a multi-platform distribution of Lua that includes batteries.

Building Lua

In most Unix-like platforms, simply do "make" with a suitable target. Here are the details.

  1. Open a terminal window and move to the top-level directory, which is named lua-5.3.x. The Makefile there controls both the build process and the installation process.

  2. Do "make" and see if your platform is listed. The platforms currently supported are:

    aix bsd c89 freebsd generic linux macosx mingw posix solaris

    If your platform is listed, just do "make xxx", where xxx is your platform name.

    If your platform is not listed, try the closest one or posix, generic, c89, in this order.

  3. The compilation takes only a few moments and produces three files in the src directory: lua (the interpreter), luac (the compiler), and liblua.a (the library).

  4. To check that Lua has been built correctly, do "make test" after building Lua. This will run the interpreter and print its version.

If you're running Linux and get compilation errors, make sure you have installed the readline development package (which is probably named libreadline-dev or readline-devel). If you get link errors after that, then try "make linux MYLIBS=-ltermcap".

Installing Lua

Once you have built Lua, you may want to install it in an official place in your system. In this case, do "make install". The official place and the way to install files are defined in the Makefile. You'll probably need the right permissions to install files.

To build and install Lua in one step, do "make xxx install", where xxx is your platform name.

To install Lua locally, do "make local". This will create a directory install with subdirectories bin, include, lib, man, share, and install Lua as listed below. To install Lua locally, but in some other directory, do "make install INSTALL_TOP=xxx", where xxx is your chosen directory. The installation starts in the src and doc directories, so take care if INSTALL_TOP is not an absolute path.

bin:
lua luac
include:
lua.h luaconf.h lualib.h lauxlib.h lua.hpp
lib:
liblua.a
man/man1:
lua.1 luac.1

These are the only directories you need for development. If you only want to run Lua programs, you only need the files in bin and man. The files in include and lib are needed for embedding Lua in C or C++ programs.

Customization

Three kinds of things can be customized by editing a file:

  • Where and how to install Lua — edit Makefile.
  • How to build Lua — edit src/Makefile.
  • Lua features — edit src/luaconf.h.

You don't actually need to edit the Makefiles because you may set the relevant variables in the command line when invoking make. Nevertheless, it's probably best to edit and save the Makefiles to record the changes you've made.

On the other hand, if you need to customize some Lua features, you'll need to edit src/luaconf.h before building and installing Lua. The edited file will be the one installed, and it will be used by any Lua clients that you build, to ensure consistency. Further customization is available to experts by editing the Lua sources.

Building Lua on other systems

If you're not using the usual Unix tools, then the instructions for building Lua depend on the compiler you use. You'll need to create projects (or whatever your compiler uses) for building the library, the interpreter, and the compiler, as follows:

library:
lapi.c lcode.c lctype.c ldebug.c ldo.c ldump.c lfunc.c lgc.c llex.c lmem.c lobject.c lopcodes.c lparser.c lstate.c lstring.c ltable.c ltm.c lundump.c lvm.c lzio.c lauxlib.c lbaselib.c lbitlib.c lcorolib.c ldblib.c liolib.c lmathlib.c loslib.c lstrlib.c ltablib.c lutf8lib.c loadlib.c linit.c
interpreter:
library, lua.c
compiler:
library, luac.c

To use Lua as a library in your own programs you'll need to know how to create and use libraries with your compiler. Moreover, to dynamically load C libraries for Lua you'll need to know how to create dynamic libraries and you'll need to make sure that the Lua API functions are accessible to those dynamic libraries — but don't link the Lua library into each dynamic library. For Unix, we recommend that the Lua library be linked statically into the host program and its symbols exported for dynamic linking; src/Makefile does this for the Lua interpreter. For Windows, we recommend that the Lua library be a DLL. In all cases, the compiler luac should be linked statically.

As mentioned above, you may edit src/luaconf.h to customize some features before building Lua.

Changes since Lua 5.2

Here are the main changes introduced in Lua 5.3. The reference manual lists the incompatibilities that had to be introduced.

Main changes

  • integers (64-bit by default)
  • official support for 32-bit numbers
  • bitwise operators
  • basic utf-8 support
  • functions for packing and unpacking values
Here are the other changes introduced in Lua 5.3:

Language

  • userdata can have any Lua value as uservalue
  • integer division
  • more flexible rules for some metamethods

Libraries

  • ipairs and the table library respect metamethods
  • strip option in string.dump
  • table library respects metamethods
  • new function table.move
  • new function string.pack
  • new function string.unpack
  • new function string.packsize

C API

  • simpler API for continuation functions in C
  • lua_gettable and similar functions return type of resulted value
  • strip option in lua_dump
  • new function: lua_geti
  • new function: lua_seti
  • new function: lua_isyieldable
  • new function: lua_numbertointeger
  • new function: lua_rotate
  • new function: lua_stringtonumber

Lua standalone interpreter

  • can be used as calculator; no need to prefix with '='
  • arg table available to all code

License

[osi certified] Lua is free software distributed under the terms of the MIT license reproduced below; it may be used for any purpose, including commercial purposes, at absolutely no cost without having to ask us. The only requirement is that if you do use Lua, then you should give us credit by including the appropriate copyright notice somewhere in your product or its documentation. For details, see this.

Copyright © 1994–2015 Lua.org, PUC-Rio.

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

wcc-0.0.2/src/wsh/lua/doc/logo.gif0000644000175000017500000001021013110675433015301 0ustar philphilGIF87a€€÷rvz}~ oooqqqvvvzzz€ƒ „‚…†…‡ˆŠŠŒ‹!!Ž%%""%%‘))’,,“55—11•55™11˜::š::œ??BBŸDDžBB EE¡JJ£HH¤LL£MM¥PP§TT¦QQ¨WW«YYªZZ¬\\«^^­``¯cc±gg±ii³jj³oo·ll´qq·vv»tt¹yy»{{½¿~~½‚‚‚………ˆˆˆŽŽŽ•••›››€€¿¡¡¡¥¥¥©©©­­­³³³···¹¹¹½½½ƒƒÁ‡‡Â‰‰Ã‹‹ÅŽŽÆÇ’’È••Ê™™Ë™™ÌŸŸÏ¡¡Ï¢¢Ñ¥¥Ò©©Ó©©Ô­­Ö¯¯×±±×±±ØµµÚ»»Ý¼¼ÝÃÃÃÇÇÇÊÊÊÌÌÌÀÀßÒÒÒÕÕÕØØØÝÝÝÁÁàÇÇãÇÇäÉÉäÊÊåÎÎæÐÐçÓÓéÕÕêØØëÚÚìÝÝîáááåååààïêêêîîîââðææóèèóééôîîöñññðð÷õõõóóù÷÷ûùùùûûýÿÿÿ,€€þ' H° Áƒ*\Ȱ¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI¡¤›“pÖ´‰Q¡:†Ä(RJI;HGSSFAP¤È‘A™!rC+j Dš´ #:S’ Y:‰A… ±mûSNF1™Rg.Ä=2 @˜°€ ;•5ÈA)s.:’‚Ä)•ˆv 0`ƒÏŸlnp¥¬#‚‚‚rdÔDD#xЙ¶èÎ 6¿€43œ#LTFy“P‘‡¹E+¯]Ûs€2ÝQkÊ( Œ¸ñ;©òËÃþ‡gÀGΗP¢œfÉh ‚(½ oNÿ¶råØ,NiHµÀG0^sËÙ&À *92…;!†lX_mw DGU…ì7É DXŸ„ä qIRw5E¢A‡á&9¢„é¤ÐMdMDH´M(Þ‡hcYC$É#ˆÈ!ˆ~8@I$~!„ $pP |æ@ ƒcø1ä“ù1a•bR®I”ã!`È`aÐã ÆY2€qÈkD–;P€ žvæâœÊ}6jèàÇ“Ø0ß}ÖF^ipZDÇ‘Eä‡ pöhÛ2+a„r&C ¡Áª}t.G¹EbÝCŠäí |Ú,¸sâ6ê9 ’Pç¶( y0¼DÖpV¯£éëêft%AfÃÀ.KH¢‚Â?,°‡În–‚b9"•Ã|/Gž±†âAH™‘ðÂ"çÜâ}ž A#޵ÂwÜú:p;x…ë5$„ öެs•E-ÀI"ƒÂ¢;[XwÇu8¤5Ñ!K­¶€žV¯}äÅÀ[A]$Ü©¨ƒep†þG… pYCœ@ôÚ„Óçkn†:mä™ VªŠXÑÁf€2 BYzD‡3ô ,.zsƒ9PBD\ñƒ lf4y",Bscdq…f(6ñJ˜°ì袋@\ø[$zäÐ@‡¸@Bæ©Úô’ ˦=5É¢EÊ8H D“kÖ8F{R= ~}Î `»g-в1€,RöBHúú„ÍŽe¾-M‚õsŽÄ ø‘(¡!{àQÔHµm ` AcRf¡ìé¡!‚ÈF ‘&D `ðDvŸòdÐ!аéB07…¼ ªˆˆ,^l…þØ£RP¥§Ih¡~ô @r)`$ hCö@€AÑG"yXœ møàBÜÀ4Œ¢i YÁ¹(DûÀÙàï †8¢& ‰¹¼ÆF+1«›Rººh ‘KIHÀ¢+ Œ@†EÂæùJ IÅé*Á #R²WûÈðÂDBhD ,ÉÉ6¶o| ¥mÀ#ˆDxBôЪVúÑ@’Œã$ì ÂY  B yC†$B*$} ëZ¿EŸ @¯ˆþûasPJ‚áoQ|ò Η?B×Yeå†JB¤ ‰8µþJH,ùÅižóuJì&àÌ9Áö™a!r(#D|ƒé­,9|D'¨yF)_€ÃÈs¶tðˆ$ @<šGl ¤¾2d8‡†rDJ £5ƒg¥0²ôx“ÐAÿ9€=e`X£Iñ5:?iQ\<`Ê,òxá§AŠPµ©ÓòôW†Ü âT#R•9ÛÄêC „Ĭ4šáz9µ®âGbØRù¢ˆ4ò¤†$C:w:$À¦DbÊ6C^ЊöUë f¨!AA„„ݦ‚¢±€f â$„Ô!p0aÑ(G+`þÈ"(ÐÏÂÙu– ”b@„/€a =(yXØ#è.!E°TCªàÌ]rëWä‰í$fËF°ÊÕh…½ÖF:v" UxH‚£5(µ9Ñ•-m¥)5ÀÒ5Tn{Ûõ ©†…2^o'€ÞЯÁ·ÑC–h >¸@ŒÇ³ƒŽì,ÿFµ!QHÂþB6IÍ( øEú9à“EóÜà;´ÄC\ð×ohæ«Ã2B5+$T}mˆ¥üHCÆÙ‡:V²–œGj€Ð”Mâ“™0¨$8Ñ!mhîApÚfÿBø½õÉ@ m¸:OâÎ<6êt}—Ýpá<1@"Ét$Hµ ¬"BíZû-š…²–³6élg¢q€,:@|PÝ aÎFƒ€ñ #äQ!…a'±ª‚ŠÆÍìõQ´i] ±Þú;$‘ˆ}–^óV_xpm…ûÛŸ½¦èÿªÍѳ·­qÍ8K`–m[@à(m`Ñq! B¬‚þ¿ ã/Â[mÇrg&^½âÒ&qt$ ½¡ 6g)ûlõ³žò Ù×];ñ•FðpÁHAб(€ƒª„µ”½ÍÉ]•r ±Æ‚bú`QAàFkÀq72ˆ-®KMâΧüh‰ x’w²ˆ=XŸvûëA@—@m‡þêˆÆºíX½ÝZO/ ?xÁ¼ă( æ+„DÞí,d9}·«EÌvž« XÔ½ë•äIe 0Ôç¯ë]4y£Ö}'W!)„îè] ´B|§æFq± D ÀͧŽ?sü„€!¾ŸÈŒþ€¬#F“ð3ž¾ø_çÓ£738® N>ãÌ@¹ï8’õl¾HÁ q„[ ‚ˆ‹·JƱ7(hEÑ6,sIúë7)¡F0晄Vp€Ÿõ„°ƒ`ƒö[%W2Æ5fc"8‚´ät.ÕAa£€ó!DÔ@Ûàiä_¤qeG#ÑUT4é…‹P„Fx„E vDæa~ ûR¿ ºtçñ<"(ò„W´Al-á‚–[±uf²$P%~°w9W@ÁxÀwH‘vÀ{9wh“Vð6à5Pþ… \ ñ"uf欖oDd2¨g«×>6-c0(°Y<¶ °1"1°òOö*p)Њ®øŠ®¨Pˆ€À’€j ‚Ò* 2Ô5ðŠ ’ „0% (@™ÃŸBaƒnSÀ{ ãDN/%J…ÒÞø ƒà ¬(3  À›b1´$ X§]‡RPñ‡Å9çZÑ*)~Æ÷NèØ-¢ô#…r]¢Ž¾N§Œ ŠhGpl Ñ^@FY½4}b/äÁM !ª¥ŠÄ0ìU|Me=édþE$Ó>pM ‘‰~ðrÕJ¶å-&&@.\ ÖØ87{¾¤3`%0‡ds+1Hhó“ÕÕ2Ÿõ2PéK€ü3 W0•ÄuEîÕ)*…U))+ °@5ö0ÓÔF¡tÈE™O‘KÐH¡P@}ä^ ™jµH0}““ùU`10 k•å’¹Ec VUK$A€—_z `ÇT„EΑUÉ•4A„ÁÖ“<Rà¨rf“PGÉ£‚ž¹BõÁz°a"gd6“€2(¹šayImø›Fà¶"q°ŒÂc¿ô“õ("þgA™yƒ€P0i@ÛeESÒ˜Ž’»‚Yç‚O9b4»"}Ù"x@'P€‚upj¡` ‚±Ÿ¸õ2¡¢2,*ðã&îq ¿Ù•¡f%àE‰³+’]‚B%f0‰²Y…ðJ3žÓf ?€1à,À/p?€;}XV5úQ€˜%H1Z4JmpOP›7¢dÑ=Oô Ày;!Ó‘peq!F¦û PP-eKfw¤¿é.lzp`š- jù¦Ñ`o@¥¦EPOv*‘Rz††UP u¨Á§…S@©Ä¨!IàO*…PáE©AO` p\ú‘ª P ê©1{:ƒ€LS€¦“PU@Q°êzRЙʪ#4PÀG`‡Š—N¬ÂÚ¬Îú¬Ð­Òê;wcc-0.0.2/src/wsh/lua/doc/luac.10000644000175000017500000000577713110675433014706 0ustar philphil.\" $Id: luac.man,v 1.29 2011/11/16 13:53:40 lhf Exp $ .TH LUAC 1 "$Date: 2011/11/16 13:53:40 $" .SH NAME luac \- Lua compiler .SH SYNOPSIS .B luac [ .I options ] [ .I filenames ] .SH DESCRIPTION .B luac is the Lua compiler. It translates programs written in the Lua programming language into binary files containing precompiled chunks that can be later loaded and executed. .LP The main advantages of precompiling chunks are: faster loading, protecting source code from accidental user changes, and off-line syntax checking. Precompiling does not imply faster execution because in Lua chunks are always compiled into bytecodes before being executed. .B luac simply allows those bytecodes to be saved in a file for later execution. Precompiled chunks are not necessarily smaller than the corresponding source. The main goal in precompiling is faster loading. .LP In the command line, you can mix text files containing Lua source and binary files containing precompiled chunks. .B luac produces a single output file containing the combined bytecodes for all files given. Executing the combined file is equivalent to executing the given files. By default, the output file is named .BR luac.out , but you can change this with the .B \-o option. .LP Precompiled chunks are .I not portable across different architectures. Moreover, the internal format of precompiled chunks is likely to change when a new version of Lua is released. Make sure you save the source files of all Lua programs that you precompile. .LP .SH OPTIONS .TP .B \-l produce a listing of the compiled bytecode for Lua's virtual machine. Listing bytecodes is useful to learn about Lua's virtual machine. If no files are given, then .B luac loads .B luac.out and lists its contents. Use .B \-l \-l for a full listing. .TP .BI \-o " file" output to .IR file , instead of the default .BR luac.out . (You can use .B "'\-'" for standard output, but not on platforms that open standard output in text mode.) The output file may be one of the given files because all files are loaded before the output file is written. Be careful not to overwrite precious files. .TP .B \-p load files but do not generate any output file. Used mainly for syntax checking and for testing precompiled chunks: corrupted files will probably generate errors when loaded. If no files are given, then .B luac loads .B luac.out and tests its contents. No messages are displayed if the file loads without errors. .TP .B \-s strip debug information before writing the output file. This saves some space in very large chunks, but if errors occur when running a stripped chunk, then the error messages may not contain the full information they usually do. In particular, line numbers and names of local variables are lost. .TP .B \-v show version information. .TP .B \-\- stop handling options. .TP .B \- stop handling options and process standard input. .SH "SEE ALSO" .BR lua (1) .br The documentation at lua.org. .SH DIAGNOSTICS Error messages should be self explanatory. .SH AUTHORS R. Ierusalimschy, L. H. de Figueiredo, W. Celes .\" EOF wcc-0.0.2/src/wsh/lua/doc/lua.10000644000175000017500000000413213110675433014523 0ustar philphil.TH LUA 1 "$Date: 2014/12/10 15:55:45 $" .SH NAME lua \- Lua interpreter .SH SYNOPSIS .B lua [ .I options ] [ .I script [ .I args ] ] .SH DESCRIPTION .B lua is the standalone Lua interpreter. It loads and executes Lua programs, either in textual source form or in precompiled binary form. (Precompiled binaries are output by .BR luac , the Lua compiler.) .B lua can be used as a batch interpreter and also interactively. .LP The given .I options are handled in order and then the Lua program in file .I script is loaded and executed. The given .I args are available to .I script as strings in a global table named .BR arg . If no options or arguments are given, then .B "\-v \-i" is assumed when the standard input is a terminal; otherwise, .B "\-" is assumed. .LP In interactive mode, .B lua prompts the user, reads lines from the standard input, and executes them as they are read. If the line contains an expression or list of expressions, then the line is evaluated and the results are printed. If a line does not contain a complete statement, then a secondary prompt is displayed and lines are read until a complete statement is formed or a syntax error is found. .LP At the very start, before even handling the command line, .B lua checks the contents of the environment variables .B LUA_INIT_5_3 or .BR LUA_INIT , in that order. If the contents is of the form .RI '@ filename ', then .I filename is executed. Otherwise, the string is assumed to be a Lua statement and is executed. .SH OPTIONS .TP .BI \-e " stat" execute statement .IR stat . .TP .B \-i enter interactive mode after executing .IR script . .TP .BI \-l " name" execute the equivalent of .IB name =require(' name ') before executing .IR script . .TP .B \-v show version information. .TP .B \-E ignore environment variables. .TP .B \-\- stop handling options. .TP .B \- stop handling options and execute the standard input as a file. .SH "SEE ALSO" .BR luac (1) .br The documentation at lua.org, especially section 7 of the reference manual. .SH DIAGNOSTICS Error messages should be self explanatory. .SH AUTHORS R. Ierusalimschy, L. H. de Figueiredo, W. Celes .\" EOF wcc-0.0.2/src/wsh/wsh.c0000644000175000017500000034225713110675433013314 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #include #include #include #include #include #include // For basename() // address sanitizer macro : disable a function by prepending ATTRIBUTE_NO_SANITIZE_ADDRESS to its definition #if defined(__clang__) || defined (__GNUC__) # define ATTRIBUTE_NO_SANITIZE_ADDRESS __attribute__((no_sanitize_address)) #else # define ATTRIBUTE_NO_SANITIZE_ADDRESS #endif #ifndef __amd64__ #define REG_RIP 16 #endif #ifdef __arm__ #define REG_EFL 0 #define REG_ERR 0 #endif #ifdef __LP64__ // Generic 64b #define Elf_Ehdr Elf64_Ehdr #define Elf_Shdr Elf64_Shdr #define Elf_Sym Elf64_Sym #define Elf_Addr Elf64_Addr #define Elf_Sword Elf64_Sxword #define Elf_Section Elf64_Half #define ELF_ST_BIND ELF64_ST_BIND #define ELF_ST_TYPE ELF64_ST_TYPE #define Elf_Rel Elf64_Rel #define Elf_Rela Elf64_Rela #define ELF_R_SYM ELF64_R_SYM #define ELF_R_TYPE ELF64_R_TYPE #define ELF_R_INFO ELF64_R_INFO #define Elf_Phdr Elf64_Phdr #define Elf_Xword Elf64_Xword #define Elf_Word Elf64_Word #define Elf_Off Elf64_Off #define ELFCLASS ELFCLASS64 #define ELFMACHINE EM_X86_64 #define CS_MODE CS_MODE_64 #define RELOC_MODE RELOC_X86_64 #define EXTRA_VDSO "linux-vdso.so.1" #else // Generic 32b #define Elf_Ehdr Elf32_Ehdr #define Elf_Shdr Elf32_Shdr #define Elf_Sym Elf32_Sym #define Elf_Addr Elf32_Addr #define Elf_Sword Elf64_Sword #define Elf_Section Elf32_Half #define ELF_ST_BIND ELF32_ST_BIND #define ELF_ST_TYPE ELF32_ST_TYPE #define Elf_Rel Elf32_Rel #define Elf_Rela Elf32_Rela #define ELF_R_SYM ELF32_R_SYM #define ELF_R_TYPE ELF32_R_TYPE #define ELF_R_INFO ELF32_R_INFO #define Elf_Phdr Elf32_Phdr #define Elf_Xword Elf32_Xword #define Elf_Word Elf32_Word #define Elf_Off Elf32_Off #define ELFCLASS ELFCLASS32 #define ELFMACHINE EM_386 #define CS_MODE CS_MODE_32 #define RELOC_MODE RELOC_X86_32 #define EXTRA_VDSO "linux-gate.so.1" #endif learn_t *protorecords = NULL; /** * Main wsh context */ extern wsh_t *wsh; /** * Bruteforce valid memory mapping ranges */ int bfmap(lua_State * L) { unsigned long int pcounter = 0; unsigned int page_size = 4096; unsigned long long int i = 0, j = 0, r = 0; printf(GREEN "\n Memory segments\n\n"); for (r = 0; r < sizeof(ranges) / sizeof(range_t); r++) { for (i = ranges[r].min; i < ranges[r].max; i += page_size) { if (pcounter++ == 10000) { pcounter = 0; printf(" %016llx\r", i); } if (msync((void *) i, page_size, MS_ASYNC)) { continue; } // Invalid page // We found a valid page, find length of mapping for (j = 0; j < 0x100000000; j += page_size) { if (msync((void *) i + j, page_size, 0)) { break; } } printf(NORMAL " %016llx-%016llx\n" GREEN, i, i + j); i += j; } } printf(NORMAL " \r\n"); return 0; } /** * Get permissions in human readable format */ int ptoh(int perms, char hperms[]) { snprintf(hperms, 5, "%s%s%s", (perms & 0x04) ? "r" : "-", (perms & 0x02) ? "w" : "-", (perms & 0x01) ? "x" : "-"); return 0; } /** * Print information on a given function */ void info_function(void *addr) { Dl_info dli; dladdr(addr, &dli); printf(" -- %s() = %p from %s:%p\n", dli.dli_sname, dli.dli_saddr, dli.dli_fname, dli.dli_fbase); } /** * Fatal error : print an error message and exit with error */ void fatal_error(lua_State * L, char *msg) { fprintf(stderr, "\nFATAL ERROR:\n %s: %s\n\n", msg, lua_tostring(L, -1)); _Exit(EXIT_FAILURE); } /** * Simple hexdump routine */ void hexdump(uint8_t * data, size_t size, size_t colorstart, size_t color_len) { size_t i = 0, j = 0; for (j = 0; j < size; j += 16) { // Highlight offset in greed if (wsh->opt_hollywood) { printf(GREEN); } printf("%p ", data + j); if (wsh->opt_hollywood) { printf(NORMAL); } for (i = j; i < j + 16; i++) { // Highlight match in red if ((wsh->opt_hollywood) && (color_len) && (colorstart == i)) { printf(RED); } if ((wsh->opt_hollywood) && (color_len) && (colorstart + color_len == i)) { printf(NORMAL); } if (i < size) { printf("%02x ", data[i] & 255); } else { printf(" "); } } printf(" "); for (i = j; i < j + 16; i++) { // Highlight match in red if ((wsh->opt_hollywood) && (color_len) && (colorstart == i)) { printf(RED); } if ((wsh->opt_hollywood) && (color_len) && (colorstart + color_len == i)) { printf(NORMAL); } if (i < size) putchar(32 <= (data[i] & 127) && (data[i] & 127) < 127 ? data[i] & 127 : '.'); else putchar(' '); } putchar('\n'); } } /** * Resolve the address of a symbol within a given library */ static unsigned long int resolve_addr(char *symbol, char *libname) { unsigned long int ret = 0; struct link_map *handle = 0; Dl_info dli; if ((!symbol) || (!*symbol)) { return -1; } handle = dlopen(libname, BIND_FLAGS); if (!handle) { fprintf(stderr, "ERROR: %s\n", dlerror()); _Exit(EXIT_FAILURE); } dlerror(); /* Clear any existing error */ ret = (unsigned long int) dlsym(handle, symbol); #ifdef PEDANTIC_WARNINGS /* Check dlerror() since ret == NULL is ok. */ char *err = 0; err = dlerror(); if (err) { fprintf(stderr, "ERROR: %s\n", err); //_Exit(EXIT_FAILURE); } #endif dladdr((void *) ret, &dli); // Is it the correct lib ? if ((dli.dli_fname) && (libname) && (strlen(libname)) && (strncmp(libname, dli.dli_fname, strlen(libname)))) { ret = -1; } dlclose(handle); return ret; } /** * Return symbol binding type in human readable format */ char *symbol_tobind(int n) { switch (n) { case 0: return "Local"; case 1: return "Global"; case 2: return "Weak"; case 10: return "Unique"; case 11: return "Secondary"; default: break; } return "Default"; } /** * Return symbol type in human readable format */ char *symbol_totype(int n) { switch (n) { case 0: return "Notype"; case 1: return "Object"; case 2: return "Function"; case 3: return "SECTION"; case 4: return "File"; case 5: return "Common"; case 6: return "TLS"; default: break; } return "Default"; } unsigned int ltrace(void) { return 0; } /** * Scan a symbol, save it to linked list */ int scan_symbol(char *symbol, char *libname) { struct link_map *handle; Dl_info dli; Elf_Sym *s = 0; char *htype = 0, *hbind = 0; unsigned long int ret = 0; unsigned int stype = 0, sbind = 0; int retv = 0; handle = dlopen(libname, BIND_FLAGS); if (!handle) { fprintf(stderr, "ERROR: %s\n", dlerror()); _Exit(EXIT_FAILURE); } dlerror(); /* Clear any existing error */ ret = (unsigned long int) dlsym(handle, symbol); if ((dladdr1((void*)ret, &dli, (void **) &s, RTLD_DL_SYMENT))&&(s)) { stype = ELF_ST_TYPE(s->st_info); htype = symbol_totype(stype); sbind = ELF_ST_BIND(s->st_info); hbind = symbol_tobind(sbind); retv = add_symbol(symbol, libname, htype, hbind, s->st_value, s->st_size, ret); if(retv){return retv;} } dlclose(handle); return 0; } /** * Shell autocompletion routine */ void completion(const char *buf, linenoiseCompletions * lc) { /** * We want to add the next word uppon 'tab' completion, * exposing all the internally available keywords dynamically */ char *opt, *word = 0; unsigned int n = 0, i = 0; unsigned int p = 0, w = 0; n = strlen(buf); switch (n) { case 0: // No letter given, add default commands to completion options for (i = 0; i < sizeof(default_options) / sizeof(char *); i++) { linenoiseAddCompletion(lc, default_options[i]); } // Add reflected symbols symbols_t *s, *stmp; DL_FOREACH_SAFE(wsh->symbols, s, stmp) { linenoiseAddCompletion(lc, s->symbol); } return; break; default: // Input buffer is non empty: // the n first characters need to stay, // the last word needs to be completed with possible options opt = strdup(buf); // find position of last word for (p = strlen(opt); p > 0; p--) { if ((opt[p] == 0x20)||(opt[p] == 0x28)) { w = p + 1; break; } } // last word now starts at opt[w] word = opt + w; if (strlen(word) == n) { // There is no space in input tokens : it is a single command, add all those that match // Add core functions for (i = 0; i < sizeof(default_options) / sizeof(char *); i++) { if (!strncmp(buf, default_options[i], strlen(buf))) { linenoiseAddCompletion(lc, default_options[i]); } } // Add all lua default functions for (i = 0; i < sizeof(lua_default_functions) / sizeof(char *); i++) { if (!strncmp(buf, lua_default_functions[i], strlen(buf))) { linenoiseAddCompletion(lc, lua_default_functions[i]); } } // Add reflected symbols symbols_t *s, *stmp; DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if (!strncmp(buf, s->symbol, strlen(buf))) { linenoiseAddCompletion(lc, s->symbol); } } } else { // There is more than one word in this command //TODO } // linenoiseAddCompletion(lc, buf); break; } } /** * Disable ASLR */ int disable_aslr(void) { int fd = 0; char c = 0x30; fd = open(PROC_ASLR_PATH, O_RDWR); if (fd < 0) { fprintf(stderr, "!! ERROR : open(%s, O_RDWR) %s\n", PROC_ASLR_PATH, strerror(errno)); return -1; } write(fd, &c, 1); close(fd); return 0; } /** * Enable ASLR */ int enable_aslr(void) { int fd = 0; // char c = 0x31; char c = 0x32; fd = open(PROC_ASLR_PATH, O_RDWR); if (fd < 0) { fprintf(stderr, "!! ERROR : open(%s,O_RDWR) %s\n", PROC_ASLR_PATH, strerror(errno)); return -1; } write(fd, &c, 1); close(fd); return 0; } /** * Display detailed help */ int detailed_help(char *name) { unsigned int i = 0; /** * Search command */ for(i=0 ; i < sizeof(cmdhelp)/sizeof(help_t) ; i++){ if(!strncmp(cmdhelp[i].name, name, strlen(cmdhelp[i].name))){ printf("\n\tWSH HELP FOR COMMAND %s\n\n\n", name); printf("NAME\n\n\t%s\n\nSYNOPSIS\n\n\t%s %s\n\nDESCRIPTION\n\n\t%s\n\nRETURN VALUES\n\n\t%s\n\n\n", cmdhelp[i].name, cmdhelp[i].name, cmdhelp[i].proto, cmdhelp[i].descr, cmdhelp[i].retval); return 0; } } /** * Search function */ for(i=0 ; i < sizeof(fcnhelp)/sizeof(help_t) ; i++){ if(!strncmp(fcnhelp[i].name, name, strlen(fcnhelp[i].name))){ printf("\n\tWSH HELP FOR FUNCTION %s\n\n\n", name); printf("NAME\n\n\t%s\n\nSYNOPSIS\n\n\t%s%s(%s)\n\nDESCRIPTION\n\n\t%s\n\nRETURN VALUES\n\n\t%s\n\n\n", fcnhelp[i].name, fcnhelp[i].protoprefix, fcnhelp[i].name, fcnhelp[i].proto, fcnhelp[i].descr, fcnhelp[i].retval); return 0; } } printf("ERROR:\tNo help available for function %s()\n", name); return 0; } /** * Display help */ int help(lua_State * L) { const char *arg = 0; if (lua_isstring(L, 1)) { arg = luaL_checkstring(L, 1); detailed_help((char *) arg); } else { printf(" [Shell commands]\n\n\thelp, quit, exit, shell, exec, clear\n\n"); printf(" [Functions]\n\n"); printf(" + basic:\n\thelp(), man()\n\n"); printf(" + memory display:\n\t hexdump(), hex_dump(), hex()\n\n"); printf(" + memory maps:\n\tshdrs(), phdrs(), map(), procmap(), bfmap()\n\n"); printf(" + symbols:\n\tsymbols(), functions(), objects(), info(), search(), headers()\n\n"); printf(" + memory search:\n\tgrep(), grepptr()\n\n"); printf(" + load libaries:\n\tloadbin(), libs(), entrypoints(), rescan()\n\n"); printf(" + code execution:\n\tlibcall()\n\n"); printf(" + buffer manipulation:\n\txalloc(), ralloc(), xfree(), balloc(), bset(), bget(), rdstr(), rdnum()\n\n"); printf(" + control flow:\n\t breakpoint(), bp()\n\n"); printf(" + system settings:\n\tenableaslr(), disableaslr()\n\n"); printf(" + settings:\n\t verbose(), hollywood()\n\n"); printf(" + advanced:\n\tltrace()\n\nTry help(\"cmdname\") for detailed usage on command cmdname.\n\n"); } return 0; } /** * Decode Segment flags */ char *decode_flags(unsigned int flags) { char message[20]; unsigned int pf_x = (flags & 0x1); unsigned int pf_w = (flags & 0x2); unsigned int pf_r = (flags & 0x4); memset(message, 0x00, 20); if (pf_r){ strcat(message, "r"); }else{ strcat(message, "-"); } if (pf_w){ strcat(message, "w"); }else{ strcat(message, "-"); } if (pf_x){ strcat(message, "x"); }else{ strcat(message, "-"); } return strdup(message); } /** * Decode Segment type */ char *decode_type(unsigned int type) { char *ret = 0; switch (type) { case 0: return "PT_NULL"; break; case 1: return "PT_LOAD"; break; case 2: return "PT_DYNAMIC"; break; case 3: return "PT_INTERP"; break; case 4: return "PT_NOTE"; break; case 5: return "PT_SHLIB"; break; case 6: return "PT_PHDR"; break; case 7: return "PT_TLS"; break; case 8: return "PT_NUM"; break; case 0x6474e550: return "PT_GNU_EH_FRAME"; break; case 0x6474e551: return "PT_GNU_STACK"; break; case 0x6474e552: return "PT_GNU_RELRO"; break; default: ret = calloc(1, 200); snprintf(ret, 199, "Unknown: 0x%x\n", type); return ret; // leak break; } } /** * Callback function to parse Program headers (ELF Segments) */ int phdr_callback(struct dl_phdr_info *info, size_t size, void *data) { char *pflags = 0, *ptype = 0; const char *fname = 0; Elf_Phdr *p = 0; int j = 0; for (j = 0; j < info->dlpi_phnum; j++) { p = (Elf_Phdr *) &info->dlpi_phdr[j]; pflags = p ? decode_flags(p->p_flags) : 0; ptype = decode_type(p->p_type); fname = info->dlpi_name; if((!fname)||(strlen(fname) < 2)){ #ifdef DEBUG if(info->dlpi_addr + p->p_vaddr >= 0x7fd000000000){ fname = "[vdso]"; }else{ fname = realpath(__progname_full,0); // leak } #else return 0; #endif } // Save segment segment_add(info->dlpi_addr + p->p_vaddr, p->p_memsz, pflags, fname, ptype, p->p_flags); } return 0; } /** * Add a symbol to linked list */ int add_symbol(char *symbol, char *libname, char *htype, char *hbind, unsigned long value, unsigned int size, unsigned long int addr){ symbols_t *s = 0; symbols_t *si = 0, *stmp = 0, *res = 0; s = calloc(1, sizeof(symbols_t)); if(!s){ fprintf(stderr, " !! Error: calloc() = %s\n", strerror(errno)); return -1; } s->addr = addr; s->symbol = strdup(symbol); s->size = size; s->value = value; s->libname = strdup(libname); s->htype = strdup(htype); s->hbind = strdup(hbind); // search this element in linked list DL_FOREACH_SAFE(wsh->symbols, si, stmp) { // same symbol name if((!strncmp(si->symbol,s->symbol,strlen(si->symbol)))&&(strlen(si->symbol) == strlen(s->symbol))){ res = si; } } if(res){ return 1; } // already in linked list DL_APPEND(wsh->symbols, s); return 0; } /** * Add a section to linked list */ void section_add(unsigned long int addr, unsigned long int size, char *libname, char *name, char *perms, int flags){ sections_t *s = 0; s = calloc(1, sizeof(sections_t)); if(!s){ fprintf(stderr, " !! Error: calloc() = %s\n", strerror(errno)); return; } s->addr = addr; s->size = size; s->flags = flags; s->libname = strdup(libname); s->name = strdup(name); s->perms = strdup(perms); DL_APPEND(wsh->shdrs, s); } /** * Add a segment to linked list */ void segment_add(unsigned long int addr, unsigned long int size, char *perms, char *fname, char *ptype, int flags){ segments_t *s = 0; s = calloc(1, sizeof(segments_t)); if(!s){ fprintf(stderr, " !! Error: calloc() = %s\n", strerror(errno)); return; } s->addr = addr; s->size = size; s->flags = flags; s->libname = strdup(fname); s->perms = strdup(perms); s->type = strdup(ptype); DL_APPEND(wsh->phdrs, s); } /** * Add an entry point to linked list */ void entry_point_add(unsigned long long int addr, char *fname){ eps_t *s = 0; s = calloc(1, sizeof(eps_t)); s->name = strdup(fname); s->addr = addr; DL_APPEND(wsh->eps, s); } /** * Parse a section from an ELF */ void scan_section(Elf_Shdr * shdr, char *strTab, int shnum, char *fname, unsigned long int baseaddr) { int i = 0; char hperms[5]; for (i = 0; i < shnum; i++) { memset(hperms, 0x00, 5); snprintf(hperms, 5, "%s%s%s", (shdr[i].sh_flags & 0x02) ? "r" : "-", (shdr[i].sh_flags & 0x01) ? "w" : "-", (shdr[i].sh_flags & 0x04) ? "x" : "-"); if(shdr[i].sh_addr){ section_add(shdr[i].sh_addr + baseaddr, shdr[i].sh_size, fname, &strTab[shdr[i].sh_name], hperms, shdr[i].sh_flags); } } } /** * Parse all sections from an ELF */ int scan_sections(char *fname, unsigned long int baseaddr) { void *data = 0; Elf_Ehdr *elf = 0; Elf_Shdr *shdr = 0; int fd = 0; char *strtab = 0; fd = open(fname, O_RDONLY); data = mmap(NULL, lseek(fd, 0, SEEK_END), PROT_READ, MAP_SHARED, fd, 0); elf = (Elf_Ehdr *) data; if(elf == (void*)-1){ return -1; } entry_point_add(elf->e_entry + baseaddr, fname); shdr = (Elf_Shdr *) (data + elf->e_shoff); strtab = (char *) (data + shdr[elf->e_shstrndx].sh_offset); scan_section(shdr, strtab, elf->e_shnum, fname, baseaddr); close(fd); return 0; } /** * Callback function to parse Section headers (ELF Sections) */ int shdr_callback(struct dl_phdr_info *info, size_t size, void *data) { if(strlen(info->dlpi_name) < 2){ return 0; } return scan_sections(info->dlpi_name, info->dlpi_addr); } /** * Display Program headers (ELF Segments) */ int phdrs(lua_State * L) { print_phdrs(); return 0; } /** * Find section from address */ sections_t *section_from_addr(unsigned long int addr){ sections_t *s = 0, *stmp = 0, *res = 0; DL_FOREACH_SAFE(wsh->shdrs, s, stmp) { if((s->addr <= addr)&&(s->addr + s->size >= addr)){ res = s; } } return res; } /** * Find segment from address */ segments_t *segment_from_addr(unsigned long int addr){ segments_t *s = 0, *stmp = 0, *res = 0; DL_FOREACH_SAFE(wsh->phdrs, s, stmp) { if((s->addr <= addr)&&(s->addr + s->size >= addr)){ res = s; } } return res; } /** * Return a symbol from an address */ symbols_t *symbol_from_addr(unsigned long int addr){ symbols_t *s = 0, *stmp = 0, *res = 0; DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if((s->addr <= addr)&&(s->addr + s->size >= addr)){ res = s; } } return res; } /** * Return a symbol from its name */ symbols_t *symbol_from_name(char *fname){ symbols_t *s = 0, *stmp = 0; DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if(!strncmp(fname,s->symbol,strlen(fname))){ return s; } } return NULL; } /** * Generate headers */ int headers(lua_State * L) { symbols_t *s = 0, *stmp = 0; unsigned int scount = 0; char *libname = 0; read_arg1(libname); printf("/**\n*\n* Automatically generated by the Whitchcraft Compiler Collection %s\n*\n* %s %s\n*\n*/\n\n\n", WVERSION, WTIME, WDATE); /** * generate headers for imported objects */ printf("/**\n* Imported objects\n**/\n"); DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if((!libname)||(strstr(s->libname, libname))){ if(!strncmp(s->htype,"Object",6)){ scount++; printf("extern void *%s;\n", s->symbol); } } } /** * generate forward prototypes for imported functions */ printf("\n\n/**\n* Imported functions\n**/\n"); DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if((!libname)||(strstr(s->libname, libname))){ if(strncmp(s->htype,"Object",6)){ if(strncmp(s->symbol, "main", 5)){ printf("void *%s();\n", s->symbol); } } } } return 0; } /** * Empty linked list of symbols */ int empty_symbols(void){ symbols_t *s = 0, *stmp = 0; DL_FOREACH_SAFE(wsh->symbols, s, stmp) { DL_DELETE(wsh->symbols, s); free(s->symbol); free(s->hbind); free(s->libname); free(s->htype); free(s); } return 0; } /** * Empty linked list of segments */ int empty_phdrs(void){ segments_t *s = 0, *stmp = 0; DL_FOREACH_SAFE(wsh->phdrs, s, stmp) { DL_DELETE(wsh->phdrs, s); free(s->type); free(s->libname); free(s->perms); free(s); } return 0; } /** * Empty linked list of sections */ int empty_shdrs(void){ sections_t *s = 0, *stmp = 0; DL_FOREACH_SAFE(wsh->shdrs, s, stmp) { DL_DELETE(wsh->shdrs, s); free(s->name); free(s->libname); free(s->perms); free(s); } return 0; } /** * Empty linked list of entry points */ int empty_eps(void){ eps_t *s = 0, *stmp = 0; DL_FOREACH_SAFE(wsh->eps, s, stmp) { DL_DELETE(wsh->eps, s); free(s->name); free(s); } return 0; } /** * Display program headers (ELF Segments) */ int print_phdrs(void){ char *lastlib = ""; segments_t *s = 0, *stmp = 0; unsigned int scount = 0; DL_COUNT(wsh->phdrs, s, scount); printf(" -- Total: %u segments\n", scount); DL_FOREACH_SAFE(wsh->phdrs, s, stmp) { if(strncmp(lastlib,s->libname,strlen(lastlib))){ printf("\n"); } lastlib = s->libname; char *pcolor = DARKGRAY; // NORMAL switch (s->flags) { case 4: // r-- pcolor = GREEN; break; case 6: // rw- pcolor = BLUE; break; case 5: // r-x pcolor = RED; break; case 7: // rwx pcolor = MAGENTA; break; default: break; } if(s->size == 0){ pcolor = DARKGRAY; } if(wsh->opt_hollywood){ printf(NORMAL "%012lx-%012lx%s\t%s\t%u\t%s\t%s"NORMAL"\n", s->addr, s->addr + s->size, pcolor, s->perms, s->size, s->libname, s->type); }else{ printf("%012lx-%012lx\t%s\t%u\t%s\t%s\n", s->addr, s->addr + s->size, s->perms, s->size, s->libname, s->type); } } printf("\n"); printf(" -- Total: %u segments\n", scount); return 0; } /** * Display symbols */ int print_symbols(lua_State * L){ unsigned int scount = 0; symbols_t *s = 0, *stmp = 0; unsigned int i = 0; unsigned int pcnt = 0; char *symname = 0; char *libname = 0; unsigned int returnall = 0; read_arg1(symname); read_arg2(libname); read_arg3(returnall); DL_COUNT(wsh->symbols, s, scount); if(returnall < 2){ printf(" -- Total: %u symbols\n", scount); printf(" -- Symbols:\n\n"); // printf(" Type Size Path Address Name (Demangled)\n"); printf("-----------------------------------------------------------------------------------------------------------------\n"); } /* create result table */ lua_newtable(L); DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if((!symname)||(strstr(s->symbol, symname))){ if((!libname)||(strstr(s->libname, libname))){ if(returnall < 2){ printf("%s ", s->libname); for (i = strlen(s->libname); i < 40; i++) printf(" "); printf("%s ", s->symbol); for (i = strlen(s->symbol); i < 30; i++) printf(" "); printf("%s ", s->htype); for (i = strlen(s->htype); i < 10; i++) printf(" "); printf(" %s %lx \t\t%lu %lx\n", s->hbind, s->value, s->size, s->addr); } /* Add symbol to Lua table */ lua_pushstring(L, s->symbol); /* push key */ lua_getglobal(L, s->symbol); /* get pointer to global with this name : keep it as value on top of stack */ lua_settable(L, -3); pcnt++; if((!returnall)&&(pcnt == LINES_MAX)){ pcnt = 0; int c = getchar(); switch(c){case 0x61: pcnt = LINES_MAX + 1; break; case 0x71: return 0; break; default: break; }; } } } } if(returnall < 2){ printf("\n"); printf(" -- %u symbols matched\n", pcnt); } // Return scount as second return value lua_pushinteger(L, scount); return 2; // Return 1 table + number of match } /** * Display functions */ int print_functions(lua_State * L){ unsigned int scount = 0; symbols_t *s = 0, *stmp = 0; unsigned int i = 0; unsigned int pcnt = 0; char *libname = 0; char *symname = 0; unsigned int returnall = 0; read_arg1(symname); read_arg2(libname); read_arg3(returnall); DL_COUNT(wsh->symbols, s, scount); if(returnall < 2){ printf(" -- Total: %u symbols\n", scount); printf(" -- Functions:\n"); printf("-----------------------------------------------------------------------------------------------------------------\n"); } scount = 0; /* create result table */ lua_newtable(L); DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if(!strncmp(s->htype,"Function",8)){ if((!symname)||(strstr(s->symbol, symname))){ if((!libname)||(strstr(s->libname, libname))){ scount++; if(returnall < 2){ printf("%s ", strlen(s->libname) ? s->libname : wsh->selflib); for (i = strlen(s->libname); i < 40; i++) printf(" "); printf("%s ", s->symbol); for (i = strlen(s->symbol); i < 30; i++) printf(" "); printf("%s ", s->htype); for (i = strlen(s->htype); i < 10; i++) printf(" "); printf(" %s %lx \t\t%lu %lx\n", s->hbind, s->value, s->size, s->addr); } /* Add function to Lua table */ lua_pushstring(L, s->symbol); /* push key */ lua_getglobal(L, s->symbol); /* get pointer to global with this name : keep it as value on top of stack */ lua_settable(L, -3); /* handle breaks via getchar() */ pcnt++; if((!returnall)&&(pcnt == LINES_MAX)){ pcnt = 0; int c = getchar(); switch(c){case 0x61: pcnt = LINES_MAX + 1; break; case 0x71: return 0; break; default: break; }; } } } } } if(returnall < 2){ printf("\n"); printf(" -- %u functions matched\n", scount); } // Return scount as second return value lua_pushinteger(L, scount); return 2; // Return 1 table + number of match } /** * Display objects (typically globals) */ int print_objects(lua_State * L){ unsigned int scount = 0; symbols_t *s = 0, *stmp = 0; unsigned int i = 0; unsigned int pcnt = 0; char *libname = 0; read_arg1(libname); DL_COUNT(wsh->symbols, s, scount); printf(" -- Total: %u symbols\n", scount); scount = 0; printf(" -- Objects:\n\n"); // printf(" Type Size Path Address Name (Demangled)\n"); printf("-----------------------------------------------------------------------------------------------------------------\n"); DL_FOREACH_SAFE(wsh->symbols, s, stmp) { if((!libname)||(strstr(s->libname, libname))){ if(!strncmp(s->htype,"Object",6)){ char *sname = 0; sname = strlen(s->libname) ? s->libname : wsh->selflib; scount++; printf("%s ", sname); for (i = strlen(sname); i < 40; i++) printf(" "); printf("%s ", s->symbol); for (i = strlen(s->symbol); i < 30; i++) printf(" "); printf("%s ", s->htype); for (i = strlen(s->htype); i < 10; i++) printf(" "); printf(" %s %lx \t\t%lu %lx\n", s->hbind, s->value, s->size, s->addr); pcnt++; if(pcnt == LINES_MAX){ pcnt = 0; int c = getchar(); switch(c){case 0x61: pcnt = LINES_MAX + 1; break; case 0x71: return 0; break; default: break; }; } } } } printf("\n"); printf(" -- %u objects matched\n", scount); return 0; } /** * Display mapped librairies, return a list of library names */ int print_libs(lua_State * L){ char *lastlib = "none"; sections_t *s = 0, *stmp = 0; unsigned int scount = 0; /* create result table */ lua_newtable(L); DL_FOREACH_SAFE(wsh->shdrs, s, stmp) { if(strncmp(lastlib,s->libname,strlen(lastlib))){ scount++; printf("%s\n",s->libname); /* Add function to Lua table */ lua_pushnumber(L, scount); /* push key */ lua_pushstring(L, s->libname); /* push value */ lua_settable(L, -3); } lastlib = s->libname; } /** * Define vdso */ printf("%s\n", EXTRA_VDSO); scount++; // Add function to Lua table // lua_pushnumber(L, scount); lua_pushstring(L, EXTRA_VDSO); lua_settable(L, -3); /* add self and vdso as shared library */ /* if(wsh->opt_appear){ // self scount++; printf("%s\n",wsh->selflib); // Add function to Lua table // lua_pushnumber(L, scount); lua_pushstring(L, wsh->selflib); lua_settable(L, -3); } */ printf("\n"); printf(" -- Total: %u libraries\n", scount); // Return scount as second return value lua_pushinteger(L, scount); return 2; // Return 1 table + number of match } /** * Display ELF sections */ int print_shdrs(void){ char *lastlib = ""; sections_t *s = 0, *stmp = 0; unsigned int scount = 0; char *segmenttype = ""; char *segmentperms = ""; segments_t *seg = 0; DL_COUNT(wsh->shdrs, s, scount); printf(" -- Total: %u sections\n", scount); DL_FOREACH_SAFE(wsh->shdrs, s, stmp) { if(strncmp(lastlib,s->libname,strlen(lastlib))){ printf("\n"); } lastlib = s->libname; char *pcolor = DARKGRAY; // NORMAL switch(s->flags&0x0f){ case 2: // r-- pcolor = GREEN; break; case 3: // rw- pcolor = BLUE; break; case 6: // r-x pcolor = RED; break; case 7: // rwx case 8: // rwx case 9: // rwx pcolor = MAGENTA; break; default: break; } segmenttype = ""; segmentperms = ""; seg = 0; seg = segment_from_addr(s->addr); if(seg){ segmenttype = seg->type; segmentperms = seg->perms; } if(wsh->opt_hollywood){ printf(NORMAL "%012lx-%012lx%s\t%s\t%lu\t%s\t%25s\t%s\t%s" NORMAL "\n", s->addr, s->addr + s->size, pcolor, s->perms, s->size, s->libname, s->name, segmenttype, segmentperms); }else{ printf("%012lx-%012lx\t%s\t%lu\t%s\t%25s\t%s\t%s\n", s->addr, s->addr + s->size, s->perms, s->size, s->libname, s->name, segmenttype, segmentperms); } } printf("\n"); printf(" -- Total: %u sections\n", scount); return 0; } /** * Display Entry points */ int print_eps(void){ eps_t *s = 0, *stmp = 0; unsigned int scount = 0; DL_COUNT(wsh->eps, s, scount); printf(" -- Total: %u entry points\n\n", scount); DL_FOREACH_SAFE(wsh->eps, s, stmp) { printf("%012llx\t%s\n", s->addr, s->name); } return 0; } /** * Sort function helper for sections */ int shdr_cmp(sections_t *a, sections_t *b){ return (a->addr - b->addr); } /** * Sort function helper for segments */ int phdr_cmp(segments_t *a, segments_t *b){ return (a->addr - b->addr); } /** * Reload linked lists from ELFs binaries */ int reload_elfs(void){ empty_eps(); empty_phdrs(); dl_iterate_phdr(phdr_callback, NULL); DL_SORT(wsh->shdrs, shdr_cmp); empty_shdrs(); dl_iterate_phdr(shdr_callback, NULL); DL_SORT(wsh->phdrs, phdr_cmp); return 0; } /** * Display section headers (ELF Sections) */ static int shdrs(lua_State * L) { print_shdrs(); return 0; } /** * Display ELF Entry points */ int entrypoints(lua_State * L) { print_eps(); return 0; } /** * Open a manual page */ int man(lua_State * L) { void *arg = 0; char cmd[255]; if (lua_isstring(L, 1)) { arg = luaL_checkstring(L, 1); memset(cmd, 0x00, 255); snprintf(cmd, 254, "man %s", arg); // Obvious injection. We don't care system(cmd); } return 0; } /** * Display information on an object/memory address */ int info(lua_State * L) { void *symbol = 0; unsigned long long int ret = 0; Dl_info dli; char *error = 0; Elf_Sym *s = 0; unsigned int stype = 0, sbind = 0; char *htype = 0, *hbind = 0; unsigned long long int n = lua_tonumber(L, 1); if(msync(n & ~0xfff, 4096, 0) == 0){ // if read as a number, destination address is mapped /** * Address is mapped */ printf(" * address 0x%llx is mapped\n", n); /** * Search corresponding symbols */ symbols_t *sym = symbol_from_addr(n); if((sym)&&(sym->addr == n)){ printf(" * %s %s %s from %s\tsize:%lu\n", sym->hbind, sym->htype, sym->symbol, sym->libname, sym->size); }else if(sym){ printf(" * %llu bytes within %s %s %s from %s\tsize:%lu\n", n - sym->addr, sym->hbind, sym->htype, sym->symbol, sym->libname, sym->size); } /** * Search corresponding section */ sections_t *sec = section_from_addr(n); if(sec){ printf(" * %llu bytes within %s:%s %s\n", n - sec->addr, sec->libname, sec->name, sec->perms); } /** * Search corresponding segment */ sections_t *seg = segment_from_addr(n); if(seg){ printf(" * %llu bytes within %s:%s %s\n", n - seg->addr, seg->libname, seg->name, seg->perms); } }else if (lua_isstring(L, 1)) { symbol = luaL_checkstring(L, 1); /** * Search corresponding symbols */ symbols_t *sym = symbol_from_name(symbol); if(!sym){ printf(" * Symbol %s does not exist\n", symbol); return 0; } /** * Resolve symbol... */ ret = (unsigned long int) dlsym(wsh->mainhandle, symbol); if ((error = dlerror()) != NULL) { fprintf(stderr, "ERROR: %s\n", error); return 0; } if (dladdr1(ret, &dli, (void **) &s, RTLD_DL_SYMENT)&&(s)) { stype = ELF_ST_TYPE(s->st_info); htype = symbol_totype(stype); sbind = ELF_ST_BIND(s->st_info); hbind = symbol_tobind(sbind); char *secname = ""; sections_t *sec = section_from_addr(dli.dli_saddr); if(sec){ secname = sec->name; } printf(" * %s %s %s at %p %s:%s size:%lu\n", htype, hbind, dli.dli_sname, dli.dli_saddr, dli.dli_fname, secname, s->st_size /*, s->st_value */ ); } else { printf(" * symbol %s does not exist.\n", symbol); } } else { printf(" !! ERROR: info requires a string argument\n"); } return 0; } /** * Buffer management subroutines */ // allocate a char ** int alloccharbuf(lua_State * L) { int n = 0; char *ptr = 0; n = lua_tonumber(L, 1); ptr = calloc(n * sizeof(char *), 1); lua_pushnumber(L, (unsigned long int) ptr); return 1; } // set a pointer within the char ** int setcharbuf(lua_State * L) { char **buff = 0; unsigned int pos = 0; char *val = 0; buff = (unsigned long int) lua_tonumber(L, 1); pos = lua_tonumber(L, 2); val = lua_tostring(L, 3); buff[pos] = val; return 0; } /** * Read a string (to a LUA string) */ int rdstr(lua_State * L) { char *buff = 0; unsigned int n = 0; char *val = 0; buff = (unsigned long int) lua_tonumber(L, 1); n = lua_tonumber(L, 2); val = buff; if(n){ lua_pushlstring(L, val, n); // Push string with length specifier }else{ lua_pushstring(L, val); // Ascii : push string (no length) } return 1; } /** * Read a number (to a LUA number) */ int rdnum(lua_State * L) { int *buff = 0; int val = 0; buff = (int) lua_tonumber(L, 1); val = buff[0]; lua_pushnumber(L, (int) val); return 1; } // read a pointer within the char ** int getcharbuf(lua_State * L) { char **buff = 0; unsigned int pos = 0; char *val = 0; buff = (unsigned long int) lua_tonumber(L, 1); pos = lua_tonumber(L, 2); val = buff[pos]; lua_pushstring(L, val); // Ascii : push string return 1; } /* int luaopen_array(lua_State * L) { lua_getglobal(L, "array"); if (lua_isnil(L, -1)) { lua_pop(L, 1); lua_newtable(L); } luaL_setfuncs(L, arraylib, 0); lua_setglobal(L, "array"); return 1; } */ /** * Run minimal lua shell */ int run_shell(lua_State * L) { char *input, shell_prompt[4096]; if (wsh->is_stdinscript) { // Execute from stdin. don't display promt, read line by line for (;;) { if (fgets(shell_prompt, sizeof(shell_prompt), stdin) == 0 || strcmp(shell_prompt, "cont\n") == 0){ return 0; } if (luaL_loadbuffer(wsh->L, shell_prompt, strlen(shell_prompt), "=(shell)") || lua_pcall(L, 0, 0, 0)) { fprintf(stderr, "ERROR: %s\n", lua_tostring(L, -1)); lua_pop(L, 1); // pop error message from the stack } lua_settop(L, 0); // remove eventual return values } } else { /** * Set handlers for tab completion */ linenoiseSetCompletionCallback(completion); /** * Prepare history full log name */ char *SHELL_HISTORY = calloc(1024, 1); snprintf(SHELL_HISTORY, 1023, "%s/%s", getenv("HOME"), SHELL_HISTORY_NAME); /** * Load shell history */ linenoiseHistoryLoad(SHELL_HISTORY); /** * Main loop */ snprintf(shell_prompt, sizeof(shell_prompt), "> "); while ((input = linenoise(shell_prompt)) != NULL) { /** * Command analysis/execution */ if (wsh->opt_hollywood == 2) { printf(GREEN); } // Check for EOF. if (!input) { break; } linenoiseHistoryAdd(input); // Add to the history. linenoiseHistorySave(SHELL_HISTORY); // Save the history on disk. if ((strlen(input) == 5) && (!strncmp(input, "shell", 5))) { unsigned int pid = fork(); int status; if (!pid) { execlp("/bin/sh", 0); } else { waitpid(pid, &status, 0); } free(input); continue; } if (!strncmp(input, "exec ", 5)) { system(input + 5); free(input); continue; } if ((strlen(input) == 4) && !strncmp(input, "quit", strlen(input))) { free(input); _Exit(EXIT_SUCCESS); } if ((strlen(input) == 4) && !strncmp(input, "exit", strlen(input))) { free(input); _Exit(EXIT_SUCCESS); } if ((strlen(input) == 4) && !strncmp(input, "help", strlen(input))) { help(L); continue; } if ((strlen(input) == 5) && !strncmp(input, "clear", strlen(input))) { printf(CLEAR); continue; } if (!strncmp(input, "historylen", 10)) { // The "historylen" command will change the history len. int len = atoi(input + 10); linenoiseHistorySetMaxLen(len); continue; } if (luaL_loadbuffer(L, input, strlen(input), "=INVALID COMMAND ") || lua_pcall(L, 0, 0, 0)) { fprintf(stderr, "ERROR: %s\n", lua_tostring(L, -1)); lua_pop(L, 1); // pop error message from the stack } lua_settop(L, 0); // remove eventual return values free(input); } free(SHELL_HISTORY); } _Exit(EXIT_SUCCESS); // never reached return 0; } int learn_proto(unsigned long*arg, unsigned long int faultaddr, int reason){ char *vreason = 0; char *tag = 0; long int offset = 0; unsigned int i = 0; unsigned int argn = 0; symbols_t *s = 0; if(!reason) { return 0; } // No error if(!faultaddr) { return 0; } // No Address if(faultaddr < 0x1000) { return 0; } // Address in first page if(faultaddr > 0xf000000000000000) { return 0; } // Address out of userland switch(reason){ case 1: // read vreason = "read"; tag = "_input_ptr"; break; case 2: // write vreason = "write"; tag = "_output_ptr"; break; case 4: // Exec vreason = "exec"; tag = "_exec_ptr"; break; default: return 0; } for(i=1; i<=7; i++){ if((faultaddr & ~0xfff) == (arg[i] & ~0xfff)){ argn = i; } } if(!argn){ return 0; } // Can't match fault address with any argument for(i=1; i<=7; i++){ if((arg[i] == arg[argn])&&(argn != i)){ return 0; } // 2 arguments in same page, can't conclude } offset = faultaddr - arg[argn]; if(arg[argn] == 0xffff){ return 0; } if(arg[argn] == 0x7fff){ return 0; } if(arg[argn] == 0xffffffff){ return 0; } if(arg[argn] == 0x7fffffff){ return 0; } s = symbol_from_addr(arg[0]); if(!wsh->learnfile){ wsh->learnfile = fopen( wsh->learnlog ? wsh->learnlog : DEFAULT_LEARN_FILE ,"a+"); } fprintf(wsh->learnfile, "TAG %s %s argument%u %s %ld\n", s->libname, s->symbol, argn, tag, offset); fflush(wsh->learnfile); return 0; } int sort_learnt(learn_t *a, learn_t *b){ return memcmp(&a->key, &b->key, sizeof(learn_key_t)); } /** * Display learned prototypes */ int prototypes(lua_State * L) { char *pattern = 0; char *patternlib = 0; char *patterntag = 0; char line[1024]; learn_t *l = 0, *p = 0; read_arg1(pattern); read_arg2(patternlib); read_arg3(patterntag); if(!wsh->learnfile){ wsh->learnfile = fopen( wsh->learnlog ? wsh->learnlog : DEFAULT_LEARN_FILE ,"a+"); } fseek(wsh->learnfile, 0, SEEK_SET); /** * Read all the lines to learnt data structure */ while (fgets(line, sizeof(line), wsh->learnfile)) { l = (learn_t*) calloc(1,sizeof(learn_t)); sscanf(line, "%10s %200s %200s %20s %200s %20s", l->key.ttype, l->key.tlib, l->key.tfunction, l->key.targ, l->key.tvalue, l->toffset); // make sure tag type is correct, else discard if(strncmp(l->key.ttype, "TAG", 3)){ printf(" !! Unknown TAG type: %s\n", l->key.ttype); free(l); continue; } // add to linked list if not present, else free HASH_FIND(hh, protorecords, &l->key, sizeof(learn_key_t), p); if(p){ free(l); }else{ HASH_ADD(hh, protorecords, key, sizeof(learn_key_t), l); } } /** * Sort learnt data structures */ HASH_SRT(hh, protorecords, sort_learnt); printf("\n [*] Prototypes: (from %u tag informations)\n", HASH_COUNT(protorecords)); HASH_ITER(hh, protorecords, l, p) { if((!patternlib) || (strstr(l->key.tlib, patternlib))){ if((!pattern) || (!strncmp(pattern, l->key.tfunction, strlen(pattern)))){ if((!patterntag) || (strstr(l->key.tvalue, patterntag))){ printf("%s\t%s\t%s\t%s\t%s\n", l->key.tlib, l->key.tfunction, l->key.targ, l->key.tvalue, l->toffset); } } } } return 0; } /* void enable_trace(void){ if(prctl(PR_SET_PTRACER, PR_SET_PTRACER_ANY, 0, 0, 0)){ // Anyone can trace us printf(" !! ERROR: prctl() %s\n", strerror(errno)); return; } } int pause_on(int syscall_req, int syscall) { if(syscall == syscall_req) do { char buf[2]; fgets(buf, sizeof(buf), stdin); // waits until enter to continue } while(0); } #include "reversetrace/syscalls.h" #include "reversetrace/syscallents.h" const char *syscall_name(int scn) { struct syscall_entry *ent; static char buf[128]; if (scn <= MAX_SYSCALL_NUM) { ent = &syscalls[scn]; if (ent->name) return ent->name; } snprintf(buf, sizeof buf, "sys_%d", scn); return buf; } long get_register(pid_t child, int off) { return ptrace(PTRACE_PEEKUSER, child, 8*off, NULL); } long get_syscall_arg(pid_t child, int which) { switch (which) { #ifdef __amd64__ case 0: return get_register(child, rdi); case 1: return get_register(child, rsi); case 2: return get_register(child, rdx); case 3: return get_register(child, r10); case 4: return get_register(child, r8); case 5: return get_register(child, r9); #else case 0: return get_register(child, ebx); case 1: return get_register(child, ecx); case 2: return get_register(child, edx); case 3: return get_register(child, esi); case 4: return get_register(child, edi); case 5: return get_register(child, ebp); #endif default: return -1L; } } int do_tracer(pid_t child, int syscall_req) { int status; int retval; usleep(100); // Let the child give us permission to trace it via prctl() if (ptrace(PTRACE_ATTACH, child, (void *)0L, (void *)0L)) { fprintf(stderr, "Cannot attach to TID %d: %s.\n", child, strerror(errno)); return 1; } waitpid(child, &status, 0); // printf("STOPPED\n"); ptrace(PTRACE_SETOPTIONS, child, 0, PTRACE_O_TRACESYSGOOD); while(1) { if (wait_for_syscall(child) != 0){ break; } print_syscall(child, syscall_req); if (wait_for_syscall(child) != 0){ break; } retval = get_register(child, eax); if((retval >= 0)&&(retval <= 4096)){ fprintf(stderr, "%d\n", retval); } else if((retval <= -1)&&(retval >= -128)){ fprintf(stderr, "%d\n", retval); }else{ fprintf(stderr, "0x%x\n", retval); } } return 0; } int wait_for_syscall(pid_t child) { int status; while (1) { ptrace(PTRACE_SYSCALL, child, 0, 0); waitpid(child, &status, 0); if (WIFSTOPPED(status) && WSTOPSIG(status) & 0x80){ return 0; } if (WIFEXITED(status)){ return 1; } fprintf(stderr, "[stopped %d (%x)]\n", status, WSTOPSIG(status)); } } void print_syscall_args(pid_t child, int num) { struct syscall_entry *ent = NULL; int nargs = SYSCALL_MAXARGS; int i; char *strval; if (num <= MAX_SYSCALL_NUM && syscalls[num].name) { ent = &syscalls[num]; nargs = ent->nargs; } for (i = 0; i < nargs; i++) { long arg = get_syscall_arg(child, i); fprintf(stderr, "0x%lx", arg); if (i != nargs - 1) fprintf(stderr, ", "); } } void print_syscall(pid_t child, int syscall_req) { int num; num = get_register(child, orig_eax); fprintf(stderr, "%s(", syscall_name(num)); print_syscall_args(child, num); fprintf(stderr, ") = "); if( syscall_req <= MAX_SYSCALL_NUM) { pause_on( num, syscall_req); } } */ /** * Main wrapper around a library call. * This function returns 9 values: ret (returned by library call), errno, firstsignal, total number of signals, firstsicode, firsterrno, faultaddr, reason, context */ static int libcall(lua_State * L) { unsigned long int *arg[10] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; unsigned int i = 0; void *(*f) () = 0; void *ret = 0; int callerrno = 0; int argnum = 0; alarm(3); for (i = 0; i < 10; i++) { if (lua_isnil(L, i + 1)) { arg[i] = 0; } else if (lua_isnumber(L, i + 1)) { arg[i] = (unsigned long) lua_tonumber(L, i + 1); } else if (lua_isstring(L, i + 1)) { arg[i] = luaL_checkstring(L, i + 1); } else if (lua_istable(L, i + 1)) { } else if (lua_isfunction(L, i + 1)) { arg[i] = lua_tocfunction(L, i + 1); } else if (lua_iscfunction(L, i + 1)) { arg[i] = lua_touserdata(L, i + 1); } else if (lua_isuserdata(L, i + 1)) { arg[i] = lua_touserdata(L, i + 1); } else { arg[i] = 0; } } wsh->firstsignal = 0; wsh->firstsicode = 0; wsh->totsignals = 0; errno = 0; wsh->btcaller = 0; wsh->firsterrno = 0; wsh->faultaddr = 0; wsh->reason = 0; if (!wsh->errcontext) { wsh->errcontext = calloc(1, sizeof(ucontext_t)); } // if (!wsh->initcontext) { // wsh->initcontext = calloc(1, sizeof(ucontext_t)); // } memset(wsh->errcontext, 0x00, sizeof(ucontext_t)); // save_context(wsh->initcontext); // this is saved to initcontext /** * Handle (reverse-) system calls tracing */ /* pid_t parent = 0; pid_t child = 0; if((wsh->trace_strace)||(wsh->trace_rtrace)){ enable_trace(); parent = getpid(); child = fork(); enable_trace(); if (child == 0) { // child process if(wsh->trace_rtrace){ return do_tracer(parent, syscall); }else{ // return do_tracee(argc-push, argv+push); printf(" -- tracee pid:%d\n", getpid()); // kill(getpid(), SIGSTOP); goto do_tracee; } } else { // parent process if(wsh->trace_rtrace){ // return do_tracee(argc-push-1, argv+push+1); printf(" -- tracee2 pid:%d\n", getpid()); // kill(getpid(), SIGSTOP); goto do_tracee; }else{ return do_tracer(child, syscall); } } } */ do_tracee: /** * Make the library call */ f = arg[0]; wsh->interrupted = 0; if (!sigsetjmp(wsh->longjmp_ptr, 1)){ // This is executed only the first time // save stack context + signals // Set align flag if(wsh->trace_unaligned){ wsh->sigbus_count = 0; wsh->sigbus_hash = 0; set_align_flag(); } // Set trace flag if(wsh->trace_singlestep){ set_trace_flag(); wsh->singlestep_count = 0; wsh->singlestep_hash = 0; } // Set branch flag if(wsh->trace_singlebranch){ set_branch_flag(); wsh->singlebranch_count = 0; wsh->singlebranch_hash = 0; set_trace_flag(); } ret = f(arg[1], arg[2], arg[3], arg[4], arg[5], arg[6], arg[7], arg[8]); }else{ // printf(" + Restored shell execution\n"); ret = -1; } unsigned int n = 0, j = 0, notascii = 0; // Unset trace flag if(wsh->trace_singlestep){ unset_trace_flag(); printf("Total: %u instructions traced\n", wsh->singlestep_count); printf("Execution hash: ss:%016llx\n", wsh->singlestep_hash); } // Unset branch flag if(wsh->trace_singlebranch){ unset_trace_flag(); unset_branch_flag(); printf("Total: %u blocks traced\n", wsh->singlebranch_count); printf("Execution hash: b:%016llx\n", wsh->singlebranch_hash); } // Unset align flag if(wsh->trace_unaligned){ unset_align_flag(); printf("Total: %u misaligned access traced\n", wsh->sigbus_count); printf("Execution hash: u:%016llx\n", wsh->sigbus_hash); } callerrno = errno; /** * Analyse return value */ n = !msync((long int)ret & (long int)~0xfff, 4096, 0); notascii = 0; if (n) { // printf("mapped: %p (len:%u)\n", ret, n); // hexdump(ret, n); // is it a string ? char *ptr = ret; for (j = 0; j < strlen(ret); j++) { if (!isascii((ptr[j]))) { notascii = 1; break; } } if (!notascii) { lua_pushstring(L, ret); // Ascii : push string } else { lua_pushinteger(L, ret); // Push as a number } } else { lua_pushinteger(L, ret); // Push as a number } if (callerrno) { fprintf(stderr, "ERROR: %s (%u)\n", strerror(callerrno), callerrno); } /** * Learn prototypes */ if((wsh->reason)&&(wsh->faultaddr >= 0x40000000)&&(wsh->faultaddr <= 0x7f0000000000)){ learn_proto(arg, wsh->faultaddr, wsh->reason); } /** * * Create output execution context table * */ /* create result table */ lua_newtable(L); /** * Push errno to lua table */ lua_pushstring(L, "errno"); /* push key */ lua_pushinteger(L, callerrno); lua_settable(L, -3); /** * Push strerror(errno) to lua table */ lua_pushstring(L, "errnostr"); /* push key */ lua_pushstring(L, strerror(callerrno)); /* push key */ lua_settable(L, -3); /** * Push first signal */ // lua_pushstring(L, "fsig"); /* push key */ // lua_pushinteger(L, wsh->firstsignal); // lua_settable(L, -3); /** * Push first signal name */ lua_pushstring(L, "signal"); /* push key */ lua_pushstring(L, wsh->firstsignal ? signaltoname(wsh->firstsignal) : ""); lua_settable(L, -3); /** * Push total of signals emmited during this libcall */ // lua_pushstring(L, "nsignals"); /* push key */ // lua_pushinteger(L, wsh->totsignals); // lua_settable(L, -3); /** * Push first errno */ // lua_pushstring(L, "ferrno"); /* push key */ // lua_pushinteger(L, wsh->firsterrno); // lua_settable(L, -3); /** * Push first sicode */ // lua_pushstring(L, "fcode"); /* push key */ // lua_pushinteger(L, wsh->firstsicode); // lua_settable(L, -3); /** * Push first sicode name */ lua_pushstring(L, "sicode"); /* push key */ // lua_pushinteger(L, wsh->firstsicode); siginfo_t *s; s = calloc(1, sizeof(siginfo_t)); s->si_code = wsh->firstsicode; lua_pushstring(L, sicode_strerror(wsh->firstsignal, s)); /* push value */ free(s); lua_settable(L, -3); /** * Address of last caller in backtrace */ symbols_t *symbt = symbol_from_addr(wsh->btcaller); if(symbt){ lua_pushstring(L, "caller"); /* push key */ lua_pushstring(L, symbt->symbol); lua_settable(L, -3); } // if(wsh->btcaller){ lua_pushstring(L, "calleraddr"); // push key // lua_pushlightuserdata(L, wsh->btcaller); lua_pushinteger(L, wsh->btcaller); lua_settable(L, -3); // } /** * Push fault address */ lua_pushstring(L, "faultaddr"); /* push key */ // if(wsh->faultaddr){ // lua_pushlightuserdata(L, wsh->faultaddr); // }else{ // lua_pushinteger(L, 0); // } lua_pushinteger(L, wsh->faultaddr); lua_settable(L, -3); /** * Push reason */ // lua_pushstring(L, "reason"); /* push key */ // lua_pushinteger(L, wsh->reason); // lua_settable(L, -3); /** * Push mode */ lua_pushstring(L, "mode"); /* push key */ switch(wsh->reason){ case 1: lua_pushstring(L, "READ"); /* push value */ break; case 2: lua_pushstring(L, "WRITE"); /* push value */ break; case 4: lua_pushstring(L, "EXEC"); /* push value */ break; case 0: default: lua_pushinteger(L, wsh->reason); /* push value */ break; } lua_settable(L, -3); /** * Push errctx */ // lua_pushstring(L, "reg"); /* push key */ // lua_pushinteger(L, wsh->totsignals ? wsh->errcontext : 0); // lua_settable(L, -3); /** * Push pointer to ucontext */ // lua_pushstring(L, "errctx"); /* push key */ // lua_pushinteger(L, wsh->errcontext); // lua_settable(L, -3); /** * Push arguments as a new table */ lua_pushstring(L, "arg"); /* push key */ lua_createtable(L,6,0); argnum = 0; for(j=1;j<=6;j++){ char argname[10]; memset(argname, 0x00, 10); snprintf(argname, 9, "arg%u", j); if(arg[j]){ lua_pushstring(L, argname); /* push key */ lua_pushinteger(L, arg[j]); lua_settable(L, -3); argnum++; } } lua_settable(L, -3); /** * Push number of non NULL arguments */ lua_pushstring(L, "argnum"); /* push key */ lua_pushinteger(L, argnum); lua_settable(L, -3); /** * Push retval */ lua_pushstring(L, "retval"); /* push key */ if (n) { // is it a string ? char *ptr = ret; for (j = 0; j < strlen(ret); j++) { if (!isascii((ptr[j]))) { notascii = 1; break; } } if (!notascii) { lua_pushstring(L, ret); // Ascii : push string } else { lua_pushinteger(L, ret); // Push as a number } } else { lua_pushinteger(L, ret); // Push as a number } lua_settable(L, -3); /** * Push libcall/libname */ // lua_pushstring(L,"caller"); /* key */ // lua_pushinteger(L, arg[0]); // lua_settable(L, -3); symbols_t *symlib = symbol_from_addr(arg[0]); if(symlib){ lua_pushstring(L,"alibcall"); /* key */ lua_pushstring(L, symlib->symbol); lua_settable(L, -3); lua_pushstring(L,"alibname"); /* key */ lua_pushstring(L, symlib->libname); lua_settable(L, -3); } //* This function returns 9 values: ret (returned by library call), errno, firstsignal, total number of signals, firstsicode, firsterrno, faultaddr, reason, context /** * Invoke store running function on context */ lua_getglobal(L, "storerun"); lua_pushvalue(L,-2); if(lua_pcall(L, 1, 1, 0)){ if(wsh->opt_verbose){ printf("ERROR: calling function storerun() in libcall() %s\n", lua_tostring(L, -1)); } } lua_pop(L,1); alarm(0); return 2; } /** * Append a command to internal lua buffer */ int luabuff_append(char *cmd){ /** * Allocate wsh->luabuff if it hasn't been initialized */ if(!wsh->luabuff){ wsh->luabuff = calloc(1, 4096); wsh->luabuffsz = 4096; } /** * Extend wsh->luabuff by one page if necessary */ if(strlen(wsh->luabuff) + strlen(cmd) >= wsh->luabuffsz){ wsh->luabuff = realloc(wsh->luabuff, wsh->luabuffsz + 4096); wsh->luabuffsz += 4096; } /** * Append buffer */ strcat(wsh->luabuff, cmd); //printf("Appending %s\n", cmd); return 0; } void scan_syms(char *dynstr, Elf_Sym * sym, unsigned long int sz, char *libname) { unsigned int cnt = 0; char *htype = 0; unsigned long int address = 0; char *demangled = 0, *symname = 0; unsigned int func = 0; unsigned int j = 0; unsigned skip_bl = 0; char newname[1024]; /** * Walk symbol table */ while ((sym)&&(!msync((long unsigned int)sym &~0xfff,4096,0))) { func = 0; if (sym->st_name >= sz) { break; } cnt++; symname = dynstr + sym->st_name; /** * Extract Symbol type */ switch (ELF_ST_TYPE(sym->st_info)) { case STT_FUNC: htype = "Function"; func = 1; break; case STT_OBJECT: htype = "Object"; break; case STT_SECTION: htype = "Section"; break; case STT_FILE: htype = "File"; break; case STT_NOTYPE: case STT_NUM: case STT_LOPROC: case STT_HIPROC: default: htype = 0; break; } /** * Resolve address */ if (symname) { address = resolve_addr(symname, libname); } else { address = (unsigned long int) -1; } /** * Demangle symbol if possible */ demangled = cplus_demangle(symname, DMGL_ANSI/*DMGL_PARAMS*/); // Skip if symbol has no name or no type if (strlen(symname) && (htype) && (address != (unsigned long int) -1) && (address)) { /** * If function name is blackslisted, skip... */ skip_bl = 0; // Lua blacklist for(j=0; j < sizeof(lua_blacklist)/sizeof(char*);j++){ if((strlen(symname) == strlen(lua_blacklist[j]))&&(!strncmp(lua_blacklist[j] ,symname, strlen(lua_blacklist[j])))){ skip_bl = 1; } } // Lua default functions for(j=0; j < sizeof(lua_default_functions)/sizeof(char*);j++){ if((strlen(symname) == strlen(lua_default_functions[j]))&&(!strncmp(lua_default_functions[j] ,symname, strlen(lua_default_functions[j])))){ skip_bl = 1; } } if(skip_bl){ #ifdef DEBUG printf(" * blacklisted function name: %s\n", symname); #endif } else if (func) { /* * Make C function available from lua */ memset(newname, 0x00, 1024); snprintf(newname, 1023, "reflect_%s", symname); lua_pushcfunction(wsh->L, (void *) address); lua_setglobal(wsh->L, newname); /** * Create a wrapper function with the original name */ char *luacmd = calloc(1, 1024); snprintf(luacmd,1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", symname, newname); luabuff_append(luacmd); free(luacmd); // Add function/object to linked list scan_symbol(symname, libname); /** * Handle demangled symbols */ /* if(demangled){ printf(" -- demangled: %s\n", demangled); luacmd = calloc(1, 1024); snprintf(luacmd,1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", demangled, newname); luabuff_append(luacmd); free(luacmd); // Add function/object to linked list scan_symbol(demangled, libname); } */ } else { /** * Add function/object to linked list */ if((!scan_symbol(symname, libname))&&(msync(address &~0xfff,4096,0) == 0)) { // no errors, mapped // Export global as a string of known size lua_pushlstring(wsh->L, (char *) address, sym->st_size); lua_setglobal(wsh->L, symname); } } } free(demangled); sym++; } } void parse_dyn(struct link_map *map) { Elf_Dyn *dyn; unsigned int cnt = 0; unsigned int done = 0; char *dynstr = 0; Elf_Sym *dynsym = 0; unsigned int dynstrsz = 0; char *sec_init = 0; char *sec_fini = 0; char *sec_initarray = 0; unsigned long int sec_initarraysz = 0; char *sec_finiarray = 0; unsigned long int sec_finiarraysz = 0; dyn = map->l_ld; /** * Walk the array of ELF_Dyn once looking for critical sections */ while ((dyn) && (!done)) { cnt++; switch (dyn->d_tag) { case DT_NULL: case DT_NEEDED: case DT_HASH: case DT_RELA: case DT_RELASZ: case DT_RELAENT: case DT_SYMENT: case DT_SONAME: case DT_RPATH: case DT_SYMBOLIC: case DT_REL: case DT_RELSZ: case DT_RELENT: case DT_PLTREL: case DT_DEBUG: case DT_TEXTREL: case DT_JMPREL: case DT_NUM: case DT_LOPROC: case DT_HIPROC: case DT_PROCNUM: case DT_VERSYM: case DT_VERDEF: case DT_VERDEFNUM: case DT_VERNEED: case DT_VERNEEDNUM: case 0x6ffffef5: break; case DT_STRTAB: dynstr = (char *) dyn->d_un.d_val; break; case DT_SYMTAB: dynsym = (Elf_Sym *) dyn->d_un.d_val; break; case DT_STRSZ: dynstrsz = dyn->d_un.d_val; break; case DT_INIT: sec_init = (char *) dyn->d_un.d_val; break; case DT_FINI: sec_fini = (char *) dyn->d_un.d_val; break; case DT_INIT_ARRAY: sec_initarray = (char *) dyn->d_un.d_val; break; case DT_INIT_ARRAYSZ: sec_initarraysz = dyn->d_un.d_val; break; case DT_FINI_ARRAY: sec_finiarray = (char *) dyn->d_un.d_val; break; case DT_FINI_ARRAYSZ: sec_finiarraysz = dyn->d_un.d_val; break; case DT_PLTGOT: // pltgot = (void *) dyn->d_un.d_val; break; case DT_PLTRELSZ: // pltsz = dyn->d_un.d_val / 16; break; default: done = 1; break; } dyn += 1; } scan_syms(dynstr, dynsym, dynstrsz, map->l_name); } int parse_link_map_dyn(struct link_map *map) { if (!map) { if(!wsh->opt_quiet){ fprintf(stderr, "WARNING: No binary loaded in memory. Try loadbin(). For help type help(\"loadbin\").\n"); } return -1; } // go to first in linked list... while ((map) && (map->l_prev)) { map = map->l_prev; } // skip first entries in an attempt to not display the libs we load for ourselves... if(!wsh->opt_appear){ if (map->l_next) { // Leave libdl.so apparent in verbose mode map = map->l_next; } if (map->l_next) { // expose ourselved map = map->l_next; } } while (map) { parse_dyn(map); map = map->l_next; } return 0; } /** * Execute internal lua buffer */ int exec_luabuff(void){ int err = 0; if(wsh->luabuffsz == 0){ return 0; } /** * Load buffer in lua */ if ((err = luaL_loadbuffer(wsh->L, wsh->luabuff, strlen(wsh->luabuff), "=Wsh internal lua buffer")) != 0) { printf("ERROR: Wsh internal lua initialization (%s): %s\n", lua_strerror(err), lua_tostring(wsh->L, -1)); fatal_error(wsh->L, "Wsh internal lua initialization failed"); } /** * Execute buffer */ if(lua_pcall(wsh->L, 0, 0, 0)){ fprintf(stderr, "ERROR: lua_pcall() failed with %s\n",lua_tostring(wsh->L, -1)); } /** * Release internal lua buffer */ // printf(" -- Executing internal buffer:\n%s\n",wsh->luabuff); free(wsh->luabuff); wsh->luabuff = 0; wsh->luabuffsz = 0; return 0; } void parse_link_vdso(void){ // add extra vdso struct link_map *vdso = 0; vdso = dlopen(EXTRA_VDSO, RTLD_NOW); if(wsh->opt_verbose){ printf(" -- Adding extra (arch specific) vdso library: %s at %p\n", EXTRA_VDSO, vdso); } parse_link_map_dyn(vdso); } /** * Rescan address space */ void rescan(void) { reload_elfs(); empty_symbols(); wsh->opt_rescan = 1; parse_link_map_dyn(wsh->mainhandle); // parse_link_vdso(); wsh->opt_rescan = 0; exec_luabuff(); } /** * Display content of /proc/self/maps */ int print_procmap(unsigned int pid) { char *path[100]; int n = 0; int fd = 0; char *buff = 0; memset(path, 0x00, 100); snprintf(path, 99, "/proc/%u/maps", pid); buff = calloc(1, 4096); fd = open(path, O_RDONLY); if(fd < 0){ printf(" !! ERROR: open %s : %s\n", path, strerror(errno)); return -1; } while ((n = read(fd, buff, 4096)) > 0){ write(1, buff, n); memset(buff, 0x00, 4096); } free(buff); close(fd); return 0; } int procmap_lua(void) { return print_procmap(getpid()); } int execlib(lua_State * L) { int child = 0; unsigned int ret = 0; int i = 0, status = 0; int pid = 0; siginfo_t si; child = fork(); if (child == 0) { // child ptrace(PTRACE_TRACEME, 0, 0, 0); ret = libcall(L); _Exit(EXIT_SUCCESS); } else if (child == -1) { fprintf(stderr, "ERROR: fork() : %s\n", strerror(errno)); _Exit(EXIT_FAILURE); } else { // parent ptrace(PTRACE_SETOPTIONS, child, 0, PTRACE_O_TRACEFORK | PTRACE_O_TRACEVFORK | PTRACE_O_TRACECLONE | PTRACE_O_TRACEEXEC | PTRACE_O_TRACEVFORKDONE | PTRACE_O_TRACEEXIT); while (1) { if (waitpid(-1, &status, __WALL) == -1) { printf(" [*] traced process exited with status %d\n", WEXITSTATUS(status)); _Exit(EXIT_FAILURE); } if (WIFSTOPPED(status)) { pid = child; // save child's pid if (ptrace(PTRACE_CONT, child, 0, 0) == -1) { fprintf(stderr, "ERROR: ptrace() : %s\n", strerror(errno)); _Exit(EXIT_FAILURE); } // check return signal/error code ptrace(PTRACE_GETSIGINFO, pid, NULL, &si); if (si.si_signo || si.si_errno || si.si_code) { printf("[*] Child stopped with signal: %i" " errno: %i code: %i\n", si.si_signo, si.si_errno, si.si_code); break; } } } } return 0; } int traceback(lua_State * L) { lua_getglobal(L, "debug"); lua_getfield(L, -1, "traceback"); lua_pushvalue(L, 1); lua_pushinteger(L, 2); lua_call(L, 2, 1); printf("%s\n", lua_tostring(L, -1)); return 1; } void print_backtrace(void) { void *traceptrs[100]; char **funcnames = 0; size_t count = 0; unsigned int i = 0; char *p = 0; count = backtrace(traceptrs, 100); funcnames = backtrace_symbols(traceptrs, count); if (count > SKIP_BOTTOM) { count -= SKIP_BOTTOM; } for (i = SKIP_INIT; i < count; i++) { // truncate at first space p = strchr(funcnames[i], 0x20); if (p) { p[0] = 0x00; } printf("\t%012lx %s\n", traceptrs[i], funcnames[i]); } free(funcnames); } char *sicodetoname(int code) { return "Unknown"; } char *signaltoname(int signal) { unsigned int i; for (i = 0; i < sizeof(signames) / sizeof(signame_t); i++) { if (signames[i].signal == signal) { return signames[i].name; } } return "Unknown Signal"; } inline void unset_align_flag(void){ #ifdef __amd64__ // Unset Align flag asm(".intel_syntax noprefix;" "pushf;" "pop rax;" "xor rax, 0x40000;" "push rax;" "popf;" ); #endif } inline void set_align_flag(void){ #ifdef __amd64__ // Set Align flag asm(".intel_syntax noprefix;" "pushf;" "pop rax;" "or rax, 0x40000;" "push rax;" "popf;" ); #endif } inline void unset_trace_flag(void){ #ifdef __amd64__ // Unset trace flag asm(".intel_syntax noprefix;" "pushf;" "pop rax;" "xor rax, 0x100;" "push rax;" "popf;" ); #endif } inline void set_trace_flag(void){ #ifdef __amd64__ // Set Trace flag asm(".intel_syntax noprefix;" "pushf;" "pop rax;" "or rax, 0x100;" "push rax;" "popf;" ); #endif } /** * Set affinity of a thread to a given CPU */ void affinity(int procnum){ cpu_set_t set; CPU_ZERO(&set); CPU_SET(procnum, &set); if (sched_setaffinity(getpid(), sizeof(set), &set) == -1){ fprintf(stderr, " !! ERROR: sched_setaffinity(%u): %s\n", procnum, strerror(errno)); } } /** * Enable Branch Tracing */ void btr_enable(int procnum){ char cpupath[200]; uint64_t data = 0x02; int fd = 0, ret = 0; memset(cpupath, 0x00, 200); snprintf(cpupath, 199, "/dev/cpu/%d/msr", procnum); fd = open(cpupath, O_WRONLY); if(fd <= 0){ fprintf(stderr, "ERROR: open(%s): %s\n", cpupath,strerror(errno)); return; } ret = lseek(fd, 0x00, SEEK_SET); if(ret != 0x00){ fprintf(stderr, "ERROR: lseek(): %s\n", strerror(errno)); return; } ret = pwrite(fd, &data, sizeof(data), 0x1d9); if(ret != sizeof(data)){ fprintf(stderr, "ERROR: write(): %s\n", strerror(errno)); return; } ret = close(fd); if(ret != 0){ fprintf(stderr, "ERROR: close(): %s\n", strerror(errno)); return; } } /** * Disable Branch Tracing */ void btr_disable(int procnum){ char cpupath[200]; uint64_t data = 0x00; int fd = 0, ret = 0; memset(cpupath, 0x00, 200); snprintf(cpupath, 199, "/dev/cpu/%d/msr", procnum); fd = open(cpupath, O_WRONLY); if(fd <= 0){ fprintf(stderr, "ERROR: open(%s): %s\n", cpupath,strerror(errno)); return; } ret = lseek(fd, 0x00, SEEK_SET); if(ret != 0x00){ fprintf(stderr, "ERROR: lseek(): %s\n", strerror(errno)); return; } ret = pwrite(fd, &data, sizeof(data), 0x1d9); if(ret != sizeof(data)){ fprintf(stderr, "ERROR: write(): %s\n", strerror(errno)); return; } ret = close(fd); if(ret != 0){ fprintf(stderr, "ERROR: close(): %s\n", strerror(errno)); return; } } inline void set_branch_flag(void){ /* // // The following code only works in ring0 // // Enable LBR asm(".intel_syntax noprefix;" "xor rdx, rdx;" "xor rax, rax;" "inc rax;" "mov rcx, 0x1d9;" "wrmsr;" ); */ // set affinity to processor MY_CPU affinity(MY_CPU); // enable Branch Tracing (BTR) via msr on processor MY_CPU btr_enable(MY_CPU); } inline void unset_branch_flag(void){ // disable btranch tracing btr_disable(MY_CPU); } /** * SIGBUS handler */ void bushandler(int signal, siginfo_t * s, void *ptr) { ucontext_t *u = (ucontext_t *) ptr; unset_align_flag(); /* // // The faulty address is NOT passed on to the user via si->si_addr : // //http://lxr.free-electrons.com/source/arch/x86/kernel/traps.c#L217 // // unsigned int fault = 0; char *hfault = ""; if (u->uc_mcontext.gregs[REG_ERR] & 0x2) { fault = FAULT_WRITE; // Write fault hfault = "WRITE"; } else if (s->si_addr == u->uc_mcontext.gregs[REG_RIP]) { fault = FAULT_EXEC; // Exec fault hfault = "EXEC"; } else { fault = FAULT_READ; // Read fault hfault = "READ"; } printf(" -- SIGBUS: %llx\t%llx:%s\n", u->uc_mcontext.gregs[REG_RIP], s->si_addr, hfault); */ #ifndef __arm__ if(wsh->trace_unaligned){ if(wsh->opt_verbosetrace){ symbols_t *s = symbol_from_addr(u->uc_mcontext.gregs[REG_RIP]); if(s){ fprintf(stderr, " -- SIGBUS[%03u] %llx\t%s()+%u\t%s\n", wsh->sigbus_count+1, u->uc_mcontext.gregs[REG_RIP], s->symbol, u->uc_mcontext.gregs[REG_RIP] - s->addr, s->libname); }else{ fprintf(stderr, " -- SIGBUS[%03u] %llx\n", wsh->sigbus_count+1, u->uc_mcontext.gregs[REG_RIP]); } } wsh->sigbus_count++; wsh->sigbus_hash = (wsh->sigbus_hash >> 2) ^ (~u->uc_mcontext.gregs[REG_RIP]); u->uc_mcontext.gregs[REG_EFL] ^= 0x40000; // Unset Align flag u->uc_mcontext.gregs[REG_EFL]|= 0x100; // Set Trace flag } #endif } void alarmhandler(int signal, siginfo_t * s, void *u) { write(1, BLUE, strlen(BLUE)); write(1, "\n[SIGALRM]\tTimeout",18); write(1, NORMAL, strlen(NORMAL)); write(1, "\n", 1); errno = ECANCELED; alarm(1); longjmp(wsh->longjmp_ptr, 1); } void inthandler(int signal, siginfo_t * s, void *u) { write(1, MAGENTA, strlen(MAGENTA)); write(1, "\n[SIGINT]\tInterrupted",21); write(1, NORMAL, strlen(NORMAL)); write(1, "\n", 1); errno = ECANCELED; if(wsh->interrupted++ < 2){ alarm(1); longjmp(wsh->longjmp_ptr, 1); // Soft interrupt }else{ alarm(0); longjmp(wsh->longjmp_ptr_high, 1); // Hard interrupt } } int mk_backtrace(void) { void *bt[20]; int bt_size; char **bt_syms; int i; bt_size = backtrace(bt, 20); bt_syms = backtrace_symbols(bt, bt_size); for (i = 2; i < bt_size; i++) { write(1, " ", 4); write(1, bt_syms[i], strlen(bt_syms[i])); write(1, "\n", 1); } free(bt_syms); return 0; } /** * generic function to restore from exit() */ void restore_exit(void){ errno = ECANCELED; longjmp(wsh->longjmp_ptr, 1); } void exit(int status){ fprintf(stderr, " + Called exit(%d), restoring...\n", status); restore_exit(); } #ifndef __arm__ void _exit(int status){ fprintf(stderr, " + Called _exit(%d), restoring...\n", status); restore_exit(); } #endif void exit_group(int status){ fprintf(stderr, " + Called exit_group(%d), restoring...\n", status); restore_exit(); } int printarg(unsigned long int val){ if(msync(val &~0xfff,4096,0) == 0){ // Mapped int nlen = 0, noflag = 0, k = 0; char *ptrx = 0; noflag = 0; ptrx = val; nlen = strnlen(ptrx, 4096 - ((unsigned long int)ptrx & ~0xfff)); if(nlen){ for(k=0;ktrace_singlebranch){ // Stop tracing ourselves unset_branch_flag(); // u->uc_mcontext.gregs[REG_EFL] ^= 0x100; // Set Trace flag } #ifndef __arm__ /** * Search corresponding Breakpoint */ for (i = 0; i < wsh->bp_num; i++) { if (wsh->bp_array[i].ptr == u->uc_mcontext.gregs[REG_RIP] - 1) { printf(" ** EXECUTED BREAKPOINT[%u] at %p weight:%u <", i + 1, u->uc_mcontext.gregs[REG_RIP] - 1, wsh->bp_array[i].weight); info_function(u->uc_mcontext.gregs[REG_RIP] - 1); ptrd = u->uc_mcontext.gregs[REG_RIP] - 1; ptrd[0] = wsh->bp_array[i].backup; wsh->bp_points += wsh->bp_array[i].weight; // Update bp_points lua_pushnumber(wsh->L, wsh->bp_points); lua_setglobal(wsh->L, "bp_points"); } } if (ptrd) { /** * This is a breakpoint */ printf(" ** Restoring execution from %p\n", ptrd); u->uc_mcontext.gregs[REG_RIP]--; // TODO : decrease by full instruction size } else if(wsh->trace_singlebranch) { /** * We are single branching */ if((u->uc_mcontext.gregs[REG_RIP] & ~0xffffff) != ((unsigned long int)traphandler & ~0xffffff)){ // Make sure we are not tracing ourselves if(wsh->opt_verbosetrace){ symbols_t *s = symbol_from_addr(u->uc_mcontext.gregs[REG_RIP]); if((s)&&(u->uc_mcontext.gregs[REG_RIP] == s->addr)){ fprintf(stderr, " -- Branch[%03d] = 0x%llx\t%s(", wsh->singlebranch_count + 1, u->uc_mcontext.gregs[REG_RIP], s->symbol); #ifdef DEBUG #ifdef __amd64__ printarg(u->uc_mcontext.gregs[REG_RDI]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_RSI]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_RDX]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_RCX]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_R8]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_R9]); #endif #endif fprintf(stderr, ")\t%s\n", s->libname); }else if(s){ fprintf(stderr, " -- Branch[%03d] = 0x%llx\t%s()+%u\t%s\n", wsh->singlebranch_count + 1, u->uc_mcontext.gregs[REG_RIP], s->symbol, u->uc_mcontext.gregs[REG_RIP] - s->addr, s->libname); }else{ fprintf(stderr, " -- Branch[%03d] = 0x%llx\n", wsh->singlebranch_count + 1, u->uc_mcontext.gregs[REG_RIP]); } } wsh->singlebranch_hash = (wsh->singlebranch_hash >> 2) ^ (~u->uc_mcontext.gregs[REG_RIP]); wsh->singlebranch_count++; } set_branch_flag(); u->uc_mcontext.gregs[REG_EFL] |= 0x100; // Set Trace flag return ; } else if(wsh->trace_singlestep) { /** * We are single stepping */ if((u->uc_mcontext.gregs[REG_RIP] & ~0xffffff) != ((unsigned long int)traphandler & ~0xffffff)){ // Make sure we are not tracing ourselves if(wsh->opt_verbosetrace){ symbols_t *s = symbol_from_addr(u->uc_mcontext.gregs[REG_RIP]); if((s)&&(u->uc_mcontext.gregs[REG_RIP] == s->addr)){ fprintf(stderr, " -- Step[%03d] = 0x%llx\t%s(", wsh->singlebranch_count + 1, u->uc_mcontext.gregs[REG_RIP], s->symbol); #ifdef DEBUG #ifdef __amd64__ printarg(u->uc_mcontext.gregs[REG_RDI]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_RSI]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_RDX]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_RCX]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_R8]); fprintf(stderr, ", "); printarg(u->uc_mcontext.gregs[REG_R9]); #endif #endif fprintf(stderr, ")\t%s\n", s->libname); }else if(s){ fprintf(stderr, " -- Step[%03d] = 0x%llx\t%s()+%u\t%s\n", wsh->singlestep_count + 1, u->uc_mcontext.gregs[REG_RIP], s->symbol, u->uc_mcontext.gregs[REG_RIP] - s->addr, s->libname); }else{ fprintf(stderr, " -- Step[%03d] = 0x%llx\n", wsh->singlestep_count + 1, u->uc_mcontext.gregs[REG_RIP]); } } wsh->singlestep_count++; wsh->singlestep_hash = (wsh->singlestep_hash >> 2) ^ (~u->uc_mcontext.gregs[REG_RIP]); u->uc_mcontext.gregs[REG_EFL] |= 0x100; // Set Trace flag } return ; } else if(wsh->trace_unaligned) { /** * We are tracing unaligned access via SIGBUS, single step once */ u->uc_mcontext.gregs[REG_EFL] |= 0x40000; // Set Align flag u->uc_mcontext.gregs[REG_EFL] ^= 0x100; // Unset Trace flag return; } else { /** * This is an unhandled exception : exit */ if (u->uc_mcontext.gregs[REG_ERR] & 0x2) { fault = FAULT_WRITE; // Write fault hfault = "WRITE"; } else if (s->si_addr == u->uc_mcontext.gregs[REG_RIP]) { fault = FAULT_EXEC; // Exec fault hfault = "EXEC"; } else { fault = FAULT_READ; // Read fault hfault = "READ"; } signame = signaltoname(signal); fprintf(stderr, "%s\t(%u)\trip:%p %s\t%08lx\t", signame, signal, u->uc_mcontext.gregs[REG_RIP], hfault, s->si_addr); psiginfo(s, ""); print_backtrace(); printf(" -- No corresponding breakpoint (among %u), exiting\n", wsh->bp_num); _Exit(EXIT_SUCCESS); } #endif if (signal) { if (!wsh->firstsignal) { wsh->firstsignal = signal; } wsh->totsignals += 1; } } char *sicode_strerror(int signal, siginfo_t * s) { char *sicode = 0; switch (signal) { case SIGBUS: switch (s->si_code) { case BUS_ADRALN: sicode = "invalid address alignment"; break; case BUS_ADRERR: sicode = "non-existent physical address"; break; case BUS_OBJERR: sicode = "object specific hardware error"; break; } break; case SIGCHLD: switch (s->si_code) { case CLD_EXITED: sicode = "child has exited"; break; case CLD_KILLED: sicode = "child was killed"; break; case CLD_DUMPED: sicode = "child terminated abnormally"; break; case CLD_TRAPPED: sicode = "traced child has trapped"; break; case CLD_STOPPED: sicode = "child has stopped"; break; case CLD_CONTINUED: sicode = "stopped child has continued"; break; } break; case SIGILL: switch (s->si_code) { case ILL_ILLOPC: sicode = "illegal opcode"; break; case ILL_ILLOPN: sicode = "illegal operand"; break; case ILL_ILLADR: sicode = "illegal addressing mode"; break; case ILL_ILLTRP: sicode = "illegal trap"; break; case ILL_PRVOPC: sicode = "privileged opcode"; break; case ILL_PRVREG: sicode = "privileged register"; break; case ILL_COPROC: sicode = "coprocessor error"; break; case ILL_BADSTK: sicode = "internal stack error"; break; } break; case SIGFPE: switch (s->si_code) { case FPE_INTDIV: sicode = "integer divide by zero"; break; case FPE_INTOVF: sicode = "integer overflow"; break; case FPE_FLTDIV: sicode = "floating point divide by zero"; break; case FPE_FLTOVF: sicode = "floating point overflow"; break; case FPE_FLTUND: sicode = "floating point underflow"; break; case FPE_FLTRES: sicode = "floating point inexact result"; break; case FPE_FLTINV: sicode = "invalid floating point operation"; break; case FPE_FLTSUB: sicode = "subscript out of range"; break; } break; case SIGSEGV: switch (s->si_code) { case SEGV_MAPERR: sicode = "address not mapped to object"; break; case SEGV_ACCERR: sicode = "invalid permissions for mapped object"; break; default: sicode = "segmentation fault"; break; } break; } return sicode; } void sighandler(int signal, siginfo_t * s, void *ptr) { ucontext_t *u = (ucontext_t *) ptr; unsigned int fault = 0; char *hfault = 0; char *signame = 0; char *sicode = 0; char defsicode[200]; unsigned int r = 0; char *accesscolor = ""; #ifndef __arm__ /** * Get access type */ if (u->uc_mcontext.gregs[REG_ERR] & 0x2) { fault = FAULT_WRITE; // Write fault hfault = "Write"; r = 2; accesscolor = YELLOW; } else if (s->si_addr == u->uc_mcontext.gregs[REG_RIP]) { fault = FAULT_EXEC; // Exec fault hfault = "Exec"; r = 4; accesscolor = RED; } else { fault = FAULT_READ; // Read fault hfault = "Read"; r = 1; accesscolor = GREEN; } /** * Get signal name */ signame = signaltoname(signal); /** * Get signal code */ sicode = sicode_strerror(signal, s); if (!sicode) { memset(defsicode, 0x00, 200); snprintf(defsicode, 199, "Error code %d", s->si_code); sicode = defsicode; } if ((wsh->totsignals == 0) || (wsh->opt_verbose)) { fprintf(stderr, "\n%s[%s]\t%s\t%012lx" BLUE " (%s)\n" NORMAL, accesscolor, signame, hfault, s->si_addr, sicode); if((fault != FAULT_EXEC)||(!msync(u->uc_mcontext.gregs[REG_RIP]&~0xfff, getpagesize(), 0))){ // Avoid segfaults on generating backtraces... print_backtrace(); } } if (!wsh->totsignals) { // Save informations relative to first signal wsh->firstsignal = signal; wsh->firstsicode = s->si_code; wsh->faultaddr = s->si_addr; wsh->reason = r; memcpy(wsh->errcontext, u, sizeof(ucontext_t)); wsh->btcaller = u->uc_mcontext.gregs[REG_RIP]; } if (!wsh->firsterrno) { wsh->firsterrno = errno; } // Save first errno as firsterrno (treated separately) wsh->totsignals += 1; wsh->globalsignals += 1; #ifdef DEBUG fprintf(stderr, " !! FATAL ERROR: Instruction Pointer 0x%012llx addr:%012llx\n", u->uc_mcontext.gregs[REG_RIP], s->si_addr); #endif #endif // end arm /** * Restore execution from known good point */ errno = ENOTRECOVERABLE; /*EFAULT;*/ longjmp(wsh->longjmp_ptr, 1); } /** * Set all signal handlers */ int set_sighandlers(void) { struct sigaction sa; sa.sa_flags = SA_SIGINFO | SA_RESTART; sigemptyset(&sa.sa_mask); sa.sa_sigaction = sighandler; if (sigaction(SIGSEGV, &sa, NULL) == -1) { perror("sigaction"); _Exit(EXIT_FAILURE); } if (sigaction(SIGABRT, &sa, NULL) == -1) { perror("sigaction"); _Exit(EXIT_FAILURE); } if (sigaction(SIGILL, &sa, NULL) == -1) { perror("sigaction"); _Exit(EXIT_FAILURE); } sa.sa_flags = SA_SIGINFO; sa.sa_sigaction = traphandler; if (sigaction(SIGTRAP, &sa, NULL) == -1) { perror("sigaction"); _Exit(EXIT_FAILURE); } sa.sa_flags = SA_SIGINFO; sa.sa_sigaction = alarmhandler; if (sigaction(SIGALRM, &sa, NULL) == -1) { perror("sigaction"); _Exit(EXIT_FAILURE); } sa.sa_flags = SA_SIGINFO; sa.sa_sigaction = inthandler; if (sigaction(SIGINT, &sa, NULL) == -1) { perror("sigaction"); _Exit(EXIT_FAILURE); } sa.sa_sigaction = bushandler; sa.sa_flags = SA_SIGINFO ; sigfillset(&sa.sa_mask); if (sigaction(SIGBUS, &sa, NULL) == -1) { perror("sigaction"); _Exit(EXIT_FAILURE); } return 0; } /** * Set global variable is_stdinscript to 1 if there is data on stdin */ int test_stdin(void) { struct pollfd fds; int ret = 0; fds.fd = 0; /* fd corresponding to STDIN */ fds.events = POLLIN; ret = poll(&fds, 1, 0); if (ret == 1) { wsh->is_stdinscript = 1; wsh->opt_hollywood = 0; } else if (ret == 0) { wsh->is_stdinscript = 0; } else { wsh->is_stdinscript = 0; } return 0; } int wsh_appear(lua_State * L) { wsh->opt_appear = 1; rescan(); parse_link_vdso(); return 0; } int wsh_hide(lua_State * L) { wsh->opt_appear = 0; rescan(); return 0; } int verbose(lua_State * L) { void *arg = 0; if (lua_isnumber(L, 1)) { arg = (unsigned long) lua_tonumber(L, 1); } printf(" -- Setting verbosity to %u\n", arg); wsh->opt_verbose = arg; return 0; } int hollywood(lua_State * L) { void *arg = 0; if (lua_isnumber(L, 1)) { arg = (unsigned long) lua_tonumber(L, 1); } printf(" -- Setting hollywood to %u\n", arg); wsh->opt_hollywood = arg; if (wsh->opt_hollywood == 2) { printf(GREEN); } if (wsh->opt_hollywood == 1) { printf(NORMAL); } return 0; } /** * Display mapped sections */ int map(lua_State * L) { unsigned int count = 0; char *sizes[] = { "b", "Kb", "Mb", "Gb", "Tb", "Pb", "Hb" }; double len = 0; int order = 0; struct section *s; s = zfirst; while (s != 0x00) { if (wsh->opt_hollywood) { char *pcolor = DARKGRAY; // NORMAL switch (s->perms) { case 2: // r-- pcolor = GREEN; break; case 6: // rw- pcolor = BLUE; break; case 3: // r-x pcolor = RED; break; case 7: // rwx pcolor = MAGENTA; break; default: break; } printf(GREEN "%012llx-%012llx" NORMAL " %s %s%s" NORMAL "\t\t%u\n", s->init, s->end, s->hperms, pcolor, s->name, s->size / sysconf(_SC_PAGE_SIZE)); } else { printf("%012llx-%012llx %s %s\t\t%u\n", s->init, s->end, s->hperms, s->name, s->size / sysconf(_SC_PAGE_SIZE)); } if (s->perms) { count += s->size / sysconf(_SC_PAGE_SIZE); } s = s->next; } len = count * sysconf(_SC_PAGE_SIZE); order = 0; while ((len >= 1024) && (order <= 3)) { order++; len = len / 1024; } printf(" --> total: %u pages mapped (%d %s)\n", count, (unsigned int) len, sizes[order]); return 0; } /** * Pollute .bss sections */ int bsspolute(lua_State * L){ sections_t *s = 0, *stmp = 0; char poison = 0xff; unsigned int num = 0; DL_FOREACH_SAFE(wsh->shdrs, s, stmp) { if((s->name)&&(!strncmp(s->name,".bss",4))){ num++; if(num >= 4){ printf("[%02u] 0x%012llx-0x%012llx %s:%s\t%02x\t%s:%u\t\t\n",num, s->addr, s->addr + s->size, s->name, s->perms, poison, s->libname, s->size); memset(s->addr, poison--, s->size); } } s = s->next; } return 0; } /** * Search a pattern in memory */ static char *searchmem(char *start, char *pattern, unsigned int patternlen, unsigned int memsz) { unsigned int i = 0; char *ptr = 0; int uplim = 0; ptr = start; uplim = memsz - patternlen; for (i = 0; (i >= 0) && (i < uplim) && (uplim > 0); i++) { if (!memcmp(ptr + i, pattern, patternlen)) { return ptr + i; } } return 0; } /** * ralloc(unsigned int size, unsigned char poison); * allocate 1 page set to 0x00, set size bytes to poison, remap the page R only */ int ralloc(lua_State * L){ unsigned int size = 0; unsigned char poison = 0; unsigned long int ret = 0; char *ptr = 0; unsigned long int *ptr2 = 0; unsigned int sz = 0; unsigned long int baseaddr = 0; read_arg1(size); read_arg2(poison); sz = getpagesize(); baseaddr = (default_poison + global_xalloc)*0x1010101000; //0x81818181000-0x1000 ptr = mmap(baseaddr, sz, PROT_WRITE|PROT_READ, MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0); if(ptr <= 0){ fprintf(stderr, " !! ERROR: malloc() : %s",strerror(errno)); return 0; } ret = ptr; // compute return address if(wsh->opt_verbosetrace){ printf("-- ralloc() ptr:%llx, size:%u, ret:%llx\t[%llx-%llx]\n", ptr, sz, ret, ret, ret + size); } mprotect(ptr, sz, PROT_EXEC | PROT_READ | PROT_WRITE); memset(ptr, poison ? poison : default_poison + global_xalloc, sz); // map with default poison bytes global_xalloc++; memset(ptr,poison, size % 4096); mprotect(ptr, sz, PROT_READ); lua_pushlightuserdata(L, ret); return 1; } /** * xalloc(unsigned int size, unsigned char poison, unsigned int perms); * Allocate size bytes (% getpagesize()) * * The mapping auto-references itself, unless a poison byte is given * * [page unmaped] * [mapped][OURPTR, size] * [page unmaped] */ ATTRIBUTE_NO_SANITIZE_ADDRESS int xalloc(lua_State * L) { unsigned int size = 0; unsigned int perms = 0; unsigned char poison = 0; unsigned long int ret = 0; char *ptr = 0; unsigned long int *ptr2 = 0; unsigned int sz = 0; unsigned long int baseaddr = 0; read_arg1(size); read_arg2(poison); read_arg3(perms); size = size % 4096; sz = getpagesize()*3; baseaddr = (default_poison + global_xalloc)*0x1010101000-0x1000; //0x616161616000 ptr = mmap(baseaddr, sz, PROT_WRITE|PROT_READ, MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0); if(ptr <= 0){ fprintf(stderr, " !! ERROR: malloc() : %s",strerror(errno)); return 0; } ret = ptr + 2*getpagesize() - size; // compute return address if(wsh->opt_verbosetrace){ printf("-- ptr:%llx, size:%u, ret:%llx\t[%llx-%llx]\n", ptr, sz, ret, ret, ret + size); } mprotect(ptr, sz, PROT_EXEC | PROT_READ | PROT_WRITE); memset(ptr, poison ? poison : default_poison + global_xalloc, sz); // map with default poison bytes global_xalloc++; if(!poison){ // If autoref, overwrite all the content with address of our own buffer for(ptr2 = ptr; ptr2 < ptr + sz ; ptr2++){ // all 3 pages *ptr2 = ret; } for(ptr2 = ret; ptr2 < ret + size ; ptr2++){ // just our small allocade part *ptr2 = ret; } } mprotect(ptr, sz, perms ? perms : PROT_READ | PROT_WRITE | PROT_EXEC); mprotect(ptr+2*getpagesize(), getpagesize(), PROT_NONE); // Third page is remapped with no permissions lua_pushlightuserdata(L, ret); return 1; } /** * Release a bloc allocated via xalloc() */ void xfree(lua_State * L){ void *ptr = 0, *trueptr = 0; unsigned int sz = 0; sz = 3*getpagesize(); read_arg1(ptr); trueptr = ((unsigned long int)ptr & ~0xfff)-0x1000; mprotect(trueptr, sz, PROT_EXEC | PROT_READ | PROT_WRITE); memset(trueptr, 0x00, sz); munmap(trueptr, sz); } /** * Resize a xallocated memory zone */ //void xrealloc(lua_State * L){ //} void traceunaligned(lua_State * L){ wsh->trace_singlebranch = 0; wsh->trace_singlestep = 0; wsh->trace_unaligned = 1; } void untraceunaligned(lua_State * L){ wsh->trace_singlebranch = 0; wsh->trace_singlestep = 0; wsh->trace_unaligned = 0; } void singlestep(lua_State * L){ wsh->trace_singlebranch = 0; wsh->trace_singlestep = 1; wsh->trace_unaligned = 0; } void unsinglestep(lua_State * L){ wsh->trace_singlebranch = 0; wsh->trace_singlestep = 0; wsh->trace_unaligned = 0; } void systrace(lua_State * L){ wsh->trace_strace = 1; wsh->trace_rtrace = 0; } void rtrace(lua_State * L){ wsh->trace_rtrace = 1; wsh->trace_strace = 0; } void unsystrace(lua_State * L){ wsh->trace_rtrace = 0; wsh->trace_strace = 0; } void unrtrace(lua_State * L){ wsh->trace_rtrace = 0; wsh->trace_strace = 0; } void verbosetrace(lua_State * L){ wsh->opt_verbosetrace = 1; } void unverbosetrace(lua_State * L){ wsh->opt_verbosetrace = 0; } void singlebranch(lua_State * L){ // // Technically, it may be possible to give wsh apabilities to run BTR without uid 0 // // sudo setcap cap_sys_rawio=ep ./wsh if(getuid() != 0){ fprintf(stderr, "!! ERROR: You need root privileges to use Branch Tracing\n"); return; } // Load LKMs in kernel land system("sudo modprobe cpuid"); system("sudo modprobe msr"); wsh->trace_singlebranch = 1; wsh->trace_singlestep = 0; wsh->trace_unaligned = 0; } void unsinglebranch(lua_State * L){ wsh->trace_singlebranch = 0; wsh->trace_singlestep = 0; wsh->trace_unaligned = 0; } /** * Search a given value in memory * * grepptr(Pattern, patternlen, hexadumplen, nbytesbeforematch) * */ int grepptr(lua_State * L) { char *ptr = 0; unsigned long int maxlen = 0, i = 0; char *match = 0; int count = 1; unsigned int dumplen = 200; unsigned int k = 0; unsigned long int p; char pattern[9]; unsigned int patternsz = 0; unsigned int aligned = 0; sections_t *s = 0, *stmp = 0; read_arg1(p); read_arg2(patternsz); read_arg3(aligned); if (!patternsz) { patternsz = sizeof(unsigned long int); } if (patternsz > 8) { fprintf(stderr, "ERROR: Wrong pattern size:%u > 8\n", patternsz); } printf(" -- Searching Pointer: 0x%lx (length:%u aligned:%u)\n", p, patternsz, aligned); memset(pattern, 0x00, 9); memcpy(pattern, &p, patternsz); /* create result table */ lua_newtable(L); DL_FOREACH_SAFE(wsh->shdrs, s, stmp) { k = 0; if (!msync(s->addr&~0xfff, s->size, 0)) { searchagain: match = searchmem(s->addr + k, pattern, patternsz, s->size - k); if (match) { if (wsh->opt_hollywood) { printf(" match[" GREEN "%d" NORMAL "] at " GREEN "%p" NORMAL " %u bytes within:%llx-%llx:" GREEN "%s:%s" NORMAL ":%s\n\n", count, match, match - (char *) s->addr, s->addr, s->addr + s->size, s->libname, s->name, s->perms); } else { printf(" match[%d] at %p %u bytes within:%llx-%llx:%s:%s:%s\n\n", count, match, match - (char *) s->addr, s->addr, s->addr + s->size, s->name, s->perms); } int delta = (char *) (s->addr+s->size) - match; if (delta > dumplen) { delta = dumplen; }; hexdump(match, patternsz + delta, 0, patternsz); // Colorize match printf("\n"); /* Add symbol to Lua table */ lua_pushnumber(L, count); /* push key */ lua_pushinteger(L, (unsigned long int)match); /* push value : matching address */ lua_settable(L, -3); count++; k = match - s->addr + 1; goto searchagain; } } // s = s->next; } // Push number of results as lua return variable // lua_pushinteger(L, count); return 1; } /** * Load a binary into the address space */ int loadbin(lua_State * L) { char *libname = 0; read_arg1(libname); if(!libname){ printf("ERROR: missing name of binary to load\n"); return 0; } do_loadlib(libname); rescan(); return 0; } /** * search a pattern over all sections mapped in memory */ int grep(lua_State * L) { // Pattern, patternlen, hexadumplen, nbytesbeforematch char *ptr = 0; unsigned int maxlen = 0, i = 0; char *match = 0; int count = 0; char *pattern = 0; unsigned int patternlen = 0; unsigned int dumplen = 0; unsigned int nbytesbeforematch = 0; unsigned int k = 0; sections_t *s, *stmp; read_arg1(pattern); read_arg2(patternlen); read_arg3(dumplen); read_arg(nbytesbeforematch, 4); // Enforce sane defaults on optional arguments if (!patternlen) { patternlen = strlen(pattern); } if (!dumplen) { dumplen = 200; } /* create result table */ lua_newtable(L); DL_FOREACH_SAFE(wsh->shdrs, s, stmp) { k = 0; if (!msync(s->addr&~0xfff, s->size, 0)) { searchagain: match = searchmem(s->addr + k, pattern, patternlen, s->size - k); if (match) { if (wsh->opt_hollywood) { printf(" match[" GREEN "%d" NORMAL "] at " GREEN "%p" NORMAL " %u bytes within:%llx-%llx:" GREEN "%s:%s" NORMAL ":%s\n\n", count + 1, match, match - (char *) s->addr, s->addr, s->addr + s->size, s->libname, s->name, s->perms); } else { printf(" match[%d] at %p %u bytes within:%llx-%llx:%s:%s:%s\n\n", count + 1, match, match - (char *) s->addr, s->addr, s->addr + s->size, s->name, s->perms); } int delta = (char *) (s->addr+s->size) - match; if (delta > dumplen) { delta = dumplen; }; hexdump(match - nbytesbeforematch, patternlen + delta, nbytesbeforematch, patternlen); // Colorize match printf("\n"); /* Add symbol to Lua table */ lua_pushnumber(L, count + 1); /* push key */ lua_pushinteger(L, (unsigned long int)match); /* push value : matching address */ lua_settable(L, -3); count++; k = match - s->addr + 1; goto searchagain; } } } // Push number of results as lua return variable // lua_pushinteger(L, count); return 1; } /* * Return a section from an address */ static struct section *sec_from_addr(unsigned long int addr) { struct section *s = zfirst; while (s != 0x00) { if ((s->init <= addr) && (s->end > addr)) { return s; } } return 0; } /** * Our own version of memcpy callable from LUA */ int priv_memcpy(lua_State * L) { void *arg1 = 0, *arg2 = 0, *arg3 = 0; char *ptr = 0; char *addr = 0; int ret = 0; read_arg1(arg1); read_arg2(arg2); read_arg3(arg3); ret = memcpy(arg1, arg2, arg3); // Push number of results as lua return variable lua_pushinteger(L, ret); return 1; } /** * Our own version of strcpy callable from LUA */ int priv_strcpy(lua_State * L) { void *arg1 = 0, *arg2 = 0; char *ptr = 0; char *addr = 0; int ret = 0; read_arg1(arg1); read_arg2(arg2); ret = strcpy(arg1, arg2); // Push number of results as lua return variable lua_pushinteger(L, ret); return 1; } /** * Our own version of strcat callable from LUA */ int priv_strcat(lua_State * L) { void *arg1 = 0, *arg2 = 0; char *ptr = 0; char *addr = 0; int ret = 0; read_arg1(arg1); read_arg2(arg2); ret = strcat(arg1, arg2); // Push number of results as lua return variable lua_pushinteger(L, ret); return 1; } /** * Set a breakpoint */ int breakpoint(lua_State * L) { void *arg1 = 0, *arg2 = 0; char *ptr = 0; char *addr = 0; char bk = 0; read_arg1(arg1); read_arg1(arg2); /** * Make sure destination address is mapped */ if ((!arg1) || (msync((long int)arg1 & (long int)~0xfff, 4096, 0))) { fprintf(stderr, "ERROR: Address %p is not mapped\n", arg1); return 0; } /** * Change memory protections to RWX on destionation's page */ ptr = arg1; addr = ((unsigned long int) ptr & (unsigned long int) ~0xfff); printf(" ** Setting BREAKPOINT[%u] (weigth:%u) <", wsh->bp_num + 1, arg2); info_function(arg1); mprotect(addr, sysconf(_SC_PAGE_SIZE), PROT_READ | PROT_WRITE | PROT_EXEC); /** * Backup byte at destination */ bk = ptr[0x00]; /** * Write Breakpoint */ ptr[0x00] = 0xcc; /** * Save breakpoint informations */ if (!wsh->bp_num) { wsh->bp_array = calloc(1, sizeof(breakpoint_t)); } else { wsh->bp_array = realloc(wsh->bp_array, sizeof(breakpoint_t) * (wsh->bp_num + 1)); } wsh->bp_array[wsh->bp_num].ptr = ptr; wsh->bp_array[wsh->bp_num].backup = bk; wsh->bp_array[wsh->bp_num].weight = arg2; wsh->bp_num++; return 0; } void declare_func(void *addr, char *name){ lua_pushcfunction(wsh->L, addr); lua_setglobal(wsh->L, name); } void declare_num(int val, char *name){ lua_pushnumber(wsh->L, val); lua_setglobal(wsh->L, name); } /** * Export functions to lua */ void declare_internals(void) { tuple_t *t; unsigned int i; /** * Create definitions for internal functions */ for(i=0;ibp_points, "bp_points"); /** * Create a wrapper functions for other internal functions */ char *luacmd = calloc(1, 1024); snprintf(luacmd, 1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", "hexdump", "lhexdump"); luabuff_append(luacmd); memset(luacmd, 0x00, 1024); snprintf(luacmd, 1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, string.len(a), c, d, e, f, g, h); return j, k; end\n", "hex", "lhexdump"); luabuff_append(luacmd); memset(luacmd, 0x00, 1024); snprintf(luacmd, 1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", "execlib", "lexeclib"); luabuff_append(luacmd); memset(luacmd, 0x00, 1024); snprintf(luacmd, 1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", "disasm", "ldisasm"); luabuff_append(luacmd); memset(luacmd, 0x00, 1024); snprintf(luacmd, 1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", "deref", "lderef"); luabuff_append(luacmd); memset(luacmd, 0x00, 1024); snprintf(luacmd, 1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", "strace", "lstrace"); luabuff_append(luacmd); memset(luacmd, 0x00, 1024); snprintf(luacmd, 1023, "function %s (a, b, c, d, e, f, g, h) j,k = libcall(%s, a, b, c, d, e, f, g, h); return j, k; end\n", "script", "lscript"); luabuff_append(luacmd); free(luacmd); } int set_alloc_opt(void){ setenv("LIBC_FATAL_STDERR_", "yes", 1); mallopt(M_CHECK_ACTION, 3); return 0; } /** * Generate a core file */ int gencore(lua_State * L){ enable_core(L); if(!fork()){ kill(getpid(), SIGQUIT); } return 0; } /** * Disable core files generation */ int disable_core(lua_State * L){ int err = 0; errno = 0; err = prctl(PR_SET_DUMPABLE, (long)0); if(err){ printf("ERROR: prctl() %s\n", strerror(errno)); } return 0; } /** * Enable core files generation */ int enable_core(lua_State * L){ int err = 0; errno = 0; err = prctl(PR_SET_DUMPABLE, (long)1); if(err){ printf("ERROR: prctl() %s\n", strerror(errno)); } return 0; } int wsh_init(void) { set_sighandlers(); // create context wsh = calloc(1, sizeof(wsh_t)); // test if we're reading a script from stdin test_stdin(); // create lua state wsh->L = luaL_newstate(); /* Create Lua state variable */ // make sure version of lua matches luaL_checkversion(wsh->L); luaL_openlibs(wsh->L); /* Load Lua libraries */ // Declare internal functions declare_internals(); // Default is to disable core files // disable_core(wsh->L); // Set malloc options set_alloc_opt(); // Set process name prctl(PR_SET_NAME,"wsh",NULL,NULL,NULL); return 0; } static char *lua_strerror(int err) { switch (err) { case 1: return "Lua Yield"; case 2: return "Runtime Error"; case 3: return "Synthax Error"; case 4: return "Memory Error"; case 5: return "Fatal Error"; default: return "Unknown Error"; }; return NULL; // Never reached } /** * Run a lua script */ int run_script(char *name) { char myerror[200]; int err = 0; if(!name){ return -1;} if(wsh->opt_verbose){ printf(" * Running lua script %s\n", name); } memset(myerror, 0x00, 200); err = 0; if ((err = luaL_loadfile(wsh->L, name) != 0)) { /* Load but don't run the Lua script */ snprintf(myerror, 199, "error %d : %s", err, lua_strerror(err)); printf(stderr, "luaL_loadfile() failed for script %s (%s)\n", name, errno ? strerror(errno) : myerror); /* Error out if file can't be read */ return -1; } if (wsh->opt_verbose) { printf(" * Running lua script %s\n", name); } memset(myerror, 0x00, 200); if (lua_pcall(wsh->L, 0, 0, 0)) { /* Run the loaded Lua script */ fprintf(stderr, "lua_pcall() failed with %s, for: %s\n",lua_tostring(wsh->L, -1), name); /* Error out if Lua file has an error */ lua_pop(wsh->L, 1); // pop error message from the stack } lua_settop(wsh->L, 0); // remove eventual returns return 0; } /** * Verify ELF signature in a binary */ unsigned int read_elf_sig(char *fname, struct stat *sb) { int fd = 0; unsigned char sig[5]; char validelf[4] = "\177ELF"; if (sb->st_size < MIN_BIN_SIZE) { return 0; // Failure } fd = open(fname, O_RDONLY); if (errno) { perror("open"); return 0; } memset(sig, 0x00, 5); read(fd, sig, 4); close(fd); return strncmp(sig, validelf, 4) ? 0 : 1; } /** * Execute default internal scripts */ int exec_default_scripts(void){ int err = 0; if ((err =luaL_loadfile(wsh->L, DEFAULT_SCRIPT_INDEX)) != 0) { printf("ERROR: %s in script %s (%s)\n", lua_strerror(err), DEFAULT_SCRIPT_INDEX, lua_tostring(wsh->L, -1)); fatal_error(wsh->L, "luaL_loadfile() failed"); } if(lua_pcall(wsh->L, 0, 0, 0)){ fprintf(stderr, "ERROR: lua_pcall() failed with %s\n",lua_tostring(wsh->L, -1)); } return 0; } int load_home_user_file(char *fname){ char pathname[255]; struct stat sb; int err = 0; memset(pathname, 0x00, 255); if(!getenv("HOME")){ printf("WARNING: HOME environment variable not set : skipping %s file", fname); return -1; } snprintf(pathname, 254, "%s/%s", getenv("HOME"), fname); if (stat(pathname, &sb) == -1) { if(wsh->opt_verbose){ printf("WARNING: %s file not found\n", pathname); } errno = 0; return -1; } if(wsh->opt_verbose){ printf(" * Running user startup script %s\n", pathname); } // load file from home user directory if present err = 0; if ((err = luaL_loadfile(wsh->L, pathname)) != 0) { printf("WARNING: %s while running startup script %s (%s)\n", lua_strerror(err), pathname, lua_tostring(wsh->L, -1)); } if(lua_pcall(wsh->L, 0, 0, 0)){ fprintf(stderr, "ERROR: lua_pcall() failed with %s\n",lua_tostring(wsh->L, -1)); } return 0; } /** * Load .wsh_profile script if it exists * We search for it in the directory * corresponding to environment variable HOME */ int load_profile(void){ load_home_user_file(DEFAULT_WSH_PROFILE); return 0; } /** * Load .wshrc script if it exists * We search for it in the directory * corresponding to environment variable HOME */ int load_wshrc(void){ load_home_user_file(DEFAULT_WSHRC); return 0; } /** * Run a lua shell/script */ int wsh_run(void) { struct script_t *s = 0; unsigned int scriptcount = 0; DL_COUNT(wsh->scripts, s, scriptcount); read_maps(getpid()); parse_link_map_dyn((struct link_map *)wsh->mainhandle); parse_link_vdso(); /** * run internal lua buffers */ exec_luabuff(); if (wsh->opt_verbose) { printf(" -- Running startup lua scripts\n"); } /** * Execute default internal scripts */ exec_default_scripts(); /** * load .wshrc if present */ load_wshrc(); /** * Run all the scripts specified in the command line */ if (wsh->opt_verbose) { printf(" -- %u user scripts in queue\n", scriptcount); } script_t *ss, *stmp; DL_FOREACH_SAFE(wsh->scripts, ss, stmp) { run_script(ss->name); } /** * Run a lua shell */ if (!sigsetjmp(wsh->longjmp_ptr_high, 1)){ // This is executed only the first time // save stack context + signals run_shell(wsh->L); }else{ if(wsh->longjmp_ptr_high_cnt++ < 3){ printf("RESTORING FROM SANE STACK STATE (%u/3)\n", wsh->longjmp_ptr_high_cnt); run_shell(wsh->L); }else{ printf("\n%s[FATAL]\tInterrupted too many times : exiting%s\n",RED,NORMAL); _Exit(EXIT_FAILURE); } } lua_close(wsh->L); /* Clean up, free the Lua state var */ return 0; } int add_script_arguments(int argc, char **argv, unsigned int i) { unsigned int j = 0; if (i >= argc) { return -1; } // Should not happen wsh->script_argnum = argc - i; wsh->script_args = calloc(sizeof(void *), argc); for (j = 0; j < wsh->script_argnum; j++) { wsh->script_args[j] = strdup(argv[j + i]); printf("argument[%u]: %s\n", j, wsh->script_args[j]); } return wsh->script_argnum; } /** * Add a script to the execution queue */ int add_script_exec(char *name) { struct script_t *s; s = calloc(1, sizeof(struct script_t)); s->name = strdup(name); DL_APPEND(wsh->scripts, s); return 0; } /** * Add a binary to the list of binaries to preload */ int add_binary_preload(char *name) { struct preload_t *p; p = calloc(1, sizeof(struct preload_t)); p->name = strdup(name); DL_APPEND(wsh->preload, p); return 0; } /** * Patch ELF ehdr->e_type to ET_DYN */ int mk_lib(char *name) { int fd = 0; struct stat sb; char *map = 0; Elf32_Ehdr *ehdr32; Elf64_Ehdr *ehdr64; fd = open(name, O_RDWR); if (fd <= 0) { printf(" !! couldn't open %s : %s\n", name, strerror(errno)); exit(EXIT_FAILURE); } if (fstat(fd, &sb) == -1) { printf(" !! couldn't stat %s : %s\n", name, strerror(errno)); exit(EXIT_FAILURE); } if ((unsigned int) sb.st_size < sizeof(Elf32_Ehdr)) { printf(" !! file %s is too small (%u bytes) to be a valid ELF.\n", name, (unsigned int) sb.st_size); exit(EXIT_FAILURE); } map = mmap(NULL, sb.st_size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0); if (map == MAP_FAILED) { printf(" !! couldn't mmap %s : %s\n", name, strerror(errno)); exit(EXIT_FAILURE); } switch (map[EI_CLASS]) { case ELFCLASS32: ehdr32 = (Elf32_Ehdr *) map; ehdr32->e_type = ET_DYN; break; case ELFCLASS64: ehdr64 = (Elf64_Ehdr *) map; ehdr64->e_type = ET_DYN; break; default: printf(" !! unknown ELF class\n"); exit(EXIT_FAILURE); } munmap(map, sb.st_size); close(fd); return 0; } /** * Attempt to patch a ET_EXEC binary as ET_DYN, * making it suitable for use with dlopen() */ int attempt_to_patch(char *libname){ struct stat sb; int err = 0; int fdin = 0, fdout = 0; unsigned int copied = 0; char *tmp_dirname = 0; char *outlib = 0, shortname = 0; /** * Verify file exists */ if (stat(libname, &sb) == -1) { if(wsh->opt_verbose){ printf("WARNING: %s file not found\n", libname); } return 0; // Fail } // printf("%s : %u bytes\n", libname, sb.st_size); fdin = open(libname, O_RDONLY, 0700); if (fdin < 0) { fprintf(stderr, "!! ERROR : open(%s, O_RDONLY) %s\n", libname, strerror(errno)); return 0; // Fail } /** * Create temporary directory under /tmp/ * * NOTE: The directory name written to is predictable. Bug ? */ tmp_dirname = calloc(20, 1); snprintf(tmp_dirname, 19, "/tmp/.wsh-%u", getpid()); if(mkdir(tmp_dirname, 0700)){ fprintf(stderr, "!! ERROR : mkdir(%s, ...) %s\n", tmp_dirname, strerror(errno)); // return 0; // Fail } /** * Open destination file */ outlib = calloc(1, 300); snprintf(outlib, 299, "/%s/%s", tmp_dirname, basename(libname)); printf(" ** libifying %s to %s (%u bytes)\n", libname, outlib, sb.st_size); fdout = open(outlib, O_RDWR|O_CREAT|O_TRUNC, 0700); if (fdout < 0) { fprintf(stderr, "!! ERROR : open(%s, O_RDWR) %s\n", outlib, strerror(errno)); return 0; // Fail } // printf(" ** Zero copy\n"); /** * Copy binary under newly created directory, with Zero copy data (sendfile()) */ copied = sendfile(fdout, fdin, 0, sb.st_size); if(copied != sb.st_size){ fprintf(stderr, "!! ERROR: sendfile(); Copy failed: %s\n", strerror(errno)); return 0; // Fail } close(fdin); close(fdout); /** * Patch ET_EXEC into ET_DYN */ mk_lib(outlib); if(wsh->libified++ != 0){ printf("\n\n Libifying more than once per process is likely to crash...\n\n"); } return dlopen(outlib, RTLD_NOW); } /** * Do load a shared binary into the address space */ struct link_map *do_loadlib(char *libname) { struct link_map *handle = 0; unsigned long int ret = 0; if((!libname)||(!strlen(libname))){ printf("ERROR: missing name of binary to load\n"); return 0; } if (wsh->opt_verbose) { printf(" * Loading %s\n", libname); } handle = dlopen(libname, RTLD_NOW); if (!handle) { fprintf(stderr, "ERROR: dlopen() %s \n", dlerror()); // attempt to patch binary as ET_DYN if was ET_EXEC handle = attempt_to_patch(libname); if(!handle){ fprintf(stderr, "ERROR: dlopen() of patched file! %s \n", dlerror()); return 0; }else{ printf(" ** loading of libified binary succeeded\n"); } } if (wsh->opt_verbose) { // printf(" * Base address: %p for %s\n", (void *) handle->l_addr, libname); printf(" * Base address: %p\n", (void *) handle->l_addr); } dlerror(); // Clear any existing load error wsh->mainhandle = handle; // Last loaded object is always the new handle return handle; } /** * Load all preload libraries */ int wsh_loadlibs(void) { struct preload_t *p = 0, *tmp = 0; unsigned int count = 0; DL_COUNT(wsh->preload, p, count); if (wsh->opt_verbose) { printf(" -- Preloading %u binaries\n", count); } DL_FOREACH_SAFE(wsh->preload, p, tmp) { do_loadlib(p->name); } return 0; } /** * Parse command line */ int wsh_getopt(int argc, char **argv) { const char *short_opt = "hqvVx"; int count = 0; struct stat sb; int c = 0, i = 0; struct option long_opt[] = { {"help", no_argument, NULL, 'h'}, {"args", no_argument, NULL, 'x'}, {"quiet", no_argument, NULL, 'q'}, {"verbose", no_argument, NULL, 'v'}, {"version", no_argument, NULL, 'V'}, {NULL, 0, NULL, 0} }; wsh->opt_hollywood = 1; // Set sane default wsh->selflib = realpath("/proc/self/exe", 0); while ((c = getopt_long(argc, argv, short_opt, long_opt, NULL)) != -1) { count++; switch (c) { case -1: /* no more arguments */ case 0: break; case 'h': wsh_usage(argv[0]); _Exit(EXIT_SUCCESS); break; case 'q': wsh->opt_quiet = 1; break; case 'v': wsh->opt_verbose = 1; break; case 'V': wsh_print_version(); _Exit(EXIT_SUCCESS); break; case 'x': goto nomoreargs; break; default: fprintf(stderr, "%s: invalid option -- %c\n", argv[0], c); fprintf(stderr, "Try `%s --help' for more information.\n", argv[0]); _Exit(EXIT_FAILURE); }; }; nomoreargs: if (count >= argc - 1) { return 0; // no file argument } if (wsh->opt_verbose) { printf(" -- Parsing command line\n"); } for (i = count + 1; i < argc; i++) { if (!strncmp(argv[i], "-x", strlen(argv[i]))) { // Is this an argument stopper ? // Every remaining argument is a script argument add_script_arguments(argc, argv, i + 1); break; } else if (!stat(argv[i], &sb)) { // file exists. Determine if this is a binary or a script if (read_elf_sig(argv[i], &sb)) { if (wsh->opt_verbose) { printf(" * User binary %s\n", argv[i]); } add_binary_preload(argv[i]); } else { if (wsh->opt_verbose) { printf(" * User script %s\n", argv[i]); } add_script_exec(argv[i]); } } else { // Every remaining argument is a script argument add_script_arguments(argc, argv, i); break; } } // Load user profile load_profile(); return 0; } /** * Print software version */ int wsh_print_version(void) { printf("%s version:%s (%s %s)\n", WNAME, WVERSION, WTIME, WDATE); return 0; } /** * Print usage */ int wsh_usage(char *name) { printf("Usage: %s [script] [-h|-q|-v|-V] [binary1] [binary2] ... [-x [script_arg1] [script_arg2] ...]\n", name); printf("\n"); printf("Options:\n\n"); printf(" -x, --args Optional script argument separator\n"); printf(" -q, --quiet Display less output\n"); printf(" -v, --verbose Display more output\n"); printf(" -V, --version Display version and build, then exit\n"); printf("\n"); printf("Script:\n\n"); printf(" If the first argument is an existing file which is not a known binary file format,\n"); printf(" it is assumed to be a lua script and gets executed.\n"); printf("\n"); printf("Binaries:\n\n"); printf(" Any binary file name before the -x tag gets loaded before running the script.\n"); printf(" The last binary loaded is the main binary analyzed.\n"); printf("\n"); return 0; } int teletype(lua_State * L) { char *str = 0; unsigned int i = 0; read_arg1(str); printf("%s", GREEN); fflush(stdout); for(i = 0; i < strlen(str); i++){ printf("%c", str[i] & 0xff); usleep(10000); fflush(stdout); } printf("%s", NORMAL); printf("\n"); fflush(stdout); return 0; } /***** Mapping of buffers *****/ /** * string res rawmemread(addr, len) * * Read len bytes at address addr and return them as a lua string. */ int rawmemread (lua_State *L) { char *addr = 0; size_t len = 0; read_arg1(addr); read_arg2(len); if(addr == NULL){ return 0; } if((unsigned long int)addr < 4096){ return 0; } // 1st page detection lua_pushlstring(L, addr, len); return 1; } /** * int written rawmemwrite(addr, data, len) * * Raw write to addr of len bytes of data * returns number of bytes written. */ int rawmemwrite (lua_State *L) { char *addr = 0; char *data = 0; size_t len = 0; read_arg1(addr); read_arg2(data); read_arg3(len); if(addr == NULL){ return 0; } if((unsigned long int)addr < 4096){ printf("ERROR: Write to first page forbidden\n"); return 0; } // 1st page detection memmove(addr, data, len); lua_pushinteger(L, len); return 1; } /** * Returns a string, from an address passed as argument. */ int rawmemstr (lua_State *L) { char *addr = 0; read_arg1(addr); if(addr == NULL){ return 0; } if((unsigned long int)addr < 4096){ printf("ERROR: Read first page forbidden\n"); return 0; } // 1st page detection lua_pushstring(L, addr); return 1; } /** * Display memory usage. */ int rawmemusage (lua_State *L) { struct rusage usage; getrusage(RUSAGE_SELF,&usage); printf(" %s, %li\n", " maximum resident set size " , usage.ru_maxrss ); printf(" %s, %li\n", " page reclaims " , usage.ru_minflt ); printf(" %s, %li\n", " block input operations " , usage.ru_inblock ); printf(" %s, %li\n", " block output operations " , usage.ru_oublock ); printf(" %s, %li\n", " voluntary context switches " , usage.ru_nvcsw ); printf(" %s, %li\n", " involuntary context switches " , usage.ru_nivcsw ); printf("Memory usage: %ld Kb\n",usage.ru_maxrss); lua_pushinteger(L, usage.ru_maxrss); return 1; } /** * int addr rawmemaddr(obj) * * Return the address in memory of the object passed as argument. * Or returns an address itself if an address is given as argument. */ int rawmemaddr(lua_State *L) { unsigned long int len = 0; read_arg1(len); lua_pushinteger(L, len); return 1; } /** * int rawmemstrlen(addr) * Returns the length of a string passed as argument */ int rawmemstrlen(lua_State *L) { char *addr = 0; read_arg1(addr); lua_pushinteger(L, strlen(addr)); return 1; } /** * Set default environment variables in constructor */ __attribute__((constructor)) static void initialize_wsh() { printf("init\n"); setenv("LIBC_FATAL_STDERR_", "1", 1); setenv("MALLOC_CHECK_", "3", 1); } wcc-0.0.2/src/wsh/helper.c0000644000175000017500000001074413110675433013763 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #define _XOPEN_SOURCE 500 #define _FILE_OFFSET_BITS 64 #include #include #include #include #include #include #include #include #include #include #include #include #include #include extern unsigned int lastsignal; #ifndef HAS_ZFIRST #define HAS_ZFIRST 1 struct section *zfirst = 0; int nsections=0; #else extern struct section *zfirst; extern int nsections; #endif /* * Is a given address mapped ? */ int is_mapped(unsigned long int addr){ struct section *tmpsection = zfirst; while (tmpsection != 0x00) { if ((tmpsection->init <= addr) && (tmpsection->end > addr)) { // return size to end of section return tmpsection->end - addr; } tmpsection = tmpsection->next; } return 0; } /* * read /proc/pid/map */ int read_maps(int pid) { char mpath[255]; FILE *fmaps; char line[1000]; #ifdef __x86_64__ unsigned long long int initz, endz, size; #else unsigned long int initz, endz, size; #endif char *name; unsigned int counter=1; struct section *zptr; unsigned int perms, t; int delta; // path to maps file sprintf(mpath, "/proc/%d/maps", pid); fmaps = fopen(mpath, "r"); if (fmaps == NULL) { perror("[!!] Error reading maps file"); exit(1); } while ( fgets ( line, sizeof line, fmaps ) != NULL ) { #ifdef __x86_64__ // we first need to check if the possible address is a 32 or 64 one initz = strtoul(line, NULL, 16); endz = strtoul(strchr(line, '-')+1, NULL, 16); size = endz - initz; delta=strchr(line, ' ')-line; #else delta=18; endz = strtoull(line + 9, NULL, 16); initz = strtoull(line + 0, NULL, 16); size = endz - initz; #endif // find permissions perms = 0; char hperms[5]; memset(hperms,0x00,5); memcpy(hperms,line+delta,4); for (t = 0; t < 4; t++) { switch (line[t + delta]) { case 'r': perms += 2; /*printf(" read "); */ break; case 'w': perms += 4; /*printf(" write "); */ break; case 'x': perms += 1; /*printf(" execute "); */ break; case 'p': /*printf(" private "); */ break; case 's': perms += 8; /*printf(" shared "); */ break; } } // find name strtok(line, " "); for (t=0;t<5;t++) { name = strtok(NULL, " "); } // Remove leading spaces while(*name != '\0' && isspace(*name)) { ++name; } // Remove trailing newline name[strlen(name) - 1] = '\0'; // Omit vsyscall as pread fails for the last address if (!strncmp("[vsyscall]", name,10)) continue; // add to linked list zptr = (struct section *)malloc(sizeof(struct section)); memset(zptr, 0x00, sizeof(struct section)); zptr->init = initz; zptr->end = endz; zptr->size = size; zptr->perms = perms; strcpy(zptr->hperms, hperms); zptr->num=counter++; strcpy(zptr->name, name); if (zfirst == 0x00) { // we are first zfirst = zptr; } else { // append struct section *tmpsection = zfirst; while (tmpsection->next != 0x00) { tmpsection = tmpsection->next; } tmpsection->next = zptr; } } fclose(fmaps); nsections=counter-1; return 0; } wcc-0.0.2/src/wld/0000755000175000017500000000000013110675433012317 5ustar philphilwcc-0.0.2/src/wld/Makefile0000644000175000017500000000153713110675433013765 0ustar philphil# # This file is part of the Witchcraft Compiler Collection # Copyright 2016 Jonathan Brossard # # Homepage: https://github.com/endrazine/wcc/ # # This file is licensed under MIT License. # # Note: # You will need to provide your own 32b static library for libbfd if you # want to cross compile to 32b intel from amd64. Simply installing # the 32b library on top of a 64b system using apt-get breaks ubuntu. # # Note that the 64b version and 32b versions alike can process # any ELF (from any architecture/OS/endianess). # all:: $(CC) $(CFLAGS) wld.c -o wld -lbfd # $(CC) $(CFLAGS) wld.c -o wld32 -m32 ../lib32/usr/lib/libbfd.a cp wld ../../bin/ # cp wld32 ../../bin/ test: clean: rm -f wld wld32 a.out install: cp wld $(DESTDIR)/usr/bin/wld # cp wld32 $(DESTDIR)/usr/bin/wld32 uninstall: rm $(DESTDIR)/usr/bin/wld -f # rm $(DESTDIR)/usr/bin/wld32 -f wcc-0.0.2/src/wld/wld.c0000644000175000017500000000651113110675433013254 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define DEFAULT_NAME "wld" /** * Patch ELF ehdr->e_type to ET_DYN */ int mk_lib(char *name) { int fd; struct stat sb; char *map = 0; Elf32_Ehdr *ehdr32; Elf64_Ehdr *ehdr64; fd = open(name, O_RDWR); if (fd <= 0) { printf(" !! couldn't open %s : %s\n", name, strerror(errno)); exit(EXIT_FAILURE); } if (fstat(fd, &sb) == -1) { printf(" !! couldn't stat %s : %s\n", name, strerror(errno)); exit(EXIT_FAILURE); } if ((unsigned int) sb.st_size < sizeof(Elf32_Ehdr)) { printf(" !! file %s is too small (%u bytes) to be a valid ELF.\n", name, (unsigned int) sb.st_size); exit(EXIT_FAILURE); } map = mmap(NULL, sb.st_size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0); if (map == MAP_FAILED) { printf(" !! couldn't mmap %s : %s\n", name, strerror(errno)); exit(EXIT_FAILURE); } switch (map[EI_CLASS]) { case ELFCLASS32: ehdr32 = (Elf32_Ehdr *) map; ehdr32->e_type = ET_DYN; break; case ELFCLASS64: ehdr64 = (Elf64_Ehdr *) map; ehdr64->e_type = ET_DYN; break; default: printf(" !! unknown ELF class\n"); exit(EXIT_FAILURE); } munmap(map, sb.st_size); close(fd); return 0; } int print_version(void) { printf("%s version:%s (%s %s)\n", WNAME, WVERSION, WTIME, WDATE); return 0; } int main(int argc, char **argv) { if ((argc < 2)||(strncmp(argv[1],"-libify",7))) { print_version(); printf("\nUsage: %s [options] file\n", argc > 0 ? argv[0] : DEFAULT_NAME); printf("\noptions:\n\n -libify Set Class to ET_DYN in input ELF file.\n\n"); exit(EXIT_FAILURE); } mk_lib(argv[2]); return 0; } wcc-0.0.2/src/tex/0000755000175000017500000000000013110675433012331 5ustar philphilwcc-0.0.2/src/tex/project.cfg0000644000175000017500000021566213110675433014474 0ustar philphil# Doxyfile 1.7.4 # This file describes the settings to be used by the documentation system # doxygen (www.doxygen.org) for a project. # # All text after a hash (#) is considered a comment and will be ignored. # The format is: # TAG = value [value, ...] # For lists items can also be appended using: # TAG += value [value, ...] # Values that contain spaces should be placed between quotes (" "). #--------------------------------------------------------------------------- # Project related configuration options #--------------------------------------------------------------------------- # This tag specifies the encoding used for all characters in the config file # that follow. The default is UTF-8 which is also the encoding used for all # text before the first occurrence of this tag. Doxygen uses libiconv (or the # iconv built into libc) for the transcoding. See # http://www.gnu.org/software/libiconv for the list of possible encodings. DOXYFILE_ENCODING = UTF-8 # The PROJECT_NAME tag is a single word (or a sequence of words surrounded # by quotes) that should identify the project. PROJECT_NAME = "The Witchcraft Compiler Collection" # The PROJECT_NUMBER tag can be used to enter a project or revision number. # This could be handy for archiving the generated documentation or # if some version control system is used. PROJECT_NUMBER = # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer # a quick idea about the purpose of the project. Keep the description short. PROJECT_BRIEF = "WCC" # With the PROJECT_LOGO tag one can specify an logo or icon that is # included in the documentation. The maximum height of the logo should not # exceed 55 pixels and the maximum width should not exceed 200 pixels. # Doxygen will copy the logo to the output directory. PROJECT_LOGO = # The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) # base path where the generated documentation will be put. # If a relative path is entered, it will be relative to the location # where doxygen was started. If left blank the current directory will be used. OUTPUT_DIRECTORY = ../doc # If the CREATE_SUBDIRS tag is set to YES, then doxygen will create # 4096 sub-directories (in 2 levels) under the output directory of each output # format and will distribute the generated files over these directories. # Enabling this option can be useful when feeding doxygen a huge amount of # source files, where putting all generated files in the same directory would # otherwise cause performance problems for the file system. CREATE_SUBDIRS = NO # The OUTPUT_LANGUAGE tag is used to specify the language in which all # documentation generated by doxygen is written. Doxygen will use this # information to generate all constant output in the proper language. # The default language is English, other supported languages are: # Afrikaans, Arabic, Brazilian, Catalan, Chinese, Chinese-Traditional, # Croatian, Czech, Danish, Dutch, Esperanto, Farsi, Finnish, French, German, # Greek, Hungarian, Italian, Japanese, Japanese-en (Japanese with English # messages), Korean, Korean-en, Lithuanian, Norwegian, Macedonian, Persian, # Polish, Portuguese, Romanian, Russian, Serbian, Serbian-Cyrillic, Slovak, # Slovene, Spanish, Swedish, Ukrainian, and Vietnamese. OUTPUT_LANGUAGE = English # If the BRIEF_MEMBER_DESC tag is set to YES (the default) Doxygen will # include brief member descriptions after the members that are listed in # the file and class documentation (similar to JavaDoc). # Set to NO to disable this. BRIEF_MEMBER_DESC = YES # If the REPEAT_BRIEF tag is set to YES (the default) Doxygen will prepend # the brief description of a member or function before the detailed description. # Note: if both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the # brief descriptions will be completely suppressed. REPEAT_BRIEF = YES # This tag implements a quasi-intelligent brief description abbreviator # that is used to form the text in various listings. Each string # in this list, if found as the leading text of the brief description, will be # stripped from the text and the result after processing the whole list, is # used as the annotated text. Otherwise, the brief description is used as-is. # If left blank, the following values are used ("$name" is automatically # replaced with the name of the entity): "The $name class" "The $name widget" # "The $name file" "is" "provides" "specifies" "contains" # "represents" "a" "an" "the" ABBREVIATE_BRIEF = # If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then # Doxygen will generate a detailed section even if there is only a brief # description. ALWAYS_DETAILED_SEC = NO # If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all # inherited members of a class in the documentation of that class as if those # members were ordinary class members. Constructors, destructors and assignment # operators of the base classes will not be shown. INLINE_INHERITED_MEMB = NO # If the FULL_PATH_NAMES tag is set to YES then Doxygen will prepend the full # path before files name in the file list and in the header files. If set # to NO the shortest path that makes the file name unique will be used. FULL_PATH_NAMES = YES # If the FULL_PATH_NAMES tag is set to YES then the STRIP_FROM_PATH tag # can be used to strip a user-defined part of the path. Stripping is # only done if one of the specified strings matches the left-hand part of # the path. The tag can be used to show relative paths in the file list. # If left blank the directory from which doxygen is run is used as the # path to strip. STRIP_FROM_PATH = # The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of # the path mentioned in the documentation of a class, which tells # the reader which header file to include in order to use a class. # If left blank only the name of the header file containing the class # definition is used. Otherwise one should specify the include paths that # are normally passed to the compiler using the -I flag. STRIP_FROM_INC_PATH = # If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter # (but less readable) file names. This can be useful if your file system # doesn't support long names like on DOS, Mac, or CD-ROM. SHORT_NAMES = NO # If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen # will interpret the first line (until the first dot) of a JavaDoc-style # comment as the brief description. If set to NO, the JavaDoc # comments will behave just like regular Qt-style comments # (thus requiring an explicit @brief command for a brief description.) JAVADOC_AUTOBRIEF = NO # If the QT_AUTOBRIEF tag is set to YES then Doxygen will # interpret the first line (until the first dot) of a Qt-style # comment as the brief description. If set to NO, the comments # will behave just like regular Qt-style comments (thus requiring # an explicit \brief command for a brief description.) QT_AUTOBRIEF = NO # The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen # treat a multi-line C++ special comment block (i.e. a block of //! or /// # comments) as a brief description. This used to be the default behaviour. # The new default is to treat a multi-line C++ comment block as a detailed # description. Set this tag to YES if you prefer the old behaviour instead. MULTILINE_CPP_IS_BRIEF = NO # If the INHERIT_DOCS tag is set to YES (the default) then an undocumented # member inherits the documentation from any documented member that it # re-implements. INHERIT_DOCS = YES # If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce # a new page for each member. If set to NO, the documentation of a member will # be part of the file/class/namespace that contains it. SEPARATE_MEMBER_PAGES = NO # The TAB_SIZE tag can be used to set the number of spaces in a tab. # Doxygen uses this value to replace tabs by spaces in code fragments. TAB_SIZE = 8 # This tag can be used to specify a number of aliases that acts # as commands in the documentation. An alias has the form "name=value". # For example adding "sideeffect=\par Side Effects:\n" will allow you to # put the command \sideeffect (or @sideeffect) in the documentation, which # will result in a user-defined paragraph with heading "Side Effects:". # You can put \n's in the value part of an alias to insert newlines. ALIASES = # Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C # sources only. Doxygen will then generate output that is more tailored for C. # For instance, some of the names that are used will be different. The list # of all members will be omitted, etc. OPTIMIZE_OUTPUT_FOR_C = YES # Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java # sources only. Doxygen will then generate output that is more tailored for # Java. For instance, namespaces will be presented as packages, qualified # scopes will look different, etc. OPTIMIZE_OUTPUT_JAVA = NO # Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran # sources only. Doxygen will then generate output that is more tailored for # Fortran. OPTIMIZE_FOR_FORTRAN = NO # Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL # sources. Doxygen will then generate output that is tailored for # VHDL. OPTIMIZE_OUTPUT_VHDL = NO # Doxygen selects the parser to use depending on the extension of the files it # parses. With this tag you can assign which parser to use for a given extension. # Doxygen has a built-in mapping, but you can override or extend it using this # tag. The format is ext=language, where ext is a file extension, and language # is one of the parsers supported by doxygen: IDL, Java, Javascript, CSharp, C, # C++, D, PHP, Objective-C, Python, Fortran, VHDL, C, C++. For instance to make # doxygen treat .inc files as Fortran files (default is PHP), and .f files as C # (default is Fortran), use: inc=Fortran f=C. Note that for custom extensions # you also need to set FILE_PATTERNS otherwise the files are not read by doxygen. EXTENSION_MAPPING = C # If you use STL classes (i.e. std::string, std::vector, etc.) but do not want # to include (a tag file for) the STL sources as input, then you should # set this tag to YES in order to let doxygen match functions declarations and # definitions whose arguments contain STL classes (e.g. func(std::string); v.s. # func(std::string) {}). This also makes the inheritance and collaboration # diagrams that involve STL classes more complete and accurate. BUILTIN_STL_SUPPORT = NO # If you use Microsoft's C++/CLI language, you should set this option to YES to # enable parsing support. CPP_CLI_SUPPORT = NO # Set the SIP_SUPPORT tag to YES if your project consists of sip sources only. # Doxygen will parse them like normal C++ but will assume all classes use public # instead of private inheritance when no explicit protection keyword is present. SIP_SUPPORT = NO # For Microsoft's IDL there are propget and propput attributes to indicate getter # and setter methods for a property. Setting this option to YES (the default) # will make doxygen replace the get and set methods by a property in the # documentation. This will only work if the methods are indeed getting or # setting a simple type. If this is not the case, or you want to show the # methods anyway, you should set this option to NO. IDL_PROPERTY_SUPPORT = YES # If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC # tag is set to YES, then doxygen will reuse the documentation of the first # member in the group (if any) for the other members of the group. By default # all members of a group must be documented explicitly. DISTRIBUTE_GROUP_DOC = NO # Set the SUBGROUPING tag to YES (the default) to allow class member groups of # the same type (for instance a group of public functions) to be put as a # subgroup of that type (e.g. under the Public Functions section). Set it to # NO to prevent subgrouping. Alternatively, this can be done per class using # the \nosubgrouping command. SUBGROUPING = YES # When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and # unions are shown inside the group in which they are included (e.g. using # @ingroup) instead of on a separate page (for HTML and Man pages) or # section (for LaTeX and RTF). INLINE_GROUPED_CLASSES = NO # When TYPEDEF_HIDES_STRUCT is enabled, a typedef of a struct, union, or enum # is documented as struct, union, or enum with the name of the typedef. So # typedef struct TypeS {} TypeT, will appear in the documentation as a struct # with name TypeT. When disabled the typedef will appear as a member of a file, # namespace, or class. And the struct will be named TypeS. This can typically # be useful for C code in case the coding convention dictates that all compound # types are typedef'ed and only the typedef is referenced, never the tag name. TYPEDEF_HIDES_STRUCT = NO # The SYMBOL_CACHE_SIZE determines the size of the internal cache use to # determine which symbols to keep in memory and which to flush to disk. # When the cache is full, less often used symbols will be written to disk. # For small to medium size projects (<1000 input files) the default value is # probably good enough. For larger projects a too small cache size can cause # doxygen to be busy swapping symbols to and from disk most of the time # causing a significant performance penalty. # If the system has enough physical memory increasing the cache will improve the # performance by keeping more symbols in memory. Note that the value works on # a logarithmic scale so increasing the size by one will roughly double the # memory usage. The cache size is given by this formula: # 2^(16+SYMBOL_CACHE_SIZE). The valid range is 0..9, the default is 0, # corresponding to a cache size of 2^16 = 65536 symbols SYMBOL_CACHE_SIZE = 0 #--------------------------------------------------------------------------- # Build related configuration options #--------------------------------------------------------------------------- # If the EXTRACT_ALL tag is set to YES doxygen will assume all entities in # documentation are documented, even if no documentation was available. # Private class members and static file members will be hidden unless # the EXTRACT_PRIVATE and EXTRACT_STATIC tags are set to YES EXTRACT_ALL = YES # If the EXTRACT_PRIVATE tag is set to YES all private members of a class # will be included in the documentation. EXTRACT_PRIVATE = NO # If the EXTRACT_STATIC tag is set to YES all static members of a file # will be included in the documentation. EXTRACT_STATIC = NO # If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs) # defined locally in source files will be included in the documentation. # If set to NO only classes defined in header files are included. EXTRACT_LOCAL_CLASSES = YES # This flag is only useful for Objective-C code. When set to YES local # methods, which are defined in the implementation section but not in # the interface are included in the documentation. # If set to NO (the default) only methods in the interface are included. EXTRACT_LOCAL_METHODS = NO # If this flag is set to YES, the members of anonymous namespaces will be # extracted and appear in the documentation as a namespace called # 'anonymous_namespace{file}', where file will be replaced with the base # name of the file that contains the anonymous namespace. By default # anonymous namespaces are hidden. EXTRACT_ANON_NSPACES = NO # If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all # undocumented members of documented classes, files or namespaces. # If set to NO (the default) these members will be included in the # various overviews, but no documentation section is generated. # This option has no effect if EXTRACT_ALL is enabled. HIDE_UNDOC_MEMBERS = NO # If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all # undocumented classes that are normally visible in the class hierarchy. # If set to NO (the default) these classes will be included in the various # overviews. This option has no effect if EXTRACT_ALL is enabled. HIDE_UNDOC_CLASSES = NO # If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all # friend (class|struct|union) declarations. # If set to NO (the default) these declarations will be included in the # documentation. HIDE_FRIEND_COMPOUNDS = NO # If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any # documentation blocks found inside the body of a function. # If set to NO (the default) these blocks will be appended to the # function's detailed documentation block. HIDE_IN_BODY_DOCS = NO # The INTERNAL_DOCS tag determines if documentation # that is typed after a \internal command is included. If the tag is set # to NO (the default) then the documentation will be excluded. # Set it to YES to include the internal documentation. INTERNAL_DOCS = NO # If the CASE_SENSE_NAMES tag is set to NO then Doxygen will only generate # file names in lower-case letters. If set to YES upper-case letters are also # allowed. This is useful if you have classes or files whose names only differ # in case and if your file system supports case sensitive file names. Windows # and Mac users are advised to set this option to NO. CASE_SENSE_NAMES = YES # If the HIDE_SCOPE_NAMES tag is set to NO (the default) then Doxygen # will show members with their full class and namespace scopes in the # documentation. If set to YES the scope will be hidden. HIDE_SCOPE_NAMES = NO # If the SHOW_INCLUDE_FILES tag is set to YES (the default) then Doxygen # will put a list of the files that are included by a file in the documentation # of that file. SHOW_INCLUDE_FILES = YES # If the FORCE_LOCAL_INCLUDES tag is set to YES then Doxygen # will list include files with double quotes in the documentation # rather than with sharp brackets. FORCE_LOCAL_INCLUDES = NO # If the INLINE_INFO tag is set to YES (the default) then a tag [inline] # is inserted in the documentation for inline members. INLINE_INFO = YES # If the SORT_MEMBER_DOCS tag is set to YES (the default) then doxygen # will sort the (detailed) documentation of file and class members # alphabetically by member name. If set to NO the members will appear in # declaration order. SORT_MEMBER_DOCS = YES # If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the # brief documentation of file, namespace and class members alphabetically # by member name. If set to NO (the default) the members will appear in # declaration order. SORT_BRIEF_DOCS = NO # If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen # will sort the (brief and detailed) documentation of class members so that # constructors and destructors are listed first. If set to NO (the default) # the constructors will appear in the respective orders defined by # SORT_MEMBER_DOCS and SORT_BRIEF_DOCS. # This tag will be ignored for brief docs if SORT_BRIEF_DOCS is set to NO # and ignored for detailed docs if SORT_MEMBER_DOCS is set to NO. SORT_MEMBERS_CTORS_1ST = NO # If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the # hierarchy of group names into alphabetical order. If set to NO (the default) # the group names will appear in their defined order. SORT_GROUP_NAMES = NO # If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be # sorted by fully-qualified names, including namespaces. If set to # NO (the default), the class list will be sorted only by class name, # not including the namespace part. # Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. # Note: This option applies only to the class list, not to the # alphabetical list. SORT_BY_SCOPE_NAME = NO # If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to # do proper type resolution of all parameters of a function it will reject a # match between the prototype and the implementation of a member function even # if there is only one candidate or it is obvious which candidate to choose # by doing a simple string match. By disabling STRICT_PROTO_MATCHING doxygen # will still accept a match between prototype and implementation in such cases. STRICT_PROTO_MATCHING = NO # The GENERATE_TODOLIST tag can be used to enable (YES) or # disable (NO) the todo list. This list is created by putting \todo # commands in the documentation. GENERATE_TODOLIST = YES # The GENERATE_TESTLIST tag can be used to enable (YES) or # disable (NO) the test list. This list is created by putting \test # commands in the documentation. GENERATE_TESTLIST = YES # The GENERATE_BUGLIST tag can be used to enable (YES) or # disable (NO) the bug list. This list is created by putting \bug # commands in the documentation. GENERATE_BUGLIST = YES # The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or # disable (NO) the deprecated list. This list is created by putting # \deprecated commands in the documentation. GENERATE_DEPRECATEDLIST= YES # The ENABLED_SECTIONS tag can be used to enable conditional # documentation sections, marked by \if sectionname ... \endif. ENABLED_SECTIONS = # The MAX_INITIALIZER_LINES tag determines the maximum number of lines # the initial value of a variable or macro consists of for it to appear in # the documentation. If the initializer consists of more lines than specified # here it will be hidden. Use a value of 0 to hide initializers completely. # The appearance of the initializer of individual variables and macros in the # documentation can be controlled using \showinitializer or \hideinitializer # command in the documentation regardless of this setting. MAX_INITIALIZER_LINES = 30 # Set the SHOW_USED_FILES tag to NO to disable the list of files generated # at the bottom of the documentation of classes and structs. If set to YES the # list will mention the files that were used to generate the documentation. SHOW_USED_FILES = YES # If the sources in your project are distributed over multiple directories # then setting the SHOW_DIRECTORIES tag to YES will show the directory hierarchy # in the documentation. The default is NO. SHOW_DIRECTORIES = NO # Set the SHOW_FILES tag to NO to disable the generation of the Files page. # This will remove the Files entry from the Quick Index and from the # Folder Tree View (if specified). The default is YES. SHOW_FILES = YES # Set the SHOW_NAMESPACES tag to NO to disable the generation of the # Namespaces page. # This will remove the Namespaces entry from the Quick Index # and from the Folder Tree View (if specified). The default is YES. SHOW_NAMESPACES = YES # The FILE_VERSION_FILTER tag can be used to specify a program or script that # doxygen should invoke to get the current version for each file (typically from # the version control system). Doxygen will invoke the program by executing (via # popen()) the command , where is the value of # the FILE_VERSION_FILTER tag, and is the name of an input file # provided by doxygen. Whatever the program writes to standard output # is used as the file version. See the manual for examples. FILE_VERSION_FILTER = # The LAYOUT_FILE tag can be used to specify a layout file which will be parsed # by doxygen. The layout file controls the global structure of the generated # output files in an output format independent way. The create the layout file # that represents doxygen's defaults, run doxygen with the -l option. # You can optionally specify a file name after the option, if omitted # DoxygenLayout.xml will be used as the name of the layout file. LAYOUT_FILE = #--------------------------------------------------------------------------- # configuration options related to warning and progress messages #--------------------------------------------------------------------------- # The QUIET tag can be used to turn on/off the messages that are generated # by doxygen. Possible values are YES and NO. If left blank NO is used. QUIET = YES # The WARNINGS tag can be used to turn on/off the warning messages that are # generated by doxygen. Possible values are YES and NO. If left blank # NO is used. WARNINGS = YES # If WARN_IF_UNDOCUMENTED is set to YES, then doxygen will generate warnings # for undocumented members. If EXTRACT_ALL is set to YES then this flag will # automatically be disabled. WARN_IF_UNDOCUMENTED = YES # If WARN_IF_DOC_ERROR is set to YES, doxygen will generate warnings for # potential errors in the documentation, such as not documenting some # parameters in a documented function, or documenting parameters that # don't exist or using markup commands wrongly. WARN_IF_DOC_ERROR = YES # The WARN_NO_PARAMDOC option can be enabled to get warnings for # functions that are documented, but have no documentation for their parameters # or return value. If set to NO (the default) doxygen will only warn about # wrong or incomplete parameter documentation, but not about the absence of # documentation. WARN_NO_PARAMDOC = NO # The WARN_FORMAT tag determines the format of the warning messages that # doxygen can produce. The string should contain the $file, $line, and $text # tags, which will be replaced by the file and line number from which the # warning originated and the warning text. Optionally the format may contain # $version, which will be replaced by the version of the file (if it could # be obtained via FILE_VERSION_FILTER) WARN_FORMAT = "$file:$line: $text" # The WARN_LOGFILE tag can be used to specify a file to which warning # and error messages should be written. If left blank the output is written # to stderr. WARN_LOGFILE = #--------------------------------------------------------------------------- # configuration options related to the input files #--------------------------------------------------------------------------- # The INPUT tag can be used to specify the files and/or directories that contain # documented source files. You may enter file names like "myfile.cpp" or # directories like "/usr/src/myproject". Separate the files or directories # with spaces. INPUT = # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding, which is # also the default input encoding. Doxygen uses libiconv (or the iconv built # into libc) for the transcoding. See http://www.gnu.org/software/libiconv for # the list of possible encodings. INPUT_ENCODING = UTF-8 # If the value of the INPUT tag contains directories, you can use the # FILE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp # and *.h) to filter out the source-files in the directories. If left # blank the following patterns are tested: # *.c *.cc *.cxx *.cpp *.c++ *.d *.java *.ii *.ixx *.ipp *.i++ *.inl *.h *.hh # *.hxx *.hpp *.h++ *.idl *.odl *.cs *.php *.php3 *.inc *.m *.mm *.dox *.py # *.f90 *.f *.for *.vhd *.vhdl FILE_PATTERNS = # The RECURSIVE tag can be used to turn specify whether or not subdirectories # should be searched for input files as well. Possible values are YES and NO. # If left blank NO is used. RECURSIVE = YES # The EXCLUDE tag can be used to specify files and/or directories that should # excluded from the INPUT source files. This way you can easily exclude a # subdirectory from a directory tree whose root is specified with the INPUT tag. EXCLUDE = fuzzing notes regression_tests # The EXCLUDE_SYMLINKS tag can be used select whether or not files or # directories that are symbolic links (a Unix file system feature) are excluded # from the input. EXCLUDE_SYMLINKS = NO # If the value of the INPUT tag contains directories, you can use the # EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude # certain files from those directories. Note that the wildcards are matched # against the file with absolute path, so to exclude all test directories # for example use the pattern */test/* EXCLUDE_PATTERNS = */.git/* EXCLUDE_PATTERNS += */lua/* EXCLUDE_PATTERNS += */luajit-2.0/* EXCLUDE_PATTERNS += */openlibm/* EXCLUDE_PATTERNS += */linenoise/* EXCLUDE_PATTERNS += */tests/* # The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names # (namespaces, classes, functions, etc.) that should be excluded from the # output. The symbol name can be a fully qualified name, a word, or if the # wildcard * is used, a substring. Examples: ANamespace, AClass, # AClass::ANamespace, ANamespace::*Test EXCLUDE_SYMBOLS = # The EXAMPLE_PATH tag can be used to specify one or more files or # directories that contain example code fragments that are included (see # the \include command). EXAMPLE_PATH = # If the value of the EXAMPLE_PATH tag contains directories, you can use the # EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp # and *.h) to filter out the source-files in the directories. If left # blank all files are included. EXAMPLE_PATTERNS = # If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be # searched for input files to be used with the \include or \dontinclude # commands irrespective of the value of the RECURSIVE tag. # Possible values are YES and NO. If left blank NO is used. EXAMPLE_RECURSIVE = NO # The IMAGE_PATH tag can be used to specify one or more files or # directories that contain image that are included in the documentation (see # the \image command). IMAGE_PATH = # The INPUT_FILTER tag can be used to specify a program that doxygen should # invoke to filter for each input file. Doxygen will invoke the filter program # by executing (via popen()) the command , where # is the value of the INPUT_FILTER tag, and is the name of an # input file. Doxygen will then use the output that the filter program writes # to standard output. # If FILTER_PATTERNS is specified, this tag will be # ignored. INPUT_FILTER = # The FILTER_PATTERNS tag can be used to specify filters on a per file pattern # basis. # Doxygen will compare the file name with each pattern and apply the # filter if there is a match. # The filters are a list of the form: # pattern=filter (like *.cpp=my_cpp_filter). See INPUT_FILTER for further # info on how filters are used. If FILTER_PATTERNS is empty or if # non of the patterns match the file name, INPUT_FILTER is applied. FILTER_PATTERNS = # If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using # INPUT_FILTER) will be used to filter the input files when producing source # files to browse (i.e. when SOURCE_BROWSER is set to YES). FILTER_SOURCE_FILES = NO # The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file # pattern. A pattern will override the setting for FILTER_PATTERN (if any) # and it is also possible to disable source filtering for a specific pattern # using *.ext= (so without naming a filter). This option only has effect when # FILTER_SOURCE_FILES is enabled. FILTER_SOURCE_PATTERNS = #--------------------------------------------------------------------------- # configuration options related to source browsing #--------------------------------------------------------------------------- # If the SOURCE_BROWSER tag is set to YES then a list of source files will # be generated. Documented entities will be cross-referenced with these sources. # Note: To get rid of all source code in the generated output, make sure also # VERBATIM_HEADERS is set to NO. SOURCE_BROWSER = YES # Setting the INLINE_SOURCES tag to YES will include the body # of functions and classes directly in the documentation. INLINE_SOURCES = NO # Setting the STRIP_CODE_COMMENTS tag to YES (the default) will instruct # doxygen to hide any special comment blocks from generated source code # fragments. Normal C and C++ comments will always remain visible. STRIP_CODE_COMMENTS = YES # If the REFERENCED_BY_RELATION tag is set to YES # then for each documented function all documented # functions referencing it will be listed. REFERENCED_BY_RELATION = NO # If the REFERENCES_RELATION tag is set to YES # then for each documented function all documented entities # called/used by that function will be listed. REFERENCES_RELATION = NO # If the REFERENCES_LINK_SOURCE tag is set to YES (the default) # and SOURCE_BROWSER tag is set to YES, then the hyperlinks from # functions in REFERENCES_RELATION and REFERENCED_BY_RELATION lists will # link to the source code. # Otherwise they will link to the documentation. REFERENCES_LINK_SOURCE = YES # If the USE_HTAGS tag is set to YES then the references to source code # will point to the HTML generated by the htags(1) tool instead of doxygen # built-in source browser. The htags tool is part of GNU's global source # tagging system (see http://www.gnu.org/software/global/global.html). You # will need version 4.8.6 or higher. USE_HTAGS = NO # If the VERBATIM_HEADERS tag is set to YES (the default) then Doxygen # will generate a verbatim copy of the header file for each class for # which an include is specified. Set to NO to disable this. VERBATIM_HEADERS = YES #--------------------------------------------------------------------------- # configuration options related to the alphabetical class index #--------------------------------------------------------------------------- # If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index # of all compounds will be generated. Enable this if the project # contains a lot of classes, structs, unions or interfaces. ALPHABETICAL_INDEX = YES # If the alphabetical index is enabled (see ALPHABETICAL_INDEX) then # the COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns # in which this list will be split (can be a number in the range [1..20]) COLS_IN_ALPHA_INDEX = 5 # In case all classes in a project start with a common prefix, all # classes will be put under the same header in the alphabetical index. # The IGNORE_PREFIX tag can be used to specify one or more prefixes that # should be ignored while generating the index headers. IGNORE_PREFIX = #--------------------------------------------------------------------------- # configuration options related to the HTML output #--------------------------------------------------------------------------- # If the GENERATE_HTML tag is set to YES (the default) Doxygen will # generate HTML output. GENERATE_HTML = YES # The HTML_OUTPUT tag is used to specify where the HTML docs will be put. # If a relative path is entered the value of OUTPUT_DIRECTORY will be # put in front of it. If left blank `html' will be used as the default path. HTML_OUTPUT = html # The HTML_FILE_EXTENSION tag can be used to specify the file extension for # each generated HTML page (for example: .htm,.php,.asp). If it is left blank # doxygen will generate files with .html extension. HTML_FILE_EXTENSION = .html # The HTML_HEADER tag can be used to specify a personal HTML header for # each generated HTML page. If it is left blank doxygen will generate a # standard header. Note that when using a custom header you are responsible # for the proper inclusion of any scripts and style sheets that doxygen # needs, which is dependent on the configuration options used. # It is adviced to generate a default header using "doxygen -w html # header.html footer.html stylesheet.css YourConfigFile" and then modify # that header. Note that the header is subject to change so you typically # have to redo this when upgrading to a newer version of doxygen or when changing the value of configuration settings such as GENERATE_TREEVIEW! HTML_HEADER = # The HTML_FOOTER tag can be used to specify a personal HTML footer for # each generated HTML page. If it is left blank doxygen will generate a # standard footer. HTML_FOOTER = # The HTML_STYLESHEET tag can be used to specify a user-defined cascading # style sheet that is used by each HTML page. It can be used to # fine-tune the look of the HTML output. If the tag is left blank doxygen # will generate a default style sheet. Note that doxygen will try to copy # the style sheet file to the HTML output directory, so don't put your own # stylesheet in the HTML output directory as well, or it will be erased! HTML_STYLESHEET = # The HTML_EXTRA_FILES tag can be used to specify one or more extra images or # other source files which should be copied to the HTML output directory. Note # that these files will be copied to the base HTML output directory. Use the # $relpath$ marker in the HTML_HEADER and/or HTML_FOOTER files to load these # files. In the HTML_STYLESHEET file, use the file name only. Also note that # the files will be copied as-is; there are no commands or markers available. HTML_EXTRA_FILES = # The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. # Doxygen will adjust the colors in the stylesheet and background images # according to this color. Hue is specified as an angle on a colorwheel, # see http://en.wikipedia.org/wiki/Hue for more information. # For instance the value 0 represents red, 60 is yellow, 120 is green, # 180 is cyan, 240 is blue, 300 purple, and 360 is red again. # The allowed range is 0 to 359. HTML_COLORSTYLE_HUE = 220 # The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of # the colors in the HTML output. For a value of 0 the output will use # grayscales only. A value of 255 will produce the most vivid colors. HTML_COLORSTYLE_SAT = 100 # The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to # the luminance component of the colors in the HTML output. Values below # 100 gradually make the output lighter, whereas values above 100 make # the output darker. The value divided by 100 is the actual gamma applied, # so 80 represents a gamma of 0.8, The value 220 represents a gamma of 2.2, # and 100 does not change the gamma. HTML_COLORSTYLE_GAMMA = 80 # If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML # page will contain the date and time when the page was generated. Setting # this to NO can help when comparing the output of multiple runs. HTML_TIMESTAMP = YES # If the HTML_ALIGN_MEMBERS tag is set to YES, the members of classes, # files or namespaces will be aligned in HTML using tables. If set to # NO a bullet list will be used. HTML_ALIGN_MEMBERS = YES # If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML # documentation will contain sections that can be hidden and shown after the # page has loaded. For this to work a browser that supports # JavaScript and DHTML is required (for instance Mozilla 1.0+, Firefox # Netscape 6.0+, Internet explorer 5.0+, Konqueror, or Safari). HTML_DYNAMIC_SECTIONS = NO # If the GENERATE_DOCSET tag is set to YES, additional index files # will be generated that can be used as input for Apple's Xcode 3 # integrated development environment, introduced with OSX 10.5 (Leopard). # To create a documentation set, doxygen will generate a Makefile in the # HTML output directory. Running make will produce the docset in that # directory and running "make install" will install the docset in # ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find # it at startup. # See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html # for more information. GENERATE_DOCSET = NO # When GENERATE_DOCSET tag is set to YES, this tag determines the name of the # feed. A documentation feed provides an umbrella under which multiple # documentation sets from a single provider (such as a company or product suite) # can be grouped. DOCSET_FEEDNAME = "Doxygen generated docs" # When GENERATE_DOCSET tag is set to YES, this tag specifies a string that # should uniquely identify the documentation set bundle. This should be a # reverse domain-name style string, e.g. com.mycompany.MyDocSet. Doxygen # will append .docset to the name. DOCSET_BUNDLE_ID = org.doxygen.Project # When GENERATE_PUBLISHER_ID tag specifies a string that should uniquely identify # the documentation publisher. This should be a reverse domain-name style # string, e.g. com.mycompany.MyDocSet.documentation. DOCSET_PUBLISHER_ID = org.doxygen.Publisher # The GENERATE_PUBLISHER_NAME tag identifies the documentation publisher. DOCSET_PUBLISHER_NAME = "Jonathan Brossard // endrazine@gmail.com" # If the GENERATE_HTMLHELP tag is set to YES, additional index files # will be generated that can be used as input for tools like the # Microsoft HTML help workshop to generate a compiled HTML help file (.chm) # of the generated HTML documentation. GENERATE_HTMLHELP = NO # If the GENERATE_HTMLHELP tag is set to YES, the CHM_FILE tag can # be used to specify the file name of the resulting .chm file. You # can add a path in front of the file if the result should not be # written to the html output directory. CHM_FILE = # If the GENERATE_HTMLHELP tag is set to YES, the HHC_LOCATION tag can # be used to specify the location (absolute path including file name) of # the HTML help compiler (hhc.exe). If non-empty doxygen will try to run # the HTML help compiler on the generated index.hhp. HHC_LOCATION = # If the GENERATE_HTMLHELP tag is set to YES, the GENERATE_CHI flag # controls if a separate .chi index file is generated (YES) or that # it should be included in the master .chm file (NO). GENERATE_CHI = NO # If the GENERATE_HTMLHELP tag is set to YES, the CHM_INDEX_ENCODING # is used to encode HtmlHelp index (hhk), content (hhc) and project file # content. CHM_INDEX_ENCODING = # If the GENERATE_HTMLHELP tag is set to YES, the BINARY_TOC flag # controls whether a binary table of contents is generated (YES) or a # normal table of contents (NO) in the .chm file. BINARY_TOC = NO # The TOC_EXPAND flag can be set to YES to add extra items for group members # to the contents of the HTML help documentation and to the tree view. TOC_EXPAND = NO # If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and # QHP_VIRTUAL_FOLDER are set, an additional index file will be generated # that can be used as input for Qt's qhelpgenerator to generate a # Qt Compressed Help (.qch) of the generated HTML documentation. GENERATE_QHP = NO # If the QHG_LOCATION tag is specified, the QCH_FILE tag can # be used to specify the file name of the resulting .qch file. # The path specified is relative to the HTML output folder. QCH_FILE = # The QHP_NAMESPACE tag specifies the namespace to use when generating # Qt Help Project output. For more information please see # http://doc.trolltech.com/qthelpproject.html#namespace QHP_NAMESPACE = org.doxygen.Project # The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating # Qt Help Project output. For more information please see # http://doc.trolltech.com/qthelpproject.html#virtual-folders QHP_VIRTUAL_FOLDER = doc # If QHP_CUST_FILTER_NAME is set, it specifies the name of a custom filter to # add. For more information please see # http://doc.trolltech.com/qthelpproject.html#custom-filters QHP_CUST_FILTER_NAME = # The QHP_CUST_FILT_ATTRS tag specifies the list of the attributes of the # custom filter to add. For more information please see # # Qt Help Project / Custom Filters. QHP_CUST_FILTER_ATTRS = # The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this # project's # filter section matches. # # Qt Help Project / Filter Attributes. QHP_SECT_FILTER_ATTRS = # If the GENERATE_QHP tag is set to YES, the QHG_LOCATION tag can # be used to specify the location of Qt's qhelpgenerator. # If non-empty doxygen will try to run qhelpgenerator on the generated # .qhp file. QHG_LOCATION = # If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files # will be generated, which together with the HTML files, form an Eclipse help # plugin. To install this plugin and make it available under the help contents # menu in Eclipse, the contents of the directory containing the HTML and XML # files needs to be copied into the plugins directory of eclipse. The name of # the directory within the plugins directory should be the same as # the ECLIPSE_DOC_ID value. After copying Eclipse needs to be restarted before # the help appears. GENERATE_ECLIPSEHELP = NO # A unique identifier for the eclipse help plugin. When installing the plugin # the directory name containing the HTML and XML files should also have # this name. ECLIPSE_DOC_ID = org.doxygen.Project # The DISABLE_INDEX tag can be used to turn on/off the condensed index at # top of each HTML page. The value NO (the default) enables the index and # the value YES disables it. DISABLE_INDEX = NO # The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values # (range [0,1..20]) that doxygen will group on one line in the generated HTML # documentation. Note that a value of 0 will completely suppress the enum # values from appearing in the overview section. ENUM_VALUES_PER_LINE = 4 # The GENERATE_TREEVIEW tag is used to specify whether a tree-like index # structure should be generated to display hierarchical information. # If the tag value is set to YES, a side panel will be generated # containing a tree-like index structure (just like the one that # is generated for HTML Help). For this to work a browser that supports # JavaScript, DHTML, CSS and frames is required (i.e. any modern browser). # Windows users are probably better off using the HTML help feature. GENERATE_TREEVIEW = NO # By enabling USE_INLINE_TREES, doxygen will generate the Groups, Directories, # and Class Hierarchy pages using a tree view instead of an ordered list. USE_INLINE_TREES = NO # If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be # used to set the initial width (in pixels) of the frame in which the tree # is shown. TREEVIEW_WIDTH = 250 # When the EXT_LINKS_IN_WINDOW option is set to YES doxygen will open # links to external symbols imported via tag files in a separate window. EXT_LINKS_IN_WINDOW = NO # Use this tag to change the font size of Latex formulas included # as images in the HTML documentation. The default is 10. Note that # when you change the font size after a successful doxygen run you need # to manually remove any form_*.png images from the HTML output directory # to force them to be regenerated. FORMULA_FONTSIZE = 10 # Use the FORMULA_TRANPARENT tag to determine whether or not the images # generated for formulas are transparent PNGs. Transparent PNGs are # not supported properly for IE 6.0, but are supported on all modern browsers. # Note that when changing this option you need to delete any form_*.png files # in the HTML output before the changes have effect. FORMULA_TRANSPARENT = YES # Enable the USE_MATHJAX option to render LaTeX formulas using MathJax # (see http://www.mathjax.org) which uses client side Javascript for the # rendering instead of using prerendered bitmaps. Use this if you do not # have LaTeX installed or if you want to formulas look prettier in the HTML # output. When enabled you also need to install MathJax separately and # configure the path to it using the MATHJAX_RELPATH option. USE_MATHJAX = NO # When MathJax is enabled you need to specify the location relative to the # HTML output directory using the MATHJAX_RELPATH option. The destination # directory should contain the MathJax.js script. For instance, if the mathjax # directory is located at the same level as the HTML output directory, then # MATHJAX_RELPATH should be ../mathjax. The default value points to the # mathjax.org site, so you can quickly see the result without installing # MathJax, but it is strongly recommended to install a local copy of MathJax # before deployment. MATHJAX_RELPATH = http://www.mathjax.org/mathjax # When the SEARCHENGINE tag is enabled doxygen will generate a search box # for the HTML output. The underlying search engine uses javascript # and DHTML and should work on any modern browser. Note that when using # HTML help (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets # (GENERATE_DOCSET) there is already a search function so this one should # typically be disabled. For large projects the javascript based search engine # can be slow, then enabling SERVER_BASED_SEARCH may provide a better solution. SEARCHENGINE = YES # When the SERVER_BASED_SEARCH tag is enabled the search engine will be # implemented using a PHP enabled web server instead of at the web client # using Javascript. Doxygen will generate the search PHP script and index # file to put on the web server. The advantage of the server # based approach is that it scales better to large projects and allows # full text search. The disadvantages are that it is more difficult to setup # and does not have live searching capabilities. SERVER_BASED_SEARCH = NO #--------------------------------------------------------------------------- # configuration options related to the LaTeX output #--------------------------------------------------------------------------- # If the GENERATE_LATEX tag is set to YES (the default) Doxygen will # generate Latex output. GENERATE_LATEX = YES # The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put. # If a relative path is entered the value of OUTPUT_DIRECTORY will be # put in front of it. If left blank `latex' will be used as the default path. LATEX_OUTPUT = latex # The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be # invoked. If left blank `latex' will be used as the default command name. # Note that when enabling USE_PDFLATEX this option is only used for # generating bitmaps for formulas in the HTML output, but not in the # Makefile that is written to the output directory. LATEX_CMD_NAME = latex # The MAKEINDEX_CMD_NAME tag can be used to specify the command name to # generate index for LaTeX. If left blank `makeindex' will be used as the # default command name. MAKEINDEX_CMD_NAME = makeindex # If the COMPACT_LATEX tag is set to YES Doxygen generates more compact # LaTeX documents. This may be useful for small projects and may help to # save some trees in general. COMPACT_LATEX = NO # The PAPER_TYPE tag can be used to set the paper type that is used # by the printer. Possible values are: a4, letter, legal and # executive. If left blank a4wide will be used. PAPER_TYPE = a4 # The EXTRA_PACKAGES tag can be to specify one or more names of LaTeX # packages that should be included in the LaTeX output. EXTRA_PACKAGES = # The LATEX_HEADER tag can be used to specify a personal LaTeX header for # the generated latex document. The header should contain everything until # the first chapter. If it is left blank doxygen will generate a # standard header. Notice: only use this tag if you know what you are doing! LATEX_HEADER = ./tex/header.tex # The LATEX_FOOTER tag can be used to specify a personal LaTeX footer for # the generated latex document. The footer should contain everything after # the last chapter. If it is left blank doxygen will generate a # standard footer. Notice: only use this tag if you know what you are doing! LATEX_FOOTER = ./tex/footer.tex # If the PDF_HYPERLINKS tag is set to YES, the LaTeX that is generated # is prepared for conversion to pdf (using ps2pdf). The pdf file will # contain links (just like the HTML output) instead of page references # This makes the output suitable for online browsing using a pdf viewer. PDF_HYPERLINKS = YES # If the USE_PDFLATEX tag is set to YES, pdflatex will be used instead of # plain latex in the generated Makefile. Set this option to YES to get a # higher quality PDF documentation. USE_PDFLATEX = YES # If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \\batchmode. # command to the generated LaTeX files. This will instruct LaTeX to keep # running if errors occur, instead of asking the user for help. # This option is also used when generating formulas in HTML. LATEX_BATCHMODE = NO # If LATEX_HIDE_INDICES is set to YES then doxygen will not # include the index chapters (such as File Index, Compound Index, etc.) # in the output. LATEX_HIDE_INDICES = NO # If LATEX_SOURCE_CODE is set to YES then doxygen will include # source code with syntax highlighting in the LaTeX output. # Note that which sources are shown also depends on other settings # such as SOURCE_BROWSER. LATEX_SOURCE_CODE = NO #--------------------------------------------------------------------------- # configuration options related to the RTF output #--------------------------------------------------------------------------- # If the GENERATE_RTF tag is set to YES Doxygen will generate RTF output # The RTF output is optimized for Word 97 and may not look very pretty with # other RTF readers or editors. GENERATE_RTF = NO # The RTF_OUTPUT tag is used to specify where the RTF docs will be put. # If a relative path is entered the value of OUTPUT_DIRECTORY will be # put in front of it. If left blank `rtf' will be used as the default path. RTF_OUTPUT = rtf # If the COMPACT_RTF tag is set to YES Doxygen generates more compact # RTF documents. This may be useful for small projects and may help to # save some trees in general. COMPACT_RTF = NO # If the RTF_HYPERLINKS tag is set to YES, the RTF that is generated # will contain hyperlink fields. The RTF file will # contain links (just like the HTML output) instead of page references. # This makes the output suitable for online browsing using WORD or other # programs which support those fields. # Note: wordpad (write) and others do not support links. RTF_HYPERLINKS = NO # Load stylesheet definitions from file. Syntax is similar to doxygen's # config file, i.e. a series of assignments. You only have to provide # replacements, missing definitions are set to their default value. RTF_STYLESHEET_FILE = # Set optional variables used in the generation of an rtf document. # Syntax is similar to doxygen's config file. RTF_EXTENSIONS_FILE = #--------------------------------------------------------------------------- # configuration options related to the man page output #--------------------------------------------------------------------------- # If the GENERATE_MAN tag is set to YES (the default) Doxygen will # generate man pages GENERATE_MAN = NO # The MAN_OUTPUT tag is used to specify where the man pages will be put. # If a relative path is entered the value of OUTPUT_DIRECTORY will be # put in front of it. If left blank `man' will be used as the default path. MAN_OUTPUT = man # The MAN_EXTENSION tag determines the extension that is added to # the generated man pages (default is the subroutine's section .3) MAN_EXTENSION = .3 # If the MAN_LINKS tag is set to YES and Doxygen generates man output, # then it will generate one additional man file for each entity # documented in the real man page(s). These additional files # only source the real man page, but without them the man command # would be unable to find the correct page. The default is NO. MAN_LINKS = NO #--------------------------------------------------------------------------- # configuration options related to the XML output #--------------------------------------------------------------------------- # If the GENERATE_XML tag is set to YES Doxygen will # generate an XML file that captures the structure of # the code including all documentation. GENERATE_XML = NO # The XML_OUTPUT tag is used to specify where the XML pages will be put. # If a relative path is entered the value of OUTPUT_DIRECTORY will be # put in front of it. If left blank `xml' will be used as the default path. XML_OUTPUT = xml # The XML_SCHEMA tag can be used to specify an XML schema, # which can be used by a validating XML parser to check the # syntax of the XML files. XML_SCHEMA = # The XML_DTD tag can be used to specify an XML DTD, # which can be used by a validating XML parser to check the # syntax of the XML files. XML_DTD = # If the XML_PROGRAMLISTING tag is set to YES Doxygen will # dump the program listings (including syntax highlighting # and cross-referencing information) to the XML output. Note that # enabling this will significantly increase the size of the XML output. XML_PROGRAMLISTING = YES #--------------------------------------------------------------------------- # configuration options for the AutoGen Definitions output #--------------------------------------------------------------------------- # If the GENERATE_AUTOGEN_DEF tag is set to YES Doxygen will # generate an AutoGen Definitions (see autogen.sf.net) file # that captures the structure of the code including all # documentation. Note that this feature is still experimental # and incomplete at the moment. GENERATE_AUTOGEN_DEF = NO #--------------------------------------------------------------------------- # configuration options related to the Perl module output #--------------------------------------------------------------------------- # If the GENERATE_PERLMOD tag is set to YES Doxygen will # generate a Perl module file that captures the structure of # the code including all documentation. Note that this # feature is still experimental and incomplete at the # moment. GENERATE_PERLMOD = NO # If the PERLMOD_LATEX tag is set to YES Doxygen will generate # the necessary Makefile rules, Perl scripts and LaTeX code to be able # to generate PDF and DVI output from the Perl module output. PERLMOD_LATEX = NO # If the PERLMOD_PRETTY tag is set to YES the Perl module output will be # nicely formatted so it can be parsed by a human reader. # This is useful # if you want to understand what is going on. # On the other hand, if this # tag is set to NO the size of the Perl module output will be much smaller # and Perl will parse it just the same. PERLMOD_PRETTY = YES # The names of the make variables in the generated doxyrules.make file # are prefixed with the string contained in PERLMOD_MAKEVAR_PREFIX. # This is useful so different doxyrules.make files included by the same # Makefile don't overwrite each other's variables. PERLMOD_MAKEVAR_PREFIX = #--------------------------------------------------------------------------- # Configuration options related to the preprocessor #--------------------------------------------------------------------------- # If the ENABLE_PREPROCESSING tag is set to YES (the default) Doxygen will # evaluate all C-preprocessor directives found in the sources and include # files. ENABLE_PREPROCESSING = YES # If the MACRO_EXPANSION tag is set to YES Doxygen will expand all macro # names in the source code. If set to NO (the default) only conditional # compilation will be performed. Macro expansion can be done in a controlled # way by setting EXPAND_ONLY_PREDEF to YES. MACRO_EXPANSION = NO # If the EXPAND_ONLY_PREDEF and MACRO_EXPANSION tags are both set to YES # then the macro expansion is limited to the macros specified with the # PREDEFINED and EXPAND_AS_DEFINED tags. EXPAND_ONLY_PREDEF = NO # If the SEARCH_INCLUDES tag is set to YES (the default) the includes files # pointed to by INCLUDE_PATH will be searched when a #include is found. SEARCH_INCLUDES = YES # The INCLUDE_PATH tag can be used to specify one or more directories that # contain include files that are not input files but should be processed by # the preprocessor. INCLUDE_PATH = # You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard # patterns (like *.h and *.hpp) to filter out the header-files in the # directories. If left blank, the patterns specified with FILE_PATTERNS will # be used. INCLUDE_FILE_PATTERNS = # The PREDEFINED tag can be used to specify one or more macro names that # are defined before the preprocessor is started (similar to the -D option of # gcc). The argument of the tag is a list of macros of the form: name # or name=definition (no spaces). If the definition and the = are # omitted =1 is assumed. To prevent a macro definition from being # undefined via #undef or recursively expanded use the := operator # instead of the = operator. PREDEFINED = # If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then # this tag can be used to specify a list of macro names that should be expanded. # The macro definition that is found in the sources will be used. # Use the PREDEFINED tag if you want to use a different macro definition that # overrules the definition found in the source code. EXPAND_AS_DEFINED = # If the SKIP_FUNCTION_MACROS tag is set to YES (the default) then # doxygen's preprocessor will remove all references to function-like macros # that are alone on a line, have an all uppercase name, and do not end with a # semicolon, because these will confuse the parser if not removed. SKIP_FUNCTION_MACROS = YES #--------------------------------------------------------------------------- # Configuration::additions related to external references #--------------------------------------------------------------------------- # The TAGFILES option can be used to specify one or more tagfiles. # Optionally an initial location of the external documentation # can be added for each tagfile. The format of a tag file without # this location is as follows: # # TAGFILES = file1 file2 ... # Adding location for the tag files is done as follows: # # TAGFILES = file1=loc1 "file2 = loc2" ... # where "loc1" and "loc2" can be relative or absolute paths or # URLs. If a location is present for each tag, the installdox tool # does not have to be run to correct the links. # Note that each tag file must have a unique name # (where the name does NOT include the path) # If a tag file is not located in the directory in which doxygen # is run, you must also specify the path to the tagfile here. TAGFILES = # When a file name is specified after GENERATE_TAGFILE, doxygen will create # a tag file that is based on the input files it reads. GENERATE_TAGFILE = # If the ALLEXTERNALS tag is set to YES all external classes will be listed # in the class index. If set to NO only the inherited external classes # will be listed. ALLEXTERNALS = NO # If the EXTERNAL_GROUPS tag is set to YES all external groups will be listed # in the modules index. If set to NO, only the current project's groups will # be listed. EXTERNAL_GROUPS = YES # The PERL_PATH should be the absolute path and name of the perl script # interpreter (i.e. the result of `which perl'). PERL_PATH = /usr/bin/perl #--------------------------------------------------------------------------- # Configuration options related to the dot tool #--------------------------------------------------------------------------- # If the CLASS_DIAGRAMS tag is set to YES (the default) Doxygen will # generate a inheritance diagram (in HTML, RTF and LaTeX) for classes with base # or super classes. Setting the tag to NO turns the diagrams off. Note that # this option also works with HAVE_DOT disabled, but it is recommended to # install and use dot, since it yields more powerful graphs. CLASS_DIAGRAMS = YES # You can define message sequence charts within doxygen comments using the \msc # command. Doxygen will then run the mscgen tool (see # http://www.mcternan.me.uk/mscgen/) to produce the chart and insert it in the # documentation. The MSCGEN_PATH tag allows you to specify the directory where # the mscgen tool resides. If left empty the tool is assumed to be found in the # default search path. MSCGEN_PATH = # If set to YES, the inheritance and collaboration graphs will hide # inheritance and usage relations if the target is undocumented # or is not a class. HIDE_UNDOC_RELATIONS = YES # If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is # available from the path. This tool is part of Graphviz, a graph visualization # toolkit from AT&T and Lucent Bell Labs. The other options in this section # have no effect if this option is set to NO (the default) HAVE_DOT = NO # The DOT_NUM_THREADS specifies the number of dot invocations doxygen is # allowed to run in parallel. When set to 0 (the default) doxygen will # base this on the number of processors available in the system. You can set it # explicitly to a value larger than 0 to get control over the balance # between CPU load and processing speed. DOT_NUM_THREADS = 0 # By default doxygen will write a font called Helvetica to the output # directory and reference it in all dot files that doxygen generates. # When you want a differently looking font you can specify the font name # using DOT_FONTNAME. You need to make sure dot is able to find the font, # which can be done by putting it in a standard location or by setting the # DOTFONTPATH environment variable or by setting DOT_FONTPATH to the directory # containing the font. DOT_FONTNAME = Helvetica # The DOT_FONTSIZE tag can be used to set the size of the font of dot graphs. # The default size is 10pt. DOT_FONTSIZE = 10 # By default doxygen will tell dot to use the output directory to look for the # FreeSans.ttf font (which doxygen will put there itself). If you specify a # different font using DOT_FONTNAME you can set the path where dot # can find it using this tag. DOT_FONTPATH = # If the CLASS_GRAPH and HAVE_DOT tags are set to YES then doxygen # will generate a graph for each documented class showing the direct and # indirect inheritance relations. Setting this tag to YES will force the # the CLASS_DIAGRAMS tag to NO. CLASS_GRAPH = YES # If the COLLABORATION_GRAPH and HAVE_DOT tags are set to YES then doxygen # will generate a graph for each documented class showing the direct and # indirect implementation dependencies (inheritance, containment, and # class references variables) of the class with other documented classes. COLLABORATION_GRAPH = YES # If the GROUP_GRAPHS and HAVE_DOT tags are set to YES then doxygen # will generate a graph for groups, showing the direct groups dependencies GROUP_GRAPHS = YES # If the UML_LOOK tag is set to YES doxygen will generate inheritance and # collaboration diagrams in a style similar to the OMG's Unified Modeling # Language. UML_LOOK = NO # If set to YES, the inheritance and collaboration graphs will show the # relations between templates and their instances. TEMPLATE_RELATIONS = NO # If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDE_GRAPH, and HAVE_DOT # tags are set to YES then doxygen will generate a graph for each documented # file showing the direct and indirect include dependencies of the file with # other documented files. INCLUDE_GRAPH = YES # If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDED_BY_GRAPH, and # HAVE_DOT tags are set to YES then doxygen will generate a graph for each # documented header file showing the documented files that directly or # indirectly include this file. INCLUDED_BY_GRAPH = YES # If the CALL_GRAPH and HAVE_DOT options are set to YES then # doxygen will generate a call dependency graph for every global function # or class method. Note that enabling this option will significantly increase # the time of a run. So in most cases it will be better to enable call graphs # for selected functions only using the \callgraph command. CALL_GRAPH = NO # If the CALLER_GRAPH and HAVE_DOT tags are set to YES then # doxygen will generate a caller dependency graph for every global function # or class method. Note that enabling this option will significantly increase # the time of a run. So in most cases it will be better to enable caller # graphs for selected functions only using the \callergraph command. CALLER_GRAPH = NO # If the GRAPHICAL_HIERARCHY and HAVE_DOT tags are set to YES then doxygen # will generate a graphical hierarchy of all classes instead of a textual one. GRAPHICAL_HIERARCHY = YES # If the DIRECTORY_GRAPH, SHOW_DIRECTORIES and HAVE_DOT tags are set to YES # then doxygen will show the dependencies a directory has on other directories # in a graphical way. The dependency relations are determined by the #include # relations between the files in the directories. DIRECTORY_GRAPH = YES # The DOT_IMAGE_FORMAT tag can be used to set the image format of the images # generated by dot. Possible values are svg, png, jpg, or gif. # If left blank png will be used. DOT_IMAGE_FORMAT = png # The tag DOT_PATH can be used to specify the path where the dot tool can be # found. If left blank, it is assumed the dot tool can be found in the path. DOT_PATH = # The DOTFILE_DIRS tag can be used to specify one or more directories that # contain dot files that are included in the documentation (see the # \dotfile command). DOTFILE_DIRS = # The MSCFILE_DIRS tag can be used to specify one or more directories that # contain msc files that are included in the documentation (see the # \mscfile command). MSCFILE_DIRS = # The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of # nodes that will be shown in the graph. If the number of nodes in a graph # becomes larger than this value, doxygen will truncate the graph, which is # visualized by representing a node as a red box. Note that doxygen if the # number of direct children of the root node in a graph is already larger than # DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note # that the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH. DOT_GRAPH_MAX_NODES = 50 # The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the # graphs generated by dot. A depth value of 3 means that only nodes reachable # from the root by following a path via at most 3 edges will be shown. Nodes # that lay further from the root node will be omitted. Note that setting this # option to 1 or 2 may greatly reduce the computation time needed for large # code bases. Also note that the size of a graph can be further restricted by # DOT_GRAPH_MAX_NODES. Using a depth of 0 means no depth restriction. MAX_DOT_GRAPH_DEPTH = 0 # Set the DOT_TRANSPARENT tag to YES to generate images with a transparent # background. This is disabled by default, because dot on Windows does not # seem to support this out of the box. Warning: Depending on the platform used, # enabling this option may lead to badly anti-aliased labels on the edges of # a graph (i.e. they become hard to read). DOT_TRANSPARENT = NO # Set the DOT_MULTI_TARGETS tag to YES allow dot to generate multiple output # files in one run (i.e. multiple -o and -T options on the command line). This # makes dot run faster, but since only newer versions of dot (>1.8.10) # support this, this feature is disabled by default. DOT_MULTI_TARGETS = YES # If the GENERATE_LEGEND tag is set to YES (the default) Doxygen will # generate a legend page explaining the meaning of the various boxes and # arrows in the dot generated graphs. GENERATE_LEGEND = YES # If the DOT_CLEANUP tag is set to YES (the default) Doxygen will # remove the intermediate dot files that are used to generate # the various graphs. DOT_CLEANUP = YES wcc-0.0.2/src/tex/doxygen.sty0000644000175000017500000002452313110675433014555 0ustar philphil% stylesheet for doxygen 1.8.4 \NeedsTeXFormat{LaTeX2e} \ProvidesPackage{doxygen} % Packages used by this style file \RequirePackage{alltt} \RequirePackage{array} \RequirePackage{calc} \RequirePackage{float} \RequirePackage{ifthen} \RequirePackage{verbatim} \RequirePackage[table]{xcolor} \RequirePackage{xtab} %---------- Internal commands used in this style file ---------------- \newcommand{\ensurespace}[1]{% \begingroup% \setlength{\dimen@}{#1}% \vskip\z@\@plus\dimen@% \penalty -100\vskip\z@\@plus -\dimen@% \vskip\dimen@% \penalty 9999% \vskip -\dimen@% \vskip\z@skip% hide the previous |\vskip| from |\addvspace| \endgroup% } \newcommand{\DoxyLabelFont}{} \newcommand{\entrylabel}[1]{% {% \parbox[b]{\labelwidth-4pt}{% \makebox[0pt][l]{\DoxyLabelFont#1}% \vspace{1.5\baselineskip}% }% }% } \newenvironment{DoxyDesc}[1]{% \ensurespace{4\baselineskip}% \begin{list}{}{% \settowidth{\labelwidth}{20pt}% \setlength{\parsep}{0pt}% \setlength{\itemsep}{0pt}% \setlength{\leftmargin}{\labelwidth+\labelsep}% \renewcommand{\makelabel}{\entrylabel}% }% \item[#1]% }{% \end{list}% } \newsavebox{\xrefbox} \newlength{\xreflength} \newcommand{\xreflabel}[1]{% \sbox{\xrefbox}{#1}% \setlength{\xreflength}{\wd\xrefbox}% \ifthenelse{\xreflength>\labelwidth}{% \begin{minipage}{\textwidth}% \setlength{\parindent}{0pt}% \hangindent=15pt\bfseries #1\vspace{1.2\itemsep}% \end{minipage}% }{% \parbox[b]{\labelwidth}{\makebox[0pt][l]{\textbf{#1}}}% }% } %---------- Commands used by doxygen LaTeX output generator ---------- % Used by
 ... 
\newenvironment{DoxyPre}{% \small% \begin{alltt}% }{% \end{alltt}% \normalsize% } % Used by @code ... @endcode \newenvironment{DoxyCode}{% \par% \scriptsize% \begin{alltt}% }{% \end{alltt}% \normalsize% } % Used by @example, @include, @includelineno and @dontinclude \newenvironment{DoxyCodeInclude}{% \DoxyCode% }{% \endDoxyCode% } % Used by @verbatim ... @endverbatim \newenvironment{DoxyVerb}{% \footnotesize% \verbatim% }{% \endverbatim% \normalsize% } % Used by @verbinclude \newenvironment{DoxyVerbInclude}{% \DoxyVerb% }{% \endDoxyVerb% } % Used by numbered lists (using '-#' or
    ...
) \newenvironment{DoxyEnumerate}{% \enumerate% }{% \endenumerate% } % Used by bullet lists (using '-', @li, @arg, or
    ...
) \newenvironment{DoxyItemize}{% \itemize% }{% \enditemize% } % Used by description lists (using
...
) \newenvironment{DoxyDescription}{% \description% }{% \enddescription% } % Used by @image, @dotfile, @dot ... @enddot, and @msc ... @endmsc % (only if caption is specified) \newenvironment{DoxyImage}{% \begin{figure}[H]% \begin{center}% }{% \end{center}% \end{figure}% } % Used by @image, @dotfile, @dot ... @enddot, and @msc ... @endmsc % (only if no caption is specified) \newenvironment{DoxyImageNoCaption}{% }{% } % Used by @attention \newenvironment{DoxyAttention}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @author and @authors \newenvironment{DoxyAuthor}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @date \newenvironment{DoxyDate}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @invariant \newenvironment{DoxyInvariant}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @note \newenvironment{DoxyNote}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @post \newenvironment{DoxyPostcond}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @pre \newenvironment{DoxyPrecond}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @copyright \newenvironment{DoxyCopyright}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @remark \newenvironment{DoxyRemark}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @return and @returns \newenvironment{DoxyReturn}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @since \newenvironment{DoxySince}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @see \newenvironment{DoxySeeAlso}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @version \newenvironment{DoxyVersion}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @warning \newenvironment{DoxyWarning}[1]{% \begin{DoxyDesc}{#1}% }{% \end{DoxyDesc}% } % Used by @internal \newenvironment{DoxyInternal}[1]{% \paragraph*{#1}% }{% } % Used by @par and @paragraph \newenvironment{DoxyParagraph}[1]{% \begin{list}{}{% \settowidth{\labelwidth}{40pt}% \setlength{\leftmargin}{\labelwidth}% \setlength{\parsep}{0pt}% \setlength{\itemsep}{-4pt}% \renewcommand{\makelabel}{\entrylabel}% }% \item[#1]% }{% \end{list}% } % Used by parameter lists \newenvironment{DoxyParams}[2][]{% \par% \tabletail{\hline}% \tablelasttail{\hline}% \tablefirsthead{}% \tablehead{}% \ifthenelse{\equal{#1}{}}% {\tablefirsthead{\multicolumn{2}{l}{\hspace{-6pt}\bfseries\fontseries{bc}\selectfont\color{darkgray} #2}\\[1ex]}% \begin{xtabular}{|>{\raggedleft\hspace{0pt}}p{0.15\textwidth}|% p{0.805\textwidth}|}}% {\ifthenelse{\equal{#1}{1}}% {\tablefirsthead{\multicolumn{2}{l}{\hspace{-6pt}\bfseries\fontseries{bc}\selectfont\color{darkgray} #2}\\[1ex]}% \begin{xtabular}{|>{\centering}p{0.10\textwidth}|% >{\raggedleft\hspace{0pt}}p{0.15\textwidth}|% p{0.678\textwidth}|}}% {\tablefirsthead{\multicolumn{2}{l}{\hspace{-6pt}\bfseries\fontseries{bc}\selectfont\color{darkgray} #2}\\[1ex]}% \begin{xtabular}{|>{\centering}p{0.10\textwidth}|% >{\centering\hspace{0pt}}p{0.15\textwidth}|% >{\raggedleft\hspace{0pt}}p{0.15\textwidth}|% p{0.501\textwidth}|}}% }\hline% }{% \end{xtabular}% \tablefirsthead{}% \vspace{6pt}% } % Used for fields of simple structs \newenvironment{DoxyFields}[1]{% \par% \tabletail{\hline}% \tablelasttail{\hline}% \tablehead{}% \tablefirsthead{\multicolumn{2}{l}{\hspace{-6pt}\bfseries\fontseries{bc}\selectfont\color{darkgray} #1}\\[1ex]}% \begin{xtabular}{|>{\raggedleft\hspace{0pt}}p{0.15\textwidth}|% p{0.15\textwidth}|% p{0.63\textwidth}|}% \hline% }{% \end{xtabular}% \tablefirsthead{}% \vspace{6pt}% } % Used for parameters within a detailed function description \newenvironment{DoxyParamCaption}{% \renewcommand{\item}[2][]{##1 {\em ##2}}% }{% } % Used by return value lists \newenvironment{DoxyRetVals}[1]{% \par% \tabletail{\hline}% \tablelasttail{\hline}% \tablehead{}% \tablefirsthead{\multicolumn{2}{l}{\hspace{-6pt}\bfseries\fontseries{bc}\selectfont\color{darkgray} #1}\\[1ex]}% \begin{xtabular}{|>{\raggedleft\hspace{0pt}}p{0.25\textwidth}|% p{0.705\textwidth}|}% \hline% }{% \end{xtabular}% \tablefirsthead{}% \vspace{6pt}% } % Used by exception lists \newenvironment{DoxyExceptions}[1]{% \par% \tabletail{\hline}% \tablelasttail{\hline}% \tablehead{}% \tablefirsthead{\multicolumn{2}{l}{\hspace{-6pt}\bfseries\fontseries{bc}\selectfont\color{darkgray} #1}\\[1ex]}% \begin{xtabular}{|>{\raggedleft\hspace{0pt}}p{0.25\textwidth}|% p{0.705\textwidth}|}% \hline% }{% \end{xtabular}% \tablefirsthead{}% \vspace{6pt}% } % Used by template parameter lists \newenvironment{DoxyTemplParams}[1]{% \par% \tabletail{\hline}% \tablelasttail{\hline}% \tablehead{}% \tablefirsthead{\multicolumn{2}{l}{\hspace{-6pt}\bfseries\fontseries{bc}\selectfont\color{darkgray} #1}\\[1ex]}% \begin{xtabular}{|>{\raggedleft\hspace{0pt}}p{0.25\textwidth}|% p{0.705\textwidth}|}% \hline% }{% \end{xtabular}% \tablefirsthead{}% \vspace{6pt}% } % Used for member lists \newenvironment{DoxyCompactItemize}{% \begin{itemize}% \setlength{\itemsep}{-3pt}% \setlength{\parsep}{0pt}% \setlength{\topsep}{0pt}% \setlength{\partopsep}{0pt}% }{% \end{itemize}% } % Used for member descriptions \newenvironment{DoxyCompactList}{% \begin{list}{}{% \setlength{\leftmargin}{0.5cm}% \setlength{\itemsep}{0pt}% \setlength{\parsep}{0pt}% \setlength{\topsep}{0pt}% \renewcommand{\makelabel}{\hfill}% }% }{% \end{list}% } % Used for reference lists (@bug, @deprecated, @todo, etc.) \newenvironment{DoxyRefList}{% \begin{list}{}{% \setlength{\labelwidth}{10pt}% \setlength{\leftmargin}{\labelwidth}% \addtolength{\leftmargin}{\labelsep}% \renewcommand{\makelabel}{\xreflabel}% }% }{% \end{list}% } % Used by @bug, @deprecated, @todo, etc. \newenvironment{DoxyRefDesc}[1]{% \begin{list}{}{% \renewcommand\makelabel[1]{\textbf{##1}}% \settowidth\labelwidth{\makelabel{#1}}% \setlength\leftmargin{\labelwidth+\labelsep}% }% }{% \end{list}% } % Used by parameter lists and simple sections \newenvironment{Desc} {\begin{list}{}{% \settowidth{\labelwidth}{40pt}% \setlength{\leftmargin}{\labelwidth}% \setlength{\parsep}{0pt}% \setlength{\itemsep}{-4pt}% \renewcommand{\makelabel}{\entrylabel}% } }{% \end{list}% } % Used by tables \newcommand{\PBS}[1]{\let\temp=\\#1\let\\=\temp}% \newlength{\tmplength}% \newenvironment{TabularC}[1]% {% \setlength{\tmplength}% {\linewidth/(#1)-\tabcolsep*2-\arrayrulewidth*(#1+1)/(#1)}% \par\begin{xtabular*}{\linewidth}% {*{#1}{|>{\PBS\raggedright\hspace{0pt}}p{\the\tmplength}}|}% }% {\end{xtabular*}\par}% % Used for member group headers \newenvironment{Indent}{% \begin{list}{}{% \setlength{\leftmargin}{0.5cm}% }% \item[]\ignorespaces% }{% \unskip% \end{list}% } % Used when hyperlinks are turned off \newcommand{\doxyref}[3]{% \textbf{#1} (\textnormal{#2}\,\pageref{#3})% } % Used for syntax highlighting \definecolor{comment}{rgb}{0.5,0.0,0.0} \definecolor{keyword}{rgb}{0.0,0.5,0.0} \definecolor{keywordtype}{rgb}{0.38,0.25,0.125} \definecolor{keywordflow}{rgb}{0.88,0.5,0.0} \definecolor{preprocessor}{rgb}{0.5,0.38,0.125} \definecolor{stringliteral}{rgb}{0.0,0.125,0.25} \definecolor{charliteral}{rgb}{0.0,0.5,0.5} \definecolor{vhdldigit}{rgb}{1.0,0.0,1.0} \definecolor{vhdlkeyword}{rgb}{0.43,0.0,0.43} \definecolor{vhdllogic}{rgb}{1.0,0.0,0.0} \definecolor{vhdlchar}{rgb}{0.0,0.0,0.0} wcc-0.0.2/src/tex/footer.tex0000644000175000017500000000020213110675433014343 0ustar philphil% Latex footer for doxygen 1.8.4 % Index \newpage \phantomsection \addcontentsline{toc}{part}{Index} \printindex \end{document} wcc-0.0.2/src/tex/header.tex0000644000175000017500000000566713110675433014321 0ustar philphil% Latex header for doxygen 1.8.4 \documentclass[twoside]{book} % Packages required by doxygen \usepackage{calc} \usepackage{doxygen} \usepackage{graphicx} \usepackage[utf8]{inputenc} \usepackage{makeidx} \usepackage{multicol} \usepackage{multirow} \usepackage{textcomp} \usepackage[table]{xcolor} % Font selection \usepackage[T1]{fontenc} \usepackage{mathptmx} \usepackage[scaled=.90]{helvet} \usepackage{courier} \usepackage{amssymb} \usepackage{sectsty} \renewcommand{\familydefault}{\sfdefault} \allsectionsfont{% \fontseries{bc}\selectfont% \color{darkgray}% } \renewcommand{\DoxyLabelFont}{% \fontseries{bc}\selectfont% \color{darkgray}% } % Page & text layout \usepackage{geometry} \geometry{% a4paper,% top=2.5cm,% bottom=2.5cm,% left=2.5cm,% right=2.5cm% } \tolerance=750 \hfuzz=15pt \hbadness=750 \setlength{\emergencystretch}{15pt} \setlength{\parindent}{0cm} \setlength{\parskip}{0.2cm} \makeatletter \renewcommand{\paragraph}{% \@startsection{paragraph}{4}{0ex}{-1.0ex}{1.0ex}{% \normalfont\normalsize\bfseries\SS@parafont% }% } \renewcommand{\subparagraph}{% \@startsection{subparagraph}{5}{0ex}{-1.0ex}{1.0ex}{% \normalfont\normalsize\bfseries\SS@subparafont% }% } \makeatother % Headers & footers \usepackage{fancyhdr} \pagestyle{fancyplain} \fancyhead[LE]{\fancyplain{}{\bfseries\thepage}} \fancyhead[CE]{\fancyplain{}{}} \fancyhead[RE]{\fancyplain{}{\bfseries\leftmark}} \fancyhead[LO]{\fancyplain{}{\bfseries\rightmark}} \fancyhead[CO]{\fancyplain{}{}} \fancyhead[RO]{\fancyplain{}{\bfseries\thepage}} \fancyfoot[LE]{\fancyplain{}{}} \fancyfoot[CE]{\fancyplain{}{}} \fancyfoot[RE]{\fancyplain{}{\bfseries\scriptsize The Witchcraft Compiler Collection }} \fancyfoot[LO]{\fancyplain{}{\bfseries\scriptsize The Witchcraft Compiler Collection }} \fancyfoot[CO]{\fancyplain{}{}} \fancyfoot[RO]{\fancyplain{}{}} \renewcommand{\footrulewidth}{0.4pt} \renewcommand{\chaptermark}[1]{% \markboth{#1}{}% } \renewcommand{\sectionmark}[1]{% \markright{\thesection\ #1}% } % Indices & bibliography \usepackage{natbib} \usepackage[titles]{tocloft} \setcounter{tocdepth}{3} \setcounter{secnumdepth}{5} \makeindex % Hyperlinks (required, but should be loaded last) \usepackage{ifpdf} \ifpdf \usepackage[pdftex,pagebackref=true]{hyperref} \else \usepackage[ps2pdf,pagebackref=true]{hyperref} \fi \hypersetup{% colorlinks=true,% linkcolor=blue,% citecolor=blue,% unicode% } % Custom commands \newcommand{\clearemptydoublepage}{% \newpage{\pagestyle{empty}\cleardoublepage}% } %===== C O N T E N T S ===== \begin{document} % Titlepage & ToC \hypersetup{pageanchor=false} \pagenumbering{roman} \begin{titlepage} \vspace*{7cm} \begin{center}% {\Large The Witchcraft Compiler Collection}\\ \vspace*{1cm} {\large http://github.com/endrazine/wcc/}\\ \vspace*{0.5cm} \end{center} \end{titlepage} \clearemptydoublepage \tableofcontents \clearemptydoublepage \pagenumbering{arabic} \hypersetup{pageanchor=true} %--- Begin generated contents --- wcc-0.0.2/LICENSE0000644000175000017500000003236713110675433011762 0ustar philphilThe Witcraft Compiler Collection is subject to the following licenses: -------------------------------------- MIT LICENSE ------------------------------------------- The MIT License (MIT) Copyright (c) 2016 Jonathan Brossard Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ------------------------------------------------------------------------------------------------ In addition, the following licenses apply to third party dependencies used within the Witchcraft Compiler Collection: ---------------------------------- linenoise --------------------------------------------------- Copyright (c) 2010-2014, Salvatore Sanfilippo Copyright (c) 2010-2013, Pieter Noordhuis All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ------------------------------------------------------------------------------------------------ ------------------------------------------ lua ------------------------------------------------- Lua is free software distributed under the terms of the MIT license reproduced below; it may be used for any purpose, including commercial purposes, at absolutely no cost without having to ask us. The only requirement is that if you do use Lua, then you should give us credit by including the appropriate copyright notice somewhere in your product or its documentation. For details, see this : http://www.lua.org/license.html Copyright © 1994–2015 Lua.org, PUC-Rio. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ------------------------------------------------------------------------------------------------ =============================================================================== LuaJIT -- a Just-In-Time Compiler for Lua. http://luajit.org/ Copyright (C) 2005-2016 Mike Pall. All rights reserved. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. [ MIT license: http://www.opensource.org/licenses/mit-license.php ] =============================================================================== [ LuaJIT includes code from Lua 5.1/5.2, which has this license statement: ] Copyright (C) 1994-2012 Lua.org, PUC-Rio. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =============================================================================== [ LuaJIT includes code from dlmalloc, which has this license statement: ] This is a version (aka dlmalloc) of malloc/free/realloc written by Doug Lea and released to the public domain, as explained at http://creativecommons.org/licenses/publicdomain =============================================================================== ## OpenLibm OpenLibm contains code that is covered by various licenses. The OpenLibm code derives from the FreeBSD msun and OpenBSD libm implementations, which in turn derives from FDLIBM 5.3. As a result, it has a number of fixes and updates that have accumulated over the years in msun, and also optimized assembly versions of many functions. These improvements are provided under the BSD and ISC licenses. The msun library also includes work placed under the public domain, which is noted in the individual files. Further work on making a standalone OpenLibm library from msun, as part of the Julia project is covered under the MIT license. The test files, test-double.c and test-float.c are under the LGPL. ## Parts copyrighted by the Julia project (MIT License) > Copyright (c) 2011-14 The Julia Project. > https://github.com/JuliaLang/openlibm/graphs/contributors > > Permission is hereby granted, free of charge, to any person obtaining > a copy of this software and associated documentation files (the > "Software"), to deal in the Software without restriction, including > without limitation the rights to use, copy, modify, merge, publish, > distribute, sublicense, and/or sell copies of the Software, and to > permit persons to whom the Software is furnished to do so, subject to > the following conditions: > > The above copyright notice and this permission notice shall be > included in all copies or substantial portions of the Software. > > THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, > EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF > MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND > NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE > LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION > OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION > WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ## Parts copyrighted by Stephen L. Moshier (ISC License) > Copyright (c) 2008 Stephen L. Moshier > > Permission to use, copy, modify, and distribute this software for any > purpose with or without fee is hereby granted, provided that the above > copyright notice and this permission notice appear in all copies. > > THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES > WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF > MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR > ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES > WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN > ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF > OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ## FREEBSD MSUN (FreeBSD/2-clause BSD/Simplified BSD License) > Copyright 1992-2011 The FreeBSD Project. All rights reserved. > > Redistribution and use in source and binary forms, with or without > modification, are permitted provided that the following conditions are > met: > > 1. Redistributions of source code must retain the above copyright > notice, this list of conditions and the following disclaimer. > > 2. Redistributions in binary form must reproduce the above copyright > notice, this list of conditions and the following disclaimer in the > documentation and/or other materials provided with the distribution. > THIS SOFTWARE IS PROVIDED BY THE FREEBSD PROJECT ``AS IS'' AND ANY > EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE > IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR > PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FREEBSD PROJECT OR > CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, > EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, > PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR > PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF > LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING > NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS > SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. > > The views and conclusions contained in the software and documentation > are those of the authors and should not be interpreted as representing > official policies, either expressed or implied, of the FreeBSD > Project. ## FDLIBM > Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. > > Developed at SunPro, a Sun Microsystems, Inc. business. > Permission to use, copy, modify, and distribute this > software is freely granted, provided that this notice > is preserved. ## Tests > Copyright (C) 1997, 1999 Free Software Foundation, Inc. > This file is part of the GNU C Library. > Contributed by Andreas Jaeger , 1997. > > The GNU C Library is free software; you can redistribute it and/or > modify it under the terms of the GNU Lesser General Public > License as published by the Free Software Foundation; either > version 2.1 of the License, or (at your option) any later version. > > The GNU C Library is distributed in the hope that it will be useful, > but WITHOUT ANY WARRANTY; without even the implied warranty of > MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU > Lesser General Public License for more details. > > You should have received a copy of the GNU Lesser General Public > License along with the GNU C Library; if not, write to the Free > Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA > 02111-1307 USA. wcc-0.0.2/include/0000755000175000017500000000000013110675433012365 5ustar philphilwcc-0.0.2/include/nametolink.h0000644000175000017500000000320013110675433014672 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ typedef struct assoc_nametolink_t{ char *name; char *dst; }assoc_nametolink_t; assoc_nametolink_t nametolink[] = { {".dynsym", ".dynstr"}, {".gnu.version_r", ".dynstr"}, {".gnu.version", ".dynsym"}, {".rela.dyn", ".dynsym"}, {".rela.plt", ".dynsym"}, {".dynamic", ".dynstr"} }; wcc-0.0.2/include/utlist.h0000644000175000017500000015512613110675433014074 0ustar philphil/* Copyright (c) 2007-2013, Troy D. Hanson http://troydhanson.github.com/uthash/ All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef UTLIST_H #define UTLIST_H #define UTLIST_VERSION 1.9.8 #include /* * This file contains macros to manipulate singly and doubly-linked lists. * * 1. LL_ macros: singly-linked lists. * 2. DL_ macros: doubly-linked lists. * 3. CDL_ macros: circular doubly-linked lists. * * To use singly-linked lists, your structure must have a "next" pointer. * To use doubly-linked lists, your structure must "prev" and "next" pointers. * Either way, the pointer to the head of the list must be initialized to NULL. * * ----------------.EXAMPLE ------------------------- * struct item { * int id; * struct item *prev, *next; * } * * struct item *list = NULL: * * int main() { * struct item *item; * ... allocate and populate item ... * DL_APPEND(list, item); * } * -------------------------------------------------- * * For doubly-linked lists, the append and delete macros are O(1) * For singly-linked lists, append and delete are O(n) but prepend is O(1) * The sort macro is O(n log(n)) for all types of single/double/circular lists. */ /* These macros use decltype or the earlier __typeof GNU extension. As decltype is only available in newer compilers (VS2010 or gcc 4.3+ when compiling c++ code), this code uses whatever method is needed or, for VS2008 where neither is available, uses casting workarounds. */ #ifdef _MSC_VER /* MS compiler */ #if _MSC_VER >= 1600 && defined(__cplusplus) /* VS2010 or newer in C++ mode */ #define LDECLTYPE(x) decltype(x) #else /* VS2008 or older (or VS2010 in C mode) */ #define NO_DECLTYPE #define LDECLTYPE(x) char* #endif #elif defined(__ICCARM__) #define NO_DECLTYPE #define LDECLTYPE(x) char* #else /* GNU, Sun and other compilers */ #define LDECLTYPE(x) __typeof(x) #endif /* for VS2008 we use some workarounds to get around the lack of decltype, * namely, we always reassign our tmp variable to the list head if we need * to dereference its prev/next pointers, and save/restore the real head.*/ #ifdef NO_DECLTYPE #define _SV(elt,list) _tmp = (char*)(list); {char **_alias = (char**)&(list); *_alias = (elt); } #define _NEXT(elt,list,next) ((char*)((list)->next)) #define _NEXTASGN(elt,list,to,next) { char **_alias = (char**)&((list)->next); *_alias=(char*)(to); } /* #define _PREV(elt,list,prev) ((char*)((list)->prev)) */ #define _PREVASGN(elt,list,to,prev) { char **_alias = (char**)&((list)->prev); *_alias=(char*)(to); } #define _RS(list) { char **_alias = (char**)&(list); *_alias=_tmp; } #define _CASTASGN(a,b) { char **_alias = (char**)&(a); *_alias=(char*)(b); } #else #define _SV(elt,list) #define _NEXT(elt,list,next) ((elt)->next) #define _NEXTASGN(elt,list,to,next) ((elt)->next)=(to) /* #define _PREV(elt,list,prev) ((elt)->prev) */ #define _PREVASGN(elt,list,to,prev) ((elt)->prev)=(to) #define _RS(list) #define _CASTASGN(a,b) (a)=(b) #endif /****************************************************************************** * The sort macro is an adaptation of Simon Tatham's O(n log(n)) mergesort * * Unwieldy variable names used here to avoid shadowing passed-in variables. * *****************************************************************************/ #define LL_SORT(list, cmp) \ LL_SORT2(list, cmp, next) #define LL_SORT2(list, cmp, next) \ do { \ LDECLTYPE(list) _ls_p; \ LDECLTYPE(list) _ls_q; \ LDECLTYPE(list) _ls_e; \ LDECLTYPE(list) _ls_tail; \ int _ls_insize, _ls_nmerges, _ls_psize, _ls_qsize, _ls_i, _ls_looping; \ if (list) { \ _ls_insize = 1; \ _ls_looping = 1; \ while (_ls_looping) { \ _CASTASGN(_ls_p,list); \ list = NULL; \ _ls_tail = NULL; \ _ls_nmerges = 0; \ while (_ls_p) { \ _ls_nmerges++; \ _ls_q = _ls_p; \ _ls_psize = 0; \ for (_ls_i = 0; _ls_i < _ls_insize; _ls_i++) { \ _ls_psize++; \ _SV(_ls_q,list); _ls_q = _NEXT(_ls_q,list,next); _RS(list); \ if (!_ls_q) break; \ } \ _ls_qsize = _ls_insize; \ while (_ls_psize > 0 || (_ls_qsize > 0 && _ls_q)) { \ if (_ls_psize == 0) { \ _ls_e = _ls_q; _SV(_ls_q,list); _ls_q = \ _NEXT(_ls_q,list,next); _RS(list); _ls_qsize--; \ } else if (_ls_qsize == 0 || !_ls_q) { \ _ls_e = _ls_p; _SV(_ls_p,list); _ls_p = \ _NEXT(_ls_p,list,next); _RS(list); _ls_psize--; \ } else if (cmp(_ls_p,_ls_q) <= 0) { \ _ls_e = _ls_p; _SV(_ls_p,list); _ls_p = \ _NEXT(_ls_p,list,next); _RS(list); _ls_psize--; \ } else { \ _ls_e = _ls_q; _SV(_ls_q,list); _ls_q = \ _NEXT(_ls_q,list,next); _RS(list); _ls_qsize--; \ } \ if (_ls_tail) { \ _SV(_ls_tail,list); _NEXTASGN(_ls_tail,list,_ls_e,next); _RS(list); \ } else { \ _CASTASGN(list,_ls_e); \ } \ _ls_tail = _ls_e; \ } \ _ls_p = _ls_q; \ } \ if (_ls_tail) { \ _SV(_ls_tail,list); _NEXTASGN(_ls_tail,list,NULL,next); _RS(list); \ } \ if (_ls_nmerges <= 1) { \ _ls_looping=0; \ } \ _ls_insize *= 2; \ } \ } \ } while (0) #define DL_SORT(list, cmp) \ DL_SORT2(list, cmp, prev, next) #define DL_SORT2(list, cmp, prev, next) \ do { \ LDECLTYPE(list) _ls_p; \ LDECLTYPE(list) _ls_q; \ LDECLTYPE(list) _ls_e; \ LDECLTYPE(list) _ls_tail; \ int _ls_insize, _ls_nmerges, _ls_psize, _ls_qsize, _ls_i, _ls_looping; \ if (list) { \ _ls_insize = 1; \ _ls_looping = 1; \ while (_ls_looping) { \ _CASTASGN(_ls_p,list); \ list = NULL; \ _ls_tail = NULL; \ _ls_nmerges = 0; \ while (_ls_p) { \ _ls_nmerges++; \ _ls_q = _ls_p; \ _ls_psize = 0; \ for (_ls_i = 0; _ls_i < _ls_insize; _ls_i++) { \ _ls_psize++; \ _SV(_ls_q,list); _ls_q = _NEXT(_ls_q,list,next); _RS(list); \ if (!_ls_q) break; \ } \ _ls_qsize = _ls_insize; \ while (_ls_psize > 0 || (_ls_qsize > 0 && _ls_q)) { \ if (_ls_psize == 0) { \ _ls_e = _ls_q; _SV(_ls_q,list); _ls_q = \ _NEXT(_ls_q,list,next); _RS(list); _ls_qsize--; \ } else if (_ls_qsize == 0 || !_ls_q) { \ _ls_e = _ls_p; _SV(_ls_p,list); _ls_p = \ _NEXT(_ls_p,list,next); _RS(list); _ls_psize--; \ } else if (cmp(_ls_p,_ls_q) <= 0) { \ _ls_e = _ls_p; _SV(_ls_p,list); _ls_p = \ _NEXT(_ls_p,list,next); _RS(list); _ls_psize--; \ } else { \ _ls_e = _ls_q; _SV(_ls_q,list); _ls_q = \ _NEXT(_ls_q,list,next); _RS(list); _ls_qsize--; \ } \ if (_ls_tail) { \ _SV(_ls_tail,list); _NEXTASGN(_ls_tail,list,_ls_e,next); _RS(list); \ } else { \ _CASTASGN(list,_ls_e); \ } \ _SV(_ls_e,list); _PREVASGN(_ls_e,list,_ls_tail,prev); _RS(list); \ _ls_tail = _ls_e; \ } \ _ls_p = _ls_q; \ } \ _CASTASGN(list->prev, _ls_tail); \ _SV(_ls_tail,list); _NEXTASGN(_ls_tail,list,NULL,next); _RS(list); \ if (_ls_nmerges <= 1) { \ _ls_looping=0; \ } \ _ls_insize *= 2; \ } \ } \ } while (0) #define CDL_SORT(list, cmp) \ CDL_SORT2(list, cmp, prev, next) #define CDL_SORT2(list, cmp, prev, next) \ do { \ LDECLTYPE(list) _ls_p; \ LDECLTYPE(list) _ls_q; \ LDECLTYPE(list) _ls_e; \ LDECLTYPE(list) _ls_tail; \ LDECLTYPE(list) _ls_oldhead; \ LDECLTYPE(list) _tmp; \ int _ls_insize, _ls_nmerges, _ls_psize, _ls_qsize, _ls_i, _ls_looping; \ if (list) { \ _ls_insize = 1; \ _ls_looping = 1; \ while (_ls_looping) { \ _CASTASGN(_ls_p,list); \ _CASTASGN(_ls_oldhead,list); \ list = NULL; \ _ls_tail = NULL; \ _ls_nmerges = 0; \ while (_ls_p) { \ _ls_nmerges++; \ _ls_q = _ls_p; \ _ls_psize = 0; \ for (_ls_i = 0; _ls_i < _ls_insize; _ls_i++) { \ _ls_psize++; \ _SV(_ls_q,list); \ if (_NEXT(_ls_q,list,next) == _ls_oldhead) { \ _ls_q = NULL; \ } else { \ _ls_q = _NEXT(_ls_q,list,next); \ } \ _RS(list); \ if (!_ls_q) break; \ } \ _ls_qsize = _ls_insize; \ while (_ls_psize > 0 || (_ls_qsize > 0 && _ls_q)) { \ if (_ls_psize == 0) { \ _ls_e = _ls_q; _SV(_ls_q,list); _ls_q = \ _NEXT(_ls_q,list,next); _RS(list); _ls_qsize--; \ if (_ls_q == _ls_oldhead) { _ls_q = NULL; } \ } else if (_ls_qsize == 0 || !_ls_q) { \ _ls_e = _ls_p; _SV(_ls_p,list); _ls_p = \ _NEXT(_ls_p,list,next); _RS(list); _ls_psize--; \ if (_ls_p == _ls_oldhead) { _ls_p = NULL; } \ } else if (cmp(_ls_p,_ls_q) <= 0) { \ _ls_e = _ls_p; _SV(_ls_p,list); _ls_p = \ _NEXT(_ls_p,list,next); _RS(list); _ls_psize--; \ if (_ls_p == _ls_oldhead) { _ls_p = NULL; } \ } else { \ _ls_e = _ls_q; _SV(_ls_q,list); _ls_q = \ _NEXT(_ls_q,list,next); _RS(list); _ls_qsize--; \ if (_ls_q == _ls_oldhead) { _ls_q = NULL; } \ } \ if (_ls_tail) { \ _SV(_ls_tail,list); _NEXTASGN(_ls_tail,list,_ls_e,next); _RS(list); \ } else { \ _CASTASGN(list,_ls_e); \ } \ _SV(_ls_e,list); _PREVASGN(_ls_e,list,_ls_tail,prev); _RS(list); \ _ls_tail = _ls_e; \ } \ _ls_p = _ls_q; \ } \ _CASTASGN(list->prev,_ls_tail); \ _CASTASGN(_tmp,list); \ _SV(_ls_tail,list); _NEXTASGN(_ls_tail,list,_tmp,next); _RS(list); \ if (_ls_nmerges <= 1) { \ _ls_looping=0; \ } \ _ls_insize *= 2; \ } \ } \ } while (0) /****************************************************************************** * singly linked list macros (non-circular) * *****************************************************************************/ #define LL_PREPEND(head,add) \ LL_PREPEND2(head,add,next) #define LL_PREPEND2(head,add,next) \ do { \ (add)->next = head; \ head = add; \ } while (0) #define LL_CONCAT(head1,head2) \ LL_CONCAT2(head1,head2,next) #define LL_CONCAT2(head1,head2,next) \ do { \ LDECLTYPE(head1) _tmp; \ if (head1) { \ _tmp = head1; \ while (_tmp->next) { _tmp = _tmp->next; } \ _tmp->next=(head2); \ } else { \ (head1)=(head2); \ } \ } while (0) #define LL_APPEND(head,add) \ LL_APPEND2(head,add,next) #define LL_APPEND2(head,add,next) \ do { \ LDECLTYPE(head) _tmp; \ (add)->next=NULL; \ if (head) { \ _tmp = head; \ while (_tmp->next) { _tmp = _tmp->next; } \ _tmp->next=(add); \ } else { \ (head)=(add); \ } \ } while (0) #define LL_DELETE(head,del) \ LL_DELETE2(head,del,next) #define LL_DELETE2(head,del,next) \ do { \ LDECLTYPE(head) _tmp; \ if ((head) == (del)) { \ (head)=(head)->next; \ } else { \ _tmp = head; \ while (_tmp->next && (_tmp->next != (del))) { \ _tmp = _tmp->next; \ } \ if (_tmp->next) { \ _tmp->next = ((del)->next); \ } \ } \ } while (0) /* Here are VS2008 replacements for LL_APPEND and LL_DELETE */ #define LL_APPEND_VS2008(head,add) \ LL_APPEND2_VS2008(head,add,next) #define LL_APPEND2_VS2008(head,add,next) \ do { \ if (head) { \ (add)->next = head; /* use add->next as a temp variable */ \ while ((add)->next->next) { (add)->next = (add)->next->next; } \ (add)->next->next=(add); \ } else { \ (head)=(add); \ } \ (add)->next=NULL; \ } while (0) #define LL_DELETE_VS2008(head,del) \ LL_DELETE2_VS2008(head,del,next) #define LL_DELETE2_VS2008(head,del,next) \ do { \ if ((head) == (del)) { \ (head)=(head)->next; \ } else { \ char *_tmp = (char*)(head); \ while ((head)->next && ((head)->next != (del))) { \ head = (head)->next; \ } \ if ((head)->next) { \ (head)->next = ((del)->next); \ } \ { \ char **_head_alias = (char**)&(head); \ *_head_alias = _tmp; \ } \ } \ } while (0) #ifdef NO_DECLTYPE #undef LL_APPEND #define LL_APPEND LL_APPEND_VS2008 #undef LL_DELETE #define LL_DELETE LL_DELETE_VS2008 #undef LL_DELETE2 #define LL_DELETE2 LL_DELETE2_VS2008 #undef LL_APPEND2 #define LL_APPEND2 LL_APPEND2_VS2008 #undef LL_CONCAT /* no LL_CONCAT_VS2008 */ #undef DL_CONCAT /* no DL_CONCAT_VS2008 */ #endif /* end VS2008 replacements */ #define LL_COUNT(head,el,counter) \ LL_COUNT2(head,el,counter,next) \ #define LL_COUNT2(head,el,counter,next) \ { \ counter = 0; \ LL_FOREACH2(head,el,next){ ++counter; } \ } #define LL_FOREACH(head,el) \ LL_FOREACH2(head,el,next) #define LL_FOREACH2(head,el,next) \ for(el=head;el;el=(el)->next) #define LL_FOREACH_SAFE(head,el,tmp) \ LL_FOREACH_SAFE2(head,el,tmp,next) #define LL_FOREACH_SAFE2(head,el,tmp,next) \ for((el)=(head);(el) && (tmp = (el)->next, 1); (el) = tmp) #define LL_SEARCH_SCALAR(head,out,field,val) \ LL_SEARCH_SCALAR2(head,out,field,val,next) #define LL_SEARCH_SCALAR2(head,out,field,val,next) \ do { \ LL_FOREACH2(head,out,next) { \ if ((out)->field == (val)) break; \ } \ } while(0) #define LL_SEARCH(head,out,elt,cmp) \ LL_SEARCH2(head,out,elt,cmp,next) #define LL_SEARCH2(head,out,elt,cmp,next) \ do { \ LL_FOREACH2(head,out,next) { \ if ((cmp(out,elt))==0) break; \ } \ } while(0) #define LL_REPLACE_ELEM(head, el, add) \ do { \ LDECLTYPE(head) _tmp; \ assert(head != NULL); \ assert(el != NULL); \ assert(add != NULL); \ (add)->next = (el)->next; \ if ((head) == (el)) { \ (head) = (add); \ } else { \ _tmp = head; \ while (_tmp->next && (_tmp->next != (el))) { \ _tmp = _tmp->next; \ } \ if (_tmp->next) { \ _tmp->next = (add); \ } \ } \ } while (0) #define LL_PREPEND_ELEM(head, el, add) \ do { \ LDECLTYPE(head) _tmp; \ assert(head != NULL); \ assert(el != NULL); \ assert(add != NULL); \ (add)->next = (el); \ if ((head) == (el)) { \ (head) = (add); \ } else { \ _tmp = head; \ while (_tmp->next && (_tmp->next != (el))) { \ _tmp = _tmp->next; \ } \ if (_tmp->next) { \ _tmp->next = (add); \ } \ } \ } while (0) \ /****************************************************************************** * doubly linked list macros (non-circular) * *****************************************************************************/ #define DL_PREPEND(head,add) \ DL_PREPEND2(head,add,prev,next) #define DL_PREPEND2(head,add,prev,next) \ do { \ (add)->next = head; \ if (head) { \ (add)->prev = (head)->prev; \ (head)->prev = (add); \ } else { \ (add)->prev = (add); \ } \ (head) = (add); \ } while (0) #define DL_APPEND(head,add) \ DL_APPEND2(head,add,prev,next) #define DL_APPEND2(head,add,prev,next) \ do { \ if (head) { \ (add)->prev = (head)->prev; \ (head)->prev->next = (add); \ (head)->prev = (add); \ (add)->next = NULL; \ } else { \ (head)=(add); \ (head)->prev = (head); \ (head)->next = NULL; \ } \ } while (0) #define DL_CONCAT(head1,head2) \ DL_CONCAT2(head1,head2,prev,next) #define DL_CONCAT2(head1,head2,prev,next) \ do { \ LDECLTYPE(head1) _tmp; \ if (head2) { \ if (head1) { \ _tmp = (head2)->prev; \ (head2)->prev = (head1)->prev; \ (head1)->prev->next = (head2); \ (head1)->prev = _tmp; \ } else { \ (head1)=(head2); \ } \ } \ } while (0) #define DL_DELETE(head,del) \ DL_DELETE2(head,del,prev,next) #define DL_DELETE2(head,del,prev,next) \ do { \ assert((del)->prev != NULL); \ if ((del)->prev == (del)) { \ (head)=NULL; \ } else if ((del)==(head)) { \ (del)->next->prev = (del)->prev; \ (head) = (del)->next; \ } else { \ (del)->prev->next = (del)->next; \ if ((del)->next) { \ (del)->next->prev = (del)->prev; \ } else { \ (head)->prev = (del)->prev; \ } \ } \ } while (0) #define DL_COUNT(head,el,counter) \ DL_COUNT2(head,el,counter,next) \ #define DL_COUNT2(head,el,counter,next) \ { \ counter = 0; \ DL_FOREACH2(head,el,next){ ++counter; } \ } #define DL_FOREACH(head,el) \ DL_FOREACH2(head,el,next) #define DL_FOREACH2(head,el,next) \ for(el=head;el;el=(el)->next) /* this version is safe for deleting the elements during iteration */ #define DL_FOREACH_SAFE(head,el,tmp) \ DL_FOREACH_SAFE2(head,el,tmp,next) #define DL_FOREACH_SAFE2(head,el,tmp,next) \ for((el)=(head);(el) && (tmp = (el)->next, 1); (el) = tmp) /* these are identical to their singly-linked list counterparts */ #define DL_SEARCH_SCALAR LL_SEARCH_SCALAR #define DL_SEARCH LL_SEARCH #define DL_SEARCH_SCALAR2 LL_SEARCH_SCALAR2 #define DL_SEARCH2 LL_SEARCH2 #define DL_REPLACE_ELEM(head, el, add) \ do { \ assert(head != NULL); \ assert(el != NULL); \ assert(add != NULL); \ if ((head) == (el)) { \ (head) = (add); \ (add)->next = (el)->next; \ if ((el)->next == NULL) { \ (add)->prev = (add); \ } else { \ (add)->prev = (el)->prev; \ (add)->next->prev = (add); \ } \ } else { \ (add)->next = (el)->next; \ (add)->prev = (el)->prev; \ (add)->prev->next = (add); \ if ((el)->next == NULL) { \ (head)->prev = (add); \ } else { \ (add)->next->prev = (add); \ } \ } \ } while (0) #define DL_PREPEND_ELEM(head, el, add) \ do { \ assert(head != NULL); \ assert(el != NULL); \ assert(add != NULL); \ (add)->next = (el); \ (add)->prev = (el)->prev; \ (el)->prev = (add); \ if ((head) == (el)) { \ (head) = (add); \ } else { \ (add)->prev->next = (add); \ } \ } while (0) \ /****************************************************************************** * circular doubly linked list macros * *****************************************************************************/ #define CDL_PREPEND(head,add) \ CDL_PREPEND2(head,add,prev,next) #define CDL_PREPEND2(head,add,prev,next) \ do { \ if (head) { \ (add)->prev = (head)->prev; \ (add)->next = (head); \ (head)->prev = (add); \ (add)->prev->next = (add); \ } else { \ (add)->prev = (add); \ (add)->next = (add); \ } \ (head)=(add); \ } while (0) #define CDL_DELETE(head,del) \ CDL_DELETE2(head,del,prev,next) #define CDL_DELETE2(head,del,prev,next) \ do { \ if ( ((head)==(del)) && ((head)->next == (head))) { \ (head) = 0L; \ } else { \ (del)->next->prev = (del)->prev; \ (del)->prev->next = (del)->next; \ if ((del) == (head)) (head)=(del)->next; \ } \ } while (0) #define CDL_COUNT(head,el,counter) \ CDL_COUNT2(head,el,counter,next) \ #define CDL_COUNT2(head, el, counter,next) \ { \ counter = 0; \ CDL_FOREACH2(head,el,next){ ++counter; } \ } #define CDL_FOREACH(head,el) \ CDL_FOREACH2(head,el,next) #define CDL_FOREACH2(head,el,next) \ for(el=head;el;el=((el)->next==head ? 0L : (el)->next)) #define CDL_FOREACH_SAFE(head,el,tmp1,tmp2) \ CDL_FOREACH_SAFE2(head,el,tmp1,tmp2,prev,next) #define CDL_FOREACH_SAFE2(head,el,tmp1,tmp2,prev,next) \ for((el)=(head), ((tmp1)=(head)?((head)->prev):NULL); \ (el) && ((tmp2)=(el)->next, 1); \ ((el) = (((el)==(tmp1)) ? 0L : (tmp2)))) #define CDL_SEARCH_SCALAR(head,out,field,val) \ CDL_SEARCH_SCALAR2(head,out,field,val,next) #define CDL_SEARCH_SCALAR2(head,out,field,val,next) \ do { \ CDL_FOREACH2(head,out,next) { \ if ((out)->field == (val)) break; \ } \ } while(0) #define CDL_SEARCH(head,out,elt,cmp) \ CDL_SEARCH2(head,out,elt,cmp,next) #define CDL_SEARCH2(head,out,elt,cmp,next) \ do { \ CDL_FOREACH2(head,out,next) { \ if ((cmp(out,elt))==0) break; \ } \ } while(0) #define CDL_REPLACE_ELEM(head, el, add) \ do { \ assert(head != NULL); \ assert(el != NULL); \ assert(add != NULL); \ if ((el)->next == (el)) { \ (add)->next = (add); \ (add)->prev = (add); \ (head) = (add); \ } else { \ (add)->next = (el)->next; \ (add)->prev = (el)->prev; \ (add)->next->prev = (add); \ (add)->prev->next = (add); \ if ((head) == (el)) { \ (head) = (add); \ } \ } \ } while (0) #define CDL_PREPEND_ELEM(head, el, add) \ do { \ assert(head != NULL); \ assert(el != NULL); \ assert(add != NULL); \ (add)->next = (el); \ (add)->prev = (el)->prev; \ (el)->prev = (add); \ (add)->prev->next = (add); \ if ((head) == (el)) { \ (head) = (add); \ } \ } while (0) \ #endif /* UTLIST_H */ wcc-0.0.2/include/nametoentsz.h0000644000175000017500000000454213110675433015112 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ /** * * Generated with: * find /usr/sbin/|while read mama; do readelf -S $mama 2>/dev/null|grep "\[" -A 1|sed s#"\[.*\]"#"\nKOALA\n"#gi|tr -d "\n"|sed s#"KOALA"#"\n"#gi|sed s#"[WAX]\{1,3\}"##g|awk '{print "{\"" $1 "\", " $6 "}," }'|grep "[0-9]" ; done|sort -u * */ typedef struct assoc_nametosz_t{ char *name; unsigned int sz; }assoc_nametosz_t; assoc_nametosz_t nametosize[] = { #ifdef __LP64__ // Generic 64b {".bss", 0x00}, {".comment", 0x01}, {".debug_str", 0x01}, {".dynamic", 0x10}, {".dynsym", 0x18}, {".got", 0x08}, {".got.plt", 0x08}, {".hash", 0x04}, {".plt", 0x10}, {".rela.dyn", 0x18}, {".rela.plt", 0x18}, {".rel.dyn", 0x18}, {".rel.plt", 0x18}, {".symtab", 0x18} #else // Generic 32b {".bss", 0x00}, {".comment", 0x01}, {".debug_str", 0x01}, {".dynamic", 0x8}, {".dynsym", 0x10}, {".got", 0x04}, {".got.plt", 0x04}, {".hash", 0x04}, {".plt", 0x10}, {".rela.dyn", 0xc}, {".rela.plt", 0xc}, //{".rel.dyn", 0x8}, //{".rel.plt", 0x8}, {".rel.dyn", 0x8}, {".rel.plt", 0x8}, {".symtab", 0x10} #endif }; wcc-0.0.2/include/nametoinfo.h0000644000175000017500000000307213110675433014677 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ typedef struct assoc_nametoinfo_t{ char *name; char *dst; }assoc_nametoinfo_t; assoc_nametoinfo_t nametoinfo[] = { {".dynsym", ".note.ABI-tag"}, {".gnu.version_r", ".note.ABI-tag"}, {".rela.plt", ".plt"}, }; wcc-0.0.2/include/config.h0000644000175000017500000000274513110675433014013 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #define WNAME "Witchcraft Compiler Collection (WCC)" #define WVERSION "0.0.1" #define WDATE __DATE__ #define WTIME __TIME__ wcc-0.0.2/include/uthash.h0000644000175000017500000016750613110675433014051 0ustar philphil/* Copyright (c) 2003-2013, Troy D. Hanson http://troydhanson.github.com/uthash/ All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef UTHASH_H #define UTHASH_H #include /* memcmp,strlen */ #include /* ptrdiff_t */ #include /* exit() */ /* These macros use decltype or the earlier __typeof GNU extension. As decltype is only available in newer compilers (VS2010 or gcc 4.3+ when compiling c++ source) this code uses whatever method is needed or, for VS2008 where neither is available, uses casting workarounds. */ #ifdef _MSC_VER /* MS compiler */ #if _MSC_VER >= 1600 && defined(__cplusplus) /* VS2010 or newer in C++ mode */ #define DECLTYPE(x) (decltype(x)) #else /* VS2008 or older (or VS2010 in C mode) */ #define NO_DECLTYPE #define DECLTYPE(x) #endif #else /* GNU, Sun and other compilers */ #define DECLTYPE(x) (__typeof(x)) #endif #ifdef NO_DECLTYPE #define DECLTYPE_ASSIGN(dst,src) \ do { \ char **_da_dst = (char**)(&(dst)); \ *_da_dst = (char*)(src); \ } while(0) #else #define DECLTYPE_ASSIGN(dst,src) \ do { \ (dst) = DECLTYPE(dst)(src); \ } while(0) #endif /* a number of the hash function use uint32_t which isn't defined on win32 */ #ifdef _MSC_VER typedef unsigned int uint32_t; typedef unsigned char uint8_t; #else #include /* uint32_t */ #endif #define UTHASH_VERSION 1.9.8 #ifndef uthash_fatal #define uthash_fatal(msg) exit(-1) /* fatal error (out of memory,etc) */ #endif #ifndef uthash_malloc #define uthash_malloc(sz) malloc(sz) /* malloc fcn */ #endif #ifndef uthash_free #define uthash_free(ptr,sz) free(ptr) /* free fcn */ #endif #ifndef uthash_noexpand_fyi #define uthash_noexpand_fyi(tbl) /* can be defined to log noexpand */ #endif #ifndef uthash_expand_fyi #define uthash_expand_fyi(tbl) /* can be defined to log expands */ #endif /* initial number of buckets */ #define HASH_INITIAL_NUM_BUCKETS 32 /* initial number of buckets */ #define HASH_INITIAL_NUM_BUCKETS_LOG2 5 /* lg2 of initial number of buckets */ #define HASH_BKT_CAPACITY_THRESH 10 /* expand when bucket count reaches */ /* calculate the element whose hash handle address is hhe */ #define ELMT_FROM_HH(tbl,hhp) ((void*)(((char*)(hhp)) - ((tbl)->hho))) #define HASH_FIND(hh,head,keyptr,keylen,out) \ do { \ unsigned _hf_bkt,_hf_hashv; \ out=NULL; \ if (head) { \ HASH_FCN(keyptr,keylen, (head)->hh.tbl->num_buckets, _hf_hashv, _hf_bkt); \ if (HASH_BLOOM_TEST((head)->hh.tbl, _hf_hashv)) { \ HASH_FIND_IN_BKT((head)->hh.tbl, hh, (head)->hh.tbl->buckets[ _hf_bkt ], \ keyptr,keylen,out); \ } \ } \ } while (0) #ifdef HASH_BLOOM #define HASH_BLOOM_BITLEN (1ULL << HASH_BLOOM) #define HASH_BLOOM_BYTELEN (HASH_BLOOM_BITLEN/8) + ((HASH_BLOOM_BITLEN%8) ? 1:0) #define HASH_BLOOM_MAKE(tbl) \ do { \ (tbl)->bloom_nbits = HASH_BLOOM; \ (tbl)->bloom_bv = (uint8_t*)uthash_malloc(HASH_BLOOM_BYTELEN); \ if (!((tbl)->bloom_bv)) { uthash_fatal( "out of memory"); } \ memset((tbl)->bloom_bv, 0, HASH_BLOOM_BYTELEN); \ (tbl)->bloom_sig = HASH_BLOOM_SIGNATURE; \ } while (0) #define HASH_BLOOM_FREE(tbl) \ do { \ uthash_free((tbl)->bloom_bv, HASH_BLOOM_BYTELEN); \ } while (0) #define HASH_BLOOM_BITSET(bv,idx) (bv[(idx)/8] |= (1U << ((idx)%8))) #define HASH_BLOOM_BITTEST(bv,idx) (bv[(idx)/8] & (1U << ((idx)%8))) #define HASH_BLOOM_ADD(tbl,hashv) \ HASH_BLOOM_BITSET((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1))) #define HASH_BLOOM_TEST(tbl,hashv) \ HASH_BLOOM_BITTEST((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1))) #else #define HASH_BLOOM_MAKE(tbl) #define HASH_BLOOM_FREE(tbl) #define HASH_BLOOM_ADD(tbl,hashv) #define HASH_BLOOM_TEST(tbl,hashv) (1) #define HASH_BLOOM_BYTELEN 0 #endif #define HASH_MAKE_TABLE(hh,head) \ do { \ (head)->hh.tbl = (UT_hash_table*)uthash_malloc( \ sizeof(UT_hash_table)); \ if (!((head)->hh.tbl)) { uthash_fatal( "out of memory"); } \ memset((head)->hh.tbl, 0, sizeof(UT_hash_table)); \ (head)->hh.tbl->tail = &((head)->hh); \ (head)->hh.tbl->num_buckets = HASH_INITIAL_NUM_BUCKETS; \ (head)->hh.tbl->log2_num_buckets = HASH_INITIAL_NUM_BUCKETS_LOG2; \ (head)->hh.tbl->hho = (char*)(&(head)->hh) - (char*)(head); \ (head)->hh.tbl->buckets = (UT_hash_bucket*)uthash_malloc( \ HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket)); \ if (! (head)->hh.tbl->buckets) { uthash_fatal( "out of memory"); } \ memset((head)->hh.tbl->buckets, 0, \ HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket)); \ HASH_BLOOM_MAKE((head)->hh.tbl); \ (head)->hh.tbl->signature = HASH_SIGNATURE; \ } while(0) #define HASH_ADD(hh,head,fieldname,keylen_in,add) \ HASH_ADD_KEYPTR(hh,head,&((add)->fieldname),keylen_in,add) #define HASH_REPLACE(hh,head,fieldname,keylen_in,add,replaced) \ do { \ replaced=NULL; \ HASH_FIND(hh,head,&((add)->fieldname),keylen_in,replaced); \ if (replaced!=NULL) { \ HASH_DELETE(hh,head,replaced); \ }; \ HASH_ADD(hh,head,fieldname,keylen_in,add); \ } while(0) #define HASH_ADD_KEYPTR(hh,head,keyptr,keylen_in,add) \ do { \ unsigned _ha_bkt; \ (add)->hh.next = NULL; \ (add)->hh.key = (char*)(keyptr); \ (add)->hh.keylen = (unsigned)(keylen_in); \ if (!(head)) { \ head = (add); \ (head)->hh.prev = NULL; \ HASH_MAKE_TABLE(hh,head); \ } else { \ (head)->hh.tbl->tail->next = (add); \ (add)->hh.prev = ELMT_FROM_HH((head)->hh.tbl, (head)->hh.tbl->tail); \ (head)->hh.tbl->tail = &((add)->hh); \ } \ (head)->hh.tbl->num_items++; \ (add)->hh.tbl = (head)->hh.tbl; \ HASH_FCN(keyptr,keylen_in, (head)->hh.tbl->num_buckets, \ (add)->hh.hashv, _ha_bkt); \ HASH_ADD_TO_BKT((head)->hh.tbl->buckets[_ha_bkt],&(add)->hh); \ HASH_BLOOM_ADD((head)->hh.tbl,(add)->hh.hashv); \ HASH_EMIT_KEY(hh,head,keyptr,keylen_in); \ HASH_FSCK(hh,head); \ } while(0) #define HASH_TO_BKT( hashv, num_bkts, bkt ) \ do { \ bkt = ((hashv) & ((num_bkts) - 1)); \ } while(0) /* delete "delptr" from the hash table. * "the usual" patch-up process for the app-order doubly-linked-list. * The use of _hd_hh_del below deserves special explanation. * These used to be expressed using (delptr) but that led to a bug * if someone used the same symbol for the head and deletee, like * HASH_DELETE(hh,users,users); * We want that to work, but by changing the head (users) below * we were forfeiting our ability to further refer to the deletee (users) * in the patch-up process. Solution: use scratch space to * copy the deletee pointer, then the latter references are via that * scratch pointer rather than through the repointed (users) symbol. */ #define HASH_DELETE(hh,head,delptr) \ do { \ unsigned _hd_bkt; \ struct UT_hash_handle *_hd_hh_del; \ if ( ((delptr)->hh.prev == NULL) && ((delptr)->hh.next == NULL) ) { \ uthash_free((head)->hh.tbl->buckets, \ (head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \ HASH_BLOOM_FREE((head)->hh.tbl); \ uthash_free((head)->hh.tbl, sizeof(UT_hash_table)); \ head = NULL; \ } else { \ _hd_hh_del = &((delptr)->hh); \ if ((delptr) == ELMT_FROM_HH((head)->hh.tbl,(head)->hh.tbl->tail)) { \ (head)->hh.tbl->tail = \ (UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) + \ (head)->hh.tbl->hho); \ } \ if ((delptr)->hh.prev) { \ ((UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) + \ (head)->hh.tbl->hho))->next = (delptr)->hh.next; \ } else { \ DECLTYPE_ASSIGN(head,(delptr)->hh.next); \ } \ if (_hd_hh_del->next) { \ ((UT_hash_handle*)((ptrdiff_t)_hd_hh_del->next + \ (head)->hh.tbl->hho))->prev = \ _hd_hh_del->prev; \ } \ HASH_TO_BKT( _hd_hh_del->hashv, (head)->hh.tbl->num_buckets, _hd_bkt); \ HASH_DEL_IN_BKT(hh,(head)->hh.tbl->buckets[_hd_bkt], _hd_hh_del); \ (head)->hh.tbl->num_items--; \ } \ HASH_FSCK(hh,head); \ } while (0) /* convenience forms of HASH_FIND/HASH_ADD/HASH_DEL */ #define HASH_FIND_STR(head,findstr,out) \ HASH_FIND(hh,head,findstr,strlen(findstr),out) #define HASH_ADD_STR(head,strfield,add) \ HASH_ADD(hh,head,strfield,strlen(add->strfield),add) #define HASH_REPLACE_STR(head,strfield,add,replaced) \ HASH_REPLACE(hh,head,strfield,strlen(add->strfield),add,replaced) #define HASH_FIND_INT(head,findint,out) \ HASH_FIND(hh,head,findint,sizeof(int),out) #define HASH_ADD_INT(head,intfield,add) \ HASH_ADD(hh,head,intfield,sizeof(int),add) #define HASH_REPLACE_INT(head,intfield,add,replaced) \ HASH_REPLACE(hh,head,intfield,sizeof(int),add,replaced) #define HASH_FIND_PTR(head,findptr,out) \ HASH_FIND(hh,head,findptr,sizeof(void *),out) #define HASH_ADD_PTR(head,ptrfield,add) \ HASH_ADD(hh,head,ptrfield,sizeof(void *),add) #define HASH_REPLACE_PTR(head,ptrfield,add,replaced) \ HASH_REPLACE(hh,head,ptrfield,sizeof(void *),add,replaced) #define HASH_DEL(head,delptr) \ HASH_DELETE(hh,head,delptr) /* HASH_FSCK checks hash integrity on every add/delete when HASH_DEBUG is defined. * This is for uthash developer only; it compiles away if HASH_DEBUG isn't defined. */ #ifdef HASH_DEBUG #define HASH_OOPS(...) do { fprintf(stderr,__VA_ARGS__); exit(-1); } while (0) #define HASH_FSCK(hh,head) \ do { \ unsigned _bkt_i; \ unsigned _count, _bkt_count; \ char *_prev; \ struct UT_hash_handle *_thh; \ if (head) { \ _count = 0; \ for( _bkt_i = 0; _bkt_i < (head)->hh.tbl->num_buckets; _bkt_i++) { \ _bkt_count = 0; \ _thh = (head)->hh.tbl->buckets[_bkt_i].hh_head; \ _prev = NULL; \ while (_thh) { \ if (_prev != (char*)(_thh->hh_prev)) { \ HASH_OOPS("invalid hh_prev %p, actual %p\n", \ _thh->hh_prev, _prev ); \ } \ _bkt_count++; \ _prev = (char*)(_thh); \ _thh = _thh->hh_next; \ } \ _count += _bkt_count; \ if ((head)->hh.tbl->buckets[_bkt_i].count != _bkt_count) { \ HASH_OOPS("invalid bucket count %d, actual %d\n", \ (head)->hh.tbl->buckets[_bkt_i].count, _bkt_count); \ } \ } \ if (_count != (head)->hh.tbl->num_items) { \ HASH_OOPS("invalid hh item count %d, actual %d\n", \ (head)->hh.tbl->num_items, _count ); \ } \ /* traverse hh in app order; check next/prev integrity, count */ \ _count = 0; \ _prev = NULL; \ _thh = &(head)->hh; \ while (_thh) { \ _count++; \ if (_prev !=(char*)(_thh->prev)) { \ HASH_OOPS("invalid prev %p, actual %p\n", \ _thh->prev, _prev ); \ } \ _prev = (char*)ELMT_FROM_HH((head)->hh.tbl, _thh); \ _thh = ( _thh->next ? (UT_hash_handle*)((char*)(_thh->next) + \ (head)->hh.tbl->hho) : NULL ); \ } \ if (_count != (head)->hh.tbl->num_items) { \ HASH_OOPS("invalid app item count %d, actual %d\n", \ (head)->hh.tbl->num_items, _count ); \ } \ } \ } while (0) #else #define HASH_FSCK(hh,head) #endif /* When compiled with -DHASH_EMIT_KEYS, length-prefixed keys are emitted to * the descriptor to which this macro is defined for tuning the hash function. * The app can #include to get the prototype for write(2). */ #ifdef HASH_EMIT_KEYS #define HASH_EMIT_KEY(hh,head,keyptr,fieldlen) \ do { \ unsigned _klen = fieldlen; \ write(HASH_EMIT_KEYS, &_klen, sizeof(_klen)); \ write(HASH_EMIT_KEYS, keyptr, fieldlen); \ } while (0) #else #define HASH_EMIT_KEY(hh,head,keyptr,fieldlen) #endif /* default to Jenkin's hash unless overridden e.g. DHASH_FUNCTION=HASH_SAX */ #ifdef HASH_FUNCTION #define HASH_FCN HASH_FUNCTION #else #define HASH_FCN HASH_JEN #endif /* The Bernstein hash function, used in Perl prior to v5.6 */ #define HASH_BER(key,keylen,num_bkts,hashv,bkt) \ do { \ unsigned _hb_keylen=keylen; \ char *_hb_key=(char*)(key); \ (hashv) = 0; \ while (_hb_keylen--) { (hashv) = ((hashv) * 33) + *_hb_key++; } \ bkt = (hashv) & (num_bkts-1); \ } while (0) /* SAX/FNV/OAT/JEN hash functions are macro variants of those listed at * http://eternallyconfuzzled.com/tuts/algorithms/jsw_tut_hashing.aspx */ #define HASH_SAX(key,keylen,num_bkts,hashv,bkt) \ do { \ unsigned _sx_i; \ char *_hs_key=(char*)(key); \ hashv = 0; \ for(_sx_i=0; _sx_i < keylen; _sx_i++) \ hashv ^= (hashv << 5) + (hashv >> 2) + _hs_key[_sx_i]; \ bkt = hashv & (num_bkts-1); \ } while (0) #define HASH_FNV(key,keylen,num_bkts,hashv,bkt) \ do { \ unsigned _fn_i; \ char *_hf_key=(char*)(key); \ hashv = 2166136261UL; \ for(_fn_i=0; _fn_i < keylen; _fn_i++) \ hashv = (hashv * 16777619) ^ _hf_key[_fn_i]; \ bkt = hashv & (num_bkts-1); \ } while(0) #define HASH_OAT(key,keylen,num_bkts,hashv,bkt) \ do { \ unsigned _ho_i; \ char *_ho_key=(char*)(key); \ hashv = 0; \ for(_ho_i=0; _ho_i < keylen; _ho_i++) { \ hashv += _ho_key[_ho_i]; \ hashv += (hashv << 10); \ hashv ^= (hashv >> 6); \ } \ hashv += (hashv << 3); \ hashv ^= (hashv >> 11); \ hashv += (hashv << 15); \ bkt = hashv & (num_bkts-1); \ } while(0) #define HASH_JEN_MIX(a,b,c) \ do { \ a -= b; a -= c; a ^= ( c >> 13 ); \ b -= c; b -= a; b ^= ( a << 8 ); \ c -= a; c -= b; c ^= ( b >> 13 ); \ a -= b; a -= c; a ^= ( c >> 12 ); \ b -= c; b -= a; b ^= ( a << 16 ); \ c -= a; c -= b; c ^= ( b >> 5 ); \ a -= b; a -= c; a ^= ( c >> 3 ); \ b -= c; b -= a; b ^= ( a << 10 ); \ c -= a; c -= b; c ^= ( b >> 15 ); \ } while (0) #define HASH_JEN(key,keylen,num_bkts,hashv,bkt) \ do { \ unsigned _hj_i,_hj_j,_hj_k; \ unsigned char *_hj_key=(unsigned char*)(key); \ hashv = 0xfeedbeef; \ _hj_i = _hj_j = 0x9e3779b9; \ _hj_k = (unsigned)(keylen); \ while (_hj_k >= 12) { \ _hj_i += (_hj_key[0] + ( (unsigned)_hj_key[1] << 8 ) \ + ( (unsigned)_hj_key[2] << 16 ) \ + ( (unsigned)_hj_key[3] << 24 ) ); \ _hj_j += (_hj_key[4] + ( (unsigned)_hj_key[5] << 8 ) \ + ( (unsigned)_hj_key[6] << 16 ) \ + ( (unsigned)_hj_key[7] << 24 ) ); \ hashv += (_hj_key[8] + ( (unsigned)_hj_key[9] << 8 ) \ + ( (unsigned)_hj_key[10] << 16 ) \ + ( (unsigned)_hj_key[11] << 24 ) ); \ \ HASH_JEN_MIX(_hj_i, _hj_j, hashv); \ \ _hj_key += 12; \ _hj_k -= 12; \ } \ hashv += keylen; \ switch ( _hj_k ) { \ case 11: hashv += ( (unsigned)_hj_key[10] << 24 ); \ case 10: hashv += ( (unsigned)_hj_key[9] << 16 ); \ case 9: hashv += ( (unsigned)_hj_key[8] << 8 ); \ case 8: _hj_j += ( (unsigned)_hj_key[7] << 24 ); \ case 7: _hj_j += ( (unsigned)_hj_key[6] << 16 ); \ case 6: _hj_j += ( (unsigned)_hj_key[5] << 8 ); \ case 5: _hj_j += _hj_key[4]; \ case 4: _hj_i += ( (unsigned)_hj_key[3] << 24 ); \ case 3: _hj_i += ( (unsigned)_hj_key[2] << 16 ); \ case 2: _hj_i += ( (unsigned)_hj_key[1] << 8 ); \ case 1: _hj_i += _hj_key[0]; \ } \ HASH_JEN_MIX(_hj_i, _hj_j, hashv); \ bkt = hashv & (num_bkts-1); \ } while(0) /* The Paul Hsieh hash function */ #undef get16bits #if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \ || defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__) #define get16bits(d) (*((const uint16_t *) (d))) #endif #if !defined (get16bits) #define get16bits(d) ((((uint32_t)(((const uint8_t *)(d))[1])) << 8) \ +(uint32_t)(((const uint8_t *)(d))[0]) ) #endif #define HASH_SFH(key,keylen,num_bkts,hashv,bkt) \ do { \ unsigned char *_sfh_key=(unsigned char*)(key); \ uint32_t _sfh_tmp, _sfh_len = keylen; \ \ int _sfh_rem = _sfh_len & 3; \ _sfh_len >>= 2; \ hashv = 0xcafebabe; \ \ /* Main loop */ \ for (;_sfh_len > 0; _sfh_len--) { \ hashv += get16bits (_sfh_key); \ _sfh_tmp = (uint32_t)(get16bits (_sfh_key+2)) << 11 ^ hashv; \ hashv = (hashv << 16) ^ _sfh_tmp; \ _sfh_key += 2*sizeof (uint16_t); \ hashv += hashv >> 11; \ } \ \ /* Handle end cases */ \ switch (_sfh_rem) { \ case 3: hashv += get16bits (_sfh_key); \ hashv ^= hashv << 16; \ hashv ^= (uint32_t)(_sfh_key[sizeof (uint16_t)] << 18); \ hashv += hashv >> 11; \ break; \ case 2: hashv += get16bits (_sfh_key); \ hashv ^= hashv << 11; \ hashv += hashv >> 17; \ break; \ case 1: hashv += *_sfh_key; \ hashv ^= hashv << 10; \ hashv += hashv >> 1; \ } \ \ /* Force "avalanching" of final 127 bits */ \ hashv ^= hashv << 3; \ hashv += hashv >> 5; \ hashv ^= hashv << 4; \ hashv += hashv >> 17; \ hashv ^= hashv << 25; \ hashv += hashv >> 6; \ bkt = hashv & (num_bkts-1); \ } while(0) #ifdef HASH_USING_NO_STRICT_ALIASING /* The MurmurHash exploits some CPU's (x86,x86_64) tolerance for unaligned reads. * For other types of CPU's (e.g. Sparc) an unaligned read causes a bus error. * MurmurHash uses the faster approach only on CPU's where we know it's safe. * * Note the preprocessor built-in defines can be emitted using: * * gcc -m64 -dM -E - < /dev/null (on gcc) * cc -## a.c (where a.c is a simple test file) (Sun Studio) */ #if (defined(__i386__) || defined(__x86_64__) || defined(_M_IX86)) #define MUR_GETBLOCK(p,i) p[i] #else /* non intel */ #define MUR_PLUS0_ALIGNED(p) (((unsigned long)p & 0x3) == 0) #define MUR_PLUS1_ALIGNED(p) (((unsigned long)p & 0x3) == 1) #define MUR_PLUS2_ALIGNED(p) (((unsigned long)p & 0x3) == 2) #define MUR_PLUS3_ALIGNED(p) (((unsigned long)p & 0x3) == 3) #define WP(p) ((uint32_t*)((unsigned long)(p) & ~3UL)) #if (defined(__BIG_ENDIAN__) || defined(SPARC) || defined(__ppc__) || defined(__ppc64__)) #define MUR_THREE_ONE(p) ((((*WP(p))&0x00ffffff) << 8) | (((*(WP(p)+1))&0xff000000) >> 24)) #define MUR_TWO_TWO(p) ((((*WP(p))&0x0000ffff) <<16) | (((*(WP(p)+1))&0xffff0000) >> 16)) #define MUR_ONE_THREE(p) ((((*WP(p))&0x000000ff) <<24) | (((*(WP(p)+1))&0xffffff00) >> 8)) #else /* assume little endian non-intel */ #define MUR_THREE_ONE(p) ((((*WP(p))&0xffffff00) >> 8) | (((*(WP(p)+1))&0x000000ff) << 24)) #define MUR_TWO_TWO(p) ((((*WP(p))&0xffff0000) >>16) | (((*(WP(p)+1))&0x0000ffff) << 16)) #define MUR_ONE_THREE(p) ((((*WP(p))&0xff000000) >>24) | (((*(WP(p)+1))&0x00ffffff) << 8)) #endif #define MUR_GETBLOCK(p,i) (MUR_PLUS0_ALIGNED(p) ? ((p)[i]) : \ (MUR_PLUS1_ALIGNED(p) ? MUR_THREE_ONE(p) : \ (MUR_PLUS2_ALIGNED(p) ? MUR_TWO_TWO(p) : \ MUR_ONE_THREE(p)))) #endif #define MUR_ROTL32(x,r) (((x) << (r)) | ((x) >> (32 - (r)))) #define MUR_FMIX(_h) \ do { \ _h ^= _h >> 16; \ _h *= 0x85ebca6b; \ _h ^= _h >> 13; \ _h *= 0xc2b2ae35l; \ _h ^= _h >> 16; \ } while(0) #define HASH_MUR(key,keylen,num_bkts,hashv,bkt) \ do { \ const uint8_t *_mur_data = (const uint8_t*)(key); \ const int _mur_nblocks = (keylen) / 4; \ uint32_t _mur_h1 = 0xf88D5353; \ uint32_t _mur_c1 = 0xcc9e2d51; \ uint32_t _mur_c2 = 0x1b873593; \ uint32_t _mur_k1 = 0; \ const uint8_t *_mur_tail; \ const uint32_t *_mur_blocks = (const uint32_t*)(_mur_data+_mur_nblocks*4); \ int _mur_i; \ for(_mur_i = -_mur_nblocks; _mur_i; _mur_i++) { \ _mur_k1 = MUR_GETBLOCK(_mur_blocks,_mur_i); \ _mur_k1 *= _mur_c1; \ _mur_k1 = MUR_ROTL32(_mur_k1,15); \ _mur_k1 *= _mur_c2; \ \ _mur_h1 ^= _mur_k1; \ _mur_h1 = MUR_ROTL32(_mur_h1,13); \ _mur_h1 = _mur_h1*5+0xe6546b64; \ } \ _mur_tail = (const uint8_t*)(_mur_data + _mur_nblocks*4); \ _mur_k1=0; \ switch((keylen) & 3) { \ case 3: _mur_k1 ^= _mur_tail[2] << 16; \ case 2: _mur_k1 ^= _mur_tail[1] << 8; \ case 1: _mur_k1 ^= _mur_tail[0]; \ _mur_k1 *= _mur_c1; \ _mur_k1 = MUR_ROTL32(_mur_k1,15); \ _mur_k1 *= _mur_c2; \ _mur_h1 ^= _mur_k1; \ } \ _mur_h1 ^= (keylen); \ MUR_FMIX(_mur_h1); \ hashv = _mur_h1; \ bkt = hashv & (num_bkts-1); \ } while(0) #endif /* HASH_USING_NO_STRICT_ALIASING */ /* key comparison function; return 0 if keys equal */ #define HASH_KEYCMP(a,b,len) memcmp(a,b,len) /* iterate over items in a known bucket to find desired item */ #define HASH_FIND_IN_BKT(tbl,hh,head,keyptr,keylen_in,out) \ do { \ if (head.hh_head) DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,head.hh_head)); \ else out=NULL; \ while (out) { \ if ((out)->hh.keylen == keylen_in) { \ if ((HASH_KEYCMP((out)->hh.key,keyptr,keylen_in)) == 0) break; \ } \ if ((out)->hh.hh_next) DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,(out)->hh.hh_next)); \ else out = NULL; \ } \ } while(0) /* add an item to a bucket */ #define HASH_ADD_TO_BKT(head,addhh) \ do { \ head.count++; \ (addhh)->hh_next = head.hh_head; \ (addhh)->hh_prev = NULL; \ if (head.hh_head) { (head).hh_head->hh_prev = (addhh); } \ (head).hh_head=addhh; \ if (head.count >= ((head.expand_mult+1) * HASH_BKT_CAPACITY_THRESH) \ && (addhh)->tbl->noexpand != 1) { \ HASH_EXPAND_BUCKETS((addhh)->tbl); \ } \ } while(0) /* remove an item from a given bucket */ #define HASH_DEL_IN_BKT(hh,head,hh_del) \ (head).count--; \ if ((head).hh_head == hh_del) { \ (head).hh_head = hh_del->hh_next; \ } \ if (hh_del->hh_prev) { \ hh_del->hh_prev->hh_next = hh_del->hh_next; \ } \ if (hh_del->hh_next) { \ hh_del->hh_next->hh_prev = hh_del->hh_prev; \ } /* Bucket expansion has the effect of doubling the number of buckets * and redistributing the items into the new buckets. Ideally the * items will distribute more or less evenly into the new buckets * (the extent to which this is true is a measure of the quality of * the hash function as it applies to the key domain). * * With the items distributed into more buckets, the chain length * (item count) in each bucket is reduced. Thus by expanding buckets * the hash keeps a bound on the chain length. This bounded chain * length is the essence of how a hash provides constant time lookup. * * The calculation of tbl->ideal_chain_maxlen below deserves some * explanation. First, keep in mind that we're calculating the ideal * maximum chain length based on the *new* (doubled) bucket count. * In fractions this is just n/b (n=number of items,b=new num buckets). * Since the ideal chain length is an integer, we want to calculate * ceil(n/b). We don't depend on floating point arithmetic in this * hash, so to calculate ceil(n/b) with integers we could write * * ceil(n/b) = (n/b) + ((n%b)?1:0) * * and in fact a previous version of this hash did just that. * But now we have improved things a bit by recognizing that b is * always a power of two. We keep its base 2 log handy (call it lb), * so now we can write this with a bit shift and logical AND: * * ceil(n/b) = (n>>lb) + ( (n & (b-1)) ? 1:0) * */ #define HASH_EXPAND_BUCKETS(tbl) \ do { \ unsigned _he_bkt; \ unsigned _he_bkt_i; \ struct UT_hash_handle *_he_thh, *_he_hh_nxt; \ UT_hash_bucket *_he_new_buckets, *_he_newbkt; \ _he_new_buckets = (UT_hash_bucket*)uthash_malloc( \ 2 * tbl->num_buckets * sizeof(struct UT_hash_bucket)); \ if (!_he_new_buckets) { uthash_fatal( "out of memory"); } \ memset(_he_new_buckets, 0, \ 2 * tbl->num_buckets * sizeof(struct UT_hash_bucket)); \ tbl->ideal_chain_maxlen = \ (tbl->num_items >> (tbl->log2_num_buckets+1)) + \ ((tbl->num_items & ((tbl->num_buckets*2)-1)) ? 1 : 0); \ tbl->nonideal_items = 0; \ for(_he_bkt_i = 0; _he_bkt_i < tbl->num_buckets; _he_bkt_i++) \ { \ _he_thh = tbl->buckets[ _he_bkt_i ].hh_head; \ while (_he_thh) { \ _he_hh_nxt = _he_thh->hh_next; \ HASH_TO_BKT( _he_thh->hashv, tbl->num_buckets*2, _he_bkt); \ _he_newbkt = &(_he_new_buckets[ _he_bkt ]); \ if (++(_he_newbkt->count) > tbl->ideal_chain_maxlen) { \ tbl->nonideal_items++; \ _he_newbkt->expand_mult = _he_newbkt->count / \ tbl->ideal_chain_maxlen; \ } \ _he_thh->hh_prev = NULL; \ _he_thh->hh_next = _he_newbkt->hh_head; \ if (_he_newbkt->hh_head) _he_newbkt->hh_head->hh_prev = \ _he_thh; \ _he_newbkt->hh_head = _he_thh; \ _he_thh = _he_hh_nxt; \ } \ } \ uthash_free( tbl->buckets, tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \ tbl->num_buckets *= 2; \ tbl->log2_num_buckets++; \ tbl->buckets = _he_new_buckets; \ tbl->ineff_expands = (tbl->nonideal_items > (tbl->num_items >> 1)) ? \ (tbl->ineff_expands+1) : 0; \ if (tbl->ineff_expands > 1) { \ tbl->noexpand=1; \ uthash_noexpand_fyi(tbl); \ } \ uthash_expand_fyi(tbl); \ } while(0) /* This is an adaptation of Simon Tatham's O(n log(n)) mergesort */ /* Note that HASH_SORT assumes the hash handle name to be hh. * HASH_SRT was added to allow the hash handle name to be passed in. */ #define HASH_SORT(head,cmpfcn) HASH_SRT(hh,head,cmpfcn) #define HASH_SRT(hh,head,cmpfcn) \ do { \ unsigned _hs_i; \ unsigned _hs_looping,_hs_nmerges,_hs_insize,_hs_psize,_hs_qsize; \ struct UT_hash_handle *_hs_p, *_hs_q, *_hs_e, *_hs_list, *_hs_tail; \ if (head) { \ _hs_insize = 1; \ _hs_looping = 1; \ _hs_list = &((head)->hh); \ while (_hs_looping) { \ _hs_p = _hs_list; \ _hs_list = NULL; \ _hs_tail = NULL; \ _hs_nmerges = 0; \ while (_hs_p) { \ _hs_nmerges++; \ _hs_q = _hs_p; \ _hs_psize = 0; \ for ( _hs_i = 0; _hs_i < _hs_insize; _hs_i++ ) { \ _hs_psize++; \ _hs_q = (UT_hash_handle*)((_hs_q->next) ? \ ((void*)((char*)(_hs_q->next) + \ (head)->hh.tbl->hho)) : NULL); \ if (! (_hs_q) ) break; \ } \ _hs_qsize = _hs_insize; \ while ((_hs_psize > 0) || ((_hs_qsize > 0) && _hs_q )) { \ if (_hs_psize == 0) { \ _hs_e = _hs_q; \ _hs_q = (UT_hash_handle*)((_hs_q->next) ? \ ((void*)((char*)(_hs_q->next) + \ (head)->hh.tbl->hho)) : NULL); \ _hs_qsize--; \ } else if ( (_hs_qsize == 0) || !(_hs_q) ) { \ _hs_e = _hs_p; \ if (_hs_p){ \ _hs_p = (UT_hash_handle*)((_hs_p->next) ? \ ((void*)((char*)(_hs_p->next) + \ (head)->hh.tbl->hho)) : NULL); \ } \ _hs_psize--; \ } else if (( \ cmpfcn(DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_p)), \ DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_q))) \ ) <= 0) { \ _hs_e = _hs_p; \ if (_hs_p){ \ _hs_p = (UT_hash_handle*)((_hs_p->next) ? \ ((void*)((char*)(_hs_p->next) + \ (head)->hh.tbl->hho)) : NULL); \ } \ _hs_psize--; \ } else { \ _hs_e = _hs_q; \ _hs_q = (UT_hash_handle*)((_hs_q->next) ? \ ((void*)((char*)(_hs_q->next) + \ (head)->hh.tbl->hho)) : NULL); \ _hs_qsize--; \ } \ if ( _hs_tail ) { \ _hs_tail->next = ((_hs_e) ? \ ELMT_FROM_HH((head)->hh.tbl,_hs_e) : NULL); \ } else { \ _hs_list = _hs_e; \ } \ if (_hs_e) { \ _hs_e->prev = ((_hs_tail) ? \ ELMT_FROM_HH((head)->hh.tbl,_hs_tail) : NULL); \ } \ _hs_tail = _hs_e; \ } \ _hs_p = _hs_q; \ } \ if (_hs_tail){ \ _hs_tail->next = NULL; \ } \ if ( _hs_nmerges <= 1 ) { \ _hs_looping=0; \ (head)->hh.tbl->tail = _hs_tail; \ DECLTYPE_ASSIGN(head,ELMT_FROM_HH((head)->hh.tbl, _hs_list)); \ } \ _hs_insize *= 2; \ } \ HASH_FSCK(hh,head); \ } \ } while (0) /* This function selects items from one hash into another hash. * The end result is that the selected items have dual presence * in both hashes. There is no copy of the items made; rather * they are added into the new hash through a secondary hash * hash handle that must be present in the structure. */ #define HASH_SELECT(hh_dst, dst, hh_src, src, cond) \ do { \ unsigned _src_bkt, _dst_bkt; \ void *_last_elt=NULL, *_elt; \ UT_hash_handle *_src_hh, *_dst_hh, *_last_elt_hh=NULL; \ ptrdiff_t _dst_hho = ((char*)(&(dst)->hh_dst) - (char*)(dst)); \ if (src) { \ for(_src_bkt=0; _src_bkt < (src)->hh_src.tbl->num_buckets; _src_bkt++) { \ for(_src_hh = (src)->hh_src.tbl->buckets[_src_bkt].hh_head; \ _src_hh; \ _src_hh = _src_hh->hh_next) { \ _elt = ELMT_FROM_HH((src)->hh_src.tbl, _src_hh); \ if (cond(_elt)) { \ _dst_hh = (UT_hash_handle*)(((char*)_elt) + _dst_hho); \ _dst_hh->key = _src_hh->key; \ _dst_hh->keylen = _src_hh->keylen; \ _dst_hh->hashv = _src_hh->hashv; \ _dst_hh->prev = _last_elt; \ _dst_hh->next = NULL; \ if (_last_elt_hh) { _last_elt_hh->next = _elt; } \ if (!dst) { \ DECLTYPE_ASSIGN(dst,_elt); \ HASH_MAKE_TABLE(hh_dst,dst); \ } else { \ _dst_hh->tbl = (dst)->hh_dst.tbl; \ } \ HASH_TO_BKT(_dst_hh->hashv, _dst_hh->tbl->num_buckets, _dst_bkt); \ HASH_ADD_TO_BKT(_dst_hh->tbl->buckets[_dst_bkt],_dst_hh); \ (dst)->hh_dst.tbl->num_items++; \ _last_elt = _elt; \ _last_elt_hh = _dst_hh; \ } \ } \ } \ } \ HASH_FSCK(hh_dst,dst); \ } while (0) #define HASH_CLEAR(hh,head) \ do { \ if (head) { \ uthash_free((head)->hh.tbl->buckets, \ (head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket)); \ HASH_BLOOM_FREE((head)->hh.tbl); \ uthash_free((head)->hh.tbl, sizeof(UT_hash_table)); \ (head)=NULL; \ } \ } while(0) #define HASH_OVERHEAD(hh,head) \ (size_t)((((head)->hh.tbl->num_items * sizeof(UT_hash_handle)) + \ ((head)->hh.tbl->num_buckets * sizeof(UT_hash_bucket)) + \ (sizeof(UT_hash_table)) + \ (HASH_BLOOM_BYTELEN))) #ifdef NO_DECLTYPE #define HASH_ITER(hh,head,el,tmp) \ for((el)=(head), (*(char**)(&(tmp)))=(char*)((head)?(head)->hh.next:NULL); \ el; (el)=(tmp),(*(char**)(&(tmp)))=(char*)((tmp)?(tmp)->hh.next:NULL)) #else #define HASH_ITER(hh,head,el,tmp) \ for((el)=(head),(tmp)=DECLTYPE(el)((head)?(head)->hh.next:NULL); \ el; (el)=(tmp),(tmp)=DECLTYPE(el)((tmp)?(tmp)->hh.next:NULL)) #endif /* obtain a count of items in the hash */ #define HASH_COUNT(head) HASH_CNT(hh,head) #define HASH_CNT(hh,head) ((head)?((head)->hh.tbl->num_items):0) typedef struct UT_hash_bucket { struct UT_hash_handle *hh_head; unsigned count; /* expand_mult is normally set to 0. In this situation, the max chain length * threshold is enforced at its default value, HASH_BKT_CAPACITY_THRESH. (If * the bucket's chain exceeds this length, bucket expansion is triggered). * However, setting expand_mult to a non-zero value delays bucket expansion * (that would be triggered by additions to this particular bucket) * until its chain length reaches a *multiple* of HASH_BKT_CAPACITY_THRESH. * (The multiplier is simply expand_mult+1). The whole idea of this * multiplier is to reduce bucket expansions, since they are expensive, in * situations where we know that a particular bucket tends to be overused. * It is better to let its chain length grow to a longer yet-still-bounded * value, than to do an O(n) bucket expansion too often. */ unsigned expand_mult; } UT_hash_bucket; /* random signature used only to find hash tables in external analysis */ #define HASH_SIGNATURE 0xa0111fe1 #define HASH_BLOOM_SIGNATURE 0xb12220f2 typedef struct UT_hash_table { UT_hash_bucket *buckets; unsigned num_buckets, log2_num_buckets; unsigned num_items; struct UT_hash_handle *tail; /* tail hh in app order, for fast append */ ptrdiff_t hho; /* hash handle offset (byte pos of hash handle in element */ /* in an ideal situation (all buckets used equally), no bucket would have * more than ceil(#items/#buckets) items. that's the ideal chain length. */ unsigned ideal_chain_maxlen; /* nonideal_items is the number of items in the hash whose chain position * exceeds the ideal chain maxlen. these items pay the penalty for an uneven * hash distribution; reaching them in a chain traversal takes >ideal steps */ unsigned nonideal_items; /* ineffective expands occur when a bucket doubling was performed, but * afterward, more than half the items in the hash had nonideal chain * positions. If this happens on two consecutive expansions we inhibit any * further expansion, as it's not helping; this happens when the hash * function isn't a good fit for the key domain. When expansion is inhibited * the hash will still work, albeit no longer in constant time. */ unsigned ineff_expands, noexpand; uint32_t signature; /* used only to find hash tables in external analysis */ #ifdef HASH_BLOOM uint32_t bloom_sig; /* used only to test bloom exists in external analysis */ uint8_t *bloom_bv; char bloom_nbits; #endif } UT_hash_table; typedef struct UT_hash_handle { struct UT_hash_table *tbl; void *prev; /* prev element in app order */ void *next; /* next element in app order */ struct UT_hash_handle *hh_prev; /* previous hh in bucket order */ struct UT_hash_handle *hh_next; /* next hh in bucket order */ void *key; /* ptr to enclosing struct's key */ unsigned keylen; /* enclosing struct's key len */ unsigned hashv; /* result of hash-fcn(key) */ } UT_hash_handle; #endif /* UTHASH_H */ wcc-0.0.2/include/nametoalign.h0000644000175000017500000000607313110675433015042 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ /** * * Generated with: * find /bin/ /sbin/ /usr/sbin/|while read mama; do readelf -S $mama 2>/dev/null|grep "\[" -A 1|sed s#"\[.*\]"#"\nKOALA\n"#gi|tr -d "\n"|sed s#"KOALA"#"\n"#gi|sed s#"[WAX]\{1,3\}"##g|awk '{print "{\"" $1 "\", " $9 "}," }'|grep "[0-9]" ; done|sort -u * */ typedef struct assoc_nametoalign_t{ char *name; unsigned int alignment; }assoc_nametoalign_t; assoc_nametoalign_t nametoalign[] = { {".bss", 32}, {".comment", 1}, {".ctors", 8}, {".data", 32}, {".data.rel.ro", 32}, {".debug_abbrev", 1}, {".debug_aranges", 16}, {".debug_info", 1}, {".debug_line", 1}, {".debug_loc", 1}, {".debug_macinfo", 1}, {".debug_macro", 1}, {".debug_pubnames", 1}, {".debug_pubtypes", 1}, {".debug_ranges", 16}, {".debug_str", 0}, {".dtors", 8}, {".dynamic", 8}, {".dynstr", 1}, {".dynsym", 8}, {".eh_frame", 8}, {".eh_frame_hdr", 4}, {".fini", 4}, {".fini_array", 8}, {".gcc_except_table", 4}, {".gnu.hash", 8}, {".gnu.version", 2}, {".gnu.version_r", 8}, {".gnu_debuglink", 1}, {".got", 8}, {".got.plt", 8}, {".hash", 8}, {".init", 4}, {".init_array", 8}, {".interp", 1}, {".jcr", 8}, {".modinfo", 16}, {".module_license", 1}, {".note.BI-tag", 4}, {".note.gnu.build-id", 4}, {".plt", 16}, {".plt.got", 8}, {".rel.dyn", 4}, {".rel.plt", 4}, {".rela.dyn", 8}, {".rela.plt", 8}, {".rodata", 32}, {".rsrc", 1}, // Microsoft Windows's resources {".shstrtab", 1}, {".strtab", 1}, {".symtab", 8}, {".tbss", 0}, {".tdata", 0}, #ifdef __LP64__ // Generic 64b {".text", 16}, #else // Generic 32b {".text", 4}, #endif {"__cmd", 32}, {"__debug", 8}, {"__libc_atexit", 8}, {"__libc_freeres_fn", 16}, {"__libc_freeres_pt", 16}, {"__libc_freeres_pt", 8}, {"__libc_subfreeres", 8}, {"__libc_thread_fre", 16}, {"__libc_thread_sub", 8}, {"pl_arch", 64}, }; wcc-0.0.2/include/arch.h0000644000175000017500000000440013110675433013451 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ #include typedef struct archi_t{ char *name; unsigned int value; }archi_t; archi_t wccarch[] = { // nicknames {"x86_64", EM_X86_64}, {"x86-64", EM_X86_64}, {"amd64", EM_X86_64}, {"i386", EM_386}, {"arm", EM_ARM}, // official names {"NONE", EM_NONE }, {"M32", EM_M32 }, {"SPARC", EM_SPARC }, {"386", EM_386 }, {"68K", EM_68K }, {"88K", EM_88K }, {"486", EM_486 }, {"860", EM_860 }, {"MIPS", EM_MIPS }, {"MIPS_RS3_LE", EM_MIPS_RS3_LE }, {"MIPS_RS4_BE", EM_MIPS_RS4_BE }, {"PARISC", EM_PARISC }, {"SPARC32PLUS", EM_SPARC32PLUS }, {"PPC", EM_PPC }, {"PPC64", EM_PPC64 }, {"SPU", EM_SPU }, {"ARM", EM_ARM }, {"SH", EM_SH }, {"SPARCV9", EM_SPARCV9 }, {"IA_64", EM_IA_64 }, {"X86_64", EM_X86_64 }, {"S390", EM_S390 }, {"CRIS", EM_CRIS }, {"V850", EM_V850 }, {"M32R", EM_M32R }, {"MN10300", EM_MN10300 }, {"BLACKFIN", EM_BLACKFIN }, {"TI_C6000", EM_TI_C6000 }, {"AARCH64", EM_AARCH64 }, {"FRV", EM_FRV } }; wcc-0.0.2/include/nametotype.h0000644000175000017500000001071113110675433014723 0ustar philphil/** * * Witchcraft Compiler Collection * * Author: Jonathan Brossard - endrazine@gmail.com * ******************************************************************************* * The MIT License (MIT) * Copyright (c) 2016 Jonathan Brossard * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. ******************************************************************************* * */ /** * * Generated with: * find /bin/ /sbin/ /usr/sbin/|while read mama; do readelf -S $mama 2>/dev/null|grep "\["|sed s#"\[.*\]"##gi|awk '{print "{\"" $1 "\", SHT_" $2 ", \"SHT_" $2 "\"}," }'; done|sort -u * */ #define SHT_VERSYM 0x6fffffff #define SHT_VERNEED 0x6ffffffe typedef struct assoc_nametotype_t{ char *name; unsigned int type; char *htype; }assoc_nametotype_t; assoc_nametotype_t nametotype[] = { {".bss", SHT_NOBITS, "SHT_NOBITS"}, {".comment", SHT_PROGBITS, "SHT_PROGBITS"}, {".ctors", SHT_PROGBITS, "SHT_PROGBITS"}, {".data", SHT_PROGBITS, "SHT_PROGBITS"}, {".data.rel.ro", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_abbrev", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_aranges", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_info", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_line", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_loc", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_macinfo", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_macro", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_pubnames", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_pubtypes", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_ranges", SHT_PROGBITS, "SHT_PROGBITS"}, {".debug_str", SHT_PROGBITS, "SHT_PROGBITS"}, {".dtors", SHT_PROGBITS, "SHT_PROGBITS"}, {".dynamic", SHT_DYNAMIC, "SHT_DYNAMIC"}, {".dynstr", SHT_STRTAB, "SHT_STRTAB"}, {".dynsym", SHT_DYNSYM, "SHT_DYNSYM"}, {".eh_frame", SHT_PROGBITS, "SHT_PROGBITS"}, {".eh_frame_hdr", SHT_PROGBITS, "SHT_PROGBITS"}, {".fini", SHT_PROGBITS, "SHT_PROGBITS"}, {".fini_array", SHT_FINI_ARRAY, "SHT_FINI_ARRAY"}, {".gcc_except_table", SHT_PROGBITS, "SHT_PROGBITS"}, {".gnu.hash", SHT_GNU_HASH, "SHT_GNU_HASH"}, {".gnu.version", SHT_VERSYM, "SHT_VERSYM"}, {".gnu.version_r", SHT_VERNEED, "SHT_VERNEED"}, {".gnu_debuglink", SHT_PROGBITS, "SHT_PROGBITS"}, {".got", SHT_PROGBITS, "SHT_PROGBITS"}, {".got.plt", SHT_PROGBITS, "SHT_PROGBITS"}, {".hash", SHT_HASH, "SHT_HASH"}, {".init", SHT_PROGBITS, "SHT_PROGBITS"}, {".init_array", SHT_INIT_ARRAY, "SHT_INIT_ARRAY"}, {".interp", SHT_PROGBITS, "SHT_PROGBITS"}, {".jcr", SHT_PROGBITS, "SHT_PROGBITS"}, {".modinfo", SHT_PROGBITS, "SHT_PROGBITS"}, {".module_license", SHT_PROGBITS, "SHT_PROGBITS"}, {".note.ABI-tag", SHT_NOTE, "SHT_NOTE"}, {".note.gnu.build-id", SHT_NOTE, "SHT_NOTE"}, {".plt", SHT_PROGBITS, "SHT_PROGBITS"}, {".plt.got", SHT_PROGBITS, "SHT_PROGBITS"}, {".rel.dyn", SHT_REL, "SHT_REL"}, {".rel.plt", SHT_REL, "SHT_REL"}, {".rela.dyn", SHT_RELA, "SHT_RELA"}, {".rela.plt", SHT_RELA, "SHT_RELA"}, {".rodata", SHT_PROGBITS, "SHT_PROGBITS"}, {".shstrtab", SHT_STRTAB, "SHT_STRTAB"}, {".strtab", SHT_STRTAB, "SHT_STRTAB"}, {".symtab", SHT_SYMTAB, "SHT_SYMTAB"}, {".tbss", SHT_NOBITS, "SHT_NOBITS"}, {".tdata", SHT_PROGBITS, "SHT_PROGBITS"}, {".text", SHT_PROGBITS, "SHT_PROGBITS"}, {"__cmd", SHT_PROGBITS, "SHT_PROGBITS"}, {"__debug", SHT_PROGBITS, "SHT_PROGBITS"}, {"__libc_atexit", SHT_PROGBITS, "SHT_PROGBITS"}, {"__libc_freeres_fn", SHT_PROGBITS, "SHT_PROGBITS"}, {"__libc_freeres_pt", SHT_NOBITS, "SHT_NOBITS"}, {"__libc_subfreeres", SHT_PROGBITS, "SHT_PROGBITS"}, {"__libc_thread_fre", SHT_PROGBITS, "SHT_PROGBITS"}, {"__libc_thread_sub", SHT_PROGBITS, "SHT_PROGBITS"}, {"pl_arch", SHT_PROGBITS, "SHT_PROGBITS"} }; wcc-0.0.2/README.md0000644000175000017500000003272213110675433012227 0ustar philphil # The Witchcraft Compiler Collection Welcome to the Witchcraft Compiler Collection ! ## Purpose WCC is a collection of compilation tools to perform binary black magic on the GNU/Linux and other POSIX platforms. ## User manual The WCC user manual is available online at : https://github.com/endrazine/wcc/wiki ## Installation ### Installation Requirements The Witchcraft Compiler Collection requires the following software to be installed: capstone, glibc, libbfd, libdl, zlib, libelf, libreadline, libgsl, make ### Installation Requirements on Ubuntu/Debian Under Ubuntu/Debian those dependencies can be installed with the following commands (tested on Ubuntu 14.04): # Required for add-apt-repository sudo apt-get install python-software-properties software-properties-common # Add repo for clang sudo add-apt-repository ppa:kxstudio-team/builds sudo apt-get update # Install dependencies sudo apt-get install binutils-dev clang libelf-dev libgsl0-dev libiberty-dev libreadline6 libreadline6-dev make uthash-dev # Install latest capstone and capstone-dev from "Ubuntu 14.04 - DEB packages" http://www.capstone-engine.org/download.html wget http://www.capstone-engine.org/download/3.0.4/ubuntu-14.04/libcapstone3_3.0.4-0.1ubuntu1_amd64.deb sudo dpkg -i libcapstone3_3.0.4-0.1ubuntu1_amd64.deb wget http://www.capstone-engine.org/download/3.0.4/ubuntu-14.04/libcapstone-dev_3.0.4-0.1ubuntu1_amd64.deb sudo dpkg -i libcapstone-dev_3.0.4-0.1ubuntu1_amd64.deb ## Building and Installing: ### Fetching the code over git This will download the code of wcc from the internet to a directory named wcc in the current working directory: git clone https://github.com/endrazine/wcc.git You can then enter this directory with: cd wcc ### Initializing git submodules From your root wcc directory, type: git submodule init git submodule update #### Building WCC From your root wcc directory, type: make #### Installing WCC Then to install wcc, type: sudo make install #### Building the WCC documentation (Optional) WCC makes use of doxygen to generate its documentation. From the root wcc directory, type make documentation ## Core commands The following commands constitute the core of the Witchcraft Compiler Collection. ### wld : The Witchcraft Linker. wld takes an ELF executable as an input and modifies it to create a shared library. #### wld command line options jonathan@blackbox:~$ wld Witchcraft Compiler Collection (WCC) version:0.0.1 (23:11:13 Jul 21 2016) Usage: wld [options] file options: -libify Set Class to ET_DYN in input ELF file. jonathan@blackbox:~$ #### Example usage of wld The following example libifies the executable /bin/ls into a shared library named /tmp/ls.so. jonathan@blackbox:~$ cp /bin/ls /tmp/ls.so jonathan@blackbox:~$ wld -libify /tmp/ls.so jonathan@blackbox:~$ #### Limits of wld wld currently only works on ELF binaries. However wld can process ELF executables irrelevant of their architecture or operating system. wld could for instance process Intel, ARM or SPARC executables from Android, Linux, BSD or UNIX operating systems and transform them into "non relocatable shared libraries". Feel free to refer to the documentation under the /doc directory for more ample details. ### wcc : The Witchcraft Compiler. The wcc compiler takes binaries (ELF, PE, ...) as an input and creates valid ELF binaries as an output. It can be used to create relocatable object files from executables or shared libraries. #### wcc command line options jonathan@blackbox:~$ wcc Witchcraft Compiler Collection (WCC) version:0.0.1 (01:47:53 Jul 29 2016) Usage: wcc [options] file options: -o, --output -m, --march -e, --entrypoint <0xaddress> -i, --interpreter -p, --poison -s, --shared -c, --compile -S, --static -x, --strip -X, --sstrip -E, --exec -C, --core -O, --original -D, --disasm -d, --debug -h, --help -v, --verbose -V, --version jonathan@blackbox:~$ #### Example usage of wcc The primary use of wcc is to "unlink" (undo the work of a linker) ELF binaries, either executables or shared libraries, back into relocatable shared objects. The following command line attempts to unlink the binary /bin/ls (from GNU binutils) into a relocatable file named /tmp/ls.o jonathan@blackbox:~$ wcc -c /bin/ls -o /tmp/ls.o jonathan@blackbox:~$ This relocatable file can then be used as if it had been directly produced by a compiler. The following command would use the gcc compiler to link /tmp/ls.o into a shared library /tmp/ls.so jonathan@blackbox:~$ gcc /tmp/ls.o -o /tmp/ls.so -shared jonathan@blackbox:~$ #### Limits of wcc wcc will process any file supported by libbfd and produce ELF files that will contain the same mapping when relinked and executed. This includes PE or OSX COFF files in 32 or 64 bits. However, rebuilding relocations is currently supported only for Intel ELF x86_64 binaries. Transforming a PE into an ELF and invoking pure functions is for instance supported. ### wsh : The Witchcraft shell The witchcraft shell accepts ELF shared libraries, ELF ET_DYN executables and Witchcraft Shell Scripts written in Punk-C as an input. It loads all the executables in its own address space and make their API available for programming in its embedded interpreter. This provides for binaries functionalities similar to those provided via reflection on languages like Java. #### wsh command line options jonathan@blackbox:~$ wsh -h Usage: wsh [script] [options] [binary1] [binary2] ... [-x] [script_arg1] [script_arg2] ... Options: -x, --args Optional script argument separator. -v, --verbose -V, --version Script: If the first argument is an existing file which is not a known binary file format, it is assumed to be a lua script and gets executed. Binaries: Any binary file name before the -x tag gets loaded before running the script. The last binary loaded is the main binary analyzed. jonathan@blackbox:~$ #### Example usage of wsh The following command loads the /usr/sbin/apache2 executable within wsh, calls the ap_get_server_banner() function within apache to retreive its banner and displays it within the wsh interpreter. jonathan@blackbox:~$ wsh /usr/sbin/apache2 > a = ap_get_server_banner() > print(a) Apache/2.4.7 > To get help at any time from the wsh interpreter, simply type help. To get help on a particular topic, type help("topic"). The following example illustrates how to display the main wsh help from the interpreter and how to get detailed help on the grep command by calling help("grep") from the wsh interpreter. > help [Shell commands] help, quit, exit, shell, exec, clear [Functions] + basic: help(), man() + memory display: hexdump(), hex_dump(), hex() + memory maps: shdrs(), phdrs(), map(), procmap(), bfmap() + symbols: symbols(), functions(), objects(), info(), search(), headers() + memory search: grep(), grepptr() + load libaries: loadbin(), libs(), entrypoints(), rescan() + code execution: libcall() + buffer manipulation: xalloc(), ralloc(), xfree(), balloc(), bset(), bget(), rdstr(), rdnum() + control flow: breakpoint(), bp() + system settings: enableaslr(), disableaslr() + settings: verbose(), hollywood() + advanced: ltrace() Try help("cmdname") for detailed usage on command cmdname. > help("grep") WSH HELP FOR FUNCTION grep NAME grep SYNOPSIS table match = grep(, [patternlen], [dumplen], [before]) DESCRIPTION Search in all ELF sections in memory. Match [patternlen] bytes, then display [dumplen] bytes, optionally including [before] bytes before the match. Results are displayed in enhanced decimal form RETURN VALUES Returns 1 lua table containing matching memory addresses. > #### Extending wsh with Witchcraft Shell Scripts The combination of a full lua interpreter in the same address space as the loaded executables and shared libraries in combination with the reflection like capabilities of wsh allow to call any function loaded in the address space from the wsh interpreter transparently. The resulting API, a powerfull combination of lua and C API is called Punk-C. Wsh is fully scriptable in Punk-C, and executes Punk-C on the fly via its dynamic interpreter. Scripts in Punk C can be invoked by specifying the full path to wsh in the magic bytes of a wsh shell. The following command displays the content of a Witchcraft shell script: jonathan@blackbox:/usr/share/wcc/scripts$ cat md5.wsh #!/usr/bin/wsh -- Computing a MD5 sum using cryptographic functions from foreign binaries (eg: sshd/OpenSSL) function str2md5(input) out = calloc(33, 1) ctx = calloc(1024, 1) MD5_Init(ctx) MD5_Update(ctx, input, strlen(input)) MD5_Final(out, ctx) free(ctx) return out end input = "Message needing hashing\n" hash = str2md5(input) hexdump(hash,16) exit(0) jonathan@blackbox:/usr/share/wcc/scripts$ To run this script using the API made available inside the address space of sshd, simply run: jonathan@blackbox:/usr/share/wcc/scripts$ ./md5.wsh /usr/sbin/sshd 0x43e8b280 d6 fc 46 91 b0 6f ab 75 4d 9c a7 58 6d 9c 7e 36 V|F.0o+uM.'Xm.~6 jonathan@blackbox:/usr/share/wcc/scripts$ #### Limits of wsh wsh can only load shared libraries and ET_DYN dynamically linked ELF executables directly. This means ET_EXEC executables may need to be libified using wld before use in wsh. Binaries in other file formats might need to be turned into ELF files using wcc. #### Note: Analysing and Executing ARM/SPARC/MIPS binaries "natively" on Intel x86_64 cpus via JIT binary translation wsh can be cross compiled to ARM, SPARC, MIPS and other plateforms and used in association with the qemu's user space emulation mode to provide JIT binary translation on the fly and analyse shared libraries and binaries from other cpus without requiring emulation a full operating system in a virtual machine. On the the analyzed binaries are translated from one CPU to an other, and the analysed binaries, the wsh cross compiled analyser and the qemu binary translator share the address space of a single program. This significantly diminishes the complexity of analysing binaries accross different hardware by seemingly allowing to run ARM or SPARC binaries on a linux x86_64 machine natively and transparently. ## Other commands The following auxiliary commands are available with WCC. They are typically simple scripts built on top of WCC. ### wldd : print shared libraries compilation flags When compiling C code, it is often required to pass extra arguments to the compiler to signify which shared libraries should explicitely linked against the compile code. Figuring out those compilation parameters can be cumbersome. The wldd commands displays the shared libraries compilation flags given at compile time for any given ELF binary. #### wldd command line options jonathan@blackbox:~$ wldd Usage: /usr/bin/wldd Returns libraries to be passed to gcc to relink this application. jonathan@blackbox:~$ #### Example usage of wldd The following command displays shared libraries compilation flags as passed to gcc when compiling /bin/ls from GNU binutils: jonathan@blackbox:~$ wldd /bin/ls -lselinux -lacl -lc -lpcre -ldl -lattr jonathan@blackbox:~$ ### wcch : generate C headers from binaries The wcch command takes an ELF binary path as a command line, and outputs a minimal C header file declaring all the exported global variables and functions from the input binary. This automates prototypes declaration when writting C code and linking with a binary for which C header files are not available. #### Example usage of wcch The following command instructs wcch to generate C headers from the apache2 executable and redirects the output from the standard output to a file named /tmp/apache2.h ready for use as a header in a C application. jonathan@blackbox:~$ wcch /usr/sbin/apache2 >/tmp/apache2.h jonathan@blackbox:~$ ## Downloading the source code The official codebase of the Witchcraft Compiler Collection is hosted on github at https://github.com/endrazine/wcc/ . It uses git modules, so some extra steps are needed to fetch all the code including depedencies. To download the source code of wcc, in a terminal, type: git clone https://github.com/endrazine/wcc.git cd wcc git submodule init git submodule update This will create a directory named wcc and fetch all required source code in it. ## Greetings The Witchcraft Compiler Collection uses the following amazing Open Source third party software: - Capstone, a lightweight multi-platform, multi-architecture disassembly framework http://www.capstone-engine.org/ - Linenoise, A small self-contained alternative to readline and libedit https://github.com/antirez/linenoise - Openlibm, High quality system independent, portable, open source libm implementation http://www.openlibm.org - Lua, The Programming Language Lua https://www.lua.org/ - LuaJit, a Just-In-Time Compiler for Lua http://luajit.org/ - Qemu, in particular its user space mode : http://wiki.qemu.org/download/qemu-doc.html#QEMU-User-space-emulator - Uthash and Utlist, Hash tables and linked list implemented as C headers https://troydhanson.github.io/uthash/ ## Licence The Witchcraft Compiler Collection is published under the MIT License. Please refer to the file named LICENSE for more information. wcc-0.0.2/.gitignore0000644000175000017500000000022113110675433012725 0ustar philphil# any bin directory bin/ # compiled object files and shared libraries *.o *.so # temporary files created by some text editors *~ # doc/html/ wcc-0.0.2/.gitmodules0000644000175000017500000000063413110675433013122 0ustar philphil[submodule "src/wsh/linenoise"] path = src/wsh/linenoise url = https://github.com/antirez/linenoise.git [submodule "src/wsh/openlibm"] path = src/wsh/openlibm url = https://github.com/JuliaLang/openlibm.git [submodule "src/wsh/luajit-2.0"] path = src/wsh/luajit-2.0 url = http://luajit.org/git/luajit-2.0.git [submodule "doc/wikidocs"] path = doc/wikidocs url = https://github.com/endrazine/wcc.wiki.git wcc-0.0.2/AUTHORS0000644000175000017500000000034113110675433012010 0ustar philphilThe Witchcraft Compiler Collection was written by the following authors: Jonathan Brossard For third party depedencies licenses, see LICENSE. linenoise, lua, lua-jit, openlibm are copyrights of their respective owners. wcc-0.0.2/doc/0000755000175000017500000000000013110675433011507 5ustar philphilwcc-0.0.2/doc/presentations/0000755000175000017500000000000013110675433014405 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/0000755000175000017500000000000013110675433017650 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/README0000644000175000017500000000042313110675433020527 0ustar philphilThis directory contains Proof of Concept code as demonstrated at the Defcon 24 conference during the talk named "Introduction to the Wicraft Compiler Collection". This code is Copyright 2016 Jonathan Brossard and licensed under the MIT License. August 2016. endrazine- wcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/0000755000175000017500000000000013110675433021326 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/Makefile0000644000175000017500000000056213110675433022771 0ustar philphilCC := gcc CFLAGS := -W -Wall LDFLAGS := -ldl -T script.lds all:: cp /usr/sbin/proftpd /tmp wld -libify /tmp/proftpd mv /tmp/proftpd /tmp/proftpd.so $(CC) $(CFLAGS) demo0.c -o demo0 $(LDFLAGS) $(CC) $(CFLAGS) demo1.c -o demo1 $(LDFLAGS) $(CC) $(CFLAGS) demo2.c -o demo2 $(LDFLAGS) $(CC) $(CFLAGS) demo3.c -o demo3 $(LDFLAGS) clean:: rm demo0 demo1 demo2 demo3 wcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/script.lds0000644000175000017500000002114613110675433023342 0ustar philphil/* Script for -z combreloc: combine and sort reloc sections */ /* Copyright (C) 2014-2015 Free Software Foundation, Inc. Copying and distribution of this script, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. */ OUTPUT_FORMAT("elf64-x86-64", "elf64-x86-64", "elf64-x86-64") OUTPUT_ARCH(i386:x86-64) ENTRY(_start) SEARCH_DIR("=/usr/x86_64-linux-gnu/lib64"); SEARCH_DIR("=/usr/local/lib64"); SEARCH_DIR("=/lib64"); SEARCH_DIR("=/usr/lib64"); SEARCH_DIR("=/usr/x86_64-linux-gnu/lib"); SEARCH_DIR("=/usr/local/lib"); SEARCH_DIR("=/lib"); SEARCH_DIR("=/usr/lib"); SECTIONS { /* Read-only sections, merged into text segment: */ PROVIDE (__executable_start = SEGMENT_START("text-segment", 0x42000000)); . = SEGMENT_START("text-segment", 0x42000000) + SIZEOF_HEADERS; .interp : { *(.interp) } .note.gnu.build-id : { *(.note.gnu.build-id) } .hash : { *(.hash) } .gnu.hash : { *(.gnu.hash) } .dynsym : { *(.dynsym) } .dynstr : { *(.dynstr) } .gnu.version : { *(.gnu.version) } .gnu.version_d : { *(.gnu.version_d) } .gnu.version_r : { *(.gnu.version_r) } .rela.dyn : { *(.rela.init) *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*) *(.rela.fini) *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*) *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*) *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*) *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*) *(.rela.ctors) *(.rela.dtors) *(.rela.got) *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*) *(.rela.ldata .rela.ldata.* .rela.gnu.linkonce.l.*) *(.rela.lbss .rela.lbss.* .rela.gnu.linkonce.lb.*) *(.rela.lrodata .rela.lrodata.* .rela.gnu.linkonce.lr.*) *(.rela.ifunc) } .rela.plt : { *(.rela.plt) PROVIDE_HIDDEN (__rela_iplt_start = .); *(.rela.iplt) PROVIDE_HIDDEN (__rela_iplt_end = .); } .init : { KEEP (*(SORT_NONE(.init))) } .plt : { *(.plt) *(.iplt) } .plt.got : { *(.plt.got) } .plt.bnd : { *(.plt.bnd) } .text : { *(.text.unlikely .text.*_unlikely .text.unlikely.*) *(.text.exit .text.exit.*) *(.text.startup .text.startup.*) *(.text.hot .text.hot.*) *(.text .stub .text.* .gnu.linkonce.t.*) /* .gnu.warning sections are handled specially by elf32.em. */ *(.gnu.warning) } .fini : { KEEP (*(SORT_NONE(.fini))) } PROVIDE (__etext = .); PROVIDE (_etext = .); PROVIDE (etext = .); .rodata : { *(.rodata .rodata.* .gnu.linkonce.r.*) } .rodata1 : { *(.rodata1) } .eh_frame_hdr : { *(.eh_frame_hdr) *(.eh_frame_entry .eh_frame_entry.*) } .eh_frame : ONLY_IF_RO { KEEP (*(.eh_frame)) *(.eh_frame.*) } .gcc_except_table : ONLY_IF_RO { *(.gcc_except_table .gcc_except_table.*) } .gnu_extab : ONLY_IF_RO { *(.gnu_extab*) } /* These sections are generated by the Sun/Oracle C++ compiler. */ .exception_ranges : ONLY_IF_RO { *(.exception_ranges .exception_ranges*) } /* Adjust the address for the data segment. We want to adjust up to the same address within the page on the next page up. */ . = DATA_SEGMENT_ALIGN (CONSTANT (MAXPAGESIZE), CONSTANT (COMMONPAGESIZE)); /* Exception handling */ .eh_frame : ONLY_IF_RW { KEEP (*(.eh_frame)) *(.eh_frame.*) } .gnu_extab : ONLY_IF_RW { *(.gnu_extab) } .gcc_except_table : ONLY_IF_RW { *(.gcc_except_table .gcc_except_table.*) } .exception_ranges : ONLY_IF_RW { *(.exception_ranges .exception_ranges*) } /* Thread Local Storage sections */ .tdata : { *(.tdata .tdata.* .gnu.linkonce.td.*) } .tbss : { *(.tbss .tbss.* .gnu.linkonce.tb.*) *(.tcommon) } .preinit_array : { PROVIDE_HIDDEN (__preinit_array_start = .); KEEP (*(.preinit_array)) PROVIDE_HIDDEN (__preinit_array_end = .); } .init_array : { PROVIDE_HIDDEN (__init_array_start = .); KEEP (*(SORT_BY_INIT_PRIORITY(.init_array.*) SORT_BY_INIT_PRIORITY(.ctors.*))) KEEP (*(.init_array EXCLUDE_FILE (*crtbegin.o *crtbegin?.o *crtend.o *crtend?.o ) .ctors)) PROVIDE_HIDDEN (__init_array_end = .); } .fini_array : { PROVIDE_HIDDEN (__fini_array_start = .); KEEP (*(SORT_BY_INIT_PRIORITY(.fini_array.*) SORT_BY_INIT_PRIORITY(.dtors.*))) KEEP (*(.fini_array EXCLUDE_FILE (*crtbegin.o *crtbegin?.o *crtend.o *crtend?.o ) .dtors)) PROVIDE_HIDDEN (__fini_array_end = .); } .ctors : { /* gcc uses crtbegin.o to find the start of the constructors, so we make sure it is first. Because this is a wildcard, it doesn't matter if the user does not actually link against crtbegin.o; the linker won't look for a file to match a wildcard. The wildcard also means that it doesn't matter which directory crtbegin.o is in. */ KEEP (*crtbegin.o(.ctors)) KEEP (*crtbegin?.o(.ctors)) /* We don't want to include the .ctor section from the crtend.o file until after the sorted ctors. The .ctor section from the crtend file contains the end of ctors marker and it must be last */ KEEP (*(EXCLUDE_FILE (*crtend.o *crtend?.o ) .ctors)) KEEP (*(SORT(.ctors.*))) KEEP (*(.ctors)) } .dtors : { KEEP (*crtbegin.o(.dtors)) KEEP (*crtbegin?.o(.dtors)) KEEP (*(EXCLUDE_FILE (*crtend.o *crtend?.o ) .dtors)) KEEP (*(SORT(.dtors.*))) KEEP (*(.dtors)) } .jcr : { KEEP (*(.jcr)) } .data.rel.ro : { *(.data.rel.ro.local* .gnu.linkonce.d.rel.ro.local.*) *(.data.rel.ro .data.rel.ro.* .gnu.linkonce.d.rel.ro.*) } .dynamic : { *(.dynamic) } .got : { *(.got) *(.igot) } . = DATA_SEGMENT_RELRO_END (SIZEOF (.got.plt) >= 24 ? 24 : 0, .); .got.plt : { *(.got.plt) *(.igot.plt) } .data : { *(.data .data.* .gnu.linkonce.d.*) SORT(CONSTRUCTORS) } .data1 : { *(.data1) } _edata = .; PROVIDE (edata = .); . = .; __bss_start = .; .bss : { *(.dynbss) *(.bss .bss.* .gnu.linkonce.b.*) *(COMMON) /* Align here to ensure that the .bss section occupies space up to _end. Align after .bss to ensure correct alignment even if the .bss section disappears because there are no input sections. FIXME: Why do we need it? When there is no .bss section, we don't pad the .data section. */ . = ALIGN(. != 0 ? 64 / 8 : 1); } .lbss : { *(.dynlbss) *(.lbss .lbss.* .gnu.linkonce.lb.*) *(LARGE_COMMON) } . = ALIGN(64 / 8); . = SEGMENT_START("ldata-segment", .); .lrodata ALIGN(CONSTANT (MAXPAGESIZE)) + (. & (CONSTANT (MAXPAGESIZE) - 1)) : { *(.lrodata .lrodata.* .gnu.linkonce.lr.*) } .ldata ALIGN(CONSTANT (MAXPAGESIZE)) + (. & (CONSTANT (MAXPAGESIZE) - 1)) : { *(.ldata .ldata.* .gnu.linkonce.l.*) . = ALIGN(. != 0 ? 64 / 8 : 1); } . = ALIGN(64 / 8); _end = .; PROVIDE (end = .); . = DATA_SEGMENT_END (.); /* Stabs debugging sections. */ .stab 0 : { *(.stab) } .stabstr 0 : { *(.stabstr) } .stab.excl 0 : { *(.stab.excl) } .stab.exclstr 0 : { *(.stab.exclstr) } .stab.index 0 : { *(.stab.index) } .stab.indexstr 0 : { *(.stab.indexstr) } .comment 0 : { *(.comment) } /* DWARF debug sections. Symbols in the DWARF debugging sections are relative to the beginning of the section so we begin them at 0. */ /* DWARF 1 */ .debug 0 : { *(.debug) } .line 0 : { *(.line) } /* GNU DWARF 1 extensions */ .debug_srcinfo 0 : { *(.debug_srcinfo) } .debug_sfnames 0 : { *(.debug_sfnames) } /* DWARF 1.1 and DWARF 2 */ .debug_aranges 0 : { *(.debug_aranges) } .debug_pubnames 0 : { *(.debug_pubnames) } /* DWARF 2 */ .debug_info 0 : { *(.debug_info .gnu.linkonce.wi.*) } .debug_abbrev 0 : { *(.debug_abbrev) } .debug_line 0 : { *(.debug_line .debug_line.* .debug_line_end ) } .debug_frame 0 : { *(.debug_frame) } .debug_str 0 : { *(.debug_str) } .debug_loc 0 : { *(.debug_loc) } .debug_macinfo 0 : { *(.debug_macinfo) } /* SGI/MIPS DWARF 2 extensions */ .debug_weaknames 0 : { *(.debug_weaknames) } .debug_funcnames 0 : { *(.debug_funcnames) } .debug_typenames 0 : { *(.debug_typenames) } .debug_varnames 0 : { *(.debug_varnames) } /* DWARF 3 */ .debug_pubtypes 0 : { *(.debug_pubtypes) } .debug_ranges 0 : { *(.debug_ranges) } /* DWARF Extension. */ .debug_macro 0 : { *(.debug_macro) } .gnu.attributes 0 : { KEEP (*(.gnu.attributes)) } /DISCARD/ : { *(.note.GNU-stack) *(.gnu_debuglink) *(.gnu.lto_*) } } wcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/README0000644000175000017500000000102013110675433022177 0ustar philphilThis directory contains proof of concept code to transform /usr/sbin/proftpd (assumed to not be compiled as Position Independant Code - else see the apache directory in the upper directory instead). The code is then used as a shared library from demo C code than call a function within proftpd to return its current version number as a string. This requires a custom linker script to make sure gcc (or clang) assigns our code a different base address than the one of our "non relocatable shared library" proftpd. endrazine- wcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/demo3.c0000644000175000017500000000167113110675433022506 0ustar philphil/** * Calling the main() ... within proftpd.so * * Note: yes, we have a "shared library" with a main() !! * * Note 2: you're not supposed to call main directly, * you may want to pass its address as an argument * to __libc_start_main() instead. * * endrazine for Defcon 24 // August 2016 */ #include #include #include #include #include static int (*__main)(int argc, char **argv) = NULL; int get_symbol(char *filename, char *symbolname){ void *handle; char *error = 0; handle = dlopen(filename, RTLD_LAZY); if (!handle) { fprintf(stderr, "%s\n", dlerror()); exit(EXIT_FAILURE); } __main = dlsym(handle, symbolname); if ((error = dlerror()) != NULL) { fprintf(stderr, "%s\n", error); exit(EXIT_FAILURE); } return 0; } int main(void){ char *argz[] = {"/bin/foo", 0x00}; get_symbol("/tmp/proftpd.so", "main"); __main(1, argz); // call main() from proftpd.so return 0; } wcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/demo1.c0000644000175000017500000000057213110675433022503 0ustar philphil/** * Calling pr_version_get_str() from Proftpd.so * * endrazine for Defcon 24 // August 2016 */ #include #include int main(void){ char* (*getversion)() = NULL; void *handle; handle = dlopen("/tmp/proftpd.so", RTLD_LAZY); getversion = dlsym(handle, "pr_version_get_str"); printf("Using proftpd.so version: \e[31m%s\e[0m\n", getversion()); return 0; } wcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/demo0.c0000644000175000017500000000045113110675433022476 0ustar philphil#include #include #include #include int main(int argc, char **argv){ void *handle = dlopen(argv[1], RTLD_LAZY); if(!handle){ printf("%s\n",dlerror()); exit(-1);} printf("[%u] : success loading %s\n", getpid(), argv[1]); getchar(); return 0; } wcc-0.0.2/doc/presentations/demos_defcon24_2016/proftpd/demo2.c0000644000175000017500000000201113110675433022472 0ustar philphil/** * Calling pr_version_get_str() from Proftpd.so * and display memory map exported via /proc/ * * endrazine for Defcon 24 // August 2016 */ #include #include #include #include #include #include #include #include #include #include static char* (*getversion)(void) = NULL; int get_symbol(char *filename, char *symbolname){ void *handle; char *error = 0; handle = dlopen(filename, RTLD_LAZY); if (!handle) { fprintf(stderr, "%s\n", dlerror()); exit(EXIT_FAILURE); } getversion = dlsym(handle, symbolname); if ((error = dlerror()) != NULL) { fprintf(stderr, "%s\n", error); exit(EXIT_FAILURE); } return 0; } int print_map(void){ char cmd[256]; memset(cmd, 0x00, 256); snprintf(cmd, 255, "cat /proc/%u/maps", getpid()); system(cmd); return 0; } int main(void){ get_symbol("/tmp/proftpd.so", "pr_version_get_str"); printf("Using proftpd.so version: %s\n", getversion()); print_map(); return 0; } wcc-0.0.2/doc/presentations/demos_defcon24_2016/apache/0000755000175000017500000000000013110675433021071 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/apache/Makefile0000644000175000017500000000017113110675433022530 0ustar philphilCC := gcc CFLAGS := -W -Wall LDFLAGS := /usr/sbin/apache2 all:: $(CC) $(CFLAGS) ap2version.c -o ap2version $(LDFLAGS) wcc-0.0.2/doc/presentations/demos_defcon24_2016/apache/README0000644000175000017500000000125413110675433021753 0ustar philphilThe code in this directory demonstrates how to link C code against an ELF binary compiled as Position Independent Code (PIE). In this case we link against apache2 and call a function within this binary as if it was a shared library (which it really is in addition to being an executable). This requires apache to be compiled with -rdynamic compilation flag to expose the relevant symbols in the dynamic symbol table, as well as the -pie -fPIE flags to be passed at compile time to enable full ASLR and allow the binary to be mapped with any base address (both should be default if your binary is shipped with a recent Linux distribution). The binary can be stripped. endrazine- wcc-0.0.2/doc/presentations/demos_defcon24_2016/apache/ap2version.c0000644000175000017500000000037713110675433023334 0ustar philphil/** * Calling ap_get_server_banner() from /usr/sbin/apache2 * * endrazine for Defcon 24 // August 2016 */ #include void *ap_get_server_banner(); int main (void){ printf("Server banner: \e[31m%s\e[0m\n", ap_get_server_banner()); return 0; } wcc-0.0.2/doc/presentations/demos_defcon24_2016/relinking/0000755000175000017500000000000013110675433021632 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/relinking/Makefile0000644000175000017500000000030213110675433023265 0ustar philphilCC := gcc-4.8 WCC = wcc CFLAGS := -W -Wall -Wextra CF := -ggdb -g3 -rdynamic #-shared all:: $(CC) $(CFLAGS) small.c -o small $(WCC) small -o small_wcc.o -c $(CC) small_wcc.o -o small2 wcc-0.0.2/doc/presentations/demos_defcon24_2016/relinking/README0000644000175000017500000000131613110675433022513 0ustar philphilThis directory contains proof of concept code as demoed at the Defcon 24 Conference. It requires the Witchcraft Compiler Collection to be installed. This directory contains C code that is compiled with gcc (or clang), then transformed back to a relocatable object file using wcc, and relinked into an executable using gcc and gnu ld. When run, the original executable and the final one provide the same output. This has been tested using x86_64 versions of both clang and gcc. Some relocation handling might be required to get this to work on other architectures or if compiled with certain compiler flags. Feel free to contribute your patches back to WCC if you implement new types of relocations :) endrazine- wcc-0.0.2/doc/presentations/demos_defcon24_2016/relinking/small.c0000644000175000017500000000322613110675433023111 0ustar philphil/** * Demo application for WCC * as demoed at Defcon 24. */ #include #include #include #include #include #include static char foobar[10]; char *unused1 = "This string is made to fill the top of the .rodata section\n"; extern char *program_invocation_name; static int wantedlen(char *str){ // Internal function, no entry in dynsym return strlen(str)+10; // relocation to strlen@plt } int do_something(char *msg){ static char *buff = 4; // Global initialized : @data buff = calloc(1, wantedlen(msg)); // relocations to calloc@plt and wantedlen@text // write to relocation buff@data // heap addresses do not require relocations if(!buff){ printf("error in calloc : %s", // relocation to perror@plt and string@rodata strerror(errno)); // relocations to strerror@plt and errno@bss (imported global variable) exit(-1); // relocation to exit@plt } sprintf(buff,"Hello %s from %s\n",msg, program_invocation_name); // relocations to sprintf@plt, %s@rodata // relocation to buff@data fprintf(stderr, buff); // relocation to fprintf@plt and stderr@bss (imported global variable) return 42; } int main (int argc, char **argv){ // arguments are passed to main@plt via __libc_start_main@plt called from _start@text int n = 0; char *msg = "Defcon !"; // Relocation to string@rodata // arguments passing and return values // require no relocations n = do_something(msg); // relocation to do_something@text : This is actually a rip relative call. // if we do not relocate it, it will work fine. It will too if we relocate it ! exit(n); // relocation to exit@plt return 0; } wcc-0.0.2/doc/presentations/demos_defcon24_2016/smbserver_exploit/0000755000175000017500000000000013110675433023424 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/smbserver_exploit/README0000644000175000017500000000103013110675433024276 0ustar philphilThis directory contains Proof of Concept code as demoed at Defcon 24. The goal is to verify that the reply_close() function from smbserver-1.5.32 is vulnerable to a symbolic link attack when calling : fopen("/tmp/jnk.close','w'); This is a privilege escalation in Samba from somewhere around 1994 ! The codebase can be found here ftp://ftp.samba.gr.jp/pub/samba/old-versions/smbserver-1.5.32.tar.gz The vulnerability can be found via symbolic execution, for instance using https://moabi.com as demoed at Defcon 24. endrazine- wcc-0.0.2/doc/presentations/demos_defcon24_2016/smbserver_exploit/poc.wsh0000644000175000017500000000042513110675433024731 0ustar philphil#!/usr/bin/wsh # running this Witcraft script should # invoke the reply_close() function # within smbserver and create a # file under /tmp/jnk.close # # # Invocation : ./poc.wsh /path/to/vulnerable/smbserver # # endrazine for Defcon 24. # reply_close("aaaaaaaa", "bbbbbbbb") wcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/0000755000175000017500000000000013110675433021562 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/Makefile0000644000175000017500000000166313110675433023230 0ustar philphilall:: #we get: #jonathan@blackbox:/tmp/bsd2linux$ ls fmt.c.O0_amd64 #fmt.c.O0_amd64 #jonathan@blackbox:/tmp/bsd2linux$ ./fmt.c.O0_amd64 #bash: ./fmt.c.O0_amd64: No such file or directory #jonathan@blackbox:/tmp/bsd2linux$ echo " [*] Fixing dynamic linker" sudo cp /lib64/ld-linux-x86-64.so.2 /usr/libexec/ld.so #we get: #./fmt.c.O0_amd64: error while loading shared libraries: libc.so.62.0: cannot open shared object file: No such file or directory echo " [*] Fixing libc" sed s#"libc.so.62.0"#"libc.so.6\x00.0"#gi ./fmt.c.O0_amd64 > out mv out ./fmt.c.O0_amd64 echo " [*] Changing permissions" chmod +x ./fmt.c.O0_amd64 #we get: #./fmt.c.O0_amd64: symbol lookup error: ./fmt.c.O0_amd64: undefined symbol: atexit echo " [*] Compiling missing symbols" cd missing && make echo " [*] Running with preloaded dependencies" LD_PRELOAD=./missing/missing.so ./fmt.c.O0_amd64 foo bar baz ; echo "" clean:: sudo rm /usr/libexec/ld.so wcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/README0000644000175000017500000000332613110675433022446 0ustar philphilThis directory demonstrates how to relink an OpenBSD binary in order to run it natively under Linux. This works because the binary doesn't call system calls directly (only the functions within the shared library it is making use of -eg: printf() - do themselves perform the system calls). This relinking process can be done either by patching the binary directly or by placing the dynamic linker and shared libraries where the binary is trying to find them (those are hardcoded in the interpreter section for the former and the names of the shared libraries and their versions are encoded in the .dynamic and the .gnu.version and .gnu.version_r sections respectively, the two later being gcc extensions). See Makefile and shell scripts for examples of both techniques. Finally, the binary is looking for a atexit() function that is not exposed in my linux libc. Since this function is called only when exit() is called to possibly call destructors(), we can safely ignore it ; we create an empty library call with this name, link it within a new shared library and pass it to the dynamic linker via LD_PRELOAD. This is good enough to run the binary natively. Note: An other way to achieve this would be to copy the original libraries (eg: chroot like), including the BSD dynamic linker, and perform the system call number translation using a ptrace() based tracer : ptrace(PTRACE_ATTACH, ...) ptrace(PTRACE_SYSCALL, ...) and then uppon each system call the BSD process is attempting to make: ptrace(PTRACE_GETREGS, ...); // get the registers in BSD process // ... translate system call number in Intel registers ptrace(PTRACE_SETREGS, ...); // set back the translated registers in BSD process ptrace(PTRACE_CONT, ...) endrazine- wcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/linuxify2.sh0000755000175000017500000000071313110675433024053 0ustar philphil#!/bin/bash echo " [*] Fixing dynamic linker" sudo cp /lib64/ld-linux-x86-64.so.2 /usr/libexec/ld.so echo " [*] Fixing libc" sudo cp /lib/x86_64-linux-gnu/libc.so.6 /lib/x86_64-linux-gnu/libc.so.62.0 echo " [*] Changing permissions" chmod +x ./fmt.c.O0_amd64 echo " [*] Compiling missing symbols" cd missing && make && cd - echo " [*] Running with preloaded dependencies" LD_PRELOAD=./missing/missing.so ./fmt.c.O0_amd64 foo bar baz ; echo "" wcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/linuxify.sh0000755000175000017500000000073213110675433023772 0ustar philphil#!/bin/bash echo " [*] Fixing dynamic linker" sudo cp /lib64/ld-linux-x86-64.so.2 /usr/libexec/ld.so echo " [*] Fixing libc" sed s#"libc.so.62.0"#"libc.so.6\x00.0"#gi ./fmt.c.O0_amd64 > out mv out ./fmt.c.O0_amd64 echo " [*] Changing permissions" chmod +x ./fmt.c.O0_amd64 echo " [*] Compiling missing symbols" cd missing && make && cd - echo " [*] Running with preloaded dependencies" LD_PRELOAD=./missing/missing.so ./fmt.c.O0_amd64 foo bar baz ; echo "" wcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/missing/0000755000175000017500000000000013110675433023233 5ustar philphilwcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/missing/Makefile0000644000175000017500000000012013110675433024664 0ustar philphilCC := gcc CFLAGS := -W all:: $(CC) $(CFLAGS) missing.c -o missing.so -shared wcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/missing/missing.c0000644000175000017500000000006313110675433025047 0ustar philphil int atexit(void (*function)(void)){ return 0; } wcc-0.0.2/doc/presentations/demos_defcon24_2016/bsd2linux/fmt.c0000644000175000017500000000034313110675433022514 0ustar philphil#include #include #include const char *foobar="static"; int main(int argc, char **argv){ char tata[]="static"; printf(foobar); printf("toto"); printf(argv[3]); printf(tata); return 0; } wcc-0.0.2/doc/wikidocs/0000755000175000017500000000000013122010155013306 5ustar philphilwcc-0.0.2/doc/wikidocs/_Sidebar.md0000644000175000017500000000016013122010155015335 0ustar philphil## Contribute The Witchcraft Compiler Collection is Licensed under the MIT License. Feel free to contribute :)wcc-0.0.2/doc/wikidocs/wldd.md0000644000175000017500000000415513122010155014567 0ustar philphil### wldd : print shared libraries compilation flags When compiling C code, it is often required to pass extra arguments to the compiler to signify which shared libraries should explicitely linked against the compile code. Figuring out those compilation parameters can be cumbersome. The wldd commands displays the shared libraries compilation flags given at compile time for any given ELF binary. #### wldd command line options jonathan@blackbox:~$ wldd Usage: /usr/bin/wldd Returns libraries to be passed to gcc to relink this application. jonathan@blackbox:~$ #### Example usage of wldd ##### On /bin/ls (ET_EXEC ELF executable) The following command displays shared libraries compilation flags as passed to gcc when compiling /bin/ls from GNU binutils: jonathan@blackbox:~$ wldd /bin/ls -lselinux -lacl -lc -lpcre -ldl -lattr jonathan@blackbox:~$ ##### On apache2 (ET_DYN ELF executable compiled as Position Independant Executable / full ASLR) The following command displays the compilation flags relative to shared libraries used when compiling /usr/sbin/apache2: jonathan@blackbox:~$ wldd /usr/sbin/apache2 -lpcre -laprutil-1 -lapr-1 -lpthread -lc -lcrypt -lexpat -luuid -ldl jonathan@blackbox:~$ ##### On the openssl shared library This command can also be ran on shared libraries. The following example displays the same compiler options for the openssl shared library: jonathan@blackbox:~$ wldd /usr/lib/x86_64-linux-gnu/libssl.so.0.9.8 -lcrypto -lc -ldl -lz jonathan@blackbox:~$ ### Security Caveat wldd invokes binutils' ldd which in turns loads the binary passed as an argument using its hardcoded dynamic linker. This does run code inside the analysed binary. As such, running wldd on potentially hostile code (eg: malware) is not safe. Note: We could get the name of the shared libraries linked with this binary from the content of its .dynamic section without having to rely on ldd nor run the binary. That would be very useful. It would also produce a non recursive answer (unlike wldd currenty), which would reflect more the actual linking of the binary. Feel free to implement it :)wcc-0.0.2/doc/wikidocs/Home.md0000644000175000017500000000037413122010155014524 0ustar philphil### The Witchcraft Compiler Collection User Manual Welcome to the Witchcraft Compiler Collection User Manual. Feel free to edit and contribute to this Manual. The latest version of this manual is available at: https://github.com/endrazine/wcc/wiki wcc-0.0.2/doc/wikidocs/wld.md0000644000175000017500000001273313122010155014424 0ustar philphil### wld : The Witchcraft Linker. wld takes an ELF executable as an input and modifies it to create a shared library. #### wld command line options jonathan@blackbox:~$ wld Witchcraft Compiler Collection (WCC) version:0.0.1 (23:11:13 Jul 21 2016) Usage: wld [options] file options: -libify Set Class to ET_DYN in input ELF file. jonathan@blackbox:~$ #### Example usage of wld The following example libifies the executable /bin/ls into a shared library named /tmp/ls.so. jonathan@blackbox:~$ cp /bin/ls /tmp/ls.so jonathan@blackbox:~$ wld -libify /tmp/ls.so jonathan@blackbox:~$ #### Limits of wld wld currently only works on ELF binaries. However wld can process ELF executables irrelevant of their architecture or operating system. wld could for instance process Intel, ARM or SPARC executables from Android, Linux, BSD or UNIX operating systems and transform them into "non relocatable shared libraries". Feel free to refer to the documentation under the /doc directory for more ample details. #### Do I even need wld ? If the ELF executable you whish to work with has been compiled with as Position Independant Executable (-pie -fpie compiler flags with gcc or clang), it already is a functional shared library and doesn't need to be libified. In particular, its ELF header is already set to ET_DYN. Here is an example executable that is of type ET_EXEC and can be libified. Mind the Type field set to EXEC: jonathan@blackbox:~$ file /bin/ls /bin/ls: ELF 64-bit LSB executable, x86-64, version 1 (SYSV), dynamically linked (uses shared libs), for GNU/Linux 2.6.24, BuildID[sha1]=8d0966ce81ec6609bbf4aa439c77138e2f48a471, stripped jonathan@blackbox:~$ readelf -h /bin/ls ELF Header: Magic: 7f 45 4c 46 02 01 01 00 00 00 00 00 00 00 00 00 Class: ELF64 Data: 2's complement, little endian Version: 1 (current) OS/ABI: UNIX - System V ABI Version: 0 Type: EXEC (Executable file) Machine: Advanced Micro Devices X86-64 Version: 0x1 Entry point address: 0x404890 Start of program headers: 64 (bytes into file) Start of section headers: 108288 (bytes into file) Flags: 0x0 Size of this header: 64 (bytes) Size of program headers: 56 (bytes) Number of program headers: 9 Size of section headers: 64 (bytes) Number of section headers: 28 Section header string table index: 27 jonathan@blackbox:~$ Here is an exemple binary compiled as Position Independant Executable and not requiring libification to be used as a shared library or loaded in wsh. Mind the Type field set to DYN: jonathan@blackbox:~$ file /usr/sbin/apache2 /usr/sbin/apache2: ELF 64-bit LSB shared object, x86-64, version 1 (SYSV), dynamically linked (uses shared libs), for GNU/Linux 2.6.24, BuildID[sha1]=02c74092325980f41ca3e1c2995daec1f3b30ea2, stripped jonathan@blackbox:~$ readelf -h /usr/sbin/apache2 ELF Header: Magic: 7f 45 4c 46 02 01 01 00 00 00 00 00 00 00 00 00 Class: ELF64 Data: 2's complement, little endian Version: 1 (current) OS/ABI: UNIX - System V ABI Version: 0 Type: DYN (Shared object file) Machine: Advanced Micro Devices X86-64 Version: 0x1 Entry point address: 0x37156 Start of program headers: 64 (bytes into file) Start of section headers: 635736 (bytes into file) Flags: 0x0 Size of this header: 64 (bytes) Size of program headers: 56 (bytes) Number of program headers: 9 Size of section headers: 64 (bytes) Number of section headers: 28 Section header string table index: 27 jonathan@blackbox:~$ Finally, here is what a libified shared library looks like. The Type field has been set to DYN by wld during the libification process: jonathan@blackbox:~$ file /tmp/ls.so /tmp/ls.so: ELF 64-bit LSB shared object, x86-64, version 1 (SYSV), dynamically linked, BuildID[sha1]=04fd28208b659339be2711ea5f6d3485b6117da6, not stripped jonathan@blackbox:~$ readelf -h /tmp/ls.so ELF Header: Magic: 7f 45 4c 46 02 01 01 00 00 00 00 00 00 00 00 00 Class: ELF64 Data: 2's complement, little endian Version: 1 (current) OS/ABI: UNIX - System V ABI Version: 0 Type: DYN (Shared object file) Machine: Advanced Micro Devices X86-64 Version: 0x1 Entry point address: 0x6200 Start of program headers: 64 (bytes into file) Start of section headers: 2261504 (bytes into file) Flags: 0x0 Size of this header: 64 (bytes) Size of program headers: 56 (bytes) Number of program headers: 6 Size of section headers: 64 (bytes) Number of section headers: 27 Section header string table index: 24 jonathan@blackbox:~$ wcc-0.0.2/doc/wikidocs/wsh.md0000644000175000017500000001244513122010155014437 0ustar philphil### wsh : The Witchcraft shell The witchcraft shell accepts ELF shared libraries, ELF ET_DYN executables and Witchcraft Shell Scripts written in Punk-C as an input. It loads all the executables in its own address space and make their API available for programming in its embedded interpreter. This provides for binaries functionalities similar to those provided via reflection on languages like Java. #### wsh command line options jonathan@blackbox:~$ wsh -h Usage: wsh [script] [options] [binary1] [binary2] ... [-x] [script_arg1] [script_arg2] ... Options: -x, --args Optional script argument separator. -v, --verbose -V, --version Script: If the first argument is an existing file which is not a known binary file format, it is assumed to be a lua script and gets executed. Binaries: Any binary file name before the -x tag gets loaded before running the script. The last binary loaded is the main binary analyzed. jonathan@blackbox:~$ #### Example usage of wsh The following command loads the /usr/sbin/apache2 executable within wsh, calls the ap_get_server_banner() function within apache to retreive its banner and displays it within the wsh intterpreter. jonathan@blackbox:~$ wsh /usr/sbin/apache2 > a = ap_get_server_banner() > print(a) Apache/2.4.7 > To get help at any time from the wsh interpreter, simply type help. To get help on a particular topic, type help("topic"). The following example illustrates how to display the main wsh help from the interpreter and how to get detailed help on the grep command by calling help("grep") from the wsh interpreter. > help [Shell commands] help, quit, exit, shell, exec, clear [Functions] + basic: help(), man() + memory display: hexdump(), hex_dump(), hex() + memory maps: shdrs(), phdrs(), map(), procmap(), bfmap() + symbols: symbols(), functions(), objects(), info(), search(), headers() + memory search: grep(), grepptr() + load libaries: loadbin(), libs(), entrypoints(), rescan() + code execution: libcall() + buffer manipulation: xalloc(), ralloc(), xfree(), balloc(), bset(), bget(), rdstr(), rdnum() + control flow: breakpoint(), bp() + system settings: enableaslr(), disableaslr() + settings: verbose(), hollywood() + advanced: ltrace() Try help("cmdname") for detailed usage on command cmdname. > help("grep") WSH HELP FOR FUNCTION grep NAME grep SYNOPSIS table match = grep(, [patternlen], [dumplen], [before]) DESCRIPTION Search in all ELF sections in memory. Match [patternlen] bytes, then display [dumplen] bytes, optionally including [before] bytes before the match. Results are displayed in enhanced decimal form RETURN VALUES Returns 1 lua table containing matching memory addresses. > #### Extending wsh with Witchcraft Shell Scripts The combination of a full lua interpreter in the same address space as the loaded executables and shared libraries in combination with the reflection like capabilities of wsh allow to call any function loaded in the address space from the wsh interpreter transparently. The resulting API, a powerfull combination of lua and C API is called Punk-C. Wsh is fully scriptable in Punk-C, and executes Punk-C on the fly via its dynamic interpreter. Scripts in Punk C can be invoked by specifying the full path to wsh in the magic bytes of a wsh shell. The following command displays the content of a Witchcraft shell script: jonathan@blackbox:/usr/share/wcc/scripts$ cat md5.wsh #!/usr/bin/wsh -- Computing a MD5 sum using cryptographic functions from foreign binaries (eg: sshd/OpenSSL) function str2md5(input) out = calloc(33, 1) ctx = calloc(1024, 1) MD5_Init(ctx) MD5_Update(ctx, input, strlen(input)) MD5_Final(out, ctx) free(ctx) return out end input = "Message needing hashing\n" hash = str2md5(input) hexdump(hash,16) exit(0) jonathan@blackbox:/usr/share/wcc/scripts$ To run this script using the API made available inside the address space of sshd, simply run: jonathan@blackbox:/usr/share/wcc/scripts$ ./md5.wsh /usr/sbin/sshd 0x43e8b280 d6 fc 46 91 b0 6f ab 75 4d 9c a7 58 6d 9c 7e 36 V|F.0o+uM.'Xm.~6 jonathan@blackbox:/usr/share/wcc/scripts$ #### Limits of wsh wsh can only load shared libraries and ET_DYN dynamically linked ELF executables directly. This means ET_EXEC executables may need to be libified using wld before use in wsh. Binaries in other file formats might need to be turned into ELF files using wcc. #### Analysing and Executing ARM/SPARC/MIPS binaries "natively" on Intel x86_64 cpus via JIT binary translation wsh can be cross compiled to ARM, SPARC, MIPS and other plateforms and used in association with the qemu's user space emulation mode to provide JIT binary translation on the fly and analyse shared libraries and binaries from other cpus without requiring emulation a full operating system in a virtual machine. On the the analyzed binaries are translated from one CPU to an other, and the analysed binaries, the wsh cross compiled analyser and the qemu binary translator share the address space of a single program. This significantly diminishes the complexity of analysing binaries accross different hardware by seemingly allowing to run ARM or SPARC binaries on a linux x86_64 machine natively and transparently. wcc-0.0.2/doc/wikidocs/wsh-Core-API.md0000644000175000017500000002105013122010155015724 0ustar philphil## Core API Overview ### basic functions help(), man() ### memory display functions hexdump(), hex_dump(), hex() ### memory maps functions shdrs(), phdrs(), map(), procmap(), bfmap() ### symbols functions symbols(), functions(), objects(), info(), search(), headers() ### memory search functions grep(), grepptr() ### load libaries functions loadbin(), libs(), entrypoints(), rescan() ### code execution functions libcall() ### buffer manipulation functions xalloc(), ralloc(), xfree(), balloc(), bset(), bget(), rdstr(), rdnum() ### control flow functions breakpoint(), bp() ### system settings functions enableaslr(), disableaslr() ### settings functions verbose(), hollywood() ### advanced functions ltrace() ## API speficitations ### function help() WSH HELP FOR FUNCTION help NAME help SYNOPSIS help([topic]) DESCRIPTION Display help on [topic]. If [topic] is ommitted, display general help. RETURN VALUES None ### function man() WSH HELP FOR FUNCTION man NAME man SYNOPSIS man([page]) DESCRIPTION Display system manual page for [page]. RETURN VALUES None ### function hexdump() WSH HELP FOR FUNCTION hexdump NAME hexdump SYNOPSIS hexdump(
, ) DESCRIPTION Display bytes from memory
in enhanced hexadecimal form. RETURN VALUES None ### function hex_dump() WSH HELP FOR FUNCTION hex_dump NAME hex SYNOPSIS hex() DESCRIPTION Display lua in enhanced hexadecimal form. RETURN VALUES None ### function hex() WSH HELP FOR FUNCTION hex NAME hex SYNOPSIS hex() DESCRIPTION Display lua in enhanced hexadecimal form. RETURN VALUES None ### function shdrs() WSH HELP FOR FUNCTION shdrs NAME shdrs SYNOPSIS shdrs() DESCRIPTION Display ELF section headers from all binaries loaded in address space. RETURN VALUES None ### function phdrs() WSH HELP FOR FUNCTION phdrs NAME phdrs SYNOPSIS phdrs() DESCRIPTION Display ELF program headers from all binaries loaded in address space. RETURN VALUES None ### function map() WSH HELP FOR FUNCTION map NAME map SYNOPSIS map() DESCRIPTION Display a table of all the memory ranges mapped in memory in the address space. RETURN VALUES None ### function procmap() WSH HELP FOR FUNCTION procmap NAME procmap SYNOPSIS procmap() DESCRIPTION Display a table of all the memory ranges mapped in memory in the address space as displayed in /proc//maps. RETURN VALUES None ### function bfmap() WSH HELP FOR FUNCTION bfmap NAME bfmap SYNOPSIS bfmap() DESCRIPTION Bruteforce valid mapped memory ranges in address space. RETURN VALUES None ### function symbols() WSH HELP FOR FUNCTION symbols NAME symbols SYNOPSIS symbols([sympattern], [libpattern], [mode]) DESCRIPTION Display all the symbols in memory matching [sympattern], from library [libpattern]. If [mode] is set to 1 or 2, do not wait user input between pagers. [mode] = 2 provides a shorter output. RETURN VALUES None ### function functions() WSH HELP FOR FUNCTION functions NAME functions SYNOPSIS table func = functions([sympattern], [libpattern], [mode]) DESCRIPTION Display all the functions in memory matching [sympattern], from library [libpattern]. If [mode] is set to 1 or 2, do not wait user input between pagers. [mode] = 2 provides a shorter output. RETURN VALUES Return 1 lua table _func_ whose keys are valid function names in address space, and values are pointers to them in memory. ### function objects() WSH HELP FOR FUNCTION objects NAME objects SYNOPSIS objects([pattern]) DESCRIPTION Display all the functions in memory matching [sympattern] RETURN VALUES None ### function info() WSH HELP FOR FUNCTION info NAME info SYNOPSIS info([address] | [name]) DESCRIPTION Display various informations about the [address] or [name] provided : if it is mapped, and if so from which library and in which section if available. RETURN VALUES None ### function search() WSH HELP FOR FUNCTION search NAME search SYNOPSIS search() DESCRIPTION Search all object names matching in address space. RETURN VALUES None ### function headers() WSH HELP FOR FUNCTION headers NAME headers SYNOPSIS headers() DESCRIPTION Display C headers suitable for linking against the API loaded in address space. RETURN VALUES None ### function grep() WSH HELP FOR FUNCTION grep NAME grep SYNOPSIS table match = grep(, [patternlen], [dumplen], [before]) DESCRIPTION Search in all ELF sections in memory. Match [patternlen] bytes, then display [dumplen] bytes, optionally including [before] bytes before the match. Results are displayed in enhanced decimal form RETURN VALUES Returns 1 lua table containing matching memory addresses. ### function grepptr() WSH HELP FOR FUNCTION grepptr NAME grep SYNOPSIS table match = grep(, [patternlen], [dumplen], [before]) DESCRIPTION Search in all ELF sections in memory. Match [patternlen] bytes, then display [dumplen] bytes, optionally including [before] bytes before the match. Results are displayed in enhanced decimal form RETURN VALUES Returns 1 lua table containing matching memory addresses. ### function loadbin() WSH HELP FOR FUNCTION loadbin NAME loadbin SYNOPSIS loadbin() DESCRIPTION Load binary to memory from . RETURN VALUES None ### function libs() WSH HELP FOR FUNCTION libs NAME libs SYNOPSIS table libraries = libs() DESCRIPTION Display all libraries loaded in address space. RETURN VALUES Returns 1 value: a lua table _libraries_ whose values contain valid binary names (executable/libraries) mapped in memory. ### function entrypoints() WSH HELP FOR FUNCTION entrypoints NAME entrypoints SYNOPSIS entrypoints() DESCRIPTION Display entry points for each binary loaded in address space. RETURN VALUES None ### function rescan() WSH HELP FOR FUNCTION rescan NAME rescan SYNOPSIS rescan() DESCRIPTION Re-perform address space scan. RETURN VALUES None ### function libcall() WSH HELP FOR FUNCTION libcall NAME libcall SYNOPSIS void *ret, table ctx = libcall(, [arg1], [arg2], ... arg[6]) DESCRIPTION Call binary with provided arguments. RETURN VALUES Returns 2 return values: _ret_ is the return value of the binary function (nill if none), _ctx_ a lua table representing the execution context of the library call. ### function xalloc() No help available for function xalloc() ### function ralloc() No help available for function ralloc() ### function xfree() No help available for function xfree() ### function balloc() No help available for function balloc() ### function bset() No help available for function bset() ### function bget() No help available for function bget() ### function rdstr() No help available for function rdstr() ### function rdnum() No help available for function rdnum() ### function breakpoint() WSH HELP FOR FUNCTION breakpoint NAME breakpoint SYNOPSIS breakpoint(
, [weight]) DESCRIPTION Set a breakpoint at memory
. Optionally add a to breakpoint score if hit. RETURN VALUES None ### function bp() WSH HELP FOR FUNCTION bp NAME bp SYNOPSIS bp(
, [weight]) DESCRIPTION Set a breakpoint at memory
. Optionally add a to breakpoint score if hit. Alias for breakpoint() function. RETURN VALUES None ### function enableaslr() WSH HELP FOR FUNCTION enableaslr NAME enableaslr SYNOPSIS enableaslr() DESCRIPTION Enable Address Space Layout Randomization (requires root privileges). RETURN VALUES None ### function disableaslr() WSH HELP FOR FUNCTION disableaslr NAME disableaslr SYNOPSIS disableaslr() DESCRIPTION Disable Address Space Layout Randomization (requires root privileges). RETURN VALUES None ### function verbose() WSH HELP FOR FUNCTION verbose NAME verbose SYNOPSIS verbose() DESCRIPTION Change verbosity setting to . RETURN VALUES None ### function hollywood() WSH HELP FOR FUNCTION hollywood NAME hollywood SYNOPSIS hollywood() DESCRIPTION Change hollywood (fun) display setting to , impacting color display (enable/disable). RETURN VALUES None wcc-0.0.2/doc/wikidocs/wcch.md0000644000175000017500000000715013122010155014557 0ustar philphil#### wcch command line options wcch takes a single mandatory argument : the path to an ELF executable or shared library. wcch wcch will generate minimal C header files suitable for compiling C code against the binary given as argument. #### Example usage of wcch The following command instructs wcch to generate C headers from the apache2 executable and redirects the output from the standard output to a file named /tmp/apache2.h ready for use as a header in a C application. jonathan@blackbox:~$ wcch /usr/sbin/apache2 >/tmp/apache2.h jonathan@blackbox:~$ Here is the actual content of the generated /tmp/apache2.h file, edited because of its large size: /** * * Automatically generated by the Whitchcraft Compiler Collection 0.0.1 * * 23:17:22 Jul 26 2016 * */ /** * Imported objects **/ extern void *_dlfcn_hook; extern void *daylight; extern void *_sys_nerr; extern void *getdate_err; extern void *__rcmd_errstr; extern void *optind; extern void *argp_program_version; extern void *__free_hook; extern void *__tzname; extern void *__progname; extern void *_environ; ... extern void *ap_hack_ap_build_cont_config; extern void *ap_hack_ap_find_etag_weak; extern void *ap_hack_ap_hook_get_post_read_request; extern void *ap_hack_apr_file_name_get; extern void *ap_hack_apr_sdbm_unlock; extern void *ap_hack_ap_is_rdirectory; extern void *ap_hack_ap_request_has_body; extern void *ap_hack_apr_pool_cleanup_run; extern void *ap_hack_ap_hook_get_type_checker; extern void *ap_hack_apr_global_mutex_pool_get; extern void *ap_hack_apr_file_data_set; extern void *ap_hack_ap_hook_get_child_status; extern void *ap_hack_ap_set_server_protocol; extern void *ap_hack_apr_hash_make_custom; extern void *ap_hack_ap_malloc; extern void *ap_hack_ap_pool_cleanup_set_null; extern void *ap_hack_apr_dbm_firstkey; extern void *ap_hack_apr_strmatch_precompile; ... /** * Imported functions **/ void *dlclose(); void *dlinfo(); void *dladdr1(); void *dlsym(); void *dladdr(); void *dlopen(); void *dlmopen(); void *dlerror(); void *dlvsym(); void *putwchar(); void *__strspn_c1(); void *__gethostname_chk(); void *__strspn_c2(); void *setrpcent(); void *__wcstod_l(); void *__strspn_c3(); void *epoll_create(); void *sched_get_priority_min(); void *__getdomainname_chk(); void *klogctl(); void *__tolower_l(); void *dprintf(); void *setuid(); ... void *ap_mpm_pod_killpg(); void *ap_register_hooks(); void *ap_remove_output_filter_byhandle(); void *ap_hook_create_request(); void *ap_expr_exec_ctx(); void *ap_send_http_options(); void *ap_mpm_set_max_requests(); void *ap_os_escape_path(); void *ap_file_walk(); void *ap_build_cont_config(); void *ap_start_lingering_close(); void *ap_hook_generate_log_id(); void *ap_varbuf_cfg_getline(); void *ap_hook_test_config(); void *ap_fcgi_header_to_array(); void *ap_http_chunk_filter(); void *ap_random_insecure_bytes(); void *ap_pcfg_open_custom(); void *ap_hook_get_auth_checker(); void *ap_expr_yyfree(); ... void *uuid_copy(); void *uuid_generate(); The functions prototypes and imported objects cover all of the API exported by executables and shared libraries including their recursive dependancies. All the programmable API in the address space. #Witchcraft #### How is this useful ? Both gcc and clang will happily use the above mention function prototypes when compiling C code making use of them instead of issuing errors due to missing function prototypes. This is a great feature : it means we can now call those functions from C without actually knowing their exact prototypes (such as arguments number and types).wcc-0.0.2/doc/wikidocs/wsh-commands.md0000644000175000017500000000672413122010155016241 0ustar philphil## The following commands are built into wsh ### help Simply typing help in the wsh interpreter displays the following help > help [Shell commands] help, quit, exit, shell, exec, clear [Functions] + basic: help(), man() + memory display: hexdump(), hex_dump(), hex() + memory maps: shdrs(), phdrs(), map(), procmap(), bfmap() + symbols: symbols(), functions(), objects(), info(), search(), headers() + memory search: grep(), grepptr() + load libaries: loadbin(), libs(), entrypoints(), rescan() + code execution: libcall() + buffer manipulation: xalloc(), ralloc(), xfree(), balloc(), bset(), bget(), rdstr(), rdnum() + control flow: breakpoint(), bp() + system settings: enableaslr(), disableaslr() + settings: verbose(), hollywood() + advanced: ltrace() Try help("cmdname") for detailed usage on command cmdname. > The advanced help for help follow: > help("help") WSH HELP FOR FUNCTION help NAME help SYNOPSIS help([topic]) DESCRIPTION Display help on [topic]. If [topic] is ommitted, display general help. RETURN VALUES None > ### quit The quit command terminates the main wsh process and exits the wsh interpreter. Here is the help page for quit > help("quit") WSH HELP FOR COMMAND quit NAME quit SYNOPSIS quit DESCRIPTION Exit wsh. RETURN VALUES Does not return : exit wsh > ### exit The exit command behaves much like the quit command. Here is the detailed help for the exit command: > help("exit") WSH HELP FOR COMMAND exit NAME exit SYNOPSIS exit DESCRIPTION Exit wsh. RETURN VALUES Does not return : exit wsh > #### Note on the exit command versus exit() function It is worth noticing that typing exit(0) in the terminal does something different entirely : this will result in calling the function exit(), typically from the C library, with the parameter 0. ### shell The shell command instanciates an instance of /bin/sh from the wsh interpreter. Terminating the /bin/sh session will allow returning in the parent wsh session. > help("shell") WSH HELP FOR COMMAND shell NAME shell SYNOPSIS shell [command] DESCRIPTION Run a /bin/sh shell. RETURN VALUES None. Returns uppon shell termination. > #### example usage of the shell command From the wsh interpreter, the following commands start a /bin/sh shell, run the /bin/id application from this shell, and finally calls exit, which terminates the /bin/sh session and returns into the wsh interpreter. > shell $ id uid=1001(jonathan) gid=1001(jonathan) groups=1001(jonathan) $ exit > ### exec The exec command allows running an external command from the wsh interpreter. Here is the detailed help page for the exec command : > help("exec") WSH HELP FOR COMMAND exec NAME exec SYNOPSIS exec DESCRIPTION Run via the system() library call. RETURN VALUES None. Returns uppon termination. > #### Example usage of the exec command The following command exemplifies calling the uname system utility with the "-a" argument: > exec uname -a Linux blackbox 3.13.0-68-generic #111-Ubuntu SMP Fri Nov 6 18:17:06 UTC 2015 x86_64 x86_64 x86_64 GNU/Linux > ### clear The clear command clears the terminal. Its detailed help follows: > help("clear") WSH HELP FOR COMMAND clear NAME clear SYNOPSIS clear DESCRIPTION Clear terminal. RETURN VALUES None. > wcc-0.0.2/doc/wikidocs/.git0000644000175000017500000000005013122010155014065 0ustar philphilgitdir: ../../.git/modules/doc/wikidocs wcc-0.0.2/doc/wikidocs/_Footer.md0000644000175000017500000000005713122010155015227 0ustar philphilThe Witchcraft Compiler Collection User Manual.wcc-0.0.2/doc/wikidocs/GettingStarted.md0000644000175000017500000000247313122010155016566 0ustar philphil This page documents how to download, compile and install WCC. ## Downloading the source code The official codebase of the Witchcraft Compiler Collection is hosted on github at https://github.com/endrazine/wcc/ . It uses git modules, so some extra steps are needed to fetch all the code including depedencies. To download the source code of wcc, in a terminal, type: git clone https://github.com/endrazine/wcc.git cd wcc git submodule init git submodule update This will create a directory named wcc and fetch all required source code in it. ## Prerequisites ### Installing requirements The Witchcraft Compiler Collection requires the following software to be installed: Glibc, libbfd, libdl, zlib, libelf, libreadline, libgsl. ### Installing requirements on Ubuntu/Debian Under ubuntu/debian those dependancies can be installed with the following command: sudo apt-get install clang libbfd-dev uthash-dev libelf-dev libcapstone-dev libreadline6 libreadline6-dev libiberty-dev libgsl-dev ## Building and Installing: #### Building WCC From your root wcc directory, type: make #### Installing WCC Then to install wcc, type: sudo make install #### Building the WCC documentation WCC makes use of doxygen to generate its documentation. From the root wcc directory, type make documentation wcc-0.0.2/doc/wikidocs/Other-resources.md0000644000175000017500000000115413122010155016722 0ustar philphil## Presentations The slides of the presentation given at the DEF CON 24 Conference in August 2016 are available at: https://github.com/endrazine/wcc/raw/master/doc/presentations/Jonathan_Brossard_Witchract_Compiler_Collection_Defcon24_2016.pdf ## More demos The source code of the all demos of the presentation given at DEF CON can be found here : https://github.com/endrazine/wcc/tree/master/doc/presentations/demos_defcon24_2016 ## Developper Manual The Doxygen documentation of the Witchcraft Compiler Collection is available at: https://github.com/endrazine/wcc/raw/master/doc/WCC_internal_documentation.pdf wcc-0.0.2/doc/wikidocs/wsh-the-Punk-C-language.md0000644000175000017500000001505713122010155020073 0ustar philphil## Disclaimer If you are an academic C teacher, your feelings may be hurt by what you are going to read in this page and what we are doing to your very dear and beautiful language for the purpose of binary wizardry. #Enjoy ## What is Punk-C ? Punk-C is the language wsh implements by extending a core lua interpreter with the API "reflected" from all the executables and shared libraries loaded in its address space. ## How is Punk C different from C ? Punk C is not compiled but interpreted. Punk C has no types declarations, does not enforce functions prototypes (wtf?) nor any of the notorious C nightmares. Think C without the problems. The control statements such as loop iterrators are inherited from lua and do not ressemble those of C. Note/TODO: Can we hack this last statement by modifying the lua grammars ? :) ### What is lua ? Lua is an amazing open source programming language and implementation. Its interpreter is very tiny yet very powerful. For more information on the Lua language, feel free to visit : https://www.lua.org/ ### How does binary "reflection" work ? We use quotes around the word "reflected" because strictly speaking there is no Virtual Machine. wsh and the loaded programs share the same address space. The functionality is made possible by parsing the struct link_map returned by dlopen() when loading a binary. It alows in particular dumping all the symbols known by the dynamic linker and their respective addresses in the address space. This allows providing reflection like functionalities on raw binaries. From a user perspective, this mechanism is transparent. We can call all of the C API present in memory directly from lua. In particular pass arguments to a C function and retrieve its return value. ### Punk-C by example The following commands examplify how to start wsh by loading the OpenSSH in memory from the path /usr/sbin/sshd. Wsh is then instructed to call the getpid() and getenv() functions and print their results. Those two functions do not exist in the Lua API : they are really made available directly from the libc by wsh's reflection mechanism. jonathan@blackbox:~$ wsh /usr/sbin/sshd > a = getpid() > print(a) 22453 > b = getenv("PWD") > print(b) /home/jonathan > exit(3) jonathan@blackbox:~$ echo $? 3 jonathan@blackbox:~$ It is worth noticing that the exit() function was too called here via reflection from the C library loaded as an OpenSSH server depedency, and its parameter returned to the parent shell as expected. ### Example witchcraft shell scripts If you installed the Witchrcaft Compiler Collection on your computer, the directory /usr/share/wcc/scripts should contain example scripts. Let's take a look at the following script: jonathan@blackbox:/usr/share/wcc/scripts$ cat read.wsh #!/usr/bin/wsh fname="/etc/passwd" printf("\n ** Reading file %s\n", fname) mem = malloc(1024) nread = read(open(fname), mem, 100) -- Composition works printf(" ** Displaying content (%u bytes) of file %s:\x0a\x0a%s\n", nread, fname, mem) free(mem) c = close(fd) exit(0); jonathan@blackbox:/usr/share/wcc/scripts$ Conventionally, wsh scripts names end with the ".wsh" extension. This script attempts to open the /etc/password file and read 100 bytes of its content into a buffer of 1024 bytes pre allocated in the heap. This content is then displayed, the allocated heap memory freed and the opened file descriptor closed, before exiting with return value 0 (success, no errors). The first line of the script instructs the linux kernel where to find the interpreter to execute it. We set this line to the full path of wsh. A few things are worth noticing : the open function is only given one parameter when the POSIX standard specifies 2 or 3 : Posix prototypes for function open(): int open(const char *pathname, int flags); int open(const char *pathname, int flags, mode_t mode); This is made possible by the fact that wsh doesn't need to know the exact type of a function to craft arguments to call it and invoke it. Non provided arguments are implicitely casted to the value 0. It is also worth noticing that arguments have no explicit types. This is made possible by the Lua typing mechanism. Comments start with the "--" marker, and end with the line return as in lua. #### Running a Witchraft shell script as a wsh argument Let us now call this script with wsh, using sshd (and its dependancies) as the API provided for all the functions we will use: jonathan@blackbox:/usr/share/wcc/scripts$ wsh ./read.wsh /usr/sbin/sshd ** Reading file /etc/passwd ** Displaying content (100 bytes) of file /etc/passwd: root:x:0:0:root:/root:/bin/bash daemon:x:1:1:daemon:/usr/sbin:/usr/sbin/nologin bin:x:2:2:bin:/bin:/ jonathan@blackbox:/usr/share/wcc/scripts$ We just invoked C functions from wsh dynamically, without compilation, and without knowing their prototypes ! #Witchcraft #### Running a Witchcraft shell script as a standalone program Let us start by making the read.wsh script executable: jonathan@blackbox:/usr/share/wcc/scripts$ sudo chmod +x read.wsh jonathan@blackbox:/usr/share/wcc/scripts$ We can now execute this script on any ELF executable or shared library by passing it as an argument to the script: jonathan@blackbox:/usr/share/wcc/scripts$ ./read.wsh /usr/sbin/sshd ** Reading file /etc/passwd ** Displaying content (100 bytes) of file /etc/passwd: root:x:0:0:root:/root:/bin/bash daemon:x:1:1:daemon:/usr/sbin:/usr/sbin/nologin bin:x:2:2:bin:/bin:/ jonathan@blackbox:/usr/share/wcc/scripts$ ### Registering a custom binfmt for .wsh scripts Linux allows to define a binfmt so that the interpreter path can be ommited in wsh scripts. Any file named with the ".wsh" extension and executed will then be executed via the wsh interpreter automatically. This is achieve via the following command: sudo update-binfmts --package wsh --install wsh /usr/bin/wsh --extension wsh You can verify if this command worked by viewing the corresponding entry under /proc : jonathan@blackbox:~$ cat /proc/sys/fs/binfmt_misc/wsh enabled interpreter /usr/bin/wsh flags: extension .wsh jonathan@blackbox:~$ We can now run .wsh scripts directly within wsh without specifying an interpreter : jonathan@blackbox:~$ echo 'printf("Hello %s !\n", "World"); exit(3);' >/tmp/hello.wsh jonathan@blackbox:~$ jonathan@blackbox:~$ chmod +x /tmp/hello.wsh jonathan@blackbox:~$ jonathan@blackbox:~$ cat /tmp/hello.wsh printf("Hello %s !\n", "World"); exit(3); jonathan@blackbox:~$ jonathan@blackbox:~$ /tmp/hello.wsh /usr/sbin/apache2 Hello World ! jonathan@blackbox:~$ echo $? 3 jonathan@blackbox:~$ wcc-0.0.2/doc/wikidocs/wcc.md0000644000175000017500000003050413122010155014406 0ustar philphil### wcc : The Witchcraft Core Compiler The wcc compiler takes binaries (ELF, PE, ...) as an input and creates valid ELF binaries as an output. It can be used to create relocatable object files from executables or shared libraries. #### wcc command line options jonathan@blackbox:~$ wcc Witchcraft Compiler Collection (WCC) version:0.0.1 (01:47:53 Jul 29 2016) Usage: wcc [options] file options: -o, --output -m, --march -e, --entrypoint <0xaddress> -i, --interpreter -p, --poison -s, --shared -c, --compile -S, --static -x, --strip -X, --sstrip -E, --exec -C, --core -O, --original -D, --disasm -d, --debug -h, --help -v, --verbose -V, --version jonathan@blackbox:~$ ###### Options description -o, --output Speficy the desired output file name. Default: a.out -m, --march Specify the desired output architecture. This option is ignored. Run the 64bit or the 32bit versions of wcc to produce 64 bits or 32 bits binaries respectively. -e, --entrypoint <0xaddress> Specify the address of the entry point as found in the ELF header manually. -i, --interpreter Specify a new program interpreter to be written to the interpreter segment of the output program. -p, --poison Specify a poison byte to be written in the unused bytes of the output file. -s, --shared Produce a shared library. -c, --compile Produce relocatable object files. -S, --static Produce a static binary. -x, --strip Do not use the Dynamic symbol table to unstrip the binary. Default: off. -X, --sstrip Strip more. -E, --exec Set binary type to ET_EXEC in the ELF header. -C, --core Set binary type to a Core file in the ELF header. -O, --original Copy original section headers from input file (which must be an ELF) instead of guessing them from bfd sections. Default: off. -D, --disasm Display application disassembly. -d, --debug Enable debug mode (very verbose). -h, --help Display help. -v, --verbose Be verbose. -V, --version Display version number. #### Example usage of wcc The primary use of wcc is to "unlink" (undo the work of a linker) ELF binaries, either executables or shared libraries, back into relocatable shared objects. The following command line attempts to unlink the binary /bin/ls (from GNU binutils) into a relocatable file named /tmp/ls.o jonathan@blackbox:~$ wcc -c /bin/ls -o /tmp/ls.o jonathan@blackbox:~$ This relocatable file can then be used as if it had been directly produced by a compiler. The following command would use the gcc compiler to link /tmp/ls.o into a shared library /tmp/ls.so jonathan@blackbox:~$ gcc /tmp/ls.o -o /tmp/ls.so -shared jonathan@blackbox:~$ #### Limits of wcc wcc will process any file supported by libbfd and produce ELF files that will contain the same mapping when relinked and executed. This includes PE or OSX COFF files in 32 or 64 bits. However, rebuilding relocations is currently supported only for Intel ELF x86_64 binaries. Transforming a PE into an ELF and invoking pure functions is for instance supported. #### How does it work ? wcc uses libbfd to parse the sections of the input binary, and generates an ELF file with the corresponding Sections and Segments. wcc also handles symbols and symbol tables and attempts to unstrip stripped binaries by parsing their dynamic symbol tables. Relocations are recreated as needed for ELF Intel x86_64 input files. Help on extending to other cpus and relocation types very welcome :) #### What does the resulting /tmp/ls.o look like in details ? In order to observe more closely the output of wcc, let's take a look at /tmp/ls.o as parsed by readelf (GNU binutils package) editted for brevity: jonathan@blackbox:~$ readelf -a /tmp/ls.o ELF Header: Magic: 7f 45 4c 46 02 01 01 00 00 00 00 00 00 00 00 00 Class: ELF64 Data: 2's complement, little endian Version: 1 (current) OS/ABI: UNIX - System V ABI Version: 0 Type: REL (Relocatable file) Machine: Advanced Micro Devices X86-64 Version: 0x1 Entry point address: 0x0 Start of program headers: 0 (bytes into file) Start of section headers: 2348624 (bytes into file) Flags: 0x0 Size of this header: 64 (bytes) Size of program headers: 0 (bytes) Number of program headers: 0 Size of section headers: 64 (bytes) Number of section headers: 9 Section header string table index: 8 Section Headers: [Nr] Name Type Address Offset Size EntSize Flags Link Info Align [ 0] NULL 0000000000000000 00000000 0000000000000000 0000000000000000 0 0 0 [ 1] .text PROGBITS 0000000000000000 0001ae00 00000000002191ec 0000000000000000 WAX 0 0 16 [ 2] .rodata PROGBITS 0000000000000000 00011f20 00000000000050fc 0000000000000000 A 0 0 32 [ 3] .data PROGBITS 0000000000000000 0001a3a0 0000000000000254 0000000000000000 WA 0 0 32 [ 4] .bss NOBITS 0000000000000000 0001a5f4 0000000000000d60 0000000000000000 WA 0 0 32 [ 5] .rela.all RELA 0000000000000000 00233fe0 0000000000007158 0000000000000018 A 7 1 8 [ 6] .strtab STRTAB 0000000000000000 0023b138 0000000000000dee 0000000000000000 0 0 1 [ 7] .symtab SYMTAB 0000000000000000 0023bf26 00000000000016f8 0000000000000018 6 5 8 [ 8] .shstrtab STRTAB 0000000000000000 0023d890 000000000000003e 0000000000000000 0 0 1 Key to Flags: W (write), A (alloc), X (execute), M (merge), S (strings), l (large) I (info), L (link order), G (group), T (TLS), E (exclude), x (unknown) O (extra OS processing required) o (OS specific), p (processor specific) There are no section groups in this file. There are no program headers in this file. Relocation section '.rela.all' at offset 0x233fe0 contains 1209 entries: Offset Info Type Sym. Value Sym. Name + Addend 000000217eb0 000600000001 R_X86_64_64 0000000000000000 __ctype_toupper_loc + 0 000000217eb8 000700000001 R_X86_64_64 0000000000000000 __uflow + 0 000000217ec0 000800000001 R_X86_64_64 0000000000000000 getenv + 0 000000217ec8 000900000001 R_X86_64_64 0000000000000000 sigprocmask + 0 000000217ed0 000a00000001 R_X86_64_64 0000000000000000 raise + 0 000000217ed8 007b00000001 R_X86_64_64 00000000004021f0 free + 0 000000217ee0 000b00000001 R_X86_64_64 0000000000000000 localtime + 0 000000217ee8 000c00000001 R_X86_64_64 0000000000000000 __mempcpy_chk + 0 000000217ef0 000d00000001 R_X86_64_64 0000000000000000 abort + 0 000000217ef8 000e00000001 R_X86_64_64 0000000000000000 __errno_location + 0 000000217f00 000f00000001 R_X86_64_64 0000000000000000 strncmp + 0 ... 00000000091f 000400000002 R_X86_64_PC32 0000000000000000 .bss + abd 000000000971 000400000002 R_X86_64_PC32 0000000000000000 .bss + ac1 000000000976 00020000000a R_X86_64_32 0000000000000000 .rodata + 1924 000000000988 000400000002 R_X86_64_PC32 0000000000000000 .bss + acd 0000000009b6 000400000002 R_X86_64_PC32 0000000000000000 .bss + ad1 0000000009ce 00020000000a R_X86_64_32 0000000000000000 .rodata + 1160 0000000009d3 00020000000a R_X86_64_32 0000000000000000 .rodata + 3ca8 000000000a0b 000400000002 R_X86_64_PC32 0000000000000000 .bss + b3e 000000000a12 000400000002 R_X86_64_PC32 0000000000000000 .bss + b46 000000000a26 000400000002 R_X86_64_PC32 0000000000000000 .bss + b0d 000000000a2f 000400000002 R_X86_64_PC32 0000000000000000 .bss + b36 000000000a39 000400000002 R_X86_64_PC32 0000000000000000 .bss + b2a ... 000000000b25 008500000002 R_X86_64_PC32 0000000000000000 optarg - 4 000000000b45 000400000002 R_X86_64_PC32 0000000000000000 .bss + ad1 000000000b50 000400000002 R_X86_64_PC32 0000000000000000 .bss + b3e 00000000240f 008200000002 R_X86_64_PC32 0000000000000000 stderr - 4 ... The decoding of unwind sections for machine type Advanced Micro Devices X86-64 is not currently supported. Symbol table '.symtab' contains 245 entries: Num: Value Size Type Bind Vis Ndx Name 0: 0000000000000000 0 NOTYPE LOCAL DEFAULT UND 1: 0000000000000000 0 SECTION LOCAL DEFAULT 1 .text 2: 0000000000000000 0 SECTION LOCAL DEFAULT 2 .rodata 3: 0000000000000000 0 SECTION LOCAL DEFAULT 3 .data 4: 0000000000000000 0 SECTION LOCAL DEFAULT 4 .bss 5: 0000000000000000 0 SECTION LOCAL DEFAULT 5 .unknown 6: 0000000000000000 0 FUNC GLOBAL DEFAULT UND __ctype_toupper_loc 7: 0000000000000000 0 FUNC GLOBAL DEFAULT UND __uflow 8: 0000000000000000 0 FUNC GLOBAL DEFAULT UND getenv 9: 0000000000000000 0 FUNC GLOBAL DEFAULT UND sigprocmask 10: 0000000000000000 0 FUNC GLOBAL DEFAULT UND raise 11: 0000000000000000 0 FUNC GLOBAL DEFAULT UND localtime 12: 0000000000000000 0 FUNC GLOBAL DEFAULT UND __mempcpy_chk ... 132: 0000000000411efc 0 NOTYPE WEAK DEFAULT UND old__fini 133: 0000000000000000 8 OBJECT GLOBAL DEFAULT UND optarg 134: 0000000000000000 100 FUNC GLOBAL DEFAULT 1 old_plt 135: 0000000000000738 100 FUNC GLOBAL DEFAULT 1 old_text 136: 00000000000104d5 100 FUNC GLOBAL DEFAULT 1 old_text_end 137: 000000000000b538 100 FUNC GLOBAL DEFAULT 1 internal_0040d6a0 138: 000000000000fd78 100 FUNC GLOBAL DEFAULT 1 internal_00411ee0 139: 000000000000c4d8 100 FUNC GLOBAL DEFAULT 1 internal_0040e640 140: 0000000000007ce8 100 FUNC GLOBAL DEFAULT 1 internal_00409e50 141: 000000000000ed28 100 FUNC GLOBAL DEFAULT 1 internal_00410e90 142: 000000000000ead8 100 FUNC GLOBAL DEFAULT 1 internal_00410c40 143: 00000000000075e8 100 FUNC GLOBAL DEFAULT 1 internal_00409750 144: 000000000000e9c8 100 FUNC GLOBAL DEFAULT 1 internal_00410b30 145: 0000000000007fb8 100 FUNC GLOBAL DEFAULT 1 internal_0040a120 146: 000000000000a6a8 100 FUNC GLOBAL DEFAULT 1 internal_0040c810 147: 000000000000c7c8 100 FUNC GLOBAL DEFAULT 1 internal_0040e930 148: 000000000000c498 100 FUNC GLOBAL DEFAULT 1 internal_0040e600 149: 000000000000c4c8 100 FUNC GLOBAL DEFAULT 1 internal_0040e630 150: 000000000000c4e8 100 FUNC GLOBAL DEFAULT 1 internal_0040e650 151: 0000000000002c68 100 FUNC GLOBAL DEFAULT 1 internal_00404dd0 ... 241: 000000000000e958 100 FUNC GLOBAL DEFAULT 1 internal_00410ac0 242: 000000000000fbc8 100 FUNC GLOBAL DEFAULT 1 internal_00411d30 243: 000000000000fc48 100 FUNC GLOBAL DEFAULT 1 internal_00411db0 244: 000000000000fc88 100 FUNC GLOBAL DEFAULT 1 internal_00411df0 No version information found in this file. jonathan@blackbox:~$ It is worth in particular noticing that wcc rebuilt different types of relocations under the new .rela.all section. It also stripped the sections non essential to a relocatable object file from the input binary, and rebuilt a symbol table. On this last topic, it is also worth noticing that wcc created new symbols named internal_00XXXXXX where 0xXXXXXX is the address of a static function within the binary, not normally exported. Finally, wcc also makes used of additional symbol tables to find the address of additional functions if any are available (parsing both symbol tables and dynamic symbol tables). wcc-0.0.2/doc/manpages/0000755000175000017500000000000013110675433013302 5ustar philphilwcc-0.0.2/doc/manpages/wld.10000644000175000017500000000214513110675433014154 0ustar philphil.TH WLD "1" "April 2017" "Witchcraft Compiler Collection" "User Commands" .SH NAME wld \- transform executables into shared libaries .SH SYNOPSIS .B wld [\fIoptions\fR] \fIfile\fR .SH DESCRIPTION The Witchcraft Linker is part of the Witchcraft Compiler Collection. .PP Options: .TP \fB\-libify\fR .TP Libifies input ELF executable into a shared library. .SH EXAMPLES .TP cp /bin/cat /tmp && wld -libify /tmp/cat Copy the executable /bin/cat to /tmp and transform it into a shared library. .SH NOTES wld alters the file passed as argument. .br The Witcraft Compiler Collection is a set of reverse engineering tools. .SH AUTHOR Written by endrazine (Jonathan Brossard) .SH "REPORTING BUGS" Witchcraft Compiler Collection online bug tracker: .SH COPYRIGHT Copyright Jonathan Brossard .br License : MIT and BSD Licenses. See . .br .SH "SEE ALSO" \fBwsh\fP(1), \fBwcc\fP(1), \fBwldd\fP(1), \fBwcch\fP(1) .PP The full documentation of the .B Witchcraft Compiler Collection is available online at https://github.com/endrazine/wcc/wiki wcc-0.0.2/doc/manpages/wcch.10000644000175000017500000000171713110675433014316 0ustar philphil.TH WCCH "1" "April 2017" "Witchcraft Compiler Collection" "User Commands" .SH NAME wcch \- generate C headers from executable files .SH SYNOPSIS .B wcch \fIfile\fR .SH DESCRIPTION wcch is part of the Witchcraft Compiler Collection. .TP Generate C header from the binary file passed as argument. .SH EXAMPLES .TP wcch /bin/ls Create a C header file from the binary executable /bin/ls .SH NOTES The Witcraft Compiler Collection is a set of reverse engineering tools. .SH AUTHOR Written by endrazine (Jonathan Brossard) .SH "REPORTING BUGS" Witchcraft Compiler Collection online bug tracker: .SH COPYRIGHT Copyright Jonathan Brossard .br License : MIT and BSD Licenses. See . .br .SH "SEE ALSO" \fBwsh\fP(1), \fBwcc\fP(1), \fBwld\fP(1), \fBwldd\fP(1) .PP The full documentation of the .B Witchcraft Compiler Collection is available online at https://github.com/endrazine/wcc/wiki wcc-0.0.2/doc/manpages/wcc.10000644000175000017500000000366713110675433014154 0ustar philphil.TH WCC "1" "April 2017" "Witchcraft Compiler Collection" "User Commands" .SH NAME wcc \- recompile binary files .SH SYNOPSIS .B wcc [\fIoptions\fR] \fIfile\fR .SH DESCRIPTION .PP The Witchcraft Core Compiler is part of the Witchcraft Compiler Collection. .PP The wcc compiler takes binaries (ELF, PE, ...) as an input and creates valid ELF binaries as an output. It can be used to create relocatable object files from executables or shared libraries. .PP Options: .TP \fB\-o\fR, \fB\-\-output\fR .TP \fB\-m\fR, \fB\-\-march\fR .TP \fB\-e\fR, \fB\-\-entrypoint\fR <0xaddress> .TP \fB\-i\fR, \fB\-\-interpreter\fR .TP \fB\-p\fR, \fB\-\-poison\fR .HP \fB\-s\fR, \fB\-\-shared\fR .HP \fB\-c\fR, \fB\-\-compile\fR .HP \fB\-S\fR, \fB\-\-static\fR .HP \fB\-x\fR, \fB\-\-strip\fR .HP \fB\-X\fR, \fB\-\-sstrip\fR .HP \fB\-E\fR, \fB\-\-exec\fR .HP \fB\-C\fR, \fB\-\-core\fR .HP \fB\-O\fR, \fB\-\-original\fR .HP \fB\-D\fR, \fB\-\-disasm\fR .HP \fB\-d\fR, \fB\-\-debug\fR .HP \fB\-h\fR, \fB\-\-help\fR .HP \fB\-v\fR, \fB\-\-verbose\fR .HP \fB\-V\fR, \fB\-\-version\fR .SH EXAMPLES .TP wcc \-c /bin/ls \-o /tmp/ls.o Unlink the binary /bin/ls into a relocatable object named /tmp/ls.o .TP gcc /tmp/ls.o \-o /tmp/ls.so \-shared Use the gcc compiler to link the previously generated /tmp/ls.o relocatable object into a shared library /tmp/ls.so .SH NOTES The Witcraft Compiler Collection is a set of reverse engineering tools. .SH AUTHOR Written by endrazine (Jonathan Brossard) .SH "REPORTING BUGS" Witchcraft Compiler Collection online bug tracker: .SH COPYRIGHT Copyright Jonathan Brossard .br License : MIT and BSD Licenses. See . .br .SH "SEE ALSO" \fBwsh\fP(1), \fBwld\fP(1), \fBwldd\fP(1), \fBwcch\fP(1) .PP The full documentation of the .B Witchcraft Compiler Collection is available online at https://github.com/endrazine/wcc/wiki wcc-0.0.2/doc/manpages/wsh.10000644000175000017500000000404613110675433014171 0ustar philphil.TH WSH "1" "April 2017" "Witchcraft Compiler Collection" "User Commands" .SH NAME wsh \- The witchcraft shell .SH SYNOPSIS .B wsh [\fIscript\fR] [-h|-q|-v|-V] [\fIbinary1\fR] [\fIbinary2\fR] ... [-x [\fIscript_arg1\fR] [\fIscript_arg2\fR] ...] .SH DESCRIPTION .PP The Witchcraft Shell is part of the Witchcraft Compiler Collection. .PP The witchcraft shell accepts shared libraries, executables and Witchcraft Shell Scripts written in Punk-C as an input. It loads all the executables in its own address space and make their API available for programming in its embedded interpreter. This provides for binaries functionalities similar to those provided via reflection on interpreted languages like Java. .PP Options: -x, --args Optional script argument separator -q, --quiet Display less output -v, --verbose Display more output -V, --version Display version and build, then exit Script: If the first argument is an existing file which is not a known binary file format, it is assumed to be a lua script and gets executed. Binaries: Any binary file name before the -x tag gets loaded before running the script. The last binary loaded is the main binary analyzed. .SH NOTES The Witchcraft shell calls dlopen() on the shared libraries and executables it loads in its address space. In doing so, it may execute constructor functions from those executables. This may be unsafe if the intent is to analyse hostile code such as malware or binary exploits. .br The Witcraft Compiler Collection is a set of reverse engineering tools. .SH AUTHOR Written by endrazine (Jonathan Brossard) .SH "REPORTING BUGS" Witchcraft Compiler Collection online bug tracker: .SH COPYRIGHT Copyright Jonathan Brossard .br License : MIT and BSD Licenses. See . .br .SH "SEE ALSO" \fBwcc\fP(1), \fBwld\fP(1), \fBwldd\fP(1), \fBwcch\fP(1) .PP The full documentation of the .B Witchcraft Compiler Collection is available online at https://github.com/endrazine/wcc/wiki wcc-0.0.2/doc/manpages/wldd.10000644000175000017500000000200213110675433014310 0ustar philphil.TH WLDD "1" "April 2017" "Witchcraft Compiler Collection" "User Commands" .SH NAME wldd \- display compilation flags .SH SYNOPSIS .B wldd \fIfile\fR .SH DESCRIPTION wldd is part of the Witchcraft Compiler Collection. .TP Displays the linking flags that were passed to the compiler when producing the binary file passed as argument. .SH EXAMPLES .TP wldd /bin/ls Display the linking flags passed to the compiler when producing /bin/ls .SH NOTES The Witcraft Compiler Collection is a set of reverse engineering tools. .SH AUTHOR Written by endrazine (Jonathan Brossard) .SH "REPORTING BUGS" Witchcraft Compiler Collection online bug tracker: .SH COPYRIGHT Copyright Jonathan Brossard .br License : MIT and BSD Licenses. See . .br .SH "SEE ALSO" \fBwsh\fP(1), \fBwcc\fP(1), \fBwld\fP(1), \fBwcch\fP(1) .PP The full documentation of the .B Witchcraft Compiler Collection is available online at https://github.com/endrazine/wcc/wiki